/-
Copyright (c) 2020 Ruben Van de Velde. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import data.int.parity
import ring_theory.int.basic

section
variables {R : Type*} [comm_ring R] {x y z : R}
lemma coprime_add_self_pow
  {n : ℕ}
  (hn : 0 < n)
  (hsoln : x ^ n + y ^ n = z ^ n)
  (hxx : is_coprime x y)
   : is_coprime x z :=
begin
  have := is_coprime.mul_add_left_right hxx.pow 1,
  rwa [mul_one, hsoln, is_coprime.pow_iff hn hn] at this,
end
end

-- Edwards p49 introduction
lemma int.factor_div (a x : ℤ) (hodd : odd x) :
  ∃ (m c : ℤ), c + m * x = a ∧ 2 * c.nat_abs < x.nat_abs :=
begin
  have h0' : x ≠ 0,
  { rintro rfl,
    simpa only [even_zero, not_true, int.odd_iff_not_even] using hodd },
  set c := a % x with hc,
  by_cases H : 2 * c.nat_abs < x.nat_abs,
  { exact ⟨a / x, c, int.mod_add_div' a x, H⟩ },
  { push_neg at H,
    refine ⟨(a + abs x) / x, c - abs x, _, _⟩,
    { have := self_dvd_abs x,
      rw [int.add_div_of_dvd_right this, add_mul, int.div_mul_cancel this, sub_add_add_cancel, hc,
        int.mod_add_div'] },
    { rw [← int.coe_nat_lt_coe_nat_iff],
      replace H := int.coe_nat_le_coe_nat_of_le H,
      rw [int.coe_nat_mul, int.coe_nat_bit0, algebra_map.coe_one] at H ⊢,
      have hcnonneg := int.mod_nonneg a h0',
      have := int.mod_lt a h0',
      rw [int.nat_abs_of_nonneg hcnonneg] at H,
      rw [←int.nat_abs_neg, neg_sub, int.nat_abs_of_nonneg (sub_nonneg_of_le this.le),
        mul_sub, sub_lt_iff_lt_add, two_mul, int.abs_eq_nat_abs, add_lt_add_iff_left],
      apply lt_of_le_of_ne H,
      contrapose! hodd with heqtwomul,
      rw [←int.even_iff_not_odd, ←int.nat_abs_even, ←int.even_coe_nat, even_iff_two_dvd],
      exact ⟨_, heqtwomul⟩ } },
end

lemma two_not_cube (r : ℕ) : r ^ 3 ≠ 2 :=
begin
  have : 1 ≤ 3,
  { norm_num },
  apply monotone.ne_of_lt_of_lt_nat (nat.pow_left_strict_mono this).monotone 1; norm_num,
end

lemma int.two_not_cube (r : ℤ) : r ^ 3 ≠ 2 :=
begin
  intro H,
  apply two_not_cube r.nat_abs,
  rw [←int.nat_abs_pow, H],
  norm_num,
end

-- todo square neg_square and neg_pow_bit0

section
variables {R : Type*} [comm_ring R] [is_domain R] [is_principal_ideal_ring R] [gcd_monoid R]

lemma irreducible.coprime_of_not_dvd_of_dvd {p k m : R}
  (hp : irreducible p) (hdvd1 : ¬(p ∣ m)) (hdvd2 : k ∣ m) : is_coprime p k :=
(irreducible.coprime_iff_not_dvd hp).mpr $ λ hdvd1', hdvd1 (hdvd1'.trans hdvd2)

lemma irreducible.dvd_of_dvd_mul_left {p k m n : R}
  (hdvd1 : ¬(p ∣ m))
  (hdvd2 : k ∣ m)
  (hp : irreducible p)
  (h : k ∣ p * n) : k ∣ n :=
(hp.coprime_of_not_dvd_of_dvd hdvd1 hdvd2).symm.dvd_of_dvd_mul_left h

end

lemma int.dvd_mul_cancel_prime' {p k m n : ℤ}
  (hdvd1 : ¬(p ∣ m))
  (hdvd2 : k ∣ m)
  (hp : prime p)
  (h : k ∣ p * n) : k ∣ n :=
irreducible.dvd_of_dvd_mul_left hdvd1 hdvd2 hp.irreducible h


/-
Copyright (c) 2019 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad
-/
import data.equiv.list

/-!
# W types

Given `α : Type` and `β : α → Type`, the W type determined by this data, `W_type β`, is the
inductively defined type of trees where the nodes are labeled by elements of `α` and the children of
a node labeled `a` are indexed by elements of `β a`.

This file is currently a stub, awaiting a full development of the theory. Currently, the main result
is that if `α` is an encodable fintype and `β a` is encodable for every `a : α`, then `W_type β` is
encodable. This can be used to show the encodability of other inductive types, such as those that
are commonly used to formalize syntax, e.g. terms and expressions in a given language. The strategy
is illustrated in the example found in the file `prop_encodable` in the `archive/examples` folder of
mathlib.

## Implementation details

While the name `W_type` is somewhat verbose, it is preferable to putting a single character
identifier `W` in the root namespace.
-/

/--
Given `β : α → Type*`, `W_type β` is the type of finitely branching trees where nodes are labeled by
elements of `α` and the children of a node labeled `a` are indexed by elements of `β a`.
-/
inductive W_type {α : Type*} (β : α → Type*)
| mk (a : α) (f : β a → W_type) : W_type

instance : inhabited (W_type (λ (_ : unit), empty)) :=
⟨W_type.mk unit.star empty.elim⟩

namespace W_type

variables {α : Type*} {β : α → Type*} [Π a : α, fintype (β a)]

/-- The depth of a finitely branching tree. -/
def depth : W_type β → ℕ
| ⟨a, f⟩ := finset.sup finset.univ (λ n, depth (f n)) + 1

lemma depth_pos (t : W_type β) : 0 < t.depth :=
by { cases t, apply nat.succ_pos }

lemma depth_lt_depth_mk (a : α) (f : β a → W_type β) (i : β a) :
  depth (f i) < depth ⟨a, f⟩ :=
nat.lt_succ_of_le (finset.le_sup (finset.mem_univ i))

end W_type

/-
Show that W types are encodable when `α` is an encodable fintype and for every `a : α`, `β a` is
encodable.

We define an auxiliary type `W_type' β n` of trees of depth at most `n`, and then we show by
induction on `n` that these are all encodable. These auxiliary constructions are not interesting in
and of themselves, so we mark them as `private`.
-/

namespace encodable

@[reducible] private def W_type' {α : Type*} (β : α → Type*)
    [Π a : α, fintype (β a)] [Π a : α, encodable (β a)] (n : ℕ) :=
{ t : W_type β // t.depth ≤ n}

variables {α : Type*} {β : α → Type*} [Π a : α, fintype (β a)] [Π a : α, encodable (β a)]

private def encodable_zero : encodable (W_type' β 0) :=
let f    : W_type' β 0 → empty := λ ⟨x, h⟩, false.elim $ not_lt_of_ge h (W_type.depth_pos _),
    finv : empty → W_type' β 0 := by { intro x, cases x} in
have ∀ x, finv (f x) = x, from λ ⟨x, h⟩, false.elim $ not_lt_of_ge h (W_type.depth_pos _),
encodable.of_left_inverse f finv this

private def f (n : ℕ) : W_type' β (n + 1) → Σ a : α, β a → W_type' β n
| ⟨t, h⟩ :=
  begin
    cases t with a f,
    have h₀ : ∀ i : β a, W_type.depth (f i) ≤ n,
      from λ i, nat.le_of_lt_succ (lt_of_lt_of_le (W_type.depth_lt_depth_mk a f i) h),
    exact ⟨a, λ i : β a, ⟨f i, h₀ i⟩⟩
  end

private def finv (n : ℕ) :
  (Σ a : α, β a → W_type' β n) → W_type' β (n + 1)
| ⟨a, f⟩ :=
  let f' := λ i : β a, (f i).val in
  have W_type.depth ⟨a, f'⟩ ≤ n + 1,
    from add_le_add_right (finset.sup_le (λ b h, (f b).2)) 1,
  ⟨⟨a, f'⟩, this⟩

variables [encodable α]

private def encodable_succ (n : nat) (h : encodable (W_type' β n)) :
  encodable (W_type' β (n + 1)) :=
encodable.of_left_inverse (f n) (finv n) (by { rintro ⟨⟨_, _⟩, _⟩, refl })

/-- `W_type` is encodable when `α` is an encodable fintype and for every `a : α`, `β a` is
encodable. -/
instance : encodable (W_type β) :=
begin
  haveI h' : Π n, encodable (W_type' β n) :=
    λ n, nat.rec_on n encodable_zero encodable_succ,
  let f    : W_type β → Σ n, W_type' β n   := λ t, ⟨t.depth, ⟨t, le_refl _⟩⟩,
  let finv : (Σ n, W_type' β n) → W_type β := λ p, p.2.1,
  have : ∀ t, finv (f t) = t, from λ t, rfl,
  exact encodable.of_left_inverse f finv this
end

end encodable


import GMLInit.Data.Nat.Basic
import GMLInit.Data.Nat.IsPos
import GMLInit.Data.Nat.Order
import GMLInit.Data.Nat.Succ
import GMLInit.Data.Nat.Add
import GMLInit.Data.Nat.Sub

namespace Nat

attribute [local eliminator] Nat.recDiagAux

-- assert theorem mul_zero (x : Nat) : x * 0 = 0

-- assert theorem zero_mul (x : Nat) : 0 * x = 0

-- assert theorem mul_one (x : Nat) : x * 1 = x

-- assert theorem one_mul (x : Nat) : 1 * x = x

-- assert theorem mul_two (x : Nat) : x * 2 = x + x

-- assert theorem two_mul (x : Nat) : 2 * x = x + x

protected theorem mul_succ' (x y : Nat) : x * (y + 1) = x * y + x := Nat.mul_succ x y

protected theorem succ_mul' (x y : Nat) : (x + 1) * y = x * y + y := Nat.succ_mul x y

protected theorem mul_pred (x y : Nat) : x * (y - 1) = x * y - x := by
  cases y with
  | zero => rw [Nat.pred_zero', Nat.mul_zero, Nat.zero_sub]
  | succ y => rw [Nat.pred_succ', Nat.mul_succ, Nat.add_sub_cancel_right]

protected theorem pred_mul (x y : Nat) : (x - 1) * y = x * y - y := by
  cases x with
  | zero => rw [Nat.pred_zero', Nat.zero_mul, Nat.zero_sub]
  | succ x => rw [Nat.pred_succ', Nat.succ_mul, Nat.add_sub_cancel_right]

-- assert theorem mul_comm (x y : Nat) : x * y = y * x

-- assert theorem mul_assoc (x y z : Nat) : (x * y) * z = x * (y * z)

-- assert theorem mul_left_comm (x y z : Nat) : x * (y * z) = y * (x * z)

-- assert theorem mul_right_comm (x y z : Nat) : (x * y) * z = (x * z) * y

protected theorem mul_cross_comm (x₁ x₂ y₁ y₂ : Nat) : (x₁ * x₂) * (y₁ * y₂) = (x₁ * y₁) * (x₂ * y₂) :=
  calc
  _ = x₁ * (x₂ * (y₁ * y₂)) := by rw [Nat.mul_assoc]
  _ = x₁ * (y₁ * (x₂ * y₂)) := by rw [Nat.mul_left_comm x₂ y₁ y₂]
  _ = (x₁ * y₁) * (x₂ * y₂) := by rw [Nat.mul_assoc]

-- assert theorem mul_add (x y z : Nat) : x * (y + z) = x * y + x * z

-- assert theorem add_mul (x y z : Nat) : (x + y) * z = x * z + y * z

protected theorem mul_sub (x y z : Nat) : x * (y - z) = x * y - x * z := by
  induction y, z with
  | left y => rw [Nat.sub_zero, Nat.mul_zero, Nat.sub_zero]
  | right z => rw [Nat.zero_sub, Nat.mul_zero, Nat.zero_sub]
  | diag y z H =>
    calc
    _ = x * ((y + 1) - (z + 1)) := rfl
    _ = x * (y - z) := by rw [Nat.succ_sub_succ]
    _ = x * y - x * z := by rw [H]
    _ = (x * y + x) - (x * z + x) := by rw [Nat.add_sub_add]
    _ = x * (y + 1) - x * (z + 1) := by rw [Nat.mul_succ, Nat.mul_succ]

protected theorem sub_mul (x y z : Nat) : (x - y) * z = x * z - y * z := by
  induction x, y with
  | left x => rw [Nat.sub_zero, Nat.zero_mul, Nat.sub_zero]
  | right y => rw [Nat.zero_sub, Nat.zero_mul, Nat.zero_sub]
  | diag x y H =>
    calc
    _ = ((x + 1) - (y + 1)) * z := rfl
    _ = (x - y) * z := by rw [Nat.succ_sub_succ]
    _ = x * z - y * z := by rw [H]
    _ = (x * z + z) - (y * z + z) := by rw [Nat.add_sub_add]
    _ = (x + 1) * z - (y + 1) * z := by rw [Nat.succ_mul, Nat.succ_mul]

protected theorem le_mul_of_pos_left (x : Nat) {y : Nat} : y > 0 → x ≤ y * x := by
  cases y with
  | zero => intro; contradiction
  | succ y => intro; rw [Nat.succ_mul]; apply Nat.le_add_left

protected theorem le_mul_of_pos_right (x : Nat) {y : Nat} : y > 0 → x ≤ x * y := by
  cases y with
  | zero => intro; contradiction
  | succ y => intro; rw [Nat.mul_succ]; apply Nat.le_add_left

protected theorem lt_mul_of_gt_one_of_pos_left {x y : Nat} (h : x > 0 := by nat_is_pos) : y > 1 → x < y * x := by
  intro hy
  cases y with
  | zero => contradiction
  | succ y =>
    rw [Nat.succ_mul]
    apply Nat.lt_add_left_of_pos
    apply Nat.mul_pos
    · exact Nat.lt_of_succ_lt_succ hy
    · exact h

protected theorem lt_mul_of_gt_one_right {x y : Nat} (h : x > 0 := by nat_is_pos) : y > 1 → x < x * y := by
  intro hy
  cases y with
  | zero => contradiction
  | succ y =>
    rw [Nat.mul_succ]
    apply Nat.lt_add_left_of_pos
    apply Nat.mul_pos
    · exact h
    · exact Nat.lt_of_succ_lt_succ hy

-- assert theorem mul_le_mul {x₁ x₂ y₁ y₂ : Nat} : x₁ ≤ x₂ → y₁ ≤ y₂ → x₁ * y₁ ≤ x₂ * y₂

-- assert theorem mul_le_mul_left {x y : Nat} (z : Nat) : x ≤ y → z * x ≤ z * y

-- assert theorem mul_le_mul_right {x y : Nat} (z : Nat) : x ≤ y → x * z ≤ y * z

-- assert theorem mul_lt_mul_of_pos_left {x y z : Nat} : x < y → z > 0 → z * x < z * y

-- assert theorem mul_lt_mul_of_pos_right {x y z : Nat} : x < y → z > 0 → x * z < y * z

protected theorem mul_lt_mul_left {x y z : Nat} : x < y → (h : z > 0 := by nat_is_pos) → z * x < z * y := Nat.mul_lt_mul_of_pos_left

protected theorem mul_lt_mul_right {x y z : Nat} : x < y → (h : z > 0 := by nat_is_pos) → x * z < y * z := Nat.mul_lt_mul_of_pos_right

protected theorem mul_lt_mul_of_lt_of_lt {x₁ x₂ y₁ y₂ : Nat} : x₁ < x₂ → y₁ < y₂ → x₁ * y₁ < x₂ * y₂ := by
  intro hx hy
  transitivity (x₂ * y₁) using LE.le, LT.lt
  · apply Nat.mul_le_mul_right
    exact Nat.le_of_lt hx
  · apply Nat.mul_lt_mul_of_pos_left
    · exact hy
    · transitivity x₁ using LE.le, LT.lt
      · apply Nat.zero_le
      · exact hx

protected theorem mul_lt_mul_of_le_of_lt {x₁ x₂ y₁ y₂ : Nat} : x₁ ≤ x₂ → y₁ < y₂ → (h : x₂ > 0 := by nat_is_pos) → x₁ * y₁ < x₂ * y₂ := by
  intro hx hy h
  transitivity (x₂ * y₁) using LE.le, LT.lt
  · exact Nat.mul_le_mul_right _ hx
  · exact Nat.mul_lt_mul_left hy

protected theorem mul_lt_mul_of_lt_of_le {x₁ x₂ y₁ y₂ : Nat} : x₁ < x₂ → y₁ ≤ y₂ → (h : y₂ > 0 := by nat_is_pos) → x₁ * y₁ < x₂ * y₂ := by
  intro hx hy h
  transitivity (x₁ * y₂) using LE.le, LT.lt
  · exact Nat.mul_le_mul_left _ hy
  · exact Nat.mul_lt_mul_right hx

protected theorem le_of_mul_le_mul_of_pos_left {x y z : Nat} : x > 0 → x * y ≤ x * z → y ≤ z := by
  intro hx hxyz
  by_cases y > z with
  | isTrue h =>
    absurd hxyz
    apply Nat.not_le_of_gt
    exact Nat.mul_lt_mul_left h
  | isFalse h =>
    exact Nat.le_of_not_gt h

protected theorem le_of_mul_le_mul_of_pos_right {x y z : Nat} : x > 0 → y * x ≤ z * x → y ≤ z := by
  intro hx hxyz
  by_cases y > z with
  | isTrue h =>
    absurd hxyz
    apply Nat.not_le_of_gt
    exact Nat.mul_lt_mul_right h
  | isFalse h =>
    exact Nat.le_of_not_gt h

protected theorem le_of_mul_le_mul_left' (x : Nat) {y z : Nat} : (h : x > 0 := by nat_is_pos) → x * y ≤ x * z → y ≤ z := Nat.le_of_mul_le_mul_of_pos_left

protected theorem le_of_mul_le_mul_right' (x : Nat) {y z : Nat} : (h : x > 0 := by nat_is_pos) → y * x ≤ z * x → y ≤ z := Nat.le_of_mul_le_mul_of_pos_right

protected theorem lt_of_mul_lt_mul_left (x : Nat) {y z : Nat} : x * y < x * z → y < z := by
  intro h
  by_cases y ≥ z with
  | isTrue ht =>
    absurd h
    apply Nat.not_lt_of_ge
    apply Nat.mul_le_mul_left
    exact ht
  | isFalse h =>
    apply Nat.lt_of_not_ge
    exact h

protected theorem lt_of_mul_lt_mul_right (x : Nat) {y z : Nat} : y * x < z * x → y < z := by
  intro h
  by_cases y ≥ z with
  | isTrue ht =>
    absurd h
    apply Nat.not_lt_of_ge
    apply Nat.mul_le_mul_right
    exact ht
  | isFalse h =>
    apply Nat.lt_of_not_ge
    exact h

end Nat


/-
Copyright (c) 2022 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import algebra.module.basic
import algebra.order.archimedean
import algebra.periodic
import data.int.succ_pred
import group_theory.quotient_group

/-!
# Reducing to an interval modulo its length

This file defines operations that reduce a number (in an `archimedean`
`linear_ordered_add_comm_group`) to a number in a given interval, modulo the length of that
interval.

## Main definitions

* `to_Ico_div a hb x` (where `hb : 0 < b`): The unique integer such that this multiple of `b`,
  subtracted from `x`, is in `Ico a (a + b)`.
* `to_Ico_mod a hb x` (where `hb : 0 < b`): Reduce `x` to the interval `Ico a (a + b)`.
* `to_Ioc_div a hb x` (where `hb : 0 < b`): The unique integer such that this multiple of `b`,
  subtracted from `x`, is in `Ioc a (a + b)`.
* `to_Ioc_mod a hb x` (where `hb : 0 < b`): Reduce `x` to the interval `Ioc a (a + b)`.

-/

noncomputable theory

section linear_ordered_add_comm_group

variables {α : Type*} [linear_ordered_add_comm_group α] [hα : archimedean α]
include hα

/--
The unique integer such that this multiple of `b`, subtracted from `x`, is in `Ico a (a + b)`. -/
def to_Ico_div (a : α) {b : α} (hb : 0 < b) (x : α) : ℤ :=
(exists_unique_sub_zsmul_mem_Ico hb x a).some

lemma sub_to_Ico_div_zsmul_mem_Ico (a : α) {b : α} (hb : 0 < b) (x : α) :
  x - to_Ico_div a hb x • b ∈ set.Ico a (a + b) :=
(exists_unique_sub_zsmul_mem_Ico hb x a).some_spec.1

lemma eq_to_Ico_div_of_sub_zsmul_mem_Ico {a b x : α} (hb : 0 < b) {y : ℤ}
  (hy : x - y • b ∈ set.Ico a (a + b)) : y = to_Ico_div a hb x :=
(exists_unique_sub_zsmul_mem_Ico hb x a).some_spec.2 y hy

/--
The unique integer such that this multiple of `b`, subtracted from `x`, is in `Ioc a (a + b)`. -/
def to_Ioc_div (a : α) {b : α} (hb : 0 < b) (x : α) : ℤ :=
(exists_unique_sub_zsmul_mem_Ioc hb x a).some

lemma sub_to_Ioc_div_zsmul_mem_Ioc (a : α) {b : α} (hb : 0 < b) (x : α) :
  x - to_Ioc_div a hb x • b ∈ set.Ioc a (a + b) :=
(exists_unique_sub_zsmul_mem_Ioc hb x a).some_spec.1

lemma eq_to_Ioc_div_of_sub_zsmul_mem_Ioc {a b x : α} (hb : 0 < b) {y : ℤ}
  (hy : x - y • b ∈ set.Ioc a (a + b)) : y = to_Ioc_div a hb x :=
(exists_unique_sub_zsmul_mem_Ioc hb x a).some_spec.2 y hy

/-- Reduce `x` to the interval `Ico a (a + b)`. -/
def to_Ico_mod (a : α) {b : α} (hb : 0 < b) (x : α) : α := x - to_Ico_div a hb x • b

/-- Reduce `x` to the interval `Ioc a (a + b)`. -/
def to_Ioc_mod (a : α) {b : α} (hb : 0 < b) (x : α) : α := x - to_Ioc_div a hb x • b

lemma to_Ico_mod_mem_Ico (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_mod a hb x ∈ set.Ico a (a + b) :=
sub_to_Ico_div_zsmul_mem_Ico a hb x

lemma to_Ico_mod_mem_Ico' {b : α} (hb : 0 < b) (x : α) :
  to_Ico_mod 0 hb x ∈ set.Ico 0 b :=
by { convert to_Ico_mod_mem_Ico 0 hb x, exact (zero_add b).symm, }

lemma to_Ioc_mod_mem_Ioc (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_mod a hb x ∈ set.Ioc a (a + b) :=
sub_to_Ioc_div_zsmul_mem_Ioc a hb x

lemma left_le_to_Ico_mod (a : α) {b : α} (hb : 0 < b) (x : α) : a ≤ to_Ico_mod a hb x :=
(set.mem_Ico.1 (to_Ico_mod_mem_Ico a hb x)).1

lemma left_lt_to_Ioc_mod (a : α) {b : α} (hb : 0 < b) (x : α) : a < to_Ioc_mod a hb x :=
(set.mem_Ioc.1 (to_Ioc_mod_mem_Ioc a hb x)).1

lemma to_Ico_mod_lt_right (a : α) {b : α} (hb : 0 < b) (x : α) : to_Ico_mod a hb x < a + b :=
(set.mem_Ico.1 (to_Ico_mod_mem_Ico a hb x)).2

lemma to_Ioc_mod_le_right (a : α) {b : α} (hb : 0 < b) (x : α) : to_Ioc_mod a hb x ≤ a + b :=
(set.mem_Ioc.1 (to_Ioc_mod_mem_Ioc a hb x)).2

@[simp] lemma self_sub_to_Ico_div_zsmul (a : α) {b : α} (hb : 0 < b) (x : α) :
  x - to_Ico_div a hb x • b = to_Ico_mod a hb x :=
rfl

@[simp] lemma self_sub_to_Ioc_div_zsmul (a : α) {b : α} (hb : 0 < b) (x : α) :
  x - to_Ioc_div a hb x • b = to_Ioc_mod a hb x :=
rfl

@[simp] lemma to_Ico_div_zsmul_sub_self (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_div a hb x • b - x = -to_Ico_mod a hb x :=
by rw [to_Ico_mod, neg_sub]

@[simp] lemma to_Ioc_div_zsmul_sub_self (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_div a hb x • b - x = -to_Ioc_mod a hb x :=
by rw [to_Ioc_mod, neg_sub]

@[simp] lemma to_Ico_mod_sub_self (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_mod a hb x - x = -to_Ico_div a hb x • b :=
by rw [to_Ico_mod, sub_sub_cancel_left, neg_smul]

@[simp] lemma to_Ioc_mod_sub_self (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_mod a hb x - x = -to_Ioc_div a hb x • b :=
by rw [to_Ioc_mod, sub_sub_cancel_left, neg_smul]

@[simp] lemma self_sub_to_Ico_mod (a : α) {b : α} (hb : 0 < b) (x : α) :
  x - to_Ico_mod a hb x = to_Ico_div a hb x • b :=
by rw [to_Ico_mod, sub_sub_cancel]

@[simp] lemma self_sub_to_Ioc_mod (a : α) {b : α} (hb : 0 < b) (x : α) :
  x - to_Ioc_mod a hb x = to_Ioc_div a hb x • b :=
by rw [to_Ioc_mod, sub_sub_cancel]

@[simp] lemma to_Ico_mod_add_to_Ico_div_zsmul (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_mod a hb x + to_Ico_div a hb x • b = x :=
by rw [to_Ico_mod, sub_add_cancel]

@[simp] lemma to_Ioc_mod_add_to_Ioc_div_zsmul (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_mod a hb x + to_Ioc_div a hb x • b = x :=
by rw [to_Ioc_mod, sub_add_cancel]

@[simp] lemma to_Ico_div_zsmul_sub_to_Ico_mod (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_div a hb x • b + to_Ico_mod a hb x = x :=
by rw [add_comm, to_Ico_mod_add_to_Ico_div_zsmul]

@[simp] lemma to_Ioc_div_zsmul_sub_to_Ioc_mod (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_div a hb x • b + to_Ioc_mod a hb x = x :=
by rw [add_comm, to_Ioc_mod_add_to_Ioc_div_zsmul]

lemma to_Ico_mod_eq_iff {a b x y : α} (hb : 0 < b) :
  to_Ico_mod a hb x = y ↔ y ∈ set.Ico a (a + b) ∧ ∃ z : ℤ, x = y + z • b :=
begin
  refine ⟨λ h, ⟨h ▸ to_Ico_mod_mem_Ico a hb x,
                to_Ico_div a hb x,
                h ▸ (to_Ico_mod_add_to_Ico_div_zsmul _ _ _).symm⟩,
          λ h, _⟩,
  rcases h with ⟨hy, z, hz⟩,
  rw ←sub_eq_iff_eq_add at hz,
  subst hz,
  rw eq_to_Ico_div_of_sub_zsmul_mem_Ico hb hy,
  refl
end

lemma to_Ioc_mod_eq_iff {a b x y : α} (hb : 0 < b) :
  to_Ioc_mod a hb x = y ↔ y ∈ set.Ioc a (a + b) ∧ ∃ z : ℤ, x = y + z • b :=
begin
  refine ⟨λ h, ⟨h ▸ to_Ioc_mod_mem_Ioc a hb x,
                to_Ioc_div a hb x,
                h ▸ (to_Ioc_mod_add_to_Ioc_div_zsmul _ hb _).symm⟩,
          λ h, _⟩,
  rcases h with ⟨hy, z, hz⟩,
  rw ←sub_eq_iff_eq_add at hz,
  subst hz,
  rw eq_to_Ioc_div_of_sub_zsmul_mem_Ioc hb hy,
  refl
end

@[simp] lemma to_Ico_div_apply_left (a : α) {b : α} (hb : 0 < b) : to_Ico_div a hb a = 0 :=
begin
  refine (eq_to_Ico_div_of_sub_zsmul_mem_Ico hb _).symm,
  simp [hb]
end

@[simp] lemma to_Ioc_div_apply_left (a : α) {b : α} (hb : 0 < b) : to_Ioc_div a hb a = -1 :=
begin
  refine (eq_to_Ioc_div_of_sub_zsmul_mem_Ioc hb _).symm,
  simp [hb],
end

@[simp] lemma to_Ico_mod_apply_left (a : α) {b : α} (hb : 0 < b) : to_Ico_mod a hb a = a :=
begin
  rw [to_Ico_mod_eq_iff hb, set.left_mem_Ico],
  refine ⟨lt_add_of_pos_right _ hb, 0, _⟩,
  simp
end

@[simp] lemma to_Ioc_mod_apply_left (a : α) {b : α} (hb : 0 < b) : to_Ioc_mod a hb a = a + b :=
begin
  rw [to_Ioc_mod_eq_iff hb, set.right_mem_Ioc],
  refine ⟨lt_add_of_pos_right _ hb, -1, _⟩,
  simp
end

lemma to_Ico_div_apply_right (a : α) {b : α} (hb : 0 < b) :
  to_Ico_div a hb (a + b) = 1 :=
begin
  refine (eq_to_Ico_div_of_sub_zsmul_mem_Ico hb _).symm,
  simp [hb]
end

lemma to_Ioc_div_apply_right (a : α) {b : α} (hb : 0 < b) :
  to_Ioc_div a hb (a + b) = 0 :=
begin
  refine (eq_to_Ioc_div_of_sub_zsmul_mem_Ioc hb _).symm,
  simp [hb]
end

lemma to_Ico_mod_apply_right (a : α) {b : α} (hb : 0 < b) : to_Ico_mod a hb (a + b) = a :=
begin
  rw [to_Ico_mod_eq_iff hb, set.left_mem_Ico],
  refine ⟨lt_add_of_pos_right _ hb, 1, _⟩,
  simp
end

lemma to_Ioc_mod_apply_right (a : α) {b : α} (hb : 0 < b) :
  to_Ioc_mod a hb (a + b) = a + b :=
begin
  rw [to_Ioc_mod_eq_iff hb, set.right_mem_Ioc],
  refine ⟨lt_add_of_pos_right _ hb, 0, _⟩,
  simp
end

@[simp] lemma to_Ico_div_add_zsmul (a : α) {b : α} (hb : 0 < b) (x : α) (m : ℤ) :
  to_Ico_div a hb (x + m • b) = to_Ico_div a hb x + m :=
begin
  refine (eq_to_Ico_div_of_sub_zsmul_mem_Ico hb _).symm,
  convert sub_to_Ico_div_zsmul_mem_Ico a hb x using 1,
  simp [add_smul],
end

@[simp] lemma to_Ioc_div_add_zsmul (a : α) {b : α} (hb : 0 < b) (x : α) (m : ℤ) :
  to_Ioc_div a hb (x + m • b) = to_Ioc_div a hb x + m :=
begin
  refine (eq_to_Ioc_div_of_sub_zsmul_mem_Ioc hb _).symm,
  convert sub_to_Ioc_div_zsmul_mem_Ioc a hb x using 1,
  simp [add_smul]
end

@[simp] lemma to_Ico_div_zsmul_add (a : α) {b : α} (hb : 0 < b) (x : α) (m : ℤ) :
  to_Ico_div a hb (m • b + x) = m + to_Ico_div a hb x :=
by rw [add_comm, to_Ico_div_add_zsmul, add_comm]

@[simp] lemma to_Ioc_div_zsmul_add (a : α) {b : α} (hb : 0 < b) (x : α) (m : ℤ) :
  to_Ioc_div a hb (m • b + x) = to_Ioc_div a hb x + m :=
by rw [add_comm, to_Ioc_div_add_zsmul, add_comm]

@[simp] lemma to_Ico_div_sub_zsmul (a : α) {b : α} (hb : 0 < b) (x : α) (m : ℤ) :
  to_Ico_div a hb (x - m • b) = to_Ico_div a hb x - m :=
by rw [sub_eq_add_neg, ←neg_smul, to_Ico_div_add_zsmul, sub_eq_add_neg]

@[simp] lemma to_Ioc_div_sub_zsmul (a : α) {b : α} (hb : 0 < b) (x : α) (m : ℤ) :
  to_Ioc_div a hb (x - m • b) = to_Ioc_div a hb x - m :=
by rw [sub_eq_add_neg, ←neg_smul, to_Ioc_div_add_zsmul, sub_eq_add_neg]

@[simp] lemma to_Ico_div_add_right (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_div a hb (x + b) = to_Ico_div a hb x + 1 :=
begin
  convert to_Ico_div_add_zsmul a hb x 1,
  exact (one_zsmul _).symm
end

@[simp] lemma to_Ioc_div_add_right (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_div a hb (x + b) = to_Ioc_div a hb x + 1 :=
begin
  convert to_Ioc_div_add_zsmul a hb x 1,
  exact (one_zsmul _).symm
end

@[simp] lemma to_Ico_div_add_left (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_div a hb (b + x) = to_Ico_div a hb x + 1 :=
by rw [add_comm, to_Ico_div_add_right]

@[simp] lemma to_Ioc_div_add_left (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_div a hb (b + x) = to_Ioc_div a hb x + 1 :=
by rw [add_comm, to_Ioc_div_add_right]

@[simp] lemma to_Ico_div_sub (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_div a hb (x - b) = to_Ico_div a hb x - 1 :=
begin
  convert to_Ico_div_sub_zsmul a hb x 1,
  exact (one_zsmul _).symm
end

@[simp] lemma to_Ioc_div_sub (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_div a hb (x - b) = to_Ioc_div a hb x - 1 :=
begin
  convert to_Ioc_div_sub_zsmul a hb x 1,
  exact (one_zsmul _).symm
end

lemma to_Ico_div_sub' (a : α) {b : α} (hb : 0 < b) (x y : α) :
  to_Ico_div a hb (x - y) = to_Ico_div (a + y) hb x :=
begin
  rw eq_comm,
  apply eq_to_Ico_div_of_sub_zsmul_mem_Ico,
  rw [←sub_right_comm, set.sub_mem_Ico_iff_left, add_right_comm],
  exact sub_to_Ico_div_zsmul_mem_Ico (a + y) hb x,
end

lemma to_Ioc_div_sub' (a : α) {b : α} (hb : 0 < b) (x y : α) :
  to_Ioc_div a hb (x - y) = to_Ioc_div (a + y) hb x :=
begin
  rw eq_comm,
  apply eq_to_Ioc_div_of_sub_zsmul_mem_Ioc,
  rw [←sub_right_comm, set.sub_mem_Ioc_iff_left, add_right_comm],
  exact sub_to_Ioc_div_zsmul_mem_Ioc (a + y) hb x,
end

lemma to_Ico_div_add_right' (a : α) {b : α} (hb : 0 < b) (x y : α) :
  to_Ico_div a hb (x + y) = to_Ico_div (a - y) hb x :=
by rw [←sub_neg_eq_add, to_Ico_div_sub', sub_eq_add_neg]

lemma to_Ioc_div_add_right' (a : α) {b : α} (hb : 0 < b) (x y : α) :
  to_Ioc_div a hb (x + y) = to_Ioc_div (a - y) hb x :=
by rw [←sub_neg_eq_add, to_Ioc_div_sub', sub_eq_add_neg]

lemma to_Ico_div_neg (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_div a hb (-x) = -(to_Ioc_div (-a) hb x + 1) :=
begin
  suffices : to_Ico_div a hb (-x) = -(to_Ioc_div (-(a + b)) hb x),
  { rwa [neg_add, ←sub_eq_add_neg, ←to_Ioc_div_add_right', to_Ioc_div_add_right] at this },
  rw [← neg_eq_iff_eq_neg],
  apply eq_to_Ioc_div_of_sub_zsmul_mem_Ioc,
  obtain ⟨hc, ho⟩ := sub_to_Ico_div_zsmul_mem_Ico a hb (-x),
  rw [←neg_lt_neg_iff, neg_sub' (-x), neg_neg, ←neg_smul] at ho,
  rw [←neg_le_neg_iff, neg_sub' (-x), neg_neg, ←neg_smul] at hc,
  refine ⟨ho, hc.trans_eq _⟩,
  rw [neg_add, neg_add_cancel_right],
end

lemma to_Ioc_div_neg (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_div a hb (-x) = -(to_Ico_div (-a) hb x + 1) :=
by rw [←neg_neg x, to_Ico_div_neg, neg_neg, neg_neg, neg_add', neg_neg, add_sub_cancel]

@[simp] lemma to_Ico_mod_add_zsmul (a : α) {b : α} (hb : 0 < b) (x : α) (m : ℤ) :
  to_Ico_mod a hb (x + m • b) = to_Ico_mod a hb x :=
begin
  rw [to_Ico_mod, to_Ico_div_add_zsmul, to_Ico_mod, add_smul],
  abel
end

@[simp] lemma to_Ioc_mod_add_zsmul (a : α) {b : α} (hb : 0 < b) (x : α) (m : ℤ) :
  to_Ioc_mod a hb (x + m • b) = to_Ioc_mod a hb x :=
begin
  rw [to_Ioc_mod, to_Ioc_div_add_zsmul, to_Ioc_mod, add_smul],
  abel
end

@[simp] lemma to_Ico_mod_zsmul_add (a : α) {b : α} (hb : 0 < b) (x : α) (m : ℤ) :
  to_Ico_mod a hb (m • b + x) = to_Ico_mod a hb x :=
by rw [add_comm, to_Ico_mod_add_zsmul]

@[simp] lemma to_Ioc_mod_zsmul_add (a : α) {b : α} (hb : 0 < b) (x : α) (m : ℤ) :
  to_Ioc_mod a hb (m • b + x) = to_Ioc_mod a hb x :=
by rw [add_comm, to_Ioc_mod_add_zsmul]

@[simp] lemma to_Ico_mod_sub_zsmul (a : α) {b : α} (hb : 0 < b) (x : α) (m : ℤ) :
  to_Ico_mod a hb (x - m • b) = to_Ico_mod a hb x :=
by rw [sub_eq_add_neg, ←neg_smul, to_Ico_mod_add_zsmul]

@[simp] lemma to_Ioc_mod_sub_zsmul (a : α) {b : α} (hb : 0 < b) (x : α) (m : ℤ) :
  to_Ioc_mod a hb (x - m • b) = to_Ioc_mod a hb x :=
by rw [sub_eq_add_neg, ←neg_smul, to_Ioc_mod_add_zsmul]

@[simp] lemma to_Ico_mod_add_right (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_mod a hb (x + b) = to_Ico_mod a hb x :=
begin
  convert to_Ico_mod_add_zsmul a hb x 1,
  exact (one_zsmul _).symm
end

@[simp] lemma to_Ioc_mod_add_right (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_mod a hb (x + b) = to_Ioc_mod a hb x :=
begin
  convert to_Ioc_mod_add_zsmul a hb x 1,
  exact (one_zsmul _).symm
end

@[simp] lemma to_Ico_mod_add_left (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_mod a hb (b + x) = to_Ico_mod a hb x :=
by rw [add_comm, to_Ico_mod_add_right]

@[simp] lemma to_Ioc_mod_add_left (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_mod a hb (b + x) = to_Ioc_mod a hb x :=
by rw [add_comm, to_Ioc_mod_add_right]

@[simp] lemma to_Ico_mod_sub (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_mod a hb (x - b) = to_Ico_mod a hb x :=
begin
  convert to_Ico_mod_sub_zsmul a hb x 1,
  exact (one_zsmul _).symm
end

@[simp] lemma to_Ioc_mod_sub (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_mod a hb (x - b) = to_Ioc_mod a hb x :=
begin
  convert to_Ioc_mod_sub_zsmul a hb x 1,
  exact (one_zsmul _).symm
end

lemma to_Ico_mod_sub' (a : α) {b : α} (hb : 0 < b) (x y : α) :
  to_Ico_mod a hb (x - y) = to_Ico_mod (a + y) hb x - y :=
by simp_rw [to_Ico_mod, to_Ico_div_sub', sub_right_comm]

lemma to_Ioc_mod_sub' (a : α) {b : α} (hb : 0 < b) (x y : α) :
  to_Ioc_mod a hb (x - y) = to_Ioc_mod (a + y) hb x - y :=
by simp_rw [to_Ioc_mod, to_Ioc_div_sub', sub_right_comm]

lemma to_Ico_mod_add_right' (a : α) {b : α} (hb : 0 < b) (x y : α) :
  to_Ico_mod a hb (x + y) = to_Ico_mod (a - y) hb x + y :=
by simp_rw [to_Ico_mod, to_Ico_div_add_right', sub_add_eq_add_sub]

lemma to_Ioc_mod_add_right' (a : α) {b : α} (hb : 0 < b) (x y : α) :
  to_Ioc_mod a hb (x + y) = to_Ioc_mod (a - y) hb x + y :=
by simp_rw [to_Ioc_mod, to_Ioc_div_add_right', sub_add_eq_add_sub]

lemma to_Ico_mod_neg (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_mod a hb (-x) = b - to_Ioc_mod (-a) hb x :=
begin
  simp_rw [to_Ico_mod, to_Ioc_mod, to_Ico_div_neg, neg_smul, add_smul],
  abel,
end

lemma to_Ioc_mod_neg (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_mod a hb (-x) = b - to_Ico_mod (-a) hb x :=
begin
  simp_rw [to_Ioc_mod, to_Ico_mod, to_Ioc_div_neg, neg_smul, add_smul],
  abel,
end

lemma to_Ico_mod_eq_to_Ico_mod (a : α) {b x y : α} (hb : 0 < b) :
  to_Ico_mod a hb x = to_Ico_mod a hb y ↔ ∃ z : ℤ, y - x = z • b :=
begin
  refine ⟨λ h, ⟨to_Ico_div a hb y - to_Ico_div a hb x, _⟩, λ h, _⟩,
  { conv_lhs { rw [←to_Ico_mod_add_to_Ico_div_zsmul a hb x,
                   ←to_Ico_mod_add_to_Ico_div_zsmul a hb y] },
    rw [h, sub_smul],
    abel },
  { rcases h with ⟨z, hz⟩,
    rw sub_eq_iff_eq_add at hz,
    rw [hz, to_Ico_mod_zsmul_add] }
end

lemma to_Ioc_mod_eq_to_Ioc_mod (a : α) {b x y : α} (hb : 0 < b) :
  to_Ioc_mod a hb x = to_Ioc_mod a hb y ↔ ∃ z : ℤ, y - x = z • b :=
begin
  refine ⟨λ h, ⟨to_Ioc_div a hb y - to_Ioc_div a hb x, _⟩, λ h, _⟩,
  { conv_lhs { rw [←to_Ioc_mod_add_to_Ioc_div_zsmul a hb x,
                   ←to_Ioc_mod_add_to_Ioc_div_zsmul a hb y] },
    rw [h, sub_smul],
    abel },
  { rcases h with ⟨z, hz⟩,
    rw sub_eq_iff_eq_add at hz,
    rw [hz, to_Ioc_mod_zsmul_add] }
end

/-! ### Links between the `Ico` and `Ioc` variants applied to the same element -/

section Ico_Ioc

variables (a : α) {b : α} (hb : 0 < b) (x : α)

omit hα
/-- `mem_Ioo_mod a b x` means that `x` lies in the open interval `(a, a + b)` modulo `b`.
Equivalently (as shown below), `x` is not congruent to `a` modulo `b`, or `to_Ico_mod a hb` agrees
with `to_Ioc_mod a hb` at `x`, or `to_Ico_div a hb` agrees with `to_Ioc_div a hb` at `x`. -/
def mem_Ioo_mod (b x : α) : Prop := ∃ z : ℤ, x - z • b ∈ set.Ioo a (a + b)
include hα

lemma tfae_mem_Ioo_mod :
  tfae [mem_Ioo_mod a b x,
    to_Ico_mod a hb x = to_Ioc_mod a hb x,
    to_Ico_mod a hb x + b ≠ to_Ioc_mod a hb x,
    to_Ico_mod a hb x ≠ a] :=
begin
  tfae_have : 1 → 2,
  { exact λ ⟨i, hi⟩,
      ((to_Ico_mod_eq_iff hb).2 ⟨set.Ioo_subset_Ico_self hi, i, (sub_add_cancel x _).symm⟩).trans
      ((to_Ioc_mod_eq_iff hb).2 ⟨set.Ioo_subset_Ioc_self hi, i, (sub_add_cancel x _).symm⟩).symm },
  tfae_have : 2 → 3,
  { intro h, rw [h, ne, add_right_eq_self], exact hb.ne' },
  tfae_have : 3 → 4,
  { refine mt (λ h, _),
    rw [h, eq_comm, to_Ioc_mod_eq_iff, set.right_mem_Ioc],
    refine ⟨lt_add_of_pos_right a hb, to_Ico_div a hb x - 1, _⟩,
    rw [sub_one_zsmul, add_add_add_comm, add_right_neg, add_zero],
    conv_lhs { rw [← to_Ico_mod_add_to_Ico_div_zsmul a hb x, h] } },
  tfae_have : 4 → 1,
  { have h' := to_Ico_mod_mem_Ico a hb x, exact λ h, ⟨_, h'.1.lt_of_ne' h, h'.2⟩ },
  tfae_finish,
end

variables {a x}

lemma mem_Ioo_mod_iff_to_Ico_mod_eq_to_Ioc_mod :
  mem_Ioo_mod a b x ↔ to_Ico_mod a hb x = to_Ioc_mod a hb x := (tfae_mem_Ioo_mod a hb x).out 0 1
lemma mem_Ioo_mod_iff_to_Ico_mod_add_period_ne_to_Ioc_mod :
  mem_Ioo_mod a b x ↔ to_Ico_mod a hb x + b ≠ to_Ioc_mod a hb x := (tfae_mem_Ioo_mod a hb x).out 0 2
lemma mem_Ioo_mod_iff_to_Ico_mod_ne_left :
  mem_Ioo_mod a b x ↔ to_Ico_mod a hb x ≠ a := (tfae_mem_Ioo_mod a hb x).out 0 3

lemma not_mem_Ioo_mod_iff_to_Ico_mod_add_period_eq_to_Ioc_mod :
  ¬mem_Ioo_mod a b x ↔ to_Ico_mod a hb x + b = to_Ioc_mod a hb x :=
(mem_Ioo_mod_iff_to_Ico_mod_add_period_ne_to_Ioc_mod hb).not_left

lemma not_mem_Ioo_mod_iff_to_Ico_mod_eq_left : ¬mem_Ioo_mod a b x ↔ to_Ico_mod a hb x = a :=
(mem_Ioo_mod_iff_to_Ico_mod_ne_left hb).not_left

lemma mem_Ioo_mod_iff_to_Ioc_mod_ne_right : mem_Ioo_mod a b x ↔ to_Ioc_mod a hb x ≠ a + b :=
begin
  rw [mem_Ioo_mod_iff_to_Ico_mod_eq_to_Ioc_mod, to_Ico_mod_eq_iff hb],
  obtain ⟨h₁, h₂⟩ := to_Ioc_mod_mem_Ioc a hb x,
  exact ⟨λ h, h.1.2.ne, λ h, ⟨⟨h₁.le, h₂.lt_of_ne h⟩, _,
    (to_Ioc_mod_add_to_Ioc_div_zsmul _ _ _).symm⟩⟩,
end

lemma not_mem_Ioo_mod_iff_to_Ioc_eq_right : ¬mem_Ioo_mod a b x ↔ to_Ioc_mod a hb x = a + b :=
(mem_Ioo_mod_iff_to_Ioc_mod_ne_right hb).not_left

lemma mem_Ioo_mod_iff_to_Ico_div_eq_to_Ioc_div :
  mem_Ioo_mod a b x ↔ to_Ico_div a hb x = to_Ioc_div a hb x :=
by rw [mem_Ioo_mod_iff_to_Ico_mod_eq_to_Ioc_mod hb,
       to_Ico_mod, to_Ioc_mod, sub_right_inj, (zsmul_strict_mono_left hb).injective.eq_iff]

lemma mem_Ioo_mod_iff_to_Ico_div_ne_to_Ioc_div_add_one :
  mem_Ioo_mod a b x ↔ to_Ico_div a hb x ≠ to_Ioc_div a hb x + 1 :=
by rw [mem_Ioo_mod_iff_to_Ico_mod_add_period_ne_to_Ioc_mod hb, ne, ne, to_Ico_mod, to_Ioc_mod,
       ← eq_sub_iff_add_eq, sub_sub, sub_right_inj, ← add_one_zsmul,
       (zsmul_strict_mono_left hb).injective.eq_iff]

lemma not_mem_Ioo_mod_iff_to_Ico_div_eq_to_Ioc_div_add_one :
  ¬mem_Ioo_mod a b x ↔ to_Ico_div a hb x = to_Ioc_div a hb x + 1 :=
(mem_Ioo_mod_iff_to_Ico_div_ne_to_Ioc_div_add_one hb).not_left

include hb

lemma mem_Ioo_mod_iff_ne_add_zsmul : mem_Ioo_mod a b x ↔ ∀ z : ℤ, x ≠ a + z • b :=
begin
  rw [mem_Ioo_mod_iff_to_Ico_mod_ne_left hb, ← not_iff_not],
  push_neg, split; intro h,
  { rw ← h,
    exact ⟨_, (to_Ico_mod_add_to_Ico_div_zsmul _ _ _).symm⟩ },
  { rw [to_Ico_mod_eq_iff, set.left_mem_Ico],
    exact ⟨lt_add_of_pos_right a hb, h⟩, },
end

lemma not_mem_Ioo_mod_iff_eq_add_zsmul : ¬mem_Ioo_mod a b x ↔ ∃ z : ℤ, x = a + z • b :=
by simpa only [not_forall, not_ne_iff] using (mem_Ioo_mod_iff_ne_add_zsmul hb).not

lemma not_mem_Ioo_mod_iff_eq_mod_zmultiples :
  ¬mem_Ioo_mod a b x ↔ (x : α ⧸ add_subgroup.zmultiples b) = a :=
by simp_rw [not_mem_Ioo_mod_iff_eq_add_zsmul hb, quotient_add_group.eq_iff_sub_mem,
    add_subgroup.mem_zmultiples_iff, eq_sub_iff_add_eq', eq_comm]

lemma mem_Ioo_mod_iff_ne_mod_zmultiples :
  mem_Ioo_mod a b x ↔ (x : α ⧸ add_subgroup.zmultiples b) ≠ a :=
(not_mem_Ioo_mod_iff_eq_mod_zmultiples hb).not_right

lemma Ico_eq_locus_Ioc_eq_Union_Ioo :
  {x | to_Ico_mod a hb x = to_Ioc_mod a hb x} = ⋃ z : ℤ, set.Ioo (a + z • b) (a + b + z • b) :=
begin
  ext1, simp_rw [set.mem_set_of, set.mem_Union, ← set.sub_mem_Ioo_iff_left],
  exact (mem_Ioo_mod_iff_to_Ico_mod_eq_to_Ioc_mod hb).symm,
end

lemma to_Ioc_div_wcovby_to_Ico_div (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_div a hb x ⩿ to_Ico_div a hb x :=
begin
  suffices : to_Ioc_div a hb x = to_Ico_div a hb x ∨ to_Ioc_div a hb x + 1 = to_Ico_div a hb x,
  { rwa [wcovby_iff_eq_or_covby, ←order.succ_eq_iff_covby] },
  rw [eq_comm, ←mem_Ioo_mod_iff_to_Ico_div_eq_to_Ioc_div,
    eq_comm, ←not_mem_Ioo_mod_iff_to_Ico_div_eq_to_Ioc_div_add_one],
  exact em _,
end

lemma to_Ico_mod_le_to_Ioc_mod (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_mod a hb x ≤ to_Ioc_mod a hb x :=
begin
  rw [to_Ico_mod, to_Ioc_mod, sub_le_sub_iff_left],
  exact zsmul_mono_left hb.le (to_Ioc_div_wcovby_to_Ico_div _ _ _).le
end

lemma to_Ioc_mod_le_to_Ico_mod_add (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_mod a hb x ≤ to_Ico_mod a hb x + b :=
begin
  rw [to_Ico_mod, to_Ioc_mod, sub_add, sub_le_sub_iff_left, sub_le_iff_le_add, ←add_one_zsmul,
    (zsmul_strict_mono_left hb).le_iff_le],
  apply (to_Ioc_div_wcovby_to_Ico_div _ _ _).le_succ,
end

end Ico_Ioc

lemma to_Ico_mod_eq_self {a b x : α} (hb : 0 < b) : to_Ico_mod a hb x = x ↔ x ∈ set.Ico a (a + b) :=
begin
  rw [to_Ico_mod_eq_iff, and_iff_left],
  refine ⟨0, _⟩,
  simp
end

lemma to_Ioc_mod_eq_self {a b x : α} (hb : 0 < b) : to_Ioc_mod a hb x = x ↔ x ∈ set.Ioc a (a + b) :=
begin
  rw [to_Ioc_mod_eq_iff, and_iff_left],
  refine ⟨0, _⟩,
  simp
end

@[simp] lemma to_Ico_mod_to_Ico_mod (a₁ a₂ : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_mod a₁ hb (to_Ico_mod a₂ hb x) = to_Ico_mod a₁ hb x :=
begin
  rw to_Ico_mod_eq_to_Ico_mod,
  exact ⟨to_Ico_div a₂ hb x, self_sub_to_Ico_mod a₂ hb x⟩
end

@[simp] lemma to_Ico_mod_to_Ioc_mod (a₁ a₂ : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_mod a₁ hb (to_Ioc_mod a₂ hb x) = to_Ico_mod a₁ hb x :=
begin
  rw to_Ico_mod_eq_to_Ico_mod,
  exact ⟨to_Ioc_div a₂ hb x, self_sub_to_Ioc_mod a₂ hb x⟩
end

@[simp] lemma to_Ioc_mod_to_Ioc_mod (a₁ a₂ : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_mod a₁ hb (to_Ioc_mod a₂ hb x) = to_Ioc_mod a₁ hb x :=
begin
  rw to_Ioc_mod_eq_to_Ioc_mod,
  exact ⟨to_Ioc_div a₂ hb x, self_sub_to_Ioc_mod a₂ hb x⟩
end

@[simp] lemma to_Ioc_mod_to_Ico_mod (a₁ a₂ : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_mod a₁ hb (to_Ico_mod a₂ hb x) = to_Ioc_mod a₁ hb x :=
begin
  rw to_Ioc_mod_eq_to_Ioc_mod,
  exact ⟨to_Ico_div a₂ hb x, self_sub_to_Ico_mod a₂ hb x⟩
end

lemma to_Ico_mod_periodic (a : α) {b : α} (hb : 0 < b) : function.periodic (to_Ico_mod a hb) b :=
to_Ico_mod_add_right a hb

lemma to_Ioc_mod_periodic (a : α) {b : α} (hb : 0 < b) : function.periodic (to_Ioc_mod a hb) b :=
to_Ioc_mod_add_right a hb

/-- `to_Ico_mod` as an equiv from the quotient. -/
@[simps symm_apply]
def quotient_add_group.equiv_Ico_mod (a : α) {b : α} (hb : 0 < b) :
  (α ⧸ add_subgroup.zmultiples b) ≃ set.Ico a (a + b) :=
{ to_fun := λ x, ⟨(to_Ico_mod_periodic a hb).lift x,
    quotient_add_group.induction_on' x $ to_Ico_mod_mem_Ico a hb⟩,
  inv_fun := coe,
  right_inv := λ x, subtype.ext $ (to_Ico_mod_eq_self hb).mpr x.prop,
  left_inv := λ x, begin
    induction x using quotient_add_group.induction_on',
    dsimp,
    rw [quotient_add_group.eq_iff_sub_mem, to_Ico_mod_sub_self],
    apply add_subgroup.zsmul_mem_zmultiples,
  end }

@[simp]
lemma quotient_add_group.equiv_Ico_mod_coe (a : α) {b : α} (hb : 0 < b) (x : α) :
  quotient_add_group.equiv_Ico_mod a hb ↑x = ⟨to_Ico_mod a hb x, to_Ico_mod_mem_Ico a hb _⟩ :=
rfl

/-- `to_Ioc_mod` as an equiv  from the quotient. -/
@[simps symm_apply]
def quotient_add_group.equiv_Ioc_mod (a : α) {b : α} (hb : 0 < b) :
  (α ⧸ add_subgroup.zmultiples b) ≃ set.Ioc a (a + b) :=
{ to_fun := λ x, ⟨(to_Ioc_mod_periodic a hb).lift x,
    quotient_add_group.induction_on' x $ to_Ioc_mod_mem_Ioc a hb⟩,
  inv_fun := coe,
  right_inv := λ x, subtype.ext $ (to_Ioc_mod_eq_self hb).mpr x.prop,
  left_inv := λ x, begin
    induction x using quotient_add_group.induction_on',
    dsimp,
    rw [quotient_add_group.eq_iff_sub_mem, to_Ioc_mod_sub_self],
    apply add_subgroup.zsmul_mem_zmultiples,
  end }

@[simp]
lemma quotient_add_group.equiv_Ioc_mod_coe (a : α) {b : α} (hb : 0 < b) (x : α) :
  quotient_add_group.equiv_Ioc_mod a hb ↑x = ⟨to_Ioc_mod a hb x, to_Ioc_mod_mem_Ioc a hb _⟩ :=
rfl

end linear_ordered_add_comm_group

section linear_ordered_field

variables {α : Type*} [linear_ordered_field α] [floor_ring α]

lemma to_Ico_div_eq_floor (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_div a hb x = ⌊(x - a) / b⌋ :=
begin
  refine (eq_to_Ico_div_of_sub_zsmul_mem_Ico hb _).symm,
  rw [set.mem_Ico, zsmul_eq_mul, ←sub_nonneg, add_comm, sub_right_comm, ←sub_lt_iff_lt_add,
    sub_right_comm _ _ a],
  exact ⟨int.sub_floor_div_mul_nonneg _ hb, int.sub_floor_div_mul_lt _ hb⟩,
end

lemma to_Ioc_div_eq_neg_floor (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_div a hb x = -⌊(a + b - x) / b⌋ :=
begin
  refine (eq_to_Ioc_div_of_sub_zsmul_mem_Ioc hb _).symm,
  rw [set.mem_Ioc, zsmul_eq_mul, int.cast_neg, neg_mul, sub_neg_eq_add, ←sub_nonneg,
    sub_add_eq_sub_sub],
  refine ⟨_, int.sub_floor_div_mul_nonneg _ hb⟩,
  rw [←add_lt_add_iff_right b, add_assoc, add_comm x, ←sub_lt_iff_lt_add, add_comm (_ * _),
      ←sub_lt_iff_lt_add],
  exact int.sub_floor_div_mul_lt _ hb
end

lemma to_Ico_div_zero_one (x : α) : to_Ico_div (0 : α) zero_lt_one x = ⌊x⌋ :=
by simp [to_Ico_div_eq_floor]

lemma to_Ico_mod_eq_add_fract_mul (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ico_mod a hb x = a + int.fract ((x - a) / b) * b :=
begin
  rw [to_Ico_mod, to_Ico_div_eq_floor, int.fract],
  field_simp [hb.ne.symm],
  ring
end

lemma to_Ico_mod_eq_fract_mul {b : α} (hb : 0 < b) (x : α) :
  to_Ico_mod 0 hb x = int.fract (x / b) * b :=
by simp [to_Ico_mod_eq_add_fract_mul]

lemma to_Ioc_mod_eq_sub_fract_mul (a : α) {b : α} (hb : 0 < b) (x : α) :
  to_Ioc_mod a hb x = a + b - int.fract ((a + b - x) / b) * b :=
begin
  rw [to_Ioc_mod, to_Ioc_div_eq_neg_floor, int.fract],
  field_simp [hb.ne.symm],
  ring
end

lemma to_Ico_mod_zero_one (x : α) : to_Ico_mod (0 : α) zero_lt_one x = int.fract x :=
by simp [to_Ico_mod_eq_add_fract_mul]

end linear_ordered_field

/-! ### Lemmas about unions of translates of intervals -/
section union

open set int

section linear_ordered_add_comm_group

variables {α : Type*} [linear_ordered_add_comm_group α] [archimedean α] (a : α) {b : α} (hb : 0 < b)
include hb

lemma Union_Ioc_add_zsmul : (⋃ (n : ℤ), Ioc (a + n • b) (a + (n + 1) • b)) = univ :=
begin
  refine eq_univ_iff_forall.mpr (λ x, mem_Union.mpr _),
  rcases sub_to_Ioc_div_zsmul_mem_Ioc a hb x with ⟨hl, hr⟩,
  refine ⟨to_Ioc_div a hb x, ⟨lt_sub_iff_add_lt.mp hl, _⟩⟩,
  rw [add_smul, one_smul, ←add_assoc],
  convert sub_le_iff_le_add.mp hr using 1, abel,
end

lemma Union_Ico_add_zsmul : (⋃ (n : ℤ), Ico (a + n • b) (a + (n + 1) • b)) = univ :=
begin
  refine eq_univ_iff_forall.mpr (λ x, mem_Union.mpr _),
  rcases sub_to_Ico_div_zsmul_mem_Ico a hb x with ⟨hl, hr⟩,
  refine ⟨to_Ico_div a hb x, ⟨le_sub_iff_add_le.mp hl, _⟩⟩,
  rw [add_smul, one_smul, ←add_assoc],
  convert sub_lt_iff_lt_add.mp hr using 1, abel,
end

lemma Union_Icc_add_zsmul : (⋃ (n : ℤ), Icc (a + n • b) (a + (n + 1) • b)) = univ :=
by simpa only [Union_Ioc_add_zsmul a hb, univ_subset_iff] using
  Union_mono (λ n : ℤ, (Ioc_subset_Icc_self : Ioc (a + n • b) (a + (n + 1) • b) ⊆ Icc _ _))

lemma Union_Ioc_zsmul : (⋃ (n : ℤ), Ioc (n • b) ((n + 1) • b)) = univ :=
by simpa only [zero_add] using Union_Ioc_add_zsmul 0 hb

lemma Union_Ico_zsmul : (⋃ (n : ℤ), Ico (n • b) ((n + 1) • b)) = univ :=
by simpa only [zero_add] using Union_Ico_add_zsmul 0 hb

lemma Union_Icc_zsmul : (⋃ (n : ℤ), Icc (n • b) ((n + 1) • b)) = univ :=
by simpa only [zero_add] using Union_Icc_add_zsmul 0 hb

end linear_ordered_add_comm_group

section linear_ordered_ring

variables {α : Type*} [linear_ordered_ring α] [archimedean α] (a : α)

lemma Union_Ioc_add_int_cast : (⋃ (n : ℤ), Ioc (a + n) (a + n + 1)) = set.univ :=
by simpa only [zsmul_one, int.cast_add, int.cast_one, ←add_assoc]
  using Union_Ioc_add_zsmul a zero_lt_one

lemma Union_Ico_add_int_cast : (⋃ (n : ℤ), Ico (a + n) (a + n + 1)) = set.univ :=
by simpa only [zsmul_one, int.cast_add, int.cast_one, ←add_assoc]
  using Union_Ico_add_zsmul a zero_lt_one

lemma Union_Icc_add_int_cast : (⋃ (n : ℤ), Icc (a + n) (a + n + 1)) = set.univ :=
by simpa only [zsmul_one, int.cast_add, int.cast_one, ←add_assoc]
  using Union_Icc_add_zsmul a (zero_lt_one' α)

variables (α)

lemma Union_Ioc_int_cast : (⋃ (n : ℤ), Ioc (n : α) (n + 1)) = set.univ :=
by simpa only [zero_add] using Union_Ioc_add_int_cast (0 : α)

lemma Union_Ico_int_cast : (⋃ (n : ℤ), Ico (n : α) (n + 1)) = set.univ :=
by simpa only [zero_add] using Union_Ico_add_int_cast (0 : α)

lemma Union_Icc_int_cast : (⋃ (n : ℤ), Icc (n : α) (n + 1)) = set.univ :=
by simpa only [zero_add] using Union_Icc_add_int_cast (0 : α)

end linear_ordered_ring

end union


import tactic.tidy

-- {! !} -> library search
example (n m k : ℕ) : n * (m - k) = n * m - n * k :=
nat.mul_sub_left_distrib n m k

lemma my_example : ∀ x : unit, x = unit.star :=
begin
   tidy
end

#print my_example

@[tidy] meta def big_bertha : tactic unit := `[finish]

lemma misc_tauto_a (p q : Prop) : (p ↔ p ∧ q) ↔ (p → q) :=
by tidy?

#print axioms misc_tauto_a

lemma misc_tauto_a' (p q : Prop) : (p ↔ p ∧ q) ↔ (p → q) :=
begin
 {! !}
end


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Yaël Dillies

! This file was ported from Lean 3 source module order.modular_lattice
! leanprover-community/mathlib commit 207cfac9fcd06138865b5d04f7091e46d9320432
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Cover
import Mathlib.Order.LatticeIntervals

/-!
# Modular Lattices

This file defines (semi)modular lattices, a kind of lattice useful in algebra.
For examples, look to the subobject lattices of abelian groups, submodules, and ideals, or consider
any distributive lattice.

## Typeclasses

We define (semi)modularity typeclasses as Prop-valued mixins.

* `IsWeakUpperModularLattice`: Weakly upper modular lattices. Lattice where `a ⊔ b` covers `a`
  and `b` if `a` and `b` both cover `a ⊓ b`.
* `IsWeakLowerModularLattice`: Weakly lower modular lattices. Lattice where `a` and `b` cover
  `a ⊓ b` if `a ⊔ b` covers both `a` and `b`
* `IsUpperModularLattice`: Upper modular lattices. Lattices where `a ⊔ b` covers `a` if `b`
  covers `a ⊓ b`.
* `IsLowerModularLattice`: Lower modular lattices. Lattices where `a` covers `a ⊓ b` if `a ⊔ b`
  covers `b`.
- `IsModularLattice`: Modular lattices. Lattices where `a ≤ c → (a ⊔ b) ⊓ c = a ⊔ (b ⊓ c)`. We
  only require an inequality because the other direction holds in all lattices.

## Main Definitions

- `infIccOrderIsoIccSup` gives an order isomorphism between the intervals
  `[a ⊓ b, a]` and `[b, a ⊔ b]`.
  This corresponds to the diamond (or second) isomorphism theorems of algebra.

## Main Results

- `isModularLattice_iff_inf_sup_inf_assoc`:
  Modularity is equivalent to the `inf_sup_inf_assoc`: `(x ⊓ z) ⊔ (y ⊓ z) = ((x ⊓ z) ⊔ y) ⊓ z`
- `DistribLattice.isModularLattice`: Distributive lattices are modular.

## References

* [Manfred Stern, *Semimodular lattices. {Theory} and applications*][stern2009]
* [Wikipedia, *Modular Lattice*][https://en.wikipedia.org/wiki/Modular_lattice]

## TODO

- Relate atoms and coatoms in modular lattices
-/

open Set

variable {α : Type _}

/-- A weakly upper modular lattice is a lattice where `a ⊔ b` covers `a` and `b` if `a` and `b` both
cover `a ⊓ b`. -/
class IsWeakUpperModularLattice (α : Type _) [Lattice α] : Prop where
/-- `a ⊔ b` covers `a` and `b` if `a` and `b` both cover `a ⊓ b`. -/
  covby_sup_of_inf_covby_covby {a b : α} : a ⊓ b ⋖ a → a ⊓ b ⋖ b → a ⋖ a ⊔ b
#align is_weak_upper_modular_lattice IsWeakUpperModularLattice

/-- A weakly lower modular lattice is a lattice where `a` and `b` cover `a ⊓ b` if `a ⊔ b` covers
both `a` and `b`. -/
class IsWeakLowerModularLattice (α : Type _) [Lattice α] : Prop where
/-- `a` and `b` cover `a ⊓ b` if `a ⊔ b` covers both `a` and `b` -/
  inf_covby_of_covby_covby_sup {a b : α} : a ⋖ a ⊔ b → b ⋖ a ⊔ b → a ⊓ b ⋖ a
#align is_weak_lower_modular_lattice IsWeakLowerModularLattice

/-- An upper modular lattice, aka semimodular lattice, is a lattice where `a ⊔ b` covers `a` and `b`
if either `a` or `b` covers `a ⊓ b`. -/
class IsUpperModularLattice (α : Type _) [Lattice α] : Prop where
/-- `a ⊔ b` covers `a` and `b` if either `a` or `b` covers `a ⊓ b` -/
  covby_sup_of_inf_covby {a b : α} : a ⊓ b ⋖ a → b ⋖ a ⊔ b
#align is_upper_modular_lattice IsUpperModularLattice

/-- A lower modular lattice is a lattice where `a` and `b` both cover `a ⊓ b` if `a ⊔ b` covers
either `a` or `b`. -/
class IsLowerModularLattice (α : Type _) [Lattice α] : Prop where
/-- `a` and `b` both cover `a ⊓ b` if `a ⊔ b` covers either `a` or `b` -/
  inf_covby_of_covby_sup {a b : α} : a ⋖ a ⊔ b → a ⊓ b ⋖ b
#align is_lower_modular_lattice IsLowerModularLattice

/-- A modular lattice is one with a limited associativity between `⊓` and `⊔`. -/
class IsModularLattice (α : Type _) [Lattice α] : Prop where
/-- Whenever `x ≤ z`, then for any `y`, `(x ⊔ y) ⊓ z ≤ x ⊔ (y ⊓ z)`  -/
  sup_inf_le_assoc_of_le : ∀ {x : α} (y : α) {z : α}, x ≤ z → (x ⊔ y) ⊓ z ≤ x ⊔ y ⊓ z
#align is_modular_lattice IsModularLattice

section WeakUpperModular

variable [Lattice α] [IsWeakUpperModularLattice α] {a b : α}

theorem covby_sup_of_inf_covby_of_inf_covby_left : a ⊓ b ⋖ a → a ⊓ b ⋖ b → a ⋖ a ⊔ b :=
  IsWeakUpperModularLattice.covby_sup_of_inf_covby_covby
#align covby_sup_of_inf_covby_of_inf_covby_left covby_sup_of_inf_covby_of_inf_covby_left

theorem covby_sup_of_inf_covby_of_inf_covby_right : a ⊓ b ⋖ a → a ⊓ b ⋖ b → b ⋖ a ⊔ b := by
  rw [inf_comm, sup_comm]
  exact fun ha hb => covby_sup_of_inf_covby_of_inf_covby_left hb ha
#align covby_sup_of_inf_covby_of_inf_covby_right covby_sup_of_inf_covby_of_inf_covby_right

alias covby_sup_of_inf_covby_of_inf_covby_left ← Covby.sup_of_inf_of_inf_left
#align covby.sup_of_inf_of_inf_left Covby.sup_of_inf_of_inf_left

alias covby_sup_of_inf_covby_of_inf_covby_right ← Covby.sup_of_inf_of_inf_right
#align covby.sup_of_inf_of_inf_right Covby.sup_of_inf_of_inf_right

instance : IsWeakLowerModularLattice (OrderDual α) :=
  ⟨fun ha hb => (ha.ofDual.sup_of_inf_of_inf_left hb.ofDual).toDual⟩

end WeakUpperModular

section WeakLowerModular

variable [Lattice α] [IsWeakLowerModularLattice α] {a b : α}

theorem inf_covby_of_covby_sup_of_covby_sup_left : a ⋖ a ⊔ b → b ⋖ a ⊔ b → a ⊓ b ⋖ a :=
  IsWeakLowerModularLattice.inf_covby_of_covby_covby_sup
#align inf_covby_of_covby_sup_of_covby_sup_left inf_covby_of_covby_sup_of_covby_sup_left

theorem inf_covby_of_covby_sup_of_covby_sup_right : a ⋖ a ⊔ b → b ⋖ a ⊔ b → a ⊓ b ⋖ b := by
  rw [sup_comm, inf_comm]
  exact fun ha hb => inf_covby_of_covby_sup_of_covby_sup_left hb ha
#align inf_covby_of_covby_sup_of_covby_sup_right inf_covby_of_covby_sup_of_covby_sup_right

alias inf_covby_of_covby_sup_of_covby_sup_left ← Covby.inf_of_sup_of_sup_left
#align covby.inf_of_sup_of_sup_left Covby.inf_of_sup_of_sup_left

alias inf_covby_of_covby_sup_of_covby_sup_right ← Covby.inf_of_sup_of_sup_right
#align covby.inf_of_sup_of_sup_right Covby.inf_of_sup_of_sup_right

instance : IsWeakUpperModularLattice (OrderDual α) :=
  ⟨fun ha hb => (ha.ofDual.inf_of_sup_of_sup_left hb.ofDual).toDual⟩

end WeakLowerModular

section UpperModular

variable [Lattice α] [IsUpperModularLattice α] {a b : α}

theorem covby_sup_of_inf_covby_left : a ⊓ b ⋖ a → b ⋖ a ⊔ b :=
  IsUpperModularLattice.covby_sup_of_inf_covby
#align covby_sup_of_inf_covby_left covby_sup_of_inf_covby_left

theorem covby_sup_of_inf_covby_right : a ⊓ b ⋖ b → a ⋖ a ⊔ b := by
  rw [sup_comm, inf_comm]
  exact covby_sup_of_inf_covby_left
#align covby_sup_of_inf_covby_right covby_sup_of_inf_covby_right

alias covby_sup_of_inf_covby_left ← Covby.sup_of_inf_left
#align covby.sup_of_inf_left Covby.sup_of_inf_left

alias covby_sup_of_inf_covby_right ← Covby.sup_of_inf_right
#align covby.sup_of_inf_right Covby.sup_of_inf_right

-- See note [lower instance priority]
instance (priority := 100) IsUpperModularLattice.to_isWeakUpperModularLattice :
    IsWeakUpperModularLattice α :=
  ⟨fun _ => Covby.sup_of_inf_right⟩
#align is_upper_modular_lattice.to_is_weak_upper_modular_lattice IsUpperModularLattice.to_isWeakUpperModularLattice

instance : IsLowerModularLattice (OrderDual α) :=
  ⟨fun h => h.ofDual.sup_of_inf_left.toDual⟩

end UpperModular

section LowerModular

variable [Lattice α] [IsLowerModularLattice α] {a b : α}

theorem inf_covby_of_covby_sup_left : a ⋖ a ⊔ b → a ⊓ b ⋖ b :=
  IsLowerModularLattice.inf_covby_of_covby_sup
#align inf_covby_of_covby_sup_left inf_covby_of_covby_sup_left

theorem inf_covby_of_covby_sup_right : b ⋖ a ⊔ b → a ⊓ b ⋖ a := by
  rw [inf_comm, sup_comm]
  exact inf_covby_of_covby_sup_left
#align inf_covby_of_covby_sup_right inf_covby_of_covby_sup_right

alias inf_covby_of_covby_sup_left ← Covby.inf_of_sup_left
#align covby.inf_of_sup_left Covby.inf_of_sup_left

alias inf_covby_of_covby_sup_right ← Covby.inf_of_sup_right
#align covby.inf_of_sup_right Covby.inf_of_sup_right

-- See note [lower instance priority]
instance (priority := 100) IsLowerModularLattice.to_isWeakLowerModularLattice :
    IsWeakLowerModularLattice α :=
  ⟨fun _ => Covby.inf_of_sup_right⟩
#align is_lower_modular_lattice.to_is_weak_lower_modular_lattice IsLowerModularLattice.to_isWeakLowerModularLattice

instance : IsUpperModularLattice (OrderDual α) :=
  ⟨fun h => h.ofDual.inf_of_sup_left.toDual⟩

end LowerModular

section IsModularLattice

variable [Lattice α] [IsModularLattice α]

theorem sup_inf_assoc_of_le {x : α} (y : α) {z : α} (h : x ≤ z) : (x ⊔ y) ⊓ z = x ⊔ y ⊓ z :=
  le_antisymm (IsModularLattice.sup_inf_le_assoc_of_le y h)
    (le_inf (sup_le_sup_left inf_le_left _) (sup_le h inf_le_right))
#align sup_inf_assoc_of_le sup_inf_assoc_of_le

theorem IsModularLattice.inf_sup_inf_assoc {x y z : α} : x ⊓ z ⊔ y ⊓ z = (x ⊓ z ⊔ y) ⊓ z :=
  (sup_inf_assoc_of_le y inf_le_right).symm
#align is_modular_lattice.inf_sup_inf_assoc IsModularLattice.inf_sup_inf_assoc

theorem inf_sup_assoc_of_le {x : α} (y : α) {z : α} (h : z ≤ x) : x ⊓ y ⊔ z = x ⊓ (y ⊔ z) := by
  rw [inf_comm, sup_comm, ← sup_inf_assoc_of_le y h, inf_comm, sup_comm]
#align inf_sup_assoc_of_le inf_sup_assoc_of_le

instance : IsModularLattice αᵒᵈ :=
  ⟨fun y z xz =>
    le_of_eq
      (by
        rw [inf_comm, sup_comm, eq_comm, inf_comm, sup_comm]
        exact @sup_inf_assoc_of_le α _ _ _ y _ xz)⟩

variable {x y z : α}

theorem IsModularLattice.sup_inf_sup_assoc : (x ⊔ z) ⊓ (y ⊔ z) = (x ⊔ z) ⊓ y ⊔ z :=
  @IsModularLattice.inf_sup_inf_assoc αᵒᵈ _ _ _ _ _
#align is_modular_lattice.sup_inf_sup_assoc IsModularLattice.sup_inf_sup_assoc

theorem eq_of_le_of_inf_le_of_sup_le (hxy : x ≤ y) (hinf : y ⊓ z ≤ x ⊓ z) (hsup : y ⊔ z ≤ x ⊔ z) :
    x = y :=
  le_antisymm hxy <|
    have h : y ≤ x ⊔ z :=
      calc
        y ≤ y ⊔ z := le_sup_left
        _ ≤ x ⊔ z := hsup

    calc
      y ≤ (x ⊔ z) ⊓ y := le_inf h le_rfl
      _ = x ⊔ z ⊓ y := sup_inf_assoc_of_le _ hxy
      _ ≤ x ⊔ z ⊓ x := sup_le_sup_left (by rw [inf_comm, @inf_comm _ _ z]; exact hinf) _
      _ ≤ x := sup_le le_rfl inf_le_right

#align eq_of_le_of_inf_le_of_sup_le eq_of_le_of_inf_le_of_sup_le

theorem sup_lt_sup_of_lt_of_inf_le_inf (hxy : x < y) (hinf : y ⊓ z ≤ x ⊓ z) : x ⊔ z < y ⊔ z :=
  lt_of_le_of_ne (sup_le_sup_right (le_of_lt hxy) _) fun hsup =>
    ne_of_lt hxy <| eq_of_le_of_inf_le_of_sup_le (le_of_lt hxy) hinf (le_of_eq hsup.symm)
#align sup_lt_sup_of_lt_of_inf_le_inf sup_lt_sup_of_lt_of_inf_le_inf

theorem inf_lt_inf_of_lt_of_sup_le_sup (hxy : x < y) (hinf : y ⊔ z ≤ x ⊔ z) : x ⊓ z < y ⊓ z :=
  @sup_lt_sup_of_lt_of_inf_le_inf αᵒᵈ _ _ _ _ _ hxy hinf
#align inf_lt_inf_of_lt_of_sup_le_sup inf_lt_inf_of_lt_of_sup_le_sup

/-- A generalization of the theorem that if `N` is a submodule of `M` and
  `N` and `M / N` are both Artinian, then `M` is Artinian. -/
theorem wellFounded_lt_exact_sequence {β γ : Type _} [PartialOrder β] [Preorder γ]
    (h₁ : WellFounded ((· < ·) : β → β → Prop)) (h₂ : WellFounded ((· < ·) : γ → γ → Prop)) (K : α)
    (f₁ : β → α) (f₂ : α → β) (g₁ : γ → α) (g₂ : α → γ) (gci : GaloisCoinsertion f₁ f₂)
    (gi : GaloisInsertion g₂ g₁) (hf : ∀ a, f₁ (f₂ a) = a ⊓ K) (hg : ∀ a, g₁ (g₂ a) = a ⊔ K) :
    WellFounded ((· < ·) : α → α → Prop) :=
  Subrelation.wf
    (@fun A B hAB =>
      show Prod.Lex (· < ·) (· < ·) (f₂ A, g₂ A) (f₂ B, g₂ B) by
        simp only [Prod.lex_def, lt_iff_le_not_le, ← gci.l_le_l_iff, ← gi.u_le_u_iff, hf, hg,
          le_antisymm_iff]
        simp only [gci.l_le_l_iff, gi.u_le_u_iff, ← lt_iff_le_not_le, ← le_antisymm_iff]
        cases' lt_or_eq_of_le (inf_le_inf_right K (le_of_lt hAB)) with h h
        · exact Or.inl h
        · exact Or.inr ⟨h, sup_lt_sup_of_lt_of_inf_le_inf hAB (le_of_eq h.symm)⟩)
    (InvImage.wf _ (h₁.prod_lex h₂))
#align well_founded_lt_exact_sequence wellFounded_lt_exact_sequence

/-- A generalization of the theorem that if `N` is a submodule of `M` and
  `N` and `M / N` are both Noetherian, then `M` is Noetherian.  -/
theorem wellFounded_gt_exact_sequence {β γ : Type _} [Preorder β] [PartialOrder γ]
    (h₁ : WellFounded ((· > ·) : β → β → Prop)) (h₂ : WellFounded ((· > ·) : γ → γ → Prop)) (K : α)
    (f₁ : β → α) (f₂ : α → β) (g₁ : γ → α) (g₂ : α → γ) (gci : GaloisCoinsertion f₁ f₂)
    (gi : GaloisInsertion g₂ g₁) (hf : ∀ a, f₁ (f₂ a) = a ⊓ K) (hg : ∀ a, g₁ (g₂ a) = a ⊔ K) :
    WellFounded ((· > ·) : α → α → Prop) :=
  @wellFounded_lt_exact_sequence αᵒᵈ _ _ γᵒᵈ βᵒᵈ _ _ h₂ h₁ K g₁ g₂ f₁ f₂ gi.dual gci.dual hg hf
#align well_founded_gt_exact_sequence wellFounded_gt_exact_sequence

/-- The diamond isomorphism between the intervals `[a ⊓ b, a]` and `[b, a ⊔ b]` -/
@[simps]
def infIccOrderIsoIccSup (a b : α) : Set.Icc (a ⊓ b) a ≃o Set.Icc b (a ⊔ b) where
  toFun x := ⟨x ⊔ b, ⟨le_sup_right, sup_le_sup_right x.prop.2 b⟩⟩
  invFun x := ⟨a ⊓ x, ⟨inf_le_inf_left a x.prop.1, inf_le_left⟩⟩
  left_inv x :=
    Subtype.ext
      (by
        change a ⊓ (↑x ⊔ b) = ↑x
        rw [sup_comm, ← inf_sup_assoc_of_le _ x.prop.2, sup_eq_right.2 x.prop.1])
  right_inv x :=
    Subtype.ext
      (by
        change a ⊓ ↑x ⊔ b = ↑x
        rw [inf_comm, inf_sup_assoc_of_le _ x.prop.1, inf_eq_left.2 x.prop.2])
  map_rel_iff' := @fun x y => by
    simp only [Subtype.mk_le_mk, Equiv.coe_fn_mk, and_true_iff, le_sup_right]
    rw [← Subtype.coe_le_coe]
    refine' ⟨fun h => _, fun h => sup_le_sup_right h _⟩
    rw [← sup_eq_right.2 x.prop.1, inf_sup_assoc_of_le _ x.prop.2, sup_comm, ←
      sup_eq_right.2 y.prop.1, inf_sup_assoc_of_le _ y.prop.2, @sup_comm _ _ b]
    exact inf_le_inf_left _ h
#align inf_Icc_order_iso_Icc_sup infIccOrderIsoIccSup
#align inf_Icc_order_iso_Icc_sup_apply_coe infIccOrderIsoIccSup_apply_coe
#align inf_Icc_order_iso_Icc_sup_symm_apply_coe infIccOrderIsoIccSup_symm_apply_coe

theorem inf_strictMonoOn_Icc_sup {a b : α} : StrictMonoOn (fun c => a ⊓ c) (Icc b (a ⊔ b)) :=
  StrictMono.of_restrict (infIccOrderIsoIccSup a b).symm.strictMono
#align inf_strict_mono_on_Icc_sup inf_strictMonoOn_Icc_sup

theorem sup_strictMonoOn_Icc_inf {a b : α} : StrictMonoOn (fun c => c ⊔ b) (Icc (a ⊓ b) a) :=
  StrictMono.of_restrict (infIccOrderIsoIccSup a b).strictMono
#align sup_strict_mono_on_Icc_inf sup_strictMonoOn_Icc_inf

/-- The diamond isomorphism between the intervals `]a ⊓ b, a[` and `}b, a ⊔ b[`. -/
@[simps]
def infIooOrderIsoIooSup (a b : α) : Ioo (a ⊓ b) a ≃o Ioo b (a ⊔ b) where
  toFun c :=
    ⟨c ⊔ b,
      le_sup_right.trans_lt <|
        sup_strictMonoOn_Icc_inf (left_mem_Icc.2 inf_le_left) (Ioo_subset_Icc_self c.2) c.2.1,
      sup_strictMonoOn_Icc_inf (Ioo_subset_Icc_self c.2) (right_mem_Icc.2 inf_le_left) c.2.2⟩
  invFun c :=
    ⟨a ⊓ c,
      inf_strictMonoOn_Icc_sup (left_mem_Icc.2 le_sup_right) (Ioo_subset_Icc_self c.2) c.2.1,
      inf_le_left.trans_lt' <|
        inf_strictMonoOn_Icc_sup (Ioo_subset_Icc_self c.2) (right_mem_Icc.2 le_sup_right) c.2.2⟩
  left_inv c :=
    Subtype.ext <| by
      dsimp
      rw [sup_comm, ← inf_sup_assoc_of_le _ c.prop.2.le, sup_eq_right.2 c.prop.1.le]
  right_inv c :=
    Subtype.ext <| by
      dsimp
      rw [inf_comm, inf_sup_assoc_of_le _ c.prop.1.le, inf_eq_left.2 c.prop.2.le]
  map_rel_iff' := @fun c d =>
    @OrderIso.le_iff_le _ _ _ _ (infIccOrderIsoIccSup _ _) ⟨c.1, Ioo_subset_Icc_self c.2⟩
      ⟨d.1, Ioo_subset_Icc_self d.2⟩
#align inf_Ioo_order_iso_Ioo_sup infIooOrderIsoIooSup
#align inf_Ioo_order_iso_Ioo_sup_apply_coe infIooOrderIsoIooSup_apply_coe
#align inf_Ioo_order_iso_Ioo_sup_symm_apply_coe infIooOrderIsoIooSup_symm_apply_coe

-- See note [lower instance priority]
instance (priority := 100) IsModularLattice.to_isLowerModularLattice : IsLowerModularLattice α :=
  ⟨fun {a b} => by
    simp_rw [covby_iff_Ioo_eq, @sup_comm _ _ a, @inf_comm _ _ a, ← isEmpty_coe_sort, right_lt_sup,
      inf_lt_left, (infIooOrderIsoIooSup b a).symm.toEquiv.isEmpty_congr]
    exact id⟩
#align is_modular_lattice.to_is_lower_modular_lattice IsModularLattice.to_isLowerModularLattice

-- See note [lower instance priority]
instance (priority := 100) IsModularLattice.to_isUpperModularLattice : IsUpperModularLattice α :=
  ⟨fun {a b} => by
    simp_rw [covby_iff_Ioo_eq, ← isEmpty_coe_sort, right_lt_sup, inf_lt_left,
      (infIooOrderIsoIooSup a b).toEquiv.isEmpty_congr]
    exact id⟩
#align is_modular_lattice.to_is_upper_modular_lattice IsModularLattice.to_isUpperModularLattice

end IsModularLattice

namespace IsCompl

variable [Lattice α] [BoundedOrder α] [IsModularLattice α]

/-- The diamond isomorphism between the intervals `Set.Iic a` and `Set.Ici b`. -/
def IicOrderIsoIci {a b : α} (h : IsCompl a b) : Set.Iic a ≃o Set.Ici b :=
  (OrderIso.setCongr (Set.Iic a) (Set.Icc (a ⊓ b) a)
        (h.inf_eq_bot.symm ▸ Set.Icc_bot.symm)).trans <|
    (infIccOrderIsoIccSup a b).trans
      (OrderIso.setCongr (Set.Icc b (a ⊔ b)) (Set.Ici b) (h.sup_eq_top.symm ▸ Set.Icc_top))
#align is_compl.Iic_order_iso_Ici IsCompl.IicOrderIsoIci

end IsCompl

theorem isModularLattice_iff_inf_sup_inf_assoc [Lattice α] :
    IsModularLattice α ↔ ∀ x y z : α, x ⊓ z ⊔ y ⊓ z = (x ⊓ z ⊔ y) ⊓ z :=
  ⟨fun h => @IsModularLattice.inf_sup_inf_assoc _ _ h, fun h =>
    ⟨fun y z xz => by rw [← inf_eq_left.2 xz, h]⟩⟩
#align is_modular_lattice_iff_inf_sup_inf_assoc isModularLattice_iff_inf_sup_inf_assoc

namespace DistribLattice

instance (priority := 100) [DistribLattice α] : IsModularLattice α :=
  ⟨fun y z xz => by rw [inf_sup_right, inf_eq_left.2 xz]⟩

end DistribLattice

theorem Disjoint.disjoint_sup_right_of_disjoint_sup_left [Lattice α] [OrderBot α]
    [IsModularLattice α] {a b c : α} (h : Disjoint a b) (hsup : Disjoint (a ⊔ b) c) :
    Disjoint a (b ⊔ c) := by
  rw [disjoint_iff_inf_le, ← h.eq_bot, sup_comm]
  apply le_inf inf_le_left
  apply (inf_le_inf_right (c ⊔ b) le_sup_right).trans
  rw [sup_comm, IsModularLattice.sup_inf_sup_assoc, hsup.eq_bot, bot_sup_eq]
#align disjoint.disjoint_sup_right_of_disjoint_sup_left Disjoint.disjoint_sup_right_of_disjoint_sup_left

theorem Disjoint.disjoint_sup_left_of_disjoint_sup_right [Lattice α] [OrderBot α]
    [IsModularLattice α] {a b c : α} (h : Disjoint b c) (hsup : Disjoint a (b ⊔ c)) :
    Disjoint (a ⊔ b) c := by
  rw [disjoint_comm, sup_comm]
  apply Disjoint.disjoint_sup_right_of_disjoint_sup_left h.symm
  rwa [sup_comm, disjoint_comm] at hsup
#align disjoint.disjoint_sup_left_of_disjoint_sup_right Disjoint.disjoint_sup_left_of_disjoint_sup_right

namespace IsModularLattice

variable [Lattice α] [IsModularLattice α] {a : α}

instance isModularLattice_Iic : IsModularLattice (Set.Iic a) :=
  ⟨@fun x y z xz => (sup_inf_le_assoc_of_le (y : α) xz : (↑x ⊔ ↑y) ⊓ ↑z ≤ ↑x ⊔ ↑y ⊓ ↑z)⟩
#align is_modular_lattice.is_modular_lattice_Iic IsModularLattice.isModularLattice_Iic

instance isModularLattice_Ici : IsModularLattice (Set.Ici a) :=
  ⟨@fun x y z xz => (sup_inf_le_assoc_of_le (y : α) xz : (↑x ⊔ ↑y) ⊓ ↑z ≤ ↑x ⊔ ↑y ⊓ ↑z)⟩
#align is_modular_lattice.is_modular_lattice_Ici IsModularLattice.isModularLattice_Ici

section ComplementedLattice

variable [BoundedOrder α] [ComplementedLattice α]

instance complementedLattice_Iic : ComplementedLattice (Set.Iic a) :=
  ⟨fun ⟨x, hx⟩ =>
    let ⟨y, hy⟩ := exists_isCompl x
    ⟨⟨y ⊓ a, Set.mem_Iic.2 inf_le_right⟩, by
      constructor
      · rw [disjoint_iff_inf_le]
        change x ⊓ (y ⊓ a) ≤ ⊥
        -- improve lattice subtype API
        rw [← inf_assoc]
        exact le_trans inf_le_left hy.1.le_bot
      · rw [codisjoint_iff_le_sup]
        change a ≤ x ⊔ y ⊓ a
        -- improve lattice subtype API
        rw [← sup_inf_assoc_of_le _ (Set.mem_Iic.1 hx), hy.2.eq_top, top_inf_eq]⟩⟩
#align is_modular_lattice.complemented_lattice_Iic IsModularLattice.complementedLattice_Iic

instance complementedLattice_Ici : ComplementedLattice (Set.Ici a) :=
  ⟨fun ⟨x, hx⟩ =>
    let ⟨y, hy⟩ := exists_isCompl x
    ⟨⟨y ⊔ a, Set.mem_Ici.2 le_sup_right⟩, by
      constructor
      · rw [disjoint_iff_inf_le]
        change x ⊓ (y ⊔ a) ≤ a
        -- improve lattice subtype API
        rw [← inf_sup_assoc_of_le _ (Set.mem_Ici.1 hx), hy.1.eq_bot, bot_sup_eq]
      · rw [codisjoint_iff_le_sup]
        change ⊤ ≤ x ⊔ (y ⊔ a)
        -- improve lattice subtype API
        rw [← sup_assoc]
        exact le_trans hy.2.top_le le_sup_left⟩⟩
#align is_modular_lattice.complemented_lattice_Ici IsModularLattice.complementedLattice_Ici

end ComplementedLattice

end IsModularLattice


/-
Copyright (c) 2021 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot
-/

import topology.algebra.valuation
import topology.algebra.with_zero_topology
import topology.algebra.uniform_field

/-!
# Valued fields and their completions

In this file we study the topology of a field `K` endowed with a valuation (in our application
to adic spaces, `K` will be the valuation field associated to some valuation on a ring, defined in
valuation.basic).

We already know from valuation.topology that one can build a topology on `K` which
makes it a topological ring.

The first goal is to show `K` is a topological *field*, ie inversion is continuous
at every non-zero element.

The next goal is to prove `K` is a *completable* topological field. This gives us
a completion `hat K` which is a topological field. We also prove that `K` is automatically
separated, so the map from `K` to `hat K` is injective.

Then we extend the valuation given on `K` to a valuation on `hat K`.
-/

open filter set
open_locale topology

section division_ring

variables {K : Type*} [division_ring K] {Γ₀ : Type*} [linear_ordered_comm_group_with_zero Γ₀]

section valuation_topological_division_ring

section inversion_estimate
variables (v : valuation K Γ₀)

-- The following is the main technical lemma ensuring that inversion is continuous
-- in the topology induced by a valuation on a division ring (ie the next instance)
-- and the fact that a valued field is completable
-- [BouAC, VI.5.1 Lemme 1]
lemma valuation.inversion_estimate {x y : K} {γ : Γ₀ˣ} (y_ne : y ≠ 0)
  (h : v (x - y) < min (γ * ((v y) * (v y))) (v y)) :
  v (x⁻¹ - y⁻¹) < γ :=
begin
  have hyp1 : v (x - y) < γ * ((v y) * (v y)),
    from lt_of_lt_of_le h (min_le_left _ _),
  have hyp1' : v (x - y) * ((v y) * (v y))⁻¹ < γ,
    from mul_inv_lt_of_lt_mul₀ hyp1,
  have hyp2 : v (x - y) < v y,
    from lt_of_lt_of_le h (min_le_right _ _),
  have key : v x = v y, from valuation.map_eq_of_sub_lt v hyp2,
  have x_ne : x ≠ 0,
  { intro h,
    apply y_ne,
    rw [h, v.map_zero] at key,
    exact v.zero_iff.1 key.symm },
  have decomp : x⁻¹ - y⁻¹ = x⁻¹ * (y - x) * y⁻¹,
  by rw [mul_sub_left_distrib, sub_mul, mul_assoc,
        show y * y⁻¹ = 1, from mul_inv_cancel y_ne,
        show x⁻¹ * x = 1, from inv_mul_cancel x_ne, mul_one, one_mul],
  calc
    v (x⁻¹ - y⁻¹) = v (x⁻¹ * (y - x) * y⁻¹) : by rw decomp
    ... = (v x⁻¹) * (v $ y - x) * (v y⁻¹) : by repeat { rw valuation.map_mul }
    ... = (v x)⁻¹ * (v $ y - x) * (v y)⁻¹ : by rw [map_inv₀, map_inv₀]
    ... = (v $ y - x) * ((v y) * (v y))⁻¹ : by
      { rw [mul_assoc, mul_comm, key, mul_assoc, mul_inv_rev] }
    ... = (v $ y - x) * ((v y) * (v y))⁻¹ : rfl
    ... = (v $ x - y) * ((v y) * (v y))⁻¹ : by rw valuation.map_sub_swap
    ... < γ : hyp1',
end
end inversion_estimate

open valued

/-- The topology coming from a valuation on a division ring makes it a topological division ring
    [BouAC, VI.5.1 middle of Proposition 1] -/
@[priority 100]
instance valued.topological_division_ring [valued K Γ₀] : topological_division_ring K :=
{ continuous_at_inv₀ :=
    begin
      intros x x_ne s s_in,
      cases valued.mem_nhds.mp s_in with γ hs, clear s_in,
      rw [mem_map, valued.mem_nhds],
      change ∃ (γ : Γ₀ˣ), {y : K | (v (y - x) : Γ₀) < γ} ⊆ {x : K | x⁻¹ ∈ s},
      have vx_ne := (valuation.ne_zero_iff $ v).mpr x_ne,
      let γ' := units.mk0 _ vx_ne,
      use min (γ * (γ'*γ')) γ',
      intros y y_in,
      apply hs,
      simp only [mem_set_of_eq] at y_in,
      rw [units.min_coe, units.coe_mul, units.coe_mul] at y_in,
      exact valuation.inversion_estimate _ x_ne y_in
    end,
  ..(by apply_instance : topological_ring K) }

/-- A valued division ring is separated. -/
@[priority 100]
instance valued_ring.separated [valued K Γ₀] : separated_space K :=
begin
  rw separated_iff_t2,
  apply topological_add_group.t2_space_of_zero_sep,
  intros x x_ne,
  refine ⟨{k | v k < v x}, _, λ h, lt_irrefl _ h⟩,
  rw valued.mem_nhds,
  have vx_ne := (valuation.ne_zero_iff $ v).mpr x_ne,
  let γ' := units.mk0 _ vx_ne,
  exact ⟨γ', λ y hy, by simpa using hy⟩,
end

section

open_locale with_zero_topology
open valued

lemma valued.continuous_valuation [valued K Γ₀] : continuous (v : K → Γ₀) :=
begin
  rw continuous_iff_continuous_at,
  intro x,
  rcases eq_or_ne x 0 with rfl|h,
  { rw [continuous_at, map_zero, with_zero_topology.tendsto_zero],
    intros γ hγ,
    rw [filter.eventually, valued.mem_nhds_zero],
    use [units.mk0 γ hγ, subset.rfl] },
  { have v_ne : (v x : Γ₀) ≠ 0, from (valuation.ne_zero_iff _).mpr h,
    rw [continuous_at, with_zero_topology.tendsto_of_ne_zero v_ne],
    apply valued.loc_const v_ne },
end
end

end valuation_topological_division_ring

end division_ring

namespace valued
open uniform_space

variables {K : Type*} [field K] {Γ₀ : Type*} [linear_ordered_comm_group_with_zero Γ₀]
  [hv: valued K Γ₀]

include hv

local notation `hat ` := completion

/-- A valued field is completable. -/
@[priority 100]
instance completable : completable_top_field K :=
{ nice := begin
    rintros F hF h0,
    have : ∃ (γ₀ : Γ₀ˣ) (M ∈ F), ∀ x ∈ M, (γ₀ : Γ₀) ≤ v x,
    { rcases filter.inf_eq_bot_iff.mp h0 with ⟨U, U_in, M, M_in, H⟩,
      rcases valued.mem_nhds_zero.mp U_in with ⟨γ₀, hU⟩,
      existsi [γ₀, M, M_in],
      intros x xM,
      apply le_of_not_lt _,
      intro hyp,
      have : x ∈ U ∩ M := ⟨hU hyp, xM⟩,
      rwa H at this },
    rcases this with ⟨γ₀, M₀, M₀_in, H₀⟩,
    rw valued.cauchy_iff at hF ⊢,
    refine ⟨hF.1.map _, _⟩,
    replace hF := hF.2,
    intros γ,
    rcases hF (min (γ * γ₀ * γ₀) γ₀) with ⟨M₁, M₁_in, H₁⟩, clear hF,
    use (λ x : K, x⁻¹) '' (M₀ ∩ M₁),
    split,
    { rw mem_map,
      apply mem_of_superset (filter.inter_mem M₀_in M₁_in),
      exact subset_preimage_image _ _ },
    { rintros _ ⟨x, ⟨x_in₀, x_in₁⟩, rfl⟩ _ ⟨y, ⟨y_in₀, y_in₁⟩, rfl⟩,
      simp only [mem_set_of_eq],
      specialize H₁ x x_in₁ y y_in₁,
      replace x_in₀ := H₀ x x_in₀,
      replace y_in₀ := H₀ y y_in₀, clear H₀,
      apply valuation.inversion_estimate,
      { have : (v x : Γ₀) ≠ 0,
        { intro h, rw h at x_in₀, simpa using x_in₀, },
        exact (valuation.ne_zero_iff _).mp this },
      { refine lt_of_lt_of_le H₁ _,
        rw units.min_coe,
        apply min_le_min _ x_in₀,
        rw mul_assoc,
        have : ((γ₀ * γ₀ : Γ₀ˣ) : Γ₀) ≤ v x * v x,
          from calc ↑γ₀ * ↑γ₀ ≤ ↑γ₀ * v x : mul_le_mul_left' x_in₀ ↑γ₀
                          ... ≤ _ : mul_le_mul_right' x_in₀ (v x),
        rw units.coe_mul,
        exact mul_le_mul_left' this γ } }
  end,
  ..valued_ring.separated }

open_locale with_zero_topology

/-- The extension of the valuation of a valued field to the completion of the field. -/
noncomputable def extension : hat K → Γ₀ :=
completion.dense_inducing_coe.extend (v : K → Γ₀)

lemma continuous_extension : continuous (valued.extension : hat K → Γ₀) :=
 begin
  refine completion.dense_inducing_coe.continuous_extend _,
  intro x₀,
  rcases eq_or_ne x₀ 0 with rfl|h,
  { refine ⟨0, _⟩,
    erw [← completion.dense_inducing_coe.to_inducing.nhds_eq_comap],
    exact valued.continuous_valuation.tendsto' 0 0 (map_zero v) },
  { have preimage_one : v ⁻¹' {(1 : Γ₀)} ∈ 𝓝 (1 : K),
    { have : (v (1 : K) : Γ₀) ≠ 0, { rw valuation.map_one, exact zero_ne_one.symm },
      convert valued.loc_const this,
      ext x,
      rw [valuation.map_one, mem_preimage, mem_singleton_iff, mem_set_of_eq] },
    obtain ⟨V, V_in, hV⟩ : ∃ V ∈ 𝓝 (1 : hat K), ∀ x : K, (x : hat K) ∈ V → (v x : Γ₀) = 1,
    { rwa [completion.dense_inducing_coe.nhds_eq_comap, mem_comap] at preimage_one },

    have : ∃ V' ∈ (𝓝 (1 : hat K)), (0 : hat K) ∉ V' ∧ ∀ x y ∈ V', x*y⁻¹ ∈ V,
    { have : tendsto (λ p : hat K × hat K, p.1*p.2⁻¹) ((𝓝 1).prod (𝓝 1)) (𝓝 1),
      { rw ← nhds_prod_eq,
        conv {congr, skip, skip, rw ← (one_mul (1 : hat K))},
        refine tendsto.mul continuous_fst.continuous_at
                           (tendsto.comp _ continuous_snd.continuous_at),
        convert continuous_at_inv₀ (zero_ne_one.symm : 1 ≠ (0 : hat K)),
        exact inv_one.symm },
      rcases tendsto_prod_self_iff.mp this V V_in with ⟨U, U_in, hU⟩,
      let hatKstar := ({0}ᶜ : set $ hat K),
      have : hatKstar ∈ 𝓝 (1 : hat K),
      from compl_singleton_mem_nhds zero_ne_one.symm,
      use  [U ∩ hatKstar, filter.inter_mem U_in this],
      split,
      { rintro ⟨h, h'⟩,
        rw mem_compl_singleton_iff at h',
        exact h' rfl },
      { rintros x ⟨hx, _⟩ y ⟨hy, _⟩,
        apply hU ; assumption } },
    rcases this with ⟨V', V'_in, zeroV', hV'⟩,
    have nhds_right : (λ x, x*x₀) '' V' ∈ 𝓝 x₀,
    { have l : function.left_inverse (λ x : hat K, x * x₀⁻¹) (λ x : hat K, x * x₀),
      { intro x,
        simp only [mul_assoc, mul_inv_cancel h, mul_one] },
      have r: function.right_inverse (λ x : hat K, x * x₀⁻¹) (λ x : hat K, x * x₀),
      { intro x,
        simp only [mul_assoc, inv_mul_cancel h, mul_one] },
      have c : continuous  (λ x : hat K, x * x₀⁻¹),
        from continuous_id.mul continuous_const,
      rw image_eq_preimage_of_inverse l r,
      rw ← mul_inv_cancel h at V'_in,
      exact c.continuous_at V'_in },
    have : ∃ (z₀ : K) (y₀ ∈ V'), coe z₀ = y₀*x₀ ∧ z₀ ≠ 0,
    { rcases completion.dense_range_coe.mem_nhds nhds_right with ⟨z₀, y₀, y₀_in, H : y₀ * x₀ = z₀⟩,
      refine ⟨z₀, y₀, y₀_in, ⟨H.symm, _⟩⟩,
      rintro rfl,
      exact mul_ne_zero (ne_of_mem_of_not_mem y₀_in zeroV') h H },
    rcases this with ⟨z₀, y₀, y₀_in, hz₀, z₀_ne⟩,
    have vz₀_ne: (v z₀ : Γ₀) ≠ 0 := by rwa valuation.ne_zero_iff,
    refine ⟨v z₀, _⟩,
    rw [with_zero_topology.tendsto_of_ne_zero vz₀_ne, eventually_comap],
    filter_upwards [nhds_right] with x x_in a ha,
    rcases x_in with ⟨y, y_in, rfl⟩,
    have : (v (a * z₀⁻¹) : Γ₀) = 1,
    { apply hV,
      have : ((z₀⁻¹ : K) : hat K) = z₀⁻¹,
      from map_inv₀ (completion.coe_ring_hom : K →+* hat K) z₀,
      rw [completion.coe_mul, this, ha, hz₀, mul_inv, mul_comm y₀⁻¹, ← mul_assoc, mul_assoc y,
          mul_inv_cancel h, mul_one],
      solve_by_elim },
    calc v a = v (a * z₀⁻¹ * z₀) : by rw [mul_assoc, inv_mul_cancel z₀_ne, mul_one]
         ... = v (a * z₀⁻¹) * v z₀ : valuation.map_mul _ _ _
         ... = v z₀ : by rw [this, one_mul]  },
end

@[simp, norm_cast]
lemma extension_extends (x : K) : extension (x : hat K) = v x :=
begin
  refine completion.dense_inducing_coe.extend_eq_of_tendsto _,
  rw ← completion.dense_inducing_coe.nhds_eq_comap,
  exact valued.continuous_valuation.continuous_at,
end

/-- the extension of a valuation on a division ring to its completion. -/
noncomputable def extension_valuation :
  valuation (hat K) Γ₀ :=
{ to_fun := valued.extension,
  map_zero' := by { rw [← v.map_zero, ← valued.extension_extends (0 : K)], refl, },
  map_one' := by { rw [← completion.coe_one, valued.extension_extends (1 : K)],
                   exact valuation.map_one _ },
  map_mul' := λ x y, begin
    apply completion.induction_on₂ x y,
    { have c1 : continuous (λ (x : hat K × hat K), valued.extension (x.1 * x.2)),
        from valued.continuous_extension.comp (continuous_fst.mul continuous_snd),

      have c2 : continuous (λ (x : hat K × hat K), valued.extension x.1 * valued.extension x.2),
        from (valued.continuous_extension.comp continuous_fst).mul
              (valued.continuous_extension.comp continuous_snd),
      exact is_closed_eq c1 c2 },
    { intros x y,
      norm_cast,
      exact valuation.map_mul _ _ _ },
  end,
  map_add_le_max' := λ x y, begin
    rw le_max_iff,
    apply completion.induction_on₂ x y,
    { have cont : continuous (valued.extension : hat K → Γ₀) := valued.continuous_extension,
      exact  (is_closed_le (cont.comp continuous_add) $ cont.comp continuous_fst).union
        (is_closed_le (cont.comp continuous_add) $ cont.comp continuous_snd) },
    { intros x y,
      dsimp,
      norm_cast,
      rw ← le_max_iff,
      exact v.map_add x y, },
  end }

-- Bourbaki CA VI §5 no.3 Proposition 5 (d)
lemma closure_coe_completion_v_lt {γ : Γ₀ˣ} :
  closure (coe '' { x : K | v x < (γ : Γ₀) }) = { x : hat K | extension_valuation x < (γ : Γ₀) } :=
begin
  ext x,
  let γ₀ := extension_valuation x,
  suffices : γ₀ ≠ 0 → (x ∈ closure (coe '' { x : K | v x < (γ : Γ₀) }) ↔ γ₀ < (γ : Γ₀)),
  { cases eq_or_ne γ₀ 0,
    { simp only [h, (valuation.zero_iff _).mp h, mem_set_of_eq, valuation.map_zero, units.zero_lt,
        iff_true],
      apply subset_closure,
      exact ⟨0, by simpa only [mem_set_of_eq, valuation.map_zero, units.zero_lt, true_and]⟩, },
    { exact this h, }, },
  intros h,
  have hγ₀ : extension ⁻¹' {γ₀} ∈ 𝓝 x := continuous_extension.continuous_at.preimage_mem_nhds
    (with_zero_topology.singleton_mem_nhds_of_ne_zero h),
  rw mem_closure_iff_nhds',
  refine ⟨λ hx, _, λ hx s hs, _⟩,
  { obtain ⟨⟨-, y, hy₁ : v y < (γ : Γ₀), rfl⟩, hy₂⟩ := hx _ hγ₀,
    replace hy₂ : v y = γ₀, { simpa using hy₂, },
    rwa ← hy₂, },
  { obtain ⟨y, hy₁, hy₂ : ↑y ∈ s⟩ := completion.dense_range_coe.mem_nhds (inter_mem hγ₀ hs),
    replace hy₁ : v y = γ₀, { simpa using hy₁, },
    rw ← hy₁ at hx,
    exact ⟨⟨y, ⟨y, hx, rfl⟩⟩, hy₂⟩, },
end

noncomputable instance valued_completion : valued (hat K) Γ₀ :=
{ v := extension_valuation,
  is_topological_valuation := λ s,
  begin
    suffices : has_basis (𝓝 (0 : hat K)) (λ _, true) (λ γ : Γ₀ˣ, { x | extension_valuation x < γ }),
    { rw this.mem_iff,
      exact exists_congr (λ γ, by simp), },
    simp_rw ← closure_coe_completion_v_lt,
    exact (has_basis_nhds_zero K Γ₀).has_basis_of_dense_inducing completion.dense_inducing_coe,
  end }

@[simp, norm_cast] lemma valued_completion_apply (x : K) : valued.v (x : hat K) = v x :=
extension_extends x

end valued


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import algebra.order.absolute_value
import algebra.euclidean_domain.instances

/-!
# Euclidean absolute values

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file defines a predicate `absolute_value.is_euclidean abv` stating the
absolute value is compatible with the Euclidean domain structure on its domain.

## Main definitions

 * `absolute_value.is_euclidean abv` is a predicate on absolute values on `R` mapping to `S`
    that preserve the order on `R` arising from the Euclidean domain structure.
 * `absolute_value.abs_is_euclidean` shows the "standard" absolute value on `ℤ`,
   mapping negative `x` to `-x`, is euclidean.
-/
local infix ` ≺ `:50 := euclidean_domain.r

namespace absolute_value

section ordered_semiring

variables {R S : Type*} [euclidean_domain R] [ordered_semiring S]
variables (abv : absolute_value R S)

/-- An absolute value `abv : R → S` is Euclidean if it is compatible with the
`euclidean_domain` structure on `R`, namely `abv` is strictly monotone with respect to the well
founded relation `≺` on `R`. -/
structure is_euclidean : Prop :=
(map_lt_map_iff' : ∀ {x y}, abv x < abv y ↔ x ≺ y)

namespace is_euclidean

variables {abv}

-- Rearrange the parameters to `map_lt_map_iff'` so it elaborates better.
lemma map_lt_map_iff {x y : R} (h : abv.is_euclidean) : abv x < abv y ↔ x ≺ y :=
map_lt_map_iff' h

attribute [simp] map_lt_map_iff

lemma sub_mod_lt (h : abv.is_euclidean) (a : R) {b : R} (hb : b ≠ 0) :
  abv (a % b) < abv b :=
h.map_lt_map_iff.mpr (euclidean_domain.mod_lt a hb)

end is_euclidean

end ordered_semiring

section int

open int

-- TODO: generalize to `linear_ordered_euclidean_domain`s if we ever get a definition of those
/-- `abs : ℤ → ℤ` is a Euclidean absolute value -/
protected lemma abs_is_euclidean : is_euclidean (absolute_value.abs : absolute_value ℤ ℤ) :=
{ map_lt_map_iff' := λ x y, show abs x < abs y ↔ nat_abs x < nat_abs y,
    by rw [abs_eq_nat_abs, abs_eq_nat_abs, coe_nat_lt] }

end int

end absolute_value