/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import algebra.euclidean_domain
import data.int.cast
import data.nat.gcd
import logic.encodable.basic

/-!
# Basics for the Rational Numbers

## Summary

We define a rational number `q` as a structure `{ num, denom, pos, cop }`, where
- `num` is the numerator of `q`,
- `denom` is the denominator of `q`,
- `pos` is a proof that `denom > 0`, and
- `cop` is a proof `num` and `denom` are coprime.

We then define the expected (discrete) field structure on `ℚ` and prove basic lemmas about it.
Moreoever, we provide the expected casts from `ℕ` and `ℤ` into `ℚ`, i.e. `(↑n : ℚ) = n / 1`.

## Main Definitions

- `rat` is the structure encoding `ℚ`.
- `rat.mk n d` constructs a rational number `q = n / d` from `n d : ℤ`.

## Notations

- `/.` is infix notation for `rat.mk`.

## Tags

rat, rationals, field, ℚ, numerator, denominator, num, denom
-/

/-- `rat`, or `ℚ`, is the type of rational numbers. It is defined
  as the set of pairs ⟨n, d⟩ of integers such that `d` is positive and `n` and
  `d` are coprime. This representation is preferred to the quotient
  because without periodic reduction, the numerator and denominator can grow
  exponentially (for example, adding 1/2 to itself repeatedly). -/
structure rat := mk' ::
(num : ℤ)
(denom : ℕ)
(pos : 0 < denom)
(cop : num.nat_abs.coprime denom)
notation `ℚ` := rat

namespace rat

/-- String representation of a rational numbers, used in `has_repr`, `has_to_string`, and
`has_to_format` instances. -/
protected def repr : ℚ → string
| ⟨n, d, _, _⟩ := if d = 1 then _root_.repr n else
  _root_.repr n ++ "/" ++ _root_.repr d

instance : has_repr ℚ := ⟨rat.repr⟩
instance : has_to_string ℚ := ⟨rat.repr⟩
meta instance : has_to_format ℚ := ⟨coe ∘ rat.repr⟩

instance : encodable ℚ := encodable.of_equiv (Σ n : ℤ, {d : ℕ // 0 < d ∧ n.nat_abs.coprime d})
  ⟨λ ⟨a, b, c, d⟩, ⟨a, b, c, d⟩, λ⟨a, b, c, d⟩, ⟨a, b, c, d⟩,
   λ ⟨a, b, c, d⟩, rfl, λ⟨a, b, c, d⟩, rfl⟩

/-- Embed an integer as a rational number -/
def of_int (n : ℤ) : ℚ :=
⟨n, 1, nat.one_pos, nat.coprime_one_right _⟩

instance : has_zero ℚ := ⟨of_int 0⟩
instance : has_one ℚ := ⟨of_int 1⟩
instance : inhabited ℚ := ⟨0⟩

lemma ext_iff {p q : ℚ} : p = q ↔ p.num = q.num ∧ p.denom = q.denom :=
by { cases p, cases q, simp }

@[ext] lemma ext {p q : ℚ} (hn : p.num = q.num) (hd : p.denom = q.denom) : p = q :=
rat.ext_iff.mpr ⟨hn, hd⟩

/-- Form the quotient `n / d` where `n:ℤ` and `d:ℕ+` (not necessarily coprime) -/
def mk_pnat (n : ℤ) : ℕ+ → ℚ | ⟨d, dpos⟩ :=
let n' := n.nat_abs, g := n'.gcd d in
⟨n / g, d / g, begin
  apply (nat.le_div_iff_mul_le _ _ (nat.gcd_pos_of_pos_right _ dpos)).2,
  simp, exact nat.le_of_dvd dpos (nat.gcd_dvd_right _ _)
end, begin
  have : int.nat_abs (n / ↑g) = n' / g,
  { cases int.nat_abs_eq n with e e; rw e, { refl },
    rw [int.neg_div_of_dvd, int.nat_abs_neg], { refl },
    exact int.coe_nat_dvd.2 (nat.gcd_dvd_left _ _) },
  rw this,
  exact nat.coprime_div_gcd_div_gcd (nat.gcd_pos_of_pos_right _ dpos)
end⟩

/-- Form the quotient `n / d` where `n:ℤ` and `d:ℕ`. In the case `d = 0`, we
  define `n / 0 = 0` by convention. -/
def mk_nat (n : ℤ) (d : ℕ) : ℚ :=
if d0 : d = 0 then 0 else mk_pnat n ⟨d, nat.pos_of_ne_zero d0⟩

/-- Form the quotient `n / d` where `n d : ℤ`. -/
def mk : ℤ → ℤ → ℚ
| n (d : ℕ) := mk_nat n d
| n -[1+ d] := mk_pnat (-n) d.succ_pnat

localized "infix ` /. `:70 := rat.mk" in rat

theorem mk_pnat_eq (n d h) : mk_pnat n ⟨d, h⟩ = n /. d :=
by change n /. d with dite _ _ _; simp [ne_of_gt h]

theorem mk_nat_eq (n d) : mk_nat n d = n /. d := rfl

@[simp] theorem mk_zero (n) : n /. 0 = 0 := rfl

@[simp] theorem zero_mk_pnat (n) : mk_pnat 0 n = 0 :=
by cases n; simp [mk_pnat]; change int.nat_abs 0 with 0; simp *; refl

@[simp] theorem zero_mk_nat (n) : mk_nat 0 n = 0 :=
by by_cases n = 0; simp [*, mk_nat]

@[simp] theorem zero_mk (n) : 0 /. n = 0 :=
by cases n; simp [mk]

private lemma gcd_abs_dvd_left {a b} : (nat.gcd (int.nat_abs a) b : ℤ) ∣ a :=
int.dvd_nat_abs.1 $ int.coe_nat_dvd.2 $ nat.gcd_dvd_left (int.nat_abs a) b

@[simp] theorem mk_eq_zero {a b : ℤ} (b0 : b ≠ 0) : a /. b = 0 ↔ a = 0 :=
begin
  constructor; intro h; [skip, {subst a, simp}],
  have : ∀ {a b}, mk_pnat a b = 0 → a = 0,
  { intros a b e, cases b with b h,
    injection e with e,
    apply int.eq_mul_of_div_eq_right gcd_abs_dvd_left e },
  cases b with b; simp [mk, mk_nat] at h,
  { simp [mt (congr_arg int.of_nat) b0] at h,
    exact this h },
  { apply neg_injective, simp [this h] }
end

theorem mk_eq : ∀ {a b c d : ℤ} (hb : b ≠ 0) (hd : d ≠ 0),
  a /. b = c /. d ↔ a * d = c * b :=
suffices ∀ a b c d hb hd, mk_pnat a ⟨b, hb⟩ = mk_pnat c ⟨d, hd⟩ ↔ a * d = c * b,
begin
  intros, cases b with b b; simp [mk, mk_nat, nat.succ_pnat],
  simp [mt (congr_arg int.of_nat) hb],
  all_goals
  { cases d with d d; simp [mk, mk_nat, nat.succ_pnat],
    simp [mt (congr_arg int.of_nat) hd],
    all_goals { rw this, try {refl} } },
  { change a * ↑(d.succ) = -c * ↑b ↔ a * -(d.succ) = c * b,
    constructor; intro h; apply neg_injective; simpa [left_distrib, neg_add_eq_iff_eq_add,
      eq_neg_iff_add_eq_zero, neg_eq_iff_add_eq_zero] using h },
  { change -a * ↑d = c * b.succ ↔ a * d = c * -b.succ,
    constructor; intro h; apply neg_injective; simpa [left_distrib, eq_comm] using h },
  { change -a * d.succ = -c * b.succ ↔ a * -d.succ = c * -b.succ,
    simp [left_distrib, sub_eq_add_neg], cc }
end,
begin
  intros, simp [mk_pnat], constructor; intro h,
  { cases h with ha hb,
    have ha,
    { have dv := @gcd_abs_dvd_left,
      have := int.eq_mul_of_div_eq_right dv ha,
      rw ← int.mul_div_assoc _ dv at this,
      exact int.eq_mul_of_div_eq_left (dv.mul_left _) this.symm },
    have hb,
    { have dv := λ {a b}, nat.gcd_dvd_right (int.nat_abs a) b,
      have := nat.eq_mul_of_div_eq_right dv hb,
      rw ← nat.mul_div_assoc _ dv at this,
      exact nat.eq_mul_of_div_eq_left (dv.mul_left _) this.symm },
    have m0 : (a.nat_abs.gcd b * c.nat_abs.gcd d : ℤ) ≠ 0,
    { refine int.coe_nat_ne_zero.2 (ne_of_gt _),
      apply mul_pos; apply nat.gcd_pos_of_pos_right; assumption },
    apply mul_right_cancel₀ m0,
    simpa [mul_comm, mul_left_comm] using
      congr (congr_arg (*) ha.symm) (congr_arg coe hb) },
  { suffices : ∀ a c, a * d = c * b →
      a / a.gcd b = c / c.gcd d ∧ b / a.gcd b = d / c.gcd d,
    { cases this a.nat_abs c.nat_abs
        (by simpa [int.nat_abs_mul] using congr_arg int.nat_abs h) with h₁ h₂,
      have hs := congr_arg int.sign h,
      simp [int.sign_eq_one_of_pos (int.coe_nat_lt.2 hb),
            int.sign_eq_one_of_pos (int.coe_nat_lt.2 hd)] at hs,
      conv in a { rw ← int.sign_mul_nat_abs a },
      conv in c { rw ← int.sign_mul_nat_abs c },
      rw [int.mul_div_assoc, int.mul_div_assoc],
      exact ⟨congr (congr_arg (*) hs) (congr_arg coe h₁), h₂⟩,
      all_goals { exact int.coe_nat_dvd.2 (nat.gcd_dvd_left _ _) } },
    intros a c h,
    suffices bd : b / a.gcd b = d / c.gcd d,
    { refine ⟨_, bd⟩,
      apply nat.eq_of_mul_eq_mul_left hb,
      rw [← nat.mul_div_assoc _ (nat.gcd_dvd_left _ _), mul_comm,
          nat.mul_div_assoc _ (nat.gcd_dvd_right _ _), bd,
          ← nat.mul_div_assoc _ (nat.gcd_dvd_right _ _), h, mul_comm,
          nat.mul_div_assoc _ (nat.gcd_dvd_left _ _)] },
    suffices : ∀ {a c : ℕ} (b>0) (d>0),
      a * d = c * b → b / a.gcd b ≤ d / c.gcd d,
    { exact le_antisymm (this _ hb _ hd h) (this _ hd _ hb h.symm) },
    intros a c b hb d hd h,
    have gb0 := nat.gcd_pos_of_pos_right a hb,
    have gd0 := nat.gcd_pos_of_pos_right c hd,
    apply nat.le_of_dvd,
    apply (nat.le_div_iff_mul_le _ _ gd0).2,
    simp, apply nat.le_of_dvd hd (nat.gcd_dvd_right _ _),
    apply (nat.coprime_div_gcd_div_gcd gb0).symm.dvd_of_dvd_mul_left,
    refine ⟨c / c.gcd d, _⟩,
    rw [← nat.mul_div_assoc _ (nat.gcd_dvd_left _ _),
        ← nat.mul_div_assoc _ (nat.gcd_dvd_right _ _)],
    apply congr_arg (/ c.gcd d),
    rw [mul_comm, ← nat.mul_div_assoc _ (nat.gcd_dvd_left _ _),
        mul_comm, h, nat.mul_div_assoc _ (nat.gcd_dvd_right _ _), mul_comm] }
end

@[simp] theorem div_mk_div_cancel_left {a b c : ℤ} (c0 : c ≠ 0) :
  (a * c) /. (b * c) = a /. b :=
begin
  by_cases b0 : b = 0, { subst b0, simp },
  apply (mk_eq (mul_ne_zero b0 c0) b0).2, simp [mul_comm, mul_assoc]
end

@[simp] theorem num_denom : ∀ {a : ℚ}, a.num /. a.denom = a
| ⟨n, d, h, (c:_=1)⟩ := show mk_nat n d = _,
  by simp [mk_nat, ne_of_gt h, mk_pnat, c]

theorem num_denom' {n d h c} : (⟨n, d, h, c⟩ : ℚ) = n /. d := num_denom.symm

theorem of_int_eq_mk (z : ℤ) : of_int z = z /. 1 := num_denom'

/-- Define a (dependent) function or prove `∀ r : ℚ, p r` by dealing with rational
numbers of the form `n /. d` with `0 < d` and coprime `n`, `d`. -/
@[elab_as_eliminator] def {u} num_denom_cases_on {C : ℚ → Sort u}
   : ∀ (a : ℚ) (H : ∀ n d, 0 < d → (int.nat_abs n).coprime d → C (n /. d)), C a
| ⟨n, d, h, c⟩ H := by rw num_denom'; exact H n d h c

/-- Define a (dependent) function or prove `∀ r : ℚ, p r` by dealing with rational
numbers of the form `n /. d` with `d ≠ 0`. -/
@[elab_as_eliminator] def {u} num_denom_cases_on' {C : ℚ → Sort u}
   (a : ℚ) (H : ∀ (n:ℤ) (d:ℕ), d ≠ 0 → C (n /. d)) : C a :=
num_denom_cases_on a $ λ n d h c, H n d h.ne'

theorem num_dvd (a) {b : ℤ} (b0 : b ≠ 0) : (a /. b).num ∣ a :=
begin
  cases e : a /. b with n d h c,
  rw [rat.num_denom', rat.mk_eq b0
    (ne_of_gt (int.coe_nat_pos.2 h))] at e,
  refine (int.nat_abs_dvd.1 $ int.dvd_nat_abs.1 $ int.coe_nat_dvd.2 $
    c.dvd_of_dvd_mul_right _),
  have := congr_arg int.nat_abs e,
  simp [int.nat_abs_mul, int.nat_abs_of_nat] at this, simp [this]
end

theorem denom_dvd (a b : ℤ) : ((a /. b).denom : ℤ) ∣ b :=
begin
  by_cases b0 : b = 0, {simp [b0]},
  cases e : a /. b with n d h c,
  rw [num_denom', mk_eq b0 (ne_of_gt (int.coe_nat_pos.2 h))] at e,
  refine (int.dvd_nat_abs.1 $ int.coe_nat_dvd.2 $ c.symm.dvd_of_dvd_mul_left _),
  rw [← int.nat_abs_mul, ← int.coe_nat_dvd, int.dvd_nat_abs, ← e], simp
end

/-- Addition of rational numbers. Use `(+)` instead. -/
protected def add : ℚ → ℚ → ℚ
| ⟨n₁, d₁, h₁, c₁⟩ ⟨n₂, d₂, h₂, c₂⟩ := mk_pnat (n₁ * d₂ + n₂ * d₁) ⟨d₁ * d₂, mul_pos h₁ h₂⟩

instance : has_add ℚ := ⟨rat.add⟩

theorem lift_binop_eq (f : ℚ → ℚ → ℚ) (f₁ : ℤ → ℤ → ℤ → ℤ → ℤ) (f₂ : ℤ → ℤ → ℤ → ℤ → ℤ)
  (fv : ∀ {n₁ d₁ h₁ c₁ n₂ d₂ h₂ c₂},
    f ⟨n₁, d₁, h₁, c₁⟩ ⟨n₂, d₂, h₂, c₂⟩ = f₁ n₁ d₁ n₂ d₂ /. f₂ n₁ d₁ n₂ d₂)
  (f0 : ∀ {n₁ d₁ n₂ d₂} (d₁0 : d₁ ≠ 0) (d₂0 : d₂ ≠ 0), f₂ n₁ d₁ n₂ d₂ ≠ 0)
  (a b c d : ℤ) (b0 : b ≠ 0) (d0 : d ≠ 0)
  (H : ∀ {n₁ d₁ n₂ d₂} (h₁ : a * d₁ = n₁ * b) (h₂ : c * d₂ = n₂ * d),
       f₁ n₁ d₁ n₂ d₂ * f₂ a b c d = f₁ a b c d * f₂ n₁ d₁ n₂ d₂) :
  f (a /. b) (c /. d) = f₁ a b c d /. f₂ a b c d :=
begin
  generalize ha : a /. b = x, cases x with n₁ d₁ h₁ c₁, rw num_denom' at ha,
  generalize hc : c /. d = x, cases x with n₂ d₂ h₂ c₂, rw num_denom' at hc,
  rw fv,
  have d₁0 := ne_of_gt (int.coe_nat_lt.2 h₁),
  have d₂0 := ne_of_gt (int.coe_nat_lt.2 h₂),
  exact (mk_eq (f0 d₁0 d₂0) (f0 b0 d0)).2 (H ((mk_eq b0 d₁0).1 ha) ((mk_eq d0 d₂0).1 hc))
end

@[simp] theorem add_def {a b c d : ℤ} (b0 : b ≠ 0) (d0 : d ≠ 0) :
  a /. b + c /. d = (a * d + c * b) /. (b * d) :=
begin
  apply lift_binop_eq rat.add; intros; try {assumption},
  { apply mk_pnat_eq },
  { apply mul_ne_zero d₁0 d₂0 },
  calc (n₁ * d₂ + n₂ * d₁) * (b * d) =
          (n₁ * b) * d₂ * d + (n₂ * d) * (d₁ * b) : by simp [mul_add, mul_comm, mul_left_comm]
    ... = (a * d₁) * d₂ * d + (c * d₂) * (d₁ * b) : by rw [h₁, h₂]
    ... = (a * d + c * b) * (d₁ * d₂)             : by simp [mul_add, mul_comm, mul_left_comm]
end

/-- Negation of rational numbers. Use `-r` instead. -/
protected def neg (r : ℚ) : ℚ :=
⟨-r.num, r.denom, r.pos, by simp [r.cop]⟩

instance : has_neg ℚ := ⟨rat.neg⟩

@[simp] theorem neg_def {a b : ℤ} : -(a /. b) = -a /. b :=
begin
  by_cases b0 :  b = 0, { subst b0, simp, refl },
  generalize ha : a /. b = x, cases x with n₁ d₁ h₁ c₁, rw num_denom' at ha,
  show rat.mk' _ _ _ _ = _, rw num_denom',
  have d0 := ne_of_gt (int.coe_nat_lt.2 h₁),
  apply (mk_eq d0 b0).2, have h₁ := (mk_eq b0 d0).1 ha,
  simp only [neg_mul, congr_arg has_neg.neg h₁]
end

@[simp] lemma mk_neg_denom (n d : ℤ) : n /. -d = -n /. d :=
begin
  by_cases hd : d = 0;
  simp [rat.mk_eq, hd]
end

/-- Multiplication of rational numbers. Use `(*)` instead. -/
protected def mul : ℚ → ℚ → ℚ
| ⟨n₁, d₁, h₁, c₁⟩ ⟨n₂, d₂, h₂, c₂⟩ := mk_pnat (n₁ * n₂) ⟨d₁ * d₂, mul_pos h₁ h₂⟩

instance : has_mul ℚ := ⟨rat.mul⟩

@[simp] theorem mul_def {a b c d : ℤ} (b0 : b ≠ 0) (d0 : d ≠ 0) :
  (a /. b) * (c /. d) = (a * c) /. (b * d) :=
begin
  apply lift_binop_eq rat.mul; intros; try {assumption},
  { apply mk_pnat_eq },
  { apply mul_ne_zero d₁0 d₂0 },
  cc
end

/-- Inverse rational number. Use `r⁻¹` instead. -/
protected def inv : ℚ → ℚ
| ⟨(n+1:ℕ), d, h, c⟩ := ⟨d, n+1, n.succ_pos, c.symm⟩
| ⟨0, d, h, c⟩ := 0
| ⟨-[1+ n], d, h, c⟩ := ⟨-d, n+1, n.succ_pos, nat.coprime.symm $ by simp; exact c⟩

instance : has_inv ℚ := ⟨rat.inv⟩

@[simp] theorem inv_def {a b : ℤ} : (a /. b)⁻¹ = b /. a :=
begin
  by_cases a0 : a = 0, { subst a0, simp, refl },
  by_cases b0 : b = 0, { subst b0, simp, refl },
  generalize ha : a /. b = x, cases x with n d h c, rw num_denom' at ha,
  refine eq.trans (_ : rat.inv ⟨n, d, h, c⟩ = d /. n) _,
  { cases n with n; [cases n with n, skip],
    { refl },
    { change int.of_nat n.succ with (n+1:ℕ),
      unfold rat.inv, rw num_denom' },
    { unfold rat.inv, rw num_denom', refl } },
  have n0 : n ≠ 0,
  { refine mt (λ (n0 : n = 0), _) a0,
    subst n0, simp at ha,
    exact (mk_eq_zero b0).1 ha },
  have d0 := ne_of_gt (int.coe_nat_lt.2 h),
  have ha := (mk_eq b0 d0).1 ha,
  apply (mk_eq n0 a0).2,
  cc
end

variables (a b c : ℚ)

protected theorem add_zero : a + 0 = a :=
num_denom_cases_on' a $ λ n d h,
by rw [← zero_mk d]; simp [h, -zero_mk]

protected theorem zero_add : 0 + a = a :=
num_denom_cases_on' a $ λ n d h,
by rw [← zero_mk d]; simp [h, -zero_mk]

protected theorem add_comm : a + b = b + a :=
num_denom_cases_on' a $ λ n₁ d₁ h₁,
num_denom_cases_on' b $ λ n₂ d₂ h₂,
by simp [h₁, h₂]; cc

protected theorem add_assoc : a + b + c = a + (b + c) :=
num_denom_cases_on' a $ λ n₁ d₁ h₁,
num_denom_cases_on' b $ λ n₂ d₂ h₂,
num_denom_cases_on' c $ λ n₃ d₃ h₃,
by simp [h₁, h₂, h₃, mul_ne_zero, mul_add, mul_comm, mul_left_comm, add_left_comm, add_assoc]

protected theorem add_left_neg : -a + a = 0 :=
num_denom_cases_on' a $ λ n d h,
by simp [h]

@[simp] lemma mk_zero_one : 0 /. 1 = 0 :=
show mk_pnat _ _ = _, by { rw mk_pnat, simp, refl }

@[simp] lemma mk_one_one : 1 /. 1 = 1 :=
show mk_pnat _ _ = _, by { rw mk_pnat, simp, refl }

@[simp] lemma mk_neg_one_one : (-1) /. 1 = -1 :=
show mk_pnat _ _ = _, by { rw mk_pnat, simp, refl }

protected theorem mul_one : a * 1 = a :=
num_denom_cases_on' a $ λ n d h,
by { rw ← mk_one_one, simp [h, -mk_one_one] }

protected theorem one_mul : 1 * a = a :=
num_denom_cases_on' a $ λ n d h,
by { rw ← mk_one_one, simp [h, -mk_one_one] }

protected theorem mul_comm : a * b = b * a :=
num_denom_cases_on' a $ λ n₁ d₁ h₁,
num_denom_cases_on' b $ λ n₂ d₂ h₂,
by simp [h₁, h₂, mul_comm]

protected theorem mul_assoc : a * b * c = a * (b * c) :=
num_denom_cases_on' a $ λ n₁ d₁ h₁,
num_denom_cases_on' b $ λ n₂ d₂ h₂,
num_denom_cases_on' c $ λ n₃ d₃ h₃,
by simp [h₁, h₂, h₃, mul_ne_zero, mul_comm, mul_left_comm]

protected theorem add_mul : (a + b) * c = a * c + b * c :=
num_denom_cases_on' a $ λ n₁ d₁ h₁,
num_denom_cases_on' b $ λ n₂ d₂ h₂,
num_denom_cases_on' c $ λ n₃ d₃ h₃,
by simp [h₁, h₂, h₃, mul_ne_zero];
   refine (div_mk_div_cancel_left (int.coe_nat_ne_zero.2 h₃)).symm.trans _;
   simp [mul_add, mul_comm, mul_assoc, mul_left_comm]

protected theorem mul_add : a * (b + c) = a * b + a * c :=
by rw [rat.mul_comm, rat.add_mul, rat.mul_comm, rat.mul_comm c a]

protected theorem zero_ne_one : 0 ≠ (1:ℚ) :=
suffices (1:ℚ) = 0 → false, by cc,
by { rw [← mk_one_one, mk_eq_zero one_ne_zero], exact one_ne_zero }

protected theorem mul_inv_cancel : a ≠ 0 → a * a⁻¹ = 1 :=
num_denom_cases_on' a $ λ n d h a0,
have n0 : n ≠ 0, from mt (by intro e; subst e; simp) a0,
by simpa [h, n0, mul_comm] using @div_mk_div_cancel_left 1 1 _ n0

protected theorem inv_mul_cancel (h : a ≠ 0) : a⁻¹ * a = 1 :=
eq.trans (rat.mul_comm _ _) (rat.mul_inv_cancel _ h)

instance : decidable_eq ℚ := by tactic.mk_dec_eq_instance

instance : field ℚ :=
{ zero             := 0,
  add              := rat.add,
  neg              := rat.neg,
  one              := 1,
  mul              := rat.mul,
  inv              := rat.inv,
  zero_add         := rat.zero_add,
  add_zero         := rat.add_zero,
  add_comm         := rat.add_comm,
  add_assoc        := rat.add_assoc,
  add_left_neg     := rat.add_left_neg,
  mul_one          := rat.mul_one,
  one_mul          := rat.one_mul,
  mul_comm         := rat.mul_comm,
  mul_assoc        := rat.mul_assoc,
  left_distrib     := rat.mul_add,
  right_distrib    := rat.add_mul,
  exists_pair_ne   := ⟨0, 1, rat.zero_ne_one⟩,
  mul_inv_cancel   := rat.mul_inv_cancel,
  inv_zero         := rfl }

/- Extra instances to short-circuit type class resolution -/
instance : division_ring ℚ      := by apply_instance
instance : is_domain ℚ          := by apply_instance
-- TODO(Mario): this instance slows down data.real.basic
instance : nontrivial ℚ         := by apply_instance
instance : comm_ring ℚ          := by apply_instance
--instance : ring ℚ             := by apply_instance
instance : comm_semiring ℚ      := by apply_instance
instance : semiring ℚ           := by apply_instance
instance : add_comm_group ℚ     := by apply_instance
instance : add_group ℚ          := by apply_instance
instance : add_comm_monoid ℚ    := by apply_instance
instance : add_monoid ℚ         := by apply_instance
instance : add_left_cancel_semigroup ℚ := by apply_instance
instance : add_right_cancel_semigroup ℚ := by apply_instance
instance : add_comm_semigroup ℚ := by apply_instance
instance : add_semigroup ℚ      := by apply_instance
instance : comm_monoid ℚ        := by apply_instance
instance : monoid ℚ             := by apply_instance
instance : comm_semigroup ℚ     := by apply_instance
instance : semigroup ℚ          := by apply_instance

theorem sub_def {a b c d : ℤ} (b0 : b ≠ 0) (d0 : d ≠ 0) :
  a /. b - c /. d = (a * d - c * b) /. (b * d) :=
by simp [b0, d0, sub_eq_add_neg]

@[simp] lemma denom_neg_eq_denom (q : ℚ) : (-q).denom = q.denom := rfl

@[simp] lemma num_neg_eq_neg_num (q : ℚ) : (-q).num = -(q.num) := rfl

@[simp] lemma num_zero : rat.num 0 = 0 := rfl

@[simp] lemma denom_zero : rat.denom 0 = 1 := rfl

lemma zero_of_num_zero {q : ℚ} (hq : q.num = 0) : q = 0 :=
have q = q.num /. q.denom, from num_denom.symm,
by simpa [hq]

lemma zero_iff_num_zero {q : ℚ} : q = 0 ↔ q.num = 0 :=
⟨λ _, by simp *, zero_of_num_zero⟩

lemma num_ne_zero_of_ne_zero {q : ℚ} (h : q ≠ 0) : q.num ≠ 0 :=
assume : q.num = 0,
h $ zero_of_num_zero this

@[simp] lemma num_one : (1 : ℚ).num = 1 := rfl

@[simp] lemma denom_one : (1 : ℚ).denom = 1 := rfl

lemma denom_ne_zero (q : ℚ) : q.denom ≠ 0 :=
ne_of_gt q.pos

lemma eq_iff_mul_eq_mul {p q : ℚ} : p = q ↔ p.num * q.denom = q.num * p.denom :=
begin
  conv_lhs { rw [←(@num_denom p), ←(@num_denom q)] },
  apply rat.mk_eq,
  { exact_mod_cast p.denom_ne_zero },
  { exact_mod_cast q.denom_ne_zero }
end

lemma mk_num_ne_zero_of_ne_zero {q : ℚ} {n d : ℤ} (hq : q ≠ 0) (hqnd : q = n /. d) : n ≠ 0 :=
assume : n = 0,
hq $ by simpa [this] using hqnd

lemma mk_denom_ne_zero_of_ne_zero {q : ℚ} {n d : ℤ} (hq : q ≠ 0) (hqnd : q = n /. d) : d ≠ 0 :=
assume : d = 0,
hq $ by simpa [this] using hqnd

lemma mk_ne_zero_of_ne_zero {n d : ℤ} (h : n ≠ 0) (hd : d ≠ 0) : n /. d ≠ 0 :=
assume : n /. d = 0,
h $ (mk_eq_zero hd).1 this

lemma mul_num_denom (q r : ℚ) : q * r = (q.num * r.num) /. ↑(q.denom * r.denom) :=
have hq' : (↑q.denom : ℤ) ≠ 0, by have := denom_ne_zero q; simpa,
have hr' : (↑r.denom : ℤ) ≠ 0, by have := denom_ne_zero r; simpa,
suffices (q.num /. ↑q.denom) * (r.num /. ↑r.denom) = (q.num * r.num) /. ↑(q.denom * r.denom),
  by simpa using this,
by simp [mul_def hq' hr', -num_denom]

lemma div_num_denom (q r : ℚ) : q / r = (q.num * r.denom) /. (q.denom * r.num) :=
if hr : r.num = 0 then
  have hr' : r = 0, from zero_of_num_zero hr,
  by simp *
else
  calc q / r = q * r⁻¹ : div_eq_mul_inv q r
         ... = (q.num /. q.denom) * (r.num /. r.denom)⁻¹ : by simp
         ... = (q.num /. q.denom) * (r.denom /. r.num) : by rw inv_def
         ... = (q.num * r.denom) /. (q.denom * r.num) : mul_def (by simpa using denom_ne_zero q) hr

lemma num_denom_mk {q : ℚ} {n d : ℤ} (hn : n ≠ 0) (hd : d ≠ 0) (qdf : q = n /. d) :
      ∃ c : ℤ, n = c * q.num ∧ d = c * q.denom :=
have hq : q ≠ 0, from
  assume : q = 0,
  hn $ (rat.mk_eq_zero hd).1 (by cc),
have q.num /. q.denom = n /. d, by rwa [num_denom],
have q.num * d = n * ↑(q.denom), from (rat.mk_eq (by simp [rat.denom_ne_zero]) hd).1 this,
begin
  existsi n / q.num,
  have hqdn : q.num ∣ n, begin rw qdf, apply rat.num_dvd, assumption end,
  split,
  { rw int.div_mul_cancel hqdn },
  { apply int.eq_mul_div_of_mul_eq_mul_of_dvd_left,
    { apply rat.num_ne_zero_of_ne_zero hq },
    repeat { assumption } }
end

theorem mk_pnat_num (n : ℤ) (d : ℕ+) :
  (mk_pnat n d).num = n / nat.gcd n.nat_abs d :=
by cases d; refl

theorem mk_pnat_denom (n : ℤ) (d : ℕ+) :
  (mk_pnat n d).denom = d / nat.gcd n.nat_abs d :=
by cases d; refl

lemma num_mk (n d : ℤ) :
  (n /. d).num = d.sign * n / n.gcd d :=
begin
  rcases d with ((_ | _) | _),
  { simp },
  { simpa [←int.coe_nat_succ, int.sign_coe_nat_of_nonzero] },
  { rw rat.mk,
    simpa [rat.mk_pnat_num, int.neg_succ_of_nat_eq, ←int.coe_nat_succ,
           int.sign_coe_nat_of_nonzero] }
end

lemma denom_mk (n d : ℤ) :
  (n /. d).denom = if d = 0 then 1 else d.nat_abs / n.gcd d :=
begin
  rcases d with ((_ | _) | _),
  { simp },
  { simpa [←int.coe_nat_succ, int.sign_coe_nat_of_nonzero] },
  { rw rat.mk,
    simpa [rat.mk_pnat_denom, int.neg_succ_of_nat_eq, ←int.coe_nat_succ,
           int.sign_coe_nat_of_nonzero] }
end

theorem mk_pnat_denom_dvd (n : ℤ) (d : ℕ+) :
  (mk_pnat n d).denom ∣ d.1 :=
begin
  rw mk_pnat_denom,
  apply nat.div_dvd_of_dvd,
  apply nat.gcd_dvd_right
end

theorem add_denom_dvd (q₁ q₂ : ℚ) : (q₁ + q₂).denom ∣ q₁.denom * q₂.denom :=
by { cases q₁, cases q₂, apply mk_pnat_denom_dvd }

theorem mul_denom_dvd (q₁ q₂ : ℚ) : (q₁ * q₂).denom ∣ q₁.denom * q₂.denom :=
by { cases q₁, cases q₂, apply mk_pnat_denom_dvd }

theorem mul_num (q₁ q₂ : ℚ) : (q₁ * q₂).num =
  (q₁.num * q₂.num) / nat.gcd (q₁.num * q₂.num).nat_abs (q₁.denom * q₂.denom) :=
by cases q₁; cases q₂; refl

theorem mul_denom (q₁ q₂ : ℚ) : (q₁ * q₂).denom =
  (q₁.denom * q₂.denom) / nat.gcd (q₁.num * q₂.num).nat_abs (q₁.denom * q₂.denom) :=
by cases q₁; cases q₂; refl

theorem mul_self_num (q : ℚ) : (q * q).num = q.num * q.num :=
by rw [mul_num, int.nat_abs_mul, nat.coprime.gcd_eq_one, int.coe_nat_one, int.div_one];
exact (q.cop.mul_right q.cop).mul (q.cop.mul_right q.cop)

theorem mul_self_denom (q : ℚ) : (q * q).denom = q.denom * q.denom :=
by rw [rat.mul_denom, int.nat_abs_mul, nat.coprime.gcd_eq_one, nat.div_one];
exact (q.cop.mul_right q.cop).mul (q.cop.mul_right q.cop)

lemma add_num_denom (q r : ℚ) : q + r =
  ((q.num * r.denom + q.denom * r.num : ℤ)) /. (↑q.denom * ↑r.denom : ℤ) :=
have hqd : (q.denom : ℤ) ≠ 0, from int.coe_nat_ne_zero_iff_pos.2 q.3,
have hrd : (r.denom : ℤ) ≠ 0, from int.coe_nat_ne_zero_iff_pos.2 r.3,
by conv_lhs { rw [←@num_denom q, ←@num_denom r, rat.add_def hqd hrd] };
  simp [mul_comm]

section casts

protected lemma add_mk (a b c : ℤ) : (a + b) /. c = a /. c + b /. c :=
if h : c = 0 then by simp [h] else
by { rw [add_def h h, mk_eq h (mul_ne_zero h h)], simp [add_mul, mul_assoc] }

theorem coe_int_eq_mk : ∀ (z : ℤ), ↑z = z /. 1
| (n : ℕ) := show (n:ℚ) = n /. 1,
  by induction n with n IH n; simp [*, rat.add_mk]
| -[1+ n] := show (-(n + 1) : ℚ) = -[1+ n] /. 1, begin
  induction n with n IH, { rw ← of_int_eq_mk, simp, refl },
  show -(n + 1 + 1 : ℚ) = -[1+ n.succ] /. 1,
  rw [neg_add, IH, ← mk_neg_one_one],
  simp [-mk_neg_one_one]
end

theorem mk_eq_div (n d : ℤ) : n /. d = ((n : ℚ) / d) :=
begin
  by_cases d0 : d = 0, {simp [d0, div_zero]},
  simp [division_def, coe_int_eq_mk, mul_def one_ne_zero d0]
end

@[simp]
theorem num_div_denom (r : ℚ) : (r.num / r.denom : ℚ) = r :=
by rw [← int.cast_coe_nat, ← mk_eq_div, num_denom]

lemma exists_eq_mul_div_num_and_eq_mul_div_denom {n d : ℤ} (n_ne_zero : n ≠ 0)
  (d_ne_zero : d ≠ 0) :
  ∃ (c : ℤ), n = c * ((n : ℚ) / d).num ∧ (d : ℤ) = c * ((n : ℚ) / d).denom :=
begin
  have : ((n : ℚ) / d) = rat.mk n d, by rw [←rat.mk_eq_div],
  exact rat.num_denom_mk n_ne_zero d_ne_zero this
end

theorem coe_int_eq_of_int (z : ℤ) : ↑z = of_int z :=
(coe_int_eq_mk z).trans (of_int_eq_mk z).symm

@[simp, norm_cast] theorem coe_int_num (n : ℤ) : (n : ℚ).num = n :=
by rw coe_int_eq_of_int; refl

@[simp, norm_cast] theorem coe_int_denom (n : ℤ) : (n : ℚ).denom = 1 :=
by rw coe_int_eq_of_int; refl

lemma coe_int_num_of_denom_eq_one {q : ℚ} (hq : q.denom = 1) : ↑(q.num) = q :=
by { conv_rhs { rw [←(@num_denom q), hq] }, rw [coe_int_eq_mk], refl }

lemma denom_eq_one_iff (r : ℚ) : r.denom = 1 ↔ ↑r.num = r :=
⟨rat.coe_int_num_of_denom_eq_one, λ h, h ▸ rat.coe_int_denom r.num⟩

instance : can_lift ℚ ℤ :=
⟨coe, λ q, q.denom = 1, λ q hq, ⟨q.num, coe_int_num_of_denom_eq_one hq⟩⟩

theorem coe_nat_eq_mk (n : ℕ) : ↑n = n /. 1 :=
by rw [← int.cast_coe_nat, coe_int_eq_mk]

@[simp, norm_cast] theorem coe_nat_num (n : ℕ) : (n : ℚ).num = n :=
by rw [← int.cast_coe_nat, coe_int_num]

@[simp, norm_cast] theorem coe_nat_denom (n : ℕ) : (n : ℚ).denom = 1 :=
by rw [← int.cast_coe_nat, coe_int_denom]

-- Will be subsumed by `int.coe_inj` after we have defined
-- `linear_ordered_field ℚ` (which implies characteristic zero).
lemma coe_int_inj (m n : ℤ) : (m : ℚ) = n ↔ m = n :=
⟨λ h, by simpa using congr_arg num h, congr_arg _⟩

end casts

lemma inv_def' {q : ℚ} : q⁻¹ = (q.denom : ℚ) / q.num :=
by { conv_lhs { rw ←(@num_denom q) }, cases q, simp [div_num_denom] }

@[simp] lemma mul_denom_eq_num {q : ℚ} : q * q.denom = q.num :=
begin
  suffices : mk (q.num) ↑(q.denom) * mk ↑(q.denom) 1 = mk (q.num) 1, by
  { conv { for q [1] { rw ←(@num_denom q) }}, rwa [coe_int_eq_mk, coe_nat_eq_mk] },
  have : (q.denom : ℤ) ≠ 0, from ne_of_gt (by exact_mod_cast q.pos),
  rw [(rat.mul_def this one_ne_zero), (mul_comm (q.denom : ℤ) 1), (div_mk_div_cancel_left this)]
end

lemma denom_div_cast_eq_one_iff (m n : ℤ) (hn : n ≠ 0) :
  ((m : ℚ) / n).denom = 1 ↔ n ∣ m :=
begin
  replace hn : (n:ℚ) ≠ 0, by rwa [ne.def, ← int.cast_zero, coe_int_inj],
  split,
  { intro h,
    lift ((m : ℚ) / n) to ℤ using h with k hk,
    use k,
    rwa [eq_div_iff_mul_eq hn, ← int.cast_mul, mul_comm, eq_comm, coe_int_inj] at hk },
  { rintros ⟨d, rfl⟩,
    rw [int.cast_mul, mul_comm, mul_div_cancel _ hn, rat.coe_int_denom] }
end

lemma num_div_eq_of_coprime {a b : ℤ} (hb0 : 0 < b) (h : nat.coprime a.nat_abs b.nat_abs) :
  (a / b : ℚ).num = a :=
begin
  lift b to ℕ using le_of_lt hb0,
  norm_cast at hb0 h,
  rw [← rat.mk_eq_div, ← rat.mk_pnat_eq a b hb0, rat.mk_pnat_num, pnat.mk_coe, h.gcd_eq_one,
    int.coe_nat_one, int.div_one]
end

lemma denom_div_eq_of_coprime {a b : ℤ} (hb0 : 0 < b) (h : nat.coprime a.nat_abs b.nat_abs) :
  ((a / b : ℚ).denom : ℤ) = b :=
begin
  lift b to ℕ using le_of_lt hb0,
  norm_cast at hb0 h,
  rw [← rat.mk_eq_div, ← rat.mk_pnat_eq a b hb0, rat.mk_pnat_denom, pnat.mk_coe, h.gcd_eq_one,
    nat.div_one]
end

lemma div_int_inj {a b c d : ℤ} (hb0 : 0 < b) (hd0 : 0 < d)
  (h1 : nat.coprime a.nat_abs b.nat_abs) (h2 : nat.coprime c.nat_abs d.nat_abs)
  (h : (a : ℚ) / b = (c : ℚ) / d) : a = c ∧ b = d :=
begin
  apply and.intro,
  { rw [← (num_div_eq_of_coprime hb0 h1), h, num_div_eq_of_coprime hd0 h2] },
  { rw [← (denom_div_eq_of_coprime hb0 h1), h, denom_div_eq_of_coprime hd0 h2] }
end

@[norm_cast] lemma coe_int_div_self (n : ℤ) : ((n / n : ℤ) : ℚ) = n / n :=
begin
  by_cases hn : n = 0,
  { subst hn, simp only [int.cast_zero, euclidean_domain.zero_div] },
  { have : (n : ℚ) ≠ 0, { rwa ← coe_int_inj at hn },
    simp only [int.div_self hn, int.cast_one, ne.def, not_false_iff, div_self this] }
end

@[norm_cast] lemma coe_nat_div_self (n : ℕ) : ((n / n : ℕ) : ℚ) = n / n :=
coe_int_div_self n

lemma coe_int_div (a b : ℤ) (h : b ∣ a) : ((a / b : ℤ) : ℚ) = a / b :=
begin
  rcases h with ⟨c, rfl⟩,
  simp only [mul_comm b, int.mul_div_assoc c (dvd_refl b), int.cast_mul, mul_div_assoc,
    coe_int_div_self]
end

lemma coe_nat_div (a b : ℕ) (h : b ∣ a) : ((a / b : ℕ) : ℚ) = a / b :=
begin
  rcases h with ⟨c, rfl⟩,
  simp only [mul_comm b, nat.mul_div_assoc c (dvd_refl b), nat.cast_mul, mul_div_assoc,
    coe_nat_div_self]
end

lemma inv_coe_int_num {a : ℤ} (ha0 : 0 < a) : (a : ℚ)⁻¹.num = 1 :=
begin
  rw [rat.inv_def', rat.coe_int_num, rat.coe_int_denom, nat.cast_one, ←int.cast_one],
  apply num_div_eq_of_coprime ha0,
  rw int.nat_abs_one,
  exact nat.coprime_one_left _,
end

lemma inv_coe_nat_num {a : ℕ} (ha0 : 0 < a) : (a : ℚ)⁻¹.num = 1 :=
inv_coe_int_num (by exact_mod_cast ha0 : 0 < (a : ℤ))

lemma inv_coe_int_denom {a : ℤ} (ha0 : 0 < a) : ((a : ℚ)⁻¹.denom : ℤ) = a :=
begin
  rw [rat.inv_def', rat.coe_int_num, rat.coe_int_denom, nat.cast_one, ←int.cast_one],
  apply denom_div_eq_of_coprime ha0,
  rw int.nat_abs_one,
  exact nat.coprime_one_left _,
end

lemma inv_coe_nat_denom {a : ℕ} (ha0 : 0 < a) : (a : ℚ)⁻¹.denom = a :=
by exact_mod_cast inv_coe_int_denom (by exact_mod_cast ha0 : 0 < (a : ℤ))

protected lemma «forall» {p : ℚ → Prop} : (∀ r, p r) ↔ ∀ a b : ℤ, p (a / b) :=
⟨λ h _ _, h _,
  λ h q, (show q = q.num / q.denom, from by simp [rat.div_num_denom]).symm ▸ (h q.1 q.2)⟩

protected lemma «exists» {p : ℚ → Prop} : (∃ r, p r) ↔ ∃ a b : ℤ, p (a / b) :=
⟨λ ⟨r, hr⟩, ⟨r.num, r.denom, by rwa [← mk_eq_div, num_denom]⟩, λ ⟨a, b, h⟩, ⟨_, h⟩⟩

end rat


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

! This file was ported from Lean 3 source module group_theory.commensurable
! leanprover-community/mathlib commit 48085f140e684306f9e7da907cd5932056d1aded
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.Index
import Mathlib.GroupTheory.Subgroup.Pointwise
import Mathlib.GroupTheory.GroupAction.ConjAct

/-!
# Commensurability for subgroups

This file defines commensurability for subgroups of a group `G`. It then goes on to prove that
commensurability defines an equivalence relation and finally defines the commensurator of a subgroup
of `G`.

## Main definitions

* `Commensurable`: defines commensurability for two subgroups `H`, `K` of  `G`
* `commensurator`: defines the commensurator of a subgroup `H` of `G`.

## Implementation details

We define the commensurator of a subgroup `H` of `G` by first defining it as a subgroup of
`(conjAct G)`, which we call commensurator' and then taking the pre-image under
the map `G → (conjAct G)` to obtain our commensurator as a subgroup of `G`.
-/

variable {G : Type _} [Group G]

/-- Two subgroups `H K` of `G` are commensurable if `H ⊓ K` has finite index in both `H` and `K` -/
def Commensurable (H K : Subgroup G) : Prop :=
  H.relindex K ≠ 0 ∧ K.relindex H ≠ 0
#align commensurable Commensurable

namespace Commensurable

open Pointwise

@[refl]
protected theorem refl (H : Subgroup G) : Commensurable H H := by simp [Commensurable]
#align commensurable.refl Commensurable.refl

theorem comm {H K : Subgroup G} : Commensurable H K ↔ Commensurable K H := and_comm
#align commensurable.comm Commensurable.comm

@[symm]
theorem symm {H K : Subgroup G} : Commensurable H K → Commensurable K H := And.symm
#align commensurable.symm Commensurable.symm

@[trans]
theorem trans {H K L : Subgroup G} (hhk : Commensurable H K) (hkl : Commensurable K L) :
    Commensurable H L :=
  ⟨Subgroup.relindex_ne_zero_trans hhk.1 hkl.1, Subgroup.relindex_ne_zero_trans hkl.2 hhk.2⟩
#align commensurable.trans Commensurable.trans

theorem equivalence : Equivalence (@Commensurable G _) :=
  ⟨Commensurable.refl, fun h => Commensurable.symm h, fun h₁ h₂ => Commensurable.trans h₁ h₂⟩
#align commensurable.equivalence Commensurable.equivalence

/-- Equivalence of `K/H ⊓ K` with `gKg⁻¹/gHg⁻¹ ⊓ gKg⁻¹`-/
def quotConjEquiv (H K : Subgroup G) (g : ConjAct G) :
    K ⧸ H.subgroupOf K ≃ (g • K).1 ⧸ (g • H).subgroupOf (g • K) :=
  Quotient.congr (K.equivSMul g).toEquiv fun a b => by
    dsimp
    rw [← Quotient.eq'', ← Quotient.eq'', QuotientGroup.eq', QuotientGroup.eq',
      Subgroup.mem_subgroupOf, Subgroup.mem_subgroupOf, ← MulEquiv.map_inv, ← MulEquiv.map_mul,
      Subgroup.equivSMul_apply_coe]
    exact Subgroup.smul_mem_pointwise_smul_iff.symm
#align commensurable.quot_conj_equiv Commensurable.quotConjEquiv

theorem commensurable_conj {H K : Subgroup G} (g : ConjAct G) :
    Commensurable H K ↔ Commensurable (g • H) (g • K) :=
  and_congr (not_iff_not.mpr (Eq.congr_left (Cardinal.toNat_congr (quotConjEquiv H K g))))
    (not_iff_not.mpr (Eq.congr_left (Cardinal.toNat_congr (quotConjEquiv K H g))))
#align commensurable.commensurable_conj Commensurable.commensurable_conj

theorem commensurable_inv (H : Subgroup G) (g : ConjAct G) :
    Commensurable (g • H) H ↔ Commensurable H (g⁻¹ • H) := by rw [commensurable_conj, inv_smul_smul]
#align commensurable.commensurable_inv Commensurable.commensurable_inv

/-- For `H` a subgroup of `G`, this is the subgroup of all elements `g : conjAut G`
such that `Commensurable (g • H) H` -/
def commensurator' (H : Subgroup G) : Subgroup (ConjAct G) where
  carrier := { g : ConjAct G | Commensurable (g • H) H }
  one_mem' := by rw [Set.mem_setOf_eq, one_smul]
  mul_mem' ha hb := by
    rw [Set.mem_setOf_eq, mul_smul]
    exact trans ((commensurable_conj _).mp hb) ha
  inv_mem' _ := by rwa [Set.mem_setOf_eq, comm, ← commensurable_inv]
#align commensurable.commensurator' Commensurable.commensurator'

/-- For `H` a subgroup of `G`, this is the subgroup of all elements `g : G`
such that `Commensurable (g H g⁻¹) H` -/
def commensurator (H : Subgroup G) : Subgroup G :=
  (commensurator' H).comap ConjAct.toConjAct.toMonoidHom
#align commensurable.commensurator Commensurable.commensurator

@[simp]
theorem commensurator'_mem_iff (H : Subgroup G) (g : ConjAct G) :
    g ∈ commensurator' H ↔ Commensurable (g • H) H := Iff.rfl
#align commensurable.commensurator'_mem_iff Commensurable.commensurator'_mem_iff

@[simp]
theorem commensurator_mem_iff (H : Subgroup G) (g : G) :
    g ∈ commensurator H ↔ Commensurable (ConjAct.toConjAct g • H) H := Iff.rfl
#align commensurable.commensurator_mem_iff Commensurable.commensurator_mem_iff

theorem eq {H K : Subgroup G} (hk : Commensurable H K) : commensurator H = commensurator K :=
  Subgroup.ext fun x =>
    let hx := (commensurable_conj x).1 hk
    ⟨fun h => hx.symm.trans (h.trans hk), fun h => hx.trans (h.trans hk.symm)⟩
#align commensurable.eq Commensurable.eq

end Commensurable


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison

! This file was ported from Lean 3 source module algebra.group.ulift
! leanprover-community/mathlib commit 13e18cfa070ea337ea960176414f5ae3a1534aae
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Int.Cast.Defs
import Mathlib.Algebra.Hom.Equiv.Basic
import Mathlib.Algebra.GroupWithZero.InjSurj

/-!
# `ULift` instances for groups and monoids

This file defines instances for group, monoid, semigroup and related structures on `ULift` types.

(Recall `ULift α` is just a "copy" of a type `α` in a higher universe.)

We also provide `MulEquiv.ulift : ULift R ≃* R` (and its additive analogue).
-/

universe u v

variable {α : Type u} {β : Type _} {x y : ULift.{v} α}

namespace ULift

@[to_additive]
instance one [One α] : One (ULift α) :=
  ⟨⟨1⟩⟩
#align ulift.has_one ULift.one
#align ulift.has_zero ULift.zero

@[to_additive (attr := simp)]
theorem one_down [One α] : (1 : ULift α).down = 1 :=
  rfl
#align ulift.one_down ULift.one_down
#align ulift.zero_down ULift.zero_down

@[to_additive]
instance mul [Mul α] : Mul (ULift α) :=
  ⟨fun f g => ⟨f.down * g.down⟩⟩
#align ulift.has_mul ULift.mul
#align ulift.has_add ULift.add

@[to_additive (attr := simp)]
theorem mul_down [Mul α] : (x * y).down = x.down * y.down :=
  rfl
#align ulift.mul_down ULift.mul_down
#align ulift.add_down ULift.add_down

@[to_additive]
instance div [Div α] : Div (ULift α) :=
  ⟨fun f g => ⟨f.down / g.down⟩⟩
#align ulift.has_div ULift.div
#align ulift.has_sub ULift.sub

@[to_additive (attr := simp)]
theorem div_down [Div α] : (x / y).down = x.down / y.down :=
  rfl
#align ulift.div_down ULift.div_down
#align ulift.sub_down ULift.sub_down

@[to_additive]
instance inv [Inv α] : Inv (ULift α) :=
  ⟨fun f => ⟨f.down⁻¹⟩⟩
#align ulift.has_inv ULift.inv
#align ulift.has_neg ULift.neg

@[to_additive (attr := simp)]
theorem inv_down [Inv α] : x⁻¹.down = x.down⁻¹ :=
  rfl
#align ulift.inv_down ULift.inv_down
#align ulift.neg_down ULift.neg_down

@[to_additive]
instance smul [SMul α β] : SMul α (ULift β) :=
  ⟨fun n x => up (n • x.down)⟩
#align ulift.has_smul ULift.smul
#align ulift.has_vadd ULift.vadd

@[to_additive (attr := simp)]
theorem smul_down [SMul α β] (a : α) (b : ULift.{v} β) : (a • b).down = a • b.down :=
  rfl
#align ulift.smul_down ULift.smul_down
#align ulift.vadd_down ULift.vadd_down

@[to_additive existing (reorder := 1) smul]
instance pow [Pow α β] : Pow (ULift α) β :=
  ⟨fun x n => up (x.down ^ n)⟩
#align ulift.has_pow ULift.pow

@[to_additive existing (attr := simp) (reorder := 1) smul_down]
theorem pow_down [Pow α β] (a : ULift.{v} α) (b : β) : (a ^ b).down = a.down ^ b :=
  rfl
#align ulift.pow_down ULift.pow_down

/-- The multiplicative equivalence between `ULift α` and `α`.
-/
-- porting note: below errors: to_additive: can't transport `ULift.MulEquiv.ulift` to itself.
-- @[to_additive "The additive equivalence between `ULift α` and `α`."]
def MulEquiv.ulift [Mul α] : ULift α ≃* α :=
  { Equiv.ulift with map_mul' := fun _ _ => rfl }
#align mul_equiv.ulift ULift.MulEquiv.ulift

-- porting notes: below failed due to error above, manually added
--@[to_additive]
instance semigroup [Semigroup α] : Semigroup (ULift α) :=
  (MulEquiv.ulift.injective.semigroup _) fun _ _ => rfl
#align ulift.semigroup ULift.semigroup

instance addSemigroup [AddSemigroup α] : AddSemigroup (ULift α) :=
  (Equiv.ulift.injective.addSemigroup _) fun _ _ => rfl
#align ulift.add_semigroup ULift.addSemigroup

@[to_additive]
instance commSemigroup [CommSemigroup α] : CommSemigroup (ULift α) :=
  (Equiv.ulift.injective.commSemigroup _) fun _ _ => rfl
#align ulift.comm_semigroup ULift.commSemigroup
#align ulift.add_comm_semigroup ULift.addCommSemigroup

@[to_additive]
instance mulOneClass [MulOneClass α] : MulOneClass (ULift α) :=
  Equiv.ulift.injective.mulOneClass _ rfl (by intros; rfl)
#align ulift.mul_one_class ULift.mulOneClass
#align ulift.add_zero_class ULift.addZeroClass

instance mulZeroOneClass [MulZeroOneClass α] : MulZeroOneClass (ULift α) :=
  Equiv.ulift.injective.mulZeroOneClass _ rfl rfl (by intros; rfl)
#align ulift.mul_zero_one_class ULift.mulZeroOneClass

@[to_additive]
instance monoid [Monoid α] : Monoid (ULift α) :=
  Equiv.ulift.injective.monoid _ rfl (fun _ _ => rfl) fun _ _ => rfl
#align ulift.monoid ULift.monoid
#align ulift.add_monoid ULift.addMonoid

@[to_additive]
instance commMonoid [CommMonoid α] : CommMonoid (ULift α) :=
  Equiv.ulift.injective.commMonoid _ rfl (fun _ _ => rfl) fun _ _ => rfl
#align ulift.comm_monoid ULift.commMonoid
#align ulift.add_comm_monoid ULift.addCommMonoid

instance natCast [NatCast α] : NatCast (ULift α) := ⟨λ a ↦ up a⟩
#align ulift.has_nat_cast ULift.natCast
instance intCast [IntCast α] : IntCast (ULift α) := ⟨λ a ↦ up a⟩
#align ulift.has_int_cast ULift.intCast

@[simp, norm_cast]
theorem up_natCast [NatCast α] (n : ℕ) : up (n : α) = n :=
  rfl
#align ulift.up_nat_cast ULift.up_natCast

@[simp, norm_cast]
theorem up_intCast [IntCast α] (n : ℤ) : up (n : α) = n :=
  rfl
#align ulift.up_int_cast ULift.up_intCast

@[simp, norm_cast]
theorem down_natCast [NatCast α] (n : ℕ) : down (n : ULift α) = n :=
  rfl
#align ulift.down_nat_cast ULift.down_natCast

@[simp, norm_cast]
theorem down_intCast [IntCast α] (n : ℤ) : down (n : ULift α) = n :=
  rfl
#align ulift.down_int_cast ULift.down_intCast

instance addMonoidWithOne [AddMonoidWithOne α] : AddMonoidWithOne (ULift α) :=
  { ULift.one, ULift.addMonoid with
      natCast := fun n => ⟨n⟩
      natCast_zero := congr_arg ULift.up Nat.cast_zero,
      natCast_succ := fun _ => congr_arg ULift.up (Nat.cast_succ _) }
#align ulift.add_monoid_with_one ULift.addMonoidWithOne

instance addCommMonoidWithOne [AddCommMonoidWithOne α] : AddCommMonoidWithOne (ULift α) :=
  { ULift.addMonoidWithOne, ULift.addCommMonoid with }
#align ulift.add_comm_monoid_with_one ULift.addCommMonoidWithOne

instance monoidWithZero [MonoidWithZero α] : MonoidWithZero (ULift α) :=
  Equiv.ulift.injective.monoidWithZero _ rfl rfl (fun _ _ => rfl) fun _ _ => rfl
#align ulift.monoid_with_zero ULift.monoidWithZero

instance commMonoidWithZero [CommMonoidWithZero α] : CommMonoidWithZero (ULift α) :=
  Equiv.ulift.injective.commMonoidWithZero _ rfl rfl (fun _ _ => rfl) fun _ _ => rfl
#align ulift.comm_monoid_with_zero ULift.commMonoidWithZero

@[to_additive]
instance divInvMonoid [DivInvMonoid α] : DivInvMonoid (ULift α) :=
  Equiv.ulift.injective.divInvMonoid _ rfl (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ _ => rfl
#align ulift.div_inv_monoid ULift.divInvMonoid
#align ulift.sub_neg_add_monoid ULift.subNegAddMonoid

@[to_additive]
instance group [Group α] : Group (ULift α) :=
  Equiv.ulift.injective.group _ rfl (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ _ => rfl
#align ulift.group ULift.group
#align ulift.add_group ULift.addGroup

@[to_additive]
instance commGroup [CommGroup α] : CommGroup (ULift α) :=
  Equiv.ulift.injective.commGroup _ rfl (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ _ => rfl
#align ulift.comm_group ULift.commGroup
#align ulift.add_comm_group ULift.addCommGroup

instance addGroupWithOne [AddGroupWithOne α] : AddGroupWithOne (ULift α) :=
  { ULift.addMonoidWithOne, ULift.addGroup with
      intCast := fun n => ⟨n⟩,
      intCast_ofNat := fun _ => congr_arg ULift.up (Int.cast_ofNat _),
      intCast_negSucc := fun _ => congr_arg ULift.up (Int.cast_negSucc _) }
#align ulift.add_group_with_one ULift.addGroupWithOne

instance addCommGroupWithOne [AddCommGroupWithOne α] : AddCommGroupWithOne (ULift α) :=
  { ULift.addGroupWithOne, ULift.addCommGroup with }
#align ulift.add_comm_group_with_one ULift.addCommGroupWithOne

instance groupWithZero [GroupWithZero α] : GroupWithZero (ULift α) :=
  Equiv.ulift.injective.groupWithZero _ rfl rfl (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ _ => rfl
#align ulift.group_with_zero ULift.groupWithZero

instance commGroupWithZero [CommGroupWithZero α] : CommGroupWithZero (ULift α) :=
  Equiv.ulift.injective.commGroupWithZero _ rfl rfl (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ _ => rfl
#align ulift.comm_group_with_zero ULift.commGroupWithZero

@[to_additive]
instance leftCancelSemigroup [LeftCancelSemigroup α] : LeftCancelSemigroup (ULift α) :=
  Equiv.ulift.injective.leftCancelSemigroup _ fun _ _ => rfl
#align ulift.left_cancel_semigroup ULift.leftCancelSemigroup
#align ulift.add_left_cancel_semigroup ULift.addLeftCancelSemigroup

@[to_additive]
instance rightCancelSemigroup [RightCancelSemigroup α] : RightCancelSemigroup (ULift α) :=
  Equiv.ulift.injective.rightCancelSemigroup _ fun _ _ => rfl
#align ulift.right_cancel_semigroup ULift.rightCancelSemigroup
#align ulift.add_right_cancel_semigroup ULift.addRightCancelSemigroup

@[to_additive]
instance leftCancelMonoid [LeftCancelMonoid α] : LeftCancelMonoid (ULift α) :=
  Equiv.ulift.injective.leftCancelMonoid _ rfl (fun _ _ => rfl) fun _ _ => rfl
#align ulift.left_cancel_monoid ULift.leftCancelMonoid
#align ulift.add_left_cancel_monoid ULift.addLeftCancelMonoid

@[to_additive]
instance rightCancelMonoid [RightCancelMonoid α] : RightCancelMonoid (ULift α) :=
  Equiv.ulift.injective.rightCancelMonoid _ rfl (fun _ _ => rfl) fun _ _ => rfl
#align ulift.right_cancel_monoid ULift.rightCancelMonoid
#align ulift.add_right_cancel_monoid ULift.addRightCancelMonoid

@[to_additive]
instance cancelMonoid [CancelMonoid α] : CancelMonoid (ULift α) :=
  Equiv.ulift.injective.cancelMonoid _ rfl (fun _ _ => rfl) fun _ _ => rfl
#align ulift.cancel_monoid ULift.cancelMonoid
#align ulift.add_cancel_monoid ULift.addCancelMonoid

@[to_additive]
instance cancelCommMonoid [CancelCommMonoid α] : CancelCommMonoid (ULift α) :=
  Equiv.ulift.injective.cancelCommMonoid _ rfl (fun _ _ => rfl) fun _ _ => rfl
#align ulift.cancel_comm_monoid ULift.cancelCommMonoid
#align ulift.add_cancel_comm_monoid ULift.addCancelCommMonoid

instance nontrivial [Nontrivial α] : Nontrivial (ULift α) :=
  Equiv.ulift.symm.injective.nontrivial
#align ulift.nontrivial ULift.nontrivial

-- TODO we don't do `OrderedCancelCommMonoid` or `OrderedCommGroup`
-- We'd need to add instances for `ULift` in `Order.Basic`.
end ULift


import algebra.squarefree
import measure_theory.integral.interval_integral

noncomputable theory
open nat finset
open_locale interval

namespace squarefree_sums

variables {R : Type*} {S : Type*}

lemma two_add {n a : ℕ} (hn : a ≤ n) : ∃ n', n = a + n' :=
begin
  use n - a,
  zify,
  ring,
end

lemma two_le_nat_iff_not_zero_one {m : ℕ} : 2 ≤ m ↔ m ≠ 0 ∧ m ≠ 1 :=
begin
  split,
  intros h,
  split,
  linarith,
  linarith,
  rintros ⟨h, hh⟩,
  induction m,
  simp [h],
  exact h rfl,
  induction m_n,
  exfalso,
  exact hh rfl,

  calc m_n_n.succ.succ = m_n_n.succ + 1 : rfl
    ... = m_n_n + 1 + 1 : rfl
    ... = m_n_n + 2 : by ring
    ... ≥ 0 + 2 : le_add_self
    ... = 2 : by ring,
end

lemma lt_of_div {a b : ℕ} (hb : 2 ≤ b) : a ≠ 0 → a / b < a :=
begin
  contrapose!,
  intros h,
  exact nat.eq_zero_of_le_div hb h,
end

lemma has_coprime_part_strong : ∀ (M m p : ℕ), m ≤ M → 1 ≤ m → nat.prime p → ∃ (m' i : ℕ), m = (p^i) * m' ∧ p.coprime m' :=
begin
  intros M,
  induction M with M hM,
  simp,
  intros m p hm hm',
  linarith,
  intros m p hm_ind one_le_m hp,
  have m_ne_zero : m ≠ 0, linarith,
  have zero_lt_m : 0 < m, linarith,
  by_cases p_dvd_m : p ∣ m,
  {
    have p_le_m : p ≤ m, exact nat.le_of_dvd zero_lt_m p_dvd_m,
    have mdp_ne_zero : m / p ≠ 0, {
      by_contradiction H,
      have : p * (m / p) = 0,
        calc p * (m / p) = p * 0 : by simp [H]
          ... = 0 : by simp,
      rw @nat.mul_div_cancel_left' p m p_dvd_m at this,
      exact m_ne_zero this,
    },
    have : 2 ≤ p, exact hp.two_le,
    have : m / p < M.succ,
      calc m / p < m : lt_of_div this m_ne_zero
        ... ≤ M.succ : hm_ind,
    have aaa : m / p ≤ M, exact lt_succ_iff.mp this,
    have bbb : 1 ≤ m / p, exact zero_lt_iff.mpr mdp_ne_zero,
    rcases hM (m / p) p aaa bbb hp with ⟨m', i', hm', hmp'⟩,
    use m',
    use i' + 1,
    split,
    conv {
      to_rhs,
      rw pow_add,
      congr,
      rw mul_comm,
    },
    conv {
      to_rhs,
      rw mul_assoc,
    },
    rw ← hm',
    simp,
    rw @nat.mul_div_cancel_left' p m p_dvd_m,
    exact hmp',
  },
  {
    use [m, 0],
    simp,
    cases coprime_or_dvd_of_prime hp m,
    exact h,
    exfalso,
    exact p_dvd_m h,
  },
end

lemma has_coprime_part : ∀ (m p : ℕ), 1 ≤ m → nat.prime p → ∃ (m' i : ℕ), m = (p^i) * m' ∧ p.coprime m' :=
begin
  intros m p,
  exact has_coprime_part_strong m m p (by linarith),
end

lemma exp_eq_iff_pow_eq {a m n : ℕ} (h : 2 ≤ a) : (m = n ↔ a ^ m = a ^ n) :=
begin
  split,
  { exact congr_arg (λ {m : ℕ}, a ^ m), },
  { intros hh,
    by_contradiction H,
    obtain ht | ht := lt_or_lt_iff_ne.mpr H,
    { exact ne_of_lt (@pow_lt_pow _ _ a _ _ (by linarith [h]) ht) hh },
    { exact ne_of_lt (@pow_lt_pow _ _ a _ _ (by linarith [h]) ht) hh.symm }, },
end

lemma prime_pow_eq_one_imp_pow_eq_zero {p i : ℕ} (hp : nat.prime p) : p^i = 1 → i = 0 :=
begin
  intros h,
  rw ← pow_zero at h,
  exact (exp_eq_iff_pow_eq hp.two_le).mpr h,
end

lemma nat_idemp_iff_zero_one {p : ℕ} : p = p * p ↔ p = 0 ∨ p = 1 :=
begin
  conv { to_lhs, to_lhs, rw ← one_mul p, },
  split,
  { intros h,
    by_cases hp : p = 0,
    { simp [hp], },
    { rw nat.mul_left_inj (zero_lt_iff.mpr hp) at h, simp [h], }, },
  intros h,
  cases h,
  { simp [h], },
  { simp [h], },
end

lemma pow_le_abs_pow [linear_ordered_ring R] {a : R} {b : ℕ} : a^b ≤ |a| ^ b :=
begin
  rw pow_abs,
  rw le_abs,
  left,
  refl,
end

lemma Ico_eq_range {n : ℕ} : finset.Ico 0 n = finset.range n :=
begin
  simp,
end

lemma finset.union_singleton {n : ℕ} {s : finset ℕ} : s ∪ {n} = insert n s :=
begin
  ext,
  rw [mem_union, mem_insert, mem_singleton, or_comm],
end

lemma not_mem_if_gt_max'
[linear_order R]
{s : finset R}
{hs : s.nonempty}
{n : R}
(hn : max' s hs < n)
:
n ∉ s
:=
begin
  by_contradiction H,
  exact ne_of_lt (calc n ≤ max' s hs : le_max' s n H ... < n : hn) rfl,
end

lemma finset.subset_finset_min_max
[linear_order R]
[locally_finite_order R]
{s : finset R}
(hs : s.nonempty) :
s ⊆ finset.Icc (s.min' hs) (s.max' hs) :=
begin
  rw subset_iff,
  intros x hx,
  simp,
  by_contradiction H,
  push_neg at H,
  by_cases h : s.min' hs ≤ x,
  specialize H h,
  rw finset.max'_lt_iff at H,
  exact ne_of_lt (H x hx) rfl,
  push_neg at h,
  rw finset.lt_min'_iff at h,
  exact ne_of_lt (h x hx) rfl,
end

lemma finset.Icc_subset_range {a b : ℕ} : finset.Icc a b ⊆ finset.range (b + 1) :=
begin
  rw subset_iff,
  intros x hx,
  rw finset.mem_range,
  simp at hx,
  simp [lt_succ_of_le hx.right],
end

lemma ite_const_rw
[decidable_eq S]
{n : S}
{f : S → R}
{a : R}
:
∀ (i : S), ite (i = n) (f i) a = ite (i = n) (f n) a
:=
begin
  intros i,
  by_cases i = n,
  simp [h],
  simp [h],
end

lemma interval_eq_Icc {a b : ℝ} (hab : a ≤ b) : set.interval a b = set.Icc a b :=
begin
  unfold set.interval,
  rw [min_eq_left hab, max_eq_right hab],
end

lemma interval_eq_Icc' {a b : ℝ} (hab : a ≤ b) : set.interval b a = set.Icc a b :=
begin
  unfold set.interval,
  rw [min_eq_right hab, max_eq_left hab],
end

lemma mem_Icc_mem_Ici
{a b : ℕ}
{x : ℝ}
:
x ∈ set.Icc (a : ℝ) ↑b → x ∈ set.Ici (a : ℝ) :=
begin
  simp,
  intros h _,
  exact h,
end

lemma mem_Icc_mem_Ici'
{a b c : ℕ}
{x : ℝ}
:
x ∈ set.Icc (a : ℝ) ↑b → c ≤ a → x ∈ set.Ici (c : ℝ) :=
begin
  simp,
  intros h _ h',
  calc (c : ℝ) ≤ ↑a : cast_le.mpr h' ... ≤ x : h,
end

lemma mem_Ico_mem_Ici
{a b : ℕ}
{x : ℝ}
:
x ∈ set.Ico (a : ℝ) ↑b → x ∈ set.Ici (a : ℝ) :=
begin
  simp,
  intros h _,
  exact h,
end

lemma mem_Ioc_mem_Ioi
{a b : ℕ}
{x : ℝ}
:
x ∈ set.Ioc (a : ℝ) ↑b → x ∈ set.Ioi (a : ℝ) :=
begin
  simp,
  intros h _,
  exact h,
end

lemma mem_Ioo_mem_Ioi
{a b : ℕ}
{x : ℝ}
:
x ∈ set.Ioo (a : ℝ) ↑b → x ∈ set.Ioi (a : ℝ) :=
begin
  simp,
  intros h _,
  exact h,
end

lemma mem_Ico_mem_Icc
{a b : ℕ}
{x : ℝ}
:
x ∈ set.Ico (a : ℝ) ↑b → x ∈ set.Icc (a : ℝ) ↑b :=
begin
  simp,
  intros h h',
  exact ⟨h, le_of_lt h'⟩,
end

lemma mem_Ioo_mem_Icc
{a b : ℕ}
{x : ℝ}
:
x ∈ set.Ioo (a : ℝ) ↑b → x ∈ set.Icc (a : ℝ) ↑b :=
begin
  simp,
  intros h h',
  exact ⟨le_of_lt h, le_of_lt h'⟩,
end

lemma mem_Ioo_mem_Ioc
{a b : ℕ}
{x : ℝ}
:
x ∈ set.Ioo (a : ℝ) ↑b → x ∈ set.Ioc (a : ℝ) ↑b :=
begin
  simp,
  intros h h',
  exact ⟨h, le_of_lt h'⟩,
end

lemma mem_Ioo_mem_Ico
{a b : ℕ}
{x : ℝ}
:
x ∈ set.Ioo (a : ℝ) ↑b → x ∈ set.Ico (a : ℝ) ↑b :=
begin
  simp,
  intros h h',
  exact ⟨le_of_lt h, h'⟩,
end

lemma ceil_of_Icc_mem_Icc
{a b : ℕ}
{x : ℝ}
(hx : x ∈ set.Icc (a : ℝ) ↑b)
:
↑⌈x⌉₊ ∈ set.Icc (a : ℝ) ↑b
:=
begin
  simp at hx,
  simp,
  split,
  have : ↑a ≤ (⌈x⌉₊ : ℝ), calc ↑a ≤ x : hx.left ... ≤ ↑⌈x⌉₊ : le_ceil x,
  exact cast_le.mp this,
  exact hx.right,
end

lemma floor_of_Icc_mem_Icc
{a b : ℕ} {x : ℝ}
(hx : x ∈ set.Icc (a : ℝ) ↑b)
:
↑⌊x⌋₊ ∈ set.Icc (a : ℝ) ↑b
:=
begin
  rw set.mem_Icc,
  norm_cast,
  refine ⟨le_floor hx.left, _⟩,
  have := floor_mono hx.right,
  rwa floor_coe at this,
end

lemma floor_of_unit_Ioo_val {R : Type*} [linear_ordered_semiring R] [floor_semiring R]
  {k : ℕ} {x : R} : x ∈ set.Ioo (k : R) (↑k + 1) → ⌊x⌋₊ = k :=
(λ ⟨hxl, hxr⟩, k.floor_eq_on_Ico x ⟨le_of_lt hxl, hxr⟩)

-- How do I use to_floor_semiring?
instance : floor_semiring ℝ :=
{ floor := λ a, ⌊a⌋.to_nat,
  ceil := λ a, ⌈a⌉.to_nat,
  floor_of_neg := λ a ha, int.to_nat_of_nonpos (int.floor_nonpos ha.le),
  gc_floor := λ a n ha, by { rw [int.le_to_nat_iff (int.floor_nonneg.2 ha), int.le_floor], refl },
  gc_ceil := λ a n, by { rw [int.to_nat_le, int.ceil_le], refl } }

lemma ceil_le_floor_add_one {R : Type*} [linear_ordered_semiring R] [floor_semiring R]
  {a : R} : ⌈a⌉₊ ≤ ⌊a⌋₊ + 1 :=
ceil_le.mpr $ le_of_lt $ lt_floor_add_one a

lemma floor_off_by_le_one {R : Type*} [linear_ordered_field R] [floor_semiring R]
  {a b : ℕ} : |(b : R) / a - ↑(b / a)| ≤ 1 :=
begin
  rw ← @floor_div_eq_div R _ _ b a,
  have target_nonneg : 0 ≤ (b : R) / ↑a - ↑⌊↑b / ↑a⌋₊,
  { rw sub_nonneg,
    exact floor_le (div_nonneg (cast_le.mpr zero_le') (cast_le.mpr zero_le')), },
  rw abs_of_nonneg target_nonneg,
  rw tsub_le_iff_left,
  refine le_trans (le_ceil _) _,
  norm_cast,
  exact ceil_le_floor_add_one,
end

end squarefree_sums


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import order.basic logic.embedding data.nat.basic

open function

universes u v w
variables {α : Type*} {β : Type*} {γ : Type*}
  {r : α → α → Prop} {s : β → β → Prop} {t : γ → γ → Prop}

structure order_embedding {α β : Type*} (r : α → α → Prop) (s : β → β → Prop) extends α ↪ β :=
(ord : ∀ {a b}, r a b ↔ s (to_embedding a) (to_embedding b))

infix ` ≼o `:50 := order_embedding

/-- the induced order on a subtype is an embedding under the natural inclusion. -/
definition subtype.order_embedding {X : Type*} (r : X → X → Prop) (p : X → Prop) :
((subtype.val : subtype p → X) ⁻¹'o r) ≼o r :=
⟨⟨subtype.val,subtype.val_injective⟩,by intros;refl⟩

namespace order_embedding

instance : has_coe_to_fun (r ≼o s) := ⟨λ _, α → β, λ o, o.to_embedding⟩

theorem ord' : ∀ (f : r ≼o s) {a b}, r a b ↔ s (f a) (f b)
| ⟨f, o⟩ := @o

@[simp] theorem coe_fn_mk (f : α ↪ β) (o) :
  (@order_embedding.mk _ _ r s f o : α → β) = f := rfl

@[simp] theorem coe_fn_to_embedding (f : r ≼o s) : (f.to_embedding : α → β) = f := rfl

theorem eq_of_to_fun_eq : ∀ {e₁ e₂ : r ≼o s}, (e₁ : α → β) = e₂ → e₁ = e₂
| ⟨⟨f₁, h₁⟩, o₁⟩ ⟨⟨f₂, h₂⟩, o₂⟩ h := by congr; exact h

@[refl] protected def refl (r : α → α → Prop) : r ≼o r :=
⟨embedding.refl _, λ a b, iff.rfl⟩

@[trans] protected def trans : r ≼o s → s ≼o t → r ≼o t
| ⟨f₁, o₁⟩ ⟨f₂, o₂⟩ := ⟨f₁.trans f₂, λ a b, by rw [o₁, o₂]; simp⟩

@[simp] theorem refl_apply (x : α) : order_embedding.refl r x = x := rfl

@[simp] theorem trans_apply : ∀ (f : r ≼o s) (g : s ≼o t) (a : α), (f.trans g) a = g (f a)
| ⟨f₁, o₁⟩ ⟨f₂, o₂⟩ a := rfl

/-- An order embedding is also an order embedding between dual orders. -/
def rsymm (f : r ≼o s) : swap r ≼o swap s :=
⟨f.to_embedding, λ a b, f.ord'⟩

/-- If `f` is injective, then it is an order embedding from the
  preimage order of `s` to `s`. -/
def preimage (f : α ↪ β) (s : β → β → Prop) : f ⁻¹'o s ≼o s := ⟨f, λ a b, iff.rfl⟩

theorem eq_preimage (f : r ≼o s) : r = f ⁻¹'o s :=
by funext a b; exact propext f.ord'

protected theorem is_irrefl : ∀ (f : r ≼o s) [is_irrefl β s], is_irrefl α r
| ⟨f, o⟩ ⟨H⟩ := ⟨λ a h, H _ (o.1 h)⟩

protected theorem is_refl : ∀ (f : r ≼o s) [is_refl β s], is_refl α r
| ⟨f, o⟩ ⟨H⟩ := ⟨λ a, o.2 (H _)⟩

protected theorem is_symm : ∀ (f : r ≼o s) [is_symm β s], is_symm α r
| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b h, o.2 (H _ _ (o.1 h))⟩

protected theorem is_asymm : ∀ (f : r ≼o s) [is_asymm β s], is_asymm α r
| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b h₁ h₂, H _ _ (o.1 h₁) (o.1 h₂)⟩

protected theorem is_antisymm : ∀ (f : r ≼o s) [is_antisymm β s], is_antisymm α r
| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b h₁ h₂, f.inj' (H _ _ (o.1 h₁) (o.1 h₂))⟩

protected theorem is_trans : ∀ (f : r ≼o s) [is_trans β s], is_trans α r
| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b c h₁ h₂, o.2 (H _ _ _ (o.1 h₁) (o.1 h₂))⟩

protected theorem is_total : ∀ (f : r ≼o s) [is_total β s], is_total α r
| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b, (or_congr o o).2 (H _ _)⟩

protected theorem is_preorder : ∀ (f : r ≼o s) [is_preorder β s], is_preorder α r
| f H := by exactI {..f.is_refl, ..f.is_trans}

protected theorem is_partial_order : ∀ (f : r ≼o s) [is_partial_order β s], is_partial_order α r
| f H := by exactI {..f.is_preorder, ..f.is_antisymm}

protected theorem is_linear_order : ∀ (f : r ≼o s) [is_linear_order β s], is_linear_order α r
| f H := by exactI {..f.is_partial_order, ..f.is_total}

protected theorem is_strict_order : ∀ (f : r ≼o s) [is_strict_order β s], is_strict_order α r
| f H := by exactI {..f.is_irrefl, ..f.is_trans}

protected theorem is_trichotomous : ∀ (f : r ≼o s) [is_trichotomous β s], is_trichotomous α r
| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b, (or_congr o (or_congr f.inj'.eq_iff.symm o)).2 (H _ _)⟩

protected theorem is_strict_total_order' : ∀ (f : r ≼o s) [is_strict_total_order' β s], is_strict_total_order' α r
| f H := by exactI {..f.is_trichotomous, ..f.is_strict_order}

protected theorem acc (f : r ≼o s) (a : α) : acc s (f a) → acc r a :=
begin
  generalize h : f a = b, intro ac,
  induction ac with _ H IH generalizing a, subst h,
  exact ⟨_, λ a' h, IH (f a') (f.ord'.1 h) _ rfl⟩
end

protected theorem well_founded : ∀ (f : r ≼o s) (h : well_founded s), well_founded r
| f ⟨H⟩ := ⟨λ a, f.acc _ (H _)⟩

protected theorem is_well_order : ∀ (f : r ≼o s) [is_well_order β s], is_well_order α r
| f H := by exactI {wf := f.well_founded H.wf, ..f.is_strict_total_order'}

/-- It suffices to prove `f` is monotone between strict orders
  to show it is an order embedding. -/
def of_monotone [is_trichotomous α r] [is_asymm β s] (f : α → β) (H : ∀ a b, r a b → s (f a) (f b)) : r ≼o s :=
begin
  haveI := @is_irrefl_of_is_asymm β s _,
  refine ⟨⟨f, λ a b e, _⟩, λ a b, ⟨H _ _, λ h, _⟩⟩,
  { refine ((@trichotomous _ r _ a b).resolve_left _).resolve_right _;
    exact λ h, @irrefl _ s _ _ (by simpa [e] using H _ _ h) },
  { refine (@trichotomous _ r _ a b).resolve_right (or.rec (λ e, _) (λ h', _)),
    { subst e, exact irrefl _ h },
    { exact asymm (H _ _ h') h } }
end

@[simp] theorem of_monotone_coe [is_trichotomous α r] [is_asymm β s] (f : α → β) (H) :
  (@of_monotone _ _ r s _ _ f H : α → β) = f := rfl

-- If le is preserved by an order embedding of preorders, then lt is too
def lt_embedding_of_le_embedding [preorder α] [preorder β]
  (f : (has_le.le : α → α → Prop) ≼o (has_le.le : β → β → Prop)) :
(has_lt.lt : α → α → Prop) ≼o (has_lt.lt : β → β → Prop) :=
{ to_fun := f,
  inj := f.inj,
  ord := by intros; simp [lt_iff_le_not_le,f.ord] }

theorem nat_lt [is_strict_order α r] (f : ℕ → α) (H : ∀ n:ℕ, r (f n) (f (n+1))) :
  ((<) : ℕ → ℕ → Prop) ≼o r :=
of_monotone f $ λ a b h, begin
  induction b with b IH, {exact (nat.not_lt_zero _ h).elim},
  cases nat.lt_succ_iff_lt_or_eq.1 h with h e,
  { exact trans (IH h) (H _) },
  { subst b, apply H }
end

theorem nat_gt [is_strict_order α r] (f : ℕ → α) (H : ∀ n:ℕ, r (f (n+1)) (f n)) :
  ((>) : ℕ → ℕ → Prop) ≼o r :=
by haveI := is_strict_order.swap r; exact rsymm (nat_lt f H)

theorem well_founded_iff_no_descending_seq [is_strict_order α r] : well_founded r ↔ ¬ nonempty (((>) : ℕ → ℕ → Prop) ≼o r) :=
⟨λ ⟨h⟩ ⟨⟨f, o⟩⟩,
  suffices ∀ a, acc r a → ∀ n, a ≠ f n, from this (f 0) (h _) 0 rfl,
  λ a ac, begin
    induction ac with a _ IH, intros n h, subst a,
    exact IH (f (n+1)) (o.1 (nat.lt_succ_self _)) _ rfl
  end,
λ N, ⟨λ a, classical.by_contradiction $ λ na,
  let ⟨f, h⟩ := classical.axiom_of_choice $
    show ∀ x : {a // ¬ acc r a}, ∃ y : {a // ¬ acc r a}, r y.1 x.1,
    from λ ⟨x, h⟩, classical.by_contradiction $ λ hn, h $
      ⟨_, λ y h, classical.by_contradiction $ λ na, hn ⟨⟨y, na⟩, h⟩⟩ in
  N ⟨nat_gt (λ n, (f^[n] ⟨a, na⟩).1) $ λ n,
    by rw nat.iterate_succ'; apply h⟩⟩⟩

end order_embedding

/-- The inclusion map `fin n → ℕ` is an order embedding. -/
def fin.val.order_embedding (n) : @order_embedding (fin n) ℕ (<) (<) :=
⟨⟨fin.val, @fin.eq_of_veq _⟩, λ a b, iff.rfl⟩

/-- The inclusion map `fin m → fin n` is an order embedding. -/
def fin_fin.order_embedding {m n} (h : m ≤ n) : @order_embedding (fin m) (fin n) (<) (<) :=
⟨⟨λ ⟨x, h'⟩, ⟨x, lt_of_lt_of_le h' h⟩,
  λ ⟨a, _⟩ ⟨b, _⟩ h, by congr; injection h⟩,
  by intros; cases a; cases b; refl⟩

instance fin.lt.is_well_order (n) : is_well_order (fin n) (<) :=
(fin.val.order_embedding _).is_well_order

/-- An order isomorphism is an equivalence that is also an order embedding. -/
structure order_iso {α β : Type*} (r : α → α → Prop) (s : β → β → Prop) extends α ≃ β :=
(ord : ∀ {a b}, r a b ↔ s (to_equiv a) (to_equiv b))

infix ` ≃o `:50 := order_iso

namespace order_iso

def to_order_embedding (f : r ≃o s) : r ≼o s :=
⟨f.to_equiv.to_embedding, f.ord⟩

instance : has_coe (r ≃o s) (r ≼o s) := ⟨to_order_embedding⟩

theorem coe_coe_fn (f : r ≃o s) : ((f : r ≼o s) : α → β) = f := rfl

theorem ord' : ∀ (f : r ≃o s) {a b}, r a b ↔ s (f a) (f b)
| ⟨f, o⟩ := @o

@[simp] theorem coe_fn_mk (f : α ≃ β) (o) :
  (@order_iso.mk _ _ r s f o : α → β) = f := rfl

@[simp] theorem coe_fn_to_equiv (f : r ≃o s) : (f.to_equiv : α → β) = f := rfl

theorem eq_of_to_fun_eq : ∀ {e₁ e₂ : r ≃o s}, (e₁ : α → β) = e₂ → e₁ = e₂
| ⟨e₁, o₁⟩ ⟨e₂, o₂⟩ h := by congr; exact equiv.eq_of_to_fun_eq h

@[refl] protected def refl (r : α → α → Prop) : r ≃o r :=
⟨equiv.refl _, λ a b, iff.rfl⟩

@[symm] protected def symm (f : r ≃o s) : s ≃o r :=
⟨f.to_equiv.symm, λ a b, by cases f with f o; rw o; simp⟩

@[trans] protected def trans (f₁ : r ≃o s) (f₂ : s ≃o t) : r ≃o t :=
⟨f₁.to_equiv.trans f₂.to_equiv, λ a b,
  by cases f₁ with f₁ o₁; cases f₂ with f₂ o₂; rw [o₁, o₂]; simp⟩

@[simp] theorem coe_fn_symm_mk (f o) : ((@order_iso.mk _ _ r s f o).symm : β → α) = f.symm :=
rfl

@[simp] theorem refl_apply (x : α) : order_iso.refl r x = x := rfl

@[simp] theorem trans_apply : ∀ (f : r ≃o s) (g : s ≃o t) (a : α), (f.trans g) a = g (f a)
| ⟨f₁, o₁⟩ ⟨f₂, o₂⟩ a := equiv.trans_apply _ _ _

@[simp] theorem apply_inverse_apply : ∀ (e : r ≃o s) (x : β), e (e.symm x) = x
| ⟨f₁, o₁⟩ x := by simp

@[simp] theorem inverse_apply_apply : ∀ (e : r ≃o s) (x : α), e.symm (e x) = x
| ⟨f₁, o₁⟩ x := by simp

/-- Any equivalence lifts to an order isomorphism between `s` and its preimage. -/
def preimage (f : α ≃ β) (s : β → β → Prop) : f ⁻¹'o s ≃o s := ⟨f, λ a b, iff.rfl⟩

noncomputable def of_surjective (f : r ≼o s) (H : surjective f) : r ≃o s :=
⟨equiv.of_bijective ⟨f.inj, H⟩, by simp [f.ord']⟩

@[simp] theorem of_surjective_coe (f : r ≼o s) (H) : (of_surjective f H : α → β) = f :=
by delta of_surjective; simp

theorem sum_lex_congr {α₁ α₂ β₁ β₂ r₁ r₂ s₁ s₂}
  (e₁ : @order_iso α₁ α₂ r₁ r₂) (e₂ : @order_iso β₁ β₂ s₁ s₂) :
  sum.lex r₁ s₁ ≃o sum.lex r₂ s₂ :=
⟨equiv.sum_congr e₁.to_equiv e₂.to_equiv, λ a b,
 by cases e₁ with f hf; cases e₂ with g hg;
    cases a; cases b; simp [hf, hg]⟩

theorem prod_lex_congr {α₁ α₂ β₁ β₂ r₁ r₂ s₁ s₂}
  (e₁ : @order_iso α₁ α₂ r₁ r₂) (e₂ : @order_iso β₁ β₂ s₁ s₂) :
  prod.lex r₁ s₁ ≃o prod.lex r₂ s₂ :=
⟨equiv.prod_congr e₁.to_equiv e₂.to_equiv,  λ a b, begin
  cases e₁ with f hf; cases e₂ with g hg,
  cases a with a₁ a₂; cases b with b₁ b₂,
  suffices : prod.lex r₁ s₁ (a₁, a₂) (b₁, b₂) ↔
    prod.lex r₂ s₂ (f a₁, g a₂) (f b₁, g b₂), {simpa [hf, hg]},
  split,
  { intro h, cases h with _ _ _ _ h _ _ _ h,
    { left, exact hf.1 h },
    { right, exact hg.1 h } },
  { generalize e : f b₁ = fb₁,
    intro h, cases h with _ _ _ _ h _ _ _ h,
    { subst e, left, exact hf.2 h },
    { have := f.bijective.1 e, subst b₁,
      right, exact hg.2 h } }
end⟩

end order_iso

/-- A subset `p : set α` embeds into `α` -/
def set_coe_embedding {α : Type*} (p : set α) : p ↪ α := ⟨subtype.val, @subtype.eq _ _⟩

/-- `subrel r p` is the inherited relation on a subset. -/
def subrel (r : α → α → Prop) (p : set α) : p → p → Prop :=
@subtype.val _ p ⁻¹'o r

@[simp] theorem subrel_val (r : α → α → Prop) (p : set α)
  {a b} : subrel r p a b ↔ r a.1 b.1 := iff.rfl

namespace subrel

protected def order_embedding (r : α → α → Prop) (p : set α) :
  subrel r p ≼o r := ⟨set_coe_embedding _, λ a b, iff.rfl⟩

@[simp] theorem order_embedding_apply (r : α → α → Prop) (p a) :
  subrel.order_embedding r p a = a.1 := rfl

instance (r : α → α → Prop) [is_well_order α r]
  (p : set α) : is_well_order p (subrel r p) :=
order_embedding.is_well_order (subrel.order_embedding r p)

end subrel

/-- Restrict the codomain of an order embedding -/
def order_embedding.cod_restrict (p : set β) (f : r ≼o s) (H : ∀ a, f a ∈ p) : r ≼o subrel s p :=
⟨f.to_embedding.cod_restrict p H, f.ord⟩

@[simp] theorem order_embedding.cod_restrict_apply (p) (f : r ≼o s) (H a) :
  order_embedding.cod_restrict p f H a = ⟨f a, H a⟩ := rfl


import Logic.Vorspiel.Vorspiel

class Semantics (F : Type u) [HasLogicSymbols F] where
  struc : Type w → Type v
  realize : {M : Type w} → struc M → F →L Prop

namespace Semantics
variable {F : Type u} [HasLogicSymbols F] [s : Semantics.{u, v, w} F]

def realizeTheory {M : Type w} (s : struc F M) (T : Set F) : Prop :=
    ∀ ⦃f⦄, f ∈ T → realize s f

postfix:max " ⊧ₛ " => realize

infix:55 " ⊧ₛ* " => realizeTheory

def consequence (T : Set F) (f : F) : Prop :=
    ∀ (M : Type w) [Inhabited M] (s : struc F M), s ⊧ₛ* T → s ⊧ₛ f

-- note that ⊨ (\vDash) is *NOT* ⊧ (\models)
infix:55 " ⊨ " => consequence

def Valid (f : F) : Prop := ∀ ⦃M : Type w⦄ [Inhabited M] (s : struc F M), s ⊧ₛ f

def Validₛ (T : Set F) : Prop := ∀ ⦃M : Type w⦄ [Inhabited M] (s : struc F M), s ⊧ₛ* T

def Satisfiable (f : F) : Prop := ∃ (M : Type w) (_ : Inhabited M) (s : struc F M), s ⊧ₛ f

def Satisfiableₛ (T : Set F) : Prop := ∃ (M : Type w) (_ : Inhabited M) (s : struc F M), s ⊧ₛ* T

lemma valid_neg_iff (f : F) : Valid (~f) ↔ ¬Satisfiable f := by simp[Valid, Satisfiable]

lemma modelsTheoryₛ_of_subset {T U : Set F} {s : struc F M} (h : s ⊧ₛ* U) (ss : T ⊆ U) : s ⊧ₛ* T :=
  fun _ hf => h (ss hf)

lemma satisfiableₛ_of_subset {T U : Set F} (h : Satisfiableₛ U) (ss : T ⊆ U) : Satisfiableₛ T :=
  by rcases h with ⟨M, i, s, h⟩; exact ⟨M, i, s, modelsTheoryₛ_of_subset h ss⟩

end Semantics


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

! This file was ported from Lean 3 source module topology.uniform_space.compare_reals
! leanprover-community/mathlib commit 69c6a5a12d8a2b159f20933e60115a4f2de62b58
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.UniformSpace.AbsoluteValue
import Mathbin.Topology.Instances.Real
import Mathbin.Topology.Instances.Rat
import Mathbin.Topology.UniformSpace.Completion

/-!
# Comparison of Cauchy reals and Bourbaki reals

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

In `data.real.basic` real numbers are defined using the so called Cauchy construction (although
it is due to Georg Cantor). More precisely, this construction applies to commutative rings equipped
with an absolute value with values in a linear ordered field.

On the other hand, in the `uniform_space` folder, we construct completions of general uniform
spaces, which allows to construct the Bourbaki real numbers. In this file we build uniformly
continuous bijections from Cauchy reals to Bourbaki reals and back. This is a cross sanity check of
both constructions. Of course those two constructions are variations on the completion idea, simply
with different level of generality. Comparing with Dedekind cuts or quasi-morphisms would be of a
completely different nature.

Note that `metric_space/cau_seq_filter` also relates the notions of Cauchy sequences in metric
spaces and Cauchy filters in general uniform spaces, and `metric_space/completion` makes sure
the completion (as a uniform space) of a metric space is a metric space.

Historical note: mathlib used to define real numbers in an intermediate way, using completion
of uniform spaces but extending multiplication in an ad-hoc way.

TODO:
* Upgrade this isomorphism to a topological ring isomorphism.
* Do the same comparison for p-adic numbers

## Implementation notes

The heavy work is done in `topology/uniform_space/abstract_completion` which provides an abstract
caracterization of completions of uniform spaces, and isomorphisms between them. The only work left
here is to prove the uniform space structure coming from the absolute value on ℚ (with values in ℚ,
not referring to ℝ) coincides with the one coming from the metric space structure (which of course
does use ℝ).

## References

* [N. Bourbaki, *Topologie générale*][bourbaki1966]

## Tags

real numbers, completion, uniform spaces
-/

open Set Function Filter CauSeq UniformSpace

#print Rat.uniformSpace_eq /-
/-- The metric space uniform structure on ℚ (which presupposes the existence
of real numbers) agrees with the one coming directly from (abs : ℚ → ℚ). -/
theorem Rat.uniformSpace_eq :
    (AbsoluteValue.abs : AbsoluteValue ℚ ℚ).UniformSpace = PseudoMetricSpace.toUniformSpace :=
  by
  ext s
  rw [(AbsoluteValue.hasBasis_uniformity _).mem_iff, metric.uniformity_basis_dist_rat.mem_iff]
  simp only [Rat.dist_eq, AbsoluteValue.abs_apply, ← Rat.cast_sub, ← Rat.cast_abs, Rat.cast_lt,
    abs_sub_comm]
#align rat.uniform_space_eq Rat.uniformSpace_eq
-/

#print rationalCauSeqPkg /-
/-- Cauchy reals packaged as a completion of ℚ using the absolute value route. -/
def rationalCauSeqPkg : @AbstractCompletion ℚ <| (@AbsoluteValue.abs ℚ _).UniformSpace
    where
  Space := ℝ
  coe := (coe : ℚ → ℝ)
  uniformStruct := by infer_instance
  complete := by infer_instance
  separation := by infer_instance
  UniformInducing := by
    rw [Rat.uniformSpace_eq]
    exact rat.uniform_embedding_coe_real.to_uniform_inducing
  dense := Rat.denseEmbedding_coe_real.dense
#align rational_cau_seq_pkg rationalCauSeqPkg
-/

namespace CompareReals

#print CompareReals.Q /-
/-- Type wrapper around ℚ to make sure the absolute value uniform space instance is picked up
instead of the metric space one. We proved in rat.uniform_space_eq that they are equal,
but they are not definitionaly equal, so it would confuse the type class system (and probably
also human readers). -/
def Q :=
  ℚ deriving CommRing, Inhabited
#align compare_reals.Q CompareReals.Q
-/

instance : UniformSpace Q :=
  (@AbsoluteValue.abs ℚ _).UniformSpace

#print CompareReals.Bourbakiℝ /-
/-- Real numbers constructed as in Bourbaki. -/
def Bourbakiℝ : Type :=
  Completion Q deriving Inhabited
#align compare_reals.Bourbakiℝ CompareReals.Bourbakiℝ
-/

#print CompareReals.Bourbaki.uniformSpace /-
instance Bourbaki.uniformSpace : UniformSpace Bourbakiℝ :=
  Completion.uniformSpace Q
#align compare_reals.bourbaki.uniform_space CompareReals.Bourbaki.uniformSpace
-/

/- warning: compare_reals.Bourbaki_pkg -> CompareReals.bourbakiPkg is a dubious translation:
lean 3 declaration is
  AbstractCompletion.{0} CompareReals.Q CompareReals.Q.uniformSpace
but is expected to have type
  AbstractCompletion.{0} CompareReals.Q CompareReals.uniformSpace
Case conversion may be inaccurate. Consider using '#align compare_reals.Bourbaki_pkg CompareReals.bourbakiPkgₓ'. -/
/-- Bourbaki reals packaged as a completion of Q using the general theory. -/
def bourbakiPkg : AbstractCompletion Q :=
  Completion.cPkg
#align compare_reals.Bourbaki_pkg CompareReals.bourbakiPkg

#print CompareReals.compareEquiv /-
/-- The uniform bijection between Bourbaki and Cauchy reals. -/
noncomputable def compareEquiv : Bourbakiℝ ≃ᵤ ℝ :=
  bourbakiPkg.compareEquiv rationalCauSeqPkg
#align compare_reals.compare_equiv CompareReals.compareEquiv
-/

/- warning: compare_reals.compare_uc -> CompareReals.compare_uc is a dubious translation:
lean 3 declaration is
  UniformContinuous.{0, 0} CompareReals.Bourbakiℝ Real CompareReals.Bourbaki.uniformSpace (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) (coeFn.{1, 1} (UniformEquiv.{0, 0} CompareReals.Bourbakiℝ Real CompareReals.Bourbaki.uniformSpace (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace)) (fun (_x : UniformEquiv.{0, 0} CompareReals.Bourbakiℝ Real CompareReals.Bourbaki.uniformSpace (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace)) => CompareReals.Bourbakiℝ -> Real) (UniformEquiv.hasCoeToFun.{0, 0} CompareReals.Bourbakiℝ Real CompareReals.Bourbaki.uniformSpace (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace)) CompareReals.compareEquiv)
but is expected to have type
  UniformContinuous.{0, 0} CompareReals.Bourbakiℝ Real CompareReals.Bourbaki.uniformSpace (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) (FunLike.coe.{1, 1, 1} (UniformEquiv.{0, 0} CompareReals.Bourbakiℝ Real CompareReals.Bourbaki.uniformSpace (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace)) CompareReals.Bourbakiℝ (fun (_x : CompareReals.Bourbakiℝ) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : CompareReals.Bourbakiℝ) => Real) _x) (EmbeddingLike.toFunLike.{1, 1, 1} (UniformEquiv.{0, 0} CompareReals.Bourbakiℝ Real CompareReals.Bourbaki.uniformSpace (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace)) CompareReals.Bourbakiℝ Real (EquivLike.toEmbeddingLike.{1, 1, 1} (UniformEquiv.{0, 0} CompareReals.Bourbakiℝ Real CompareReals.Bourbaki.uniformSpace (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace)) CompareReals.Bourbakiℝ Real (UniformEquiv.instEquivLikeUniformEquiv.{0, 0} CompareReals.Bourbakiℝ Real CompareReals.Bourbaki.uniformSpace (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace)))) CompareReals.compareEquiv)
Case conversion may be inaccurate. Consider using '#align compare_reals.compare_uc CompareReals.compare_ucₓ'. -/
theorem compare_uc : UniformContinuous compareEquiv :=
  bourbakiPkg.uniformContinuous_compareEquiv _
#align compare_reals.compare_uc CompareReals.compare_uc

/- warning: compare_reals.compare_uc_symm -> CompareReals.compare_uc_symm is a dubious translation:
lean 3 declaration is
  UniformContinuous.{0, 0} Real CompareReals.Bourbakiℝ (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) CompareReals.Bourbaki.uniformSpace (coeFn.{1, 1} (UniformEquiv.{0, 0} Real CompareReals.Bourbakiℝ (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) CompareReals.Bourbaki.uniformSpace) (fun (_x : UniformEquiv.{0, 0} Real CompareReals.Bourbakiℝ (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) CompareReals.Bourbaki.uniformSpace) => Real -> CompareReals.Bourbakiℝ) (UniformEquiv.hasCoeToFun.{0, 0} Real CompareReals.Bourbakiℝ (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) CompareReals.Bourbaki.uniformSpace) (UniformEquiv.symm.{0, 0} CompareReals.Bourbakiℝ Real CompareReals.Bourbaki.uniformSpace (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) CompareReals.compareEquiv))
but is expected to have type
  UniformContinuous.{0, 0} Real CompareReals.Bourbakiℝ (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) CompareReals.Bourbaki.uniformSpace (FunLike.coe.{1, 1, 1} (UniformEquiv.{0, 0} Real CompareReals.Bourbakiℝ (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) CompareReals.Bourbaki.uniformSpace) Real (fun (_x : Real) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : Real) => CompareReals.Bourbakiℝ) _x) (EmbeddingLike.toFunLike.{1, 1, 1} (UniformEquiv.{0, 0} Real CompareReals.Bourbakiℝ (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) CompareReals.Bourbaki.uniformSpace) Real CompareReals.Bourbakiℝ (EquivLike.toEmbeddingLike.{1, 1, 1} (UniformEquiv.{0, 0} Real CompareReals.Bourbakiℝ (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) CompareReals.Bourbaki.uniformSpace) Real CompareReals.Bourbakiℝ (UniformEquiv.instEquivLikeUniformEquiv.{0, 0} Real CompareReals.Bourbakiℝ (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) CompareReals.Bourbaki.uniformSpace))) (UniformEquiv.symm.{0, 0} CompareReals.Bourbakiℝ Real CompareReals.Bourbaki.uniformSpace (PseudoMetricSpace.toUniformSpace.{0} Real Real.pseudoMetricSpace) CompareReals.compareEquiv))
Case conversion may be inaccurate. Consider using '#align compare_reals.compare_uc_symm CompareReals.compare_uc_symmₓ'. -/
theorem compare_uc_symm : UniformContinuous compareEquiv.symm :=
  bourbakiPkg.uniformContinuous_compareEquiv_symm _
#align compare_reals.compare_uc_symm CompareReals.compare_uc_symm

end CompareReals


/-
Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ashvni Narayanan
-/
import data.nat.prime
import data.nat.parity
import algebra.order.with_zero
import algebra.gcd_monoid.nat

/-!
# Properties of natural numbers
This file describes some properties of natural numbers that are required throughout this project.
In the end, we keep some `helper` lemmas which are specific to this project.

## Tags
Naturals
-/

namespace nat
lemma dvd_sub_comm (a b n : ℕ) (h : (n : ℤ) ∣ (a : ℤ) - (b : ℤ)) : (n : ℤ) ∣ (b : ℤ) - (a : ℤ) :=
(dvd_neg ↑n (↑b - ↑a)).mp (by {simp only [h, neg_sub]})

lemma coprime_sub {n m : ℕ} (h : n.coprime m) (hn : m ≤ n) : (n - m).coprime n :=
begin
  by_contradiction h',
  obtain ⟨p, h1, h2, h3⟩ := nat.prime.not_coprime_iff_dvd.1 h',
  have h4 := nat.dvd_sub (nat.sub_le _ _) h3 h2,
  rw nat.sub_sub_self hn at h4,
  apply nat.prime.not_coprime_iff_dvd.2 ⟨p, h1, h3, h4⟩ h,
end

lemma ne_zero_of_lt' (b : ℕ) {a : ℕ} [fact (b < a)] : a ≠ 0 := @ne_zero_of_lt _ _ b _ (fact.out _)

variables {p : ℕ} [fact p.prime] {d : ℕ}
lemma one_lt_mul_pow_of_ne_one [fact (0 < d)] {k : ℕ} (h : d * p^k ≠ 1) : 1 < d * p^k :=
nat.one_lt_iff_ne_zero_and_ne_one.2 ⟨nat.mul_ne_zero (ne_zero_of_lt' 0)
  (pow_ne_zero _ (nat.prime.ne_zero (fact.out _))), h⟩

lemma mul_pow_eq_one_of_mul_pow_sq_not_one_lt {p : ℕ} [fact p.prime] {d : ℕ} [fact (0 < d)]
  {n : ℕ} (h : ¬ 1 < d * p^(2 * n)) : d * p^n = 1 :=
begin
  rw [not_lt_iff_eq_or_lt, lt_one_iff, nat.mul_eq_zero] at h,
  cases h,
  { have h' := h.symm,
    rw [nat.mul_eq_one_iff, pow_mul', pow_succ, pow_one, nat.mul_eq_one_iff] at h',
    rw [h'.1, h'.2.1, one_mul], },
  { have p2 : p^(2 * n) ≠ 0 := pow_ne_zero _ (nat.prime.ne_zero (fact.out _)),
    simp only [ne_zero_of_lt' 0, p2, or_self] at h,
    exfalso,
    exact h, },
end

instance [fact (0 < d)] {n : ℕ} : fact (0 < d * p^n) :=
fact_iff.2 (mul_pos (fact.out _) (pow_pos (nat.prime.pos (fact.out _)) _))

lemma mul_prime_pow_pos [fact (0 < d)] (m : ℕ) : 0 < d * p^m := fact_iff.1 infer_instance

lemma mul_pow_lt_mul_pow_succ [fact (0 < d)] (m : ℕ) : d * p ^ m < d * p ^ m.succ :=
mul_lt_mul' le_rfl (nat.pow_lt_pow_succ (nat.prime.one_lt (fact_iff.1 infer_instance)) m)
    (nat.zero_le _) (fact_iff.1 infer_instance)

lemma lt_pow {n a : ℕ} (h1 : 1 < a) (h2 : 1 < n) : a < a^n :=
begin
  conv { congr, rw ←pow_one a, skip, skip, },
  apply pow_lt_pow h1 h2,
end

lemma le_pow {n a : ℕ} (h1 : 1 ≤ a) (h2 : 1 ≤ n) : a ≤ a^n :=
begin
  conv { congr, rw ←pow_one a, skip, skip, },
  apply pow_le_pow h1 h2,
end

lemma pow_lt_mul_pow_succ_right [fact (0 < d)] (m : ℕ) : p ^ m < d * p ^ m.succ :=
begin
  rw [pow_succ, ←mul_assoc],
  apply lt_mul_of_one_lt_left (pow_pos (nat.prime.pos (fact.out _)) _)
    (one_lt_mul ((nat.succ_le_iff).2 (fact.out _)) (nat.prime.one_lt (fact.out _))),
  all_goals { assumption, },
end

lemma lt_mul_pow_right {m a b : ℕ} (h1 : 0 < b) (h2 : 1 < a) (h3 : 1 < m) : a < b * a^m :=
lt_of_le_of_lt ((le_mul_iff_one_le_left (lt_trans zero_lt_one h2)).2 h1)
  (mul_lt_mul' le_rfl (nat.lt_pow h2 h3) (nat.zero_le _) h1)

lemma le_mul_pow_right {m a b : ℕ} (h1 : 0 < b) (h2 : 1 < a) (h3 : 1 ≤ m) : a ≤ b * a^m :=
le_trans ((le_mul_iff_one_le_left (lt_trans zero_lt_one h2)).2 h1)
  (mul_le_mul' le_rfl (nat.le_pow (le_of_lt h2) h3))

lemma cast_eq_coe_b (x : ℕ) : @nat.cast ℤ _ _ _ x = coe_b x :=
begin
  induction x with d hd,
  { change 0 = @has_coe.coe ℕ ℤ _ 0,
    change _ = int.of_nat 0,
    simp only [int.coe_nat_zero, int.of_nat_eq_coe], },
  { show d.cast + 1 = @has_coe.coe ℕ ℤ _ d.succ,
    change _ = int.of_nat d.succ,
    simp only [int.of_nat_eq_coe, int.coe_nat_succ, add_left_inj],
    change _ = int.of_nat d at hd, simp [hd], },
end

lemma coprime.mul_pow {a b c : ℕ} (n : ℕ) (hc' : c.coprime a) (hc : c.coprime b) :
  c.coprime (a * b^n) := coprime_mul_iff_right.2 ⟨hc', coprime.pow_right n hc⟩

lemma add_sub_pred (n : ℕ) : n + (n - 1) = 2 * n - 1 :=
begin
  cases n,
  { refl, },
  { rw [←nat.add_sub_assoc (nat.succ_le_succ (nat.zero_le _)), nat.succ_mul, one_mul], },
end

lemma two_mul_sub_one_mod_two_eq_one {k : ℕ} (hk : 1 ≤ k) : (2 * k - 1) % 2 = 1 :=
begin
  have : 2 * k - 1 = 2 * k + 1 - 2, { norm_num, },
  rw [this, ←nat.mod_eq_sub_mod (nat.succ_le_succ (one_le_mul one_le_two hk)),
    nat.odd_iff.1 ⟨k, rfl⟩],
end

lemma pred_add_one_eq_self {n : ℕ} (hn : 0 < n) : n.pred + 1 = n := nat.succ_pred_eq_of_pos hn

lemma prime_dvd_of_not_coprime (p : ℕ) [fact p.prime] {n : ℕ} (h : ¬ n.coprime p) : p ∣ n :=
begin
  have := @nat.coprime_or_dvd_of_prime p (fact.out _) n,
  cases this,
  { exfalso, apply h this.symm, },
  { assumption, },
end

lemma eq_zero_of_not_pos {n : ℕ} (hn : ¬ 0 < n) : n = 0 := by linarith

lemma coprime_of_dvd_of_coprime {m n x y : ℕ} (h : m.coprime n) (hx : x ∣ m) (hy : y ∣ n) :
  x.coprime y :=
begin
  have : x.coprime n,
  { rw ← nat.is_coprime_iff_coprime,
    apply is_coprime.of_coprime_of_dvd_left (nat.is_coprime_iff_coprime.2 h) _,
    norm_cast, assumption, },
  rw ← nat.is_coprime_iff_coprime,
--  rw is_coprime_comm,
  apply is_coprime.of_coprime_of_dvd_right (nat.is_coprime_iff_coprime.2 this) _,
  norm_cast, assumption,
end

lemma sub_ne_zero {n k : ℕ} (h : k < n) : n - k ≠ 0 :=
begin
  intro h',
  rw nat.sub_eq_zero_iff_le at h',
  rw ← not_lt at h',
  apply h' h,
end

lemma coprime.sub_self {m n : ℕ} (h : m.coprime n) (h' : m ≤ n) : (n - m).coprime n :=
begin
  contrapose h,
  rw nat.prime.not_coprime_iff_dvd at *,
  rcases h with ⟨p, hp, h1, h2⟩,
  refine ⟨p, hp, _, h2⟩,
  rw ← nat.sub_sub_self h',
  apply nat.dvd_sub (nat.sub_le _ _) h2 h1,
end
end nat

lemma helper_4 {x y : ℕ} (m : ℕ) [fact (0 < m)] : gcd_monoid.lcm (x * y^m) y = x * y^m :=
begin
  rw lcm_eq_left_iff _ _ _,
  apply dvd_mul_of_dvd_right (dvd_pow_self y (nat.ne_zero_of_lt' 0)) x,
  { apply_instance, },
  { rw normalize_eq _, },
end

variables {p : ℕ} [fact p.prime] {d m : ℕ}
lemma helper_5 {k : ℕ} (hk : 1 < k) : (d * p^m)^(k - 1) = (d * p^m) * (d * p^m)^(k - 2) :=
begin
  conv_rhs { congr, rw ←pow_one (d * p^m), },
  rw [←pow_add],
  congr,
  rw add_comm,
  conv_rhs { rw [nat.sub_succ, ←nat.succ_eq_add_one,
    nat.succ_pred_eq_of_pos (lt_tsub_iff_right.2 _)], skip, apply_congr hk, },
end


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import order.hom.basic
import logic.equiv.set
import data.set.image

/-!
# Order homomorphisms and sets

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

open order_dual

variables {F α β γ δ : Type*}

namespace order_iso

section has_le

variables [has_le α] [has_le β] [has_le γ]

@[simp] lemma symm_image_image (e : α ≃o β) (s : set α) : e.symm '' (e '' s) = s :=
e.to_equiv.symm_image_image s

@[simp] lemma image_symm_image (e : α ≃o β) (s : set β) : e '' (e.symm '' s) = s :=
e.to_equiv.image_symm_image s

lemma image_eq_preimage (e : α ≃o β) (s : set α) : e '' s = e.symm ⁻¹' s :=
e.to_equiv.image_eq_preimage s

@[simp] lemma preimage_symm_preimage (e : α ≃o β) (s : set α) : e ⁻¹' (e.symm ⁻¹' s) = s :=
e.to_equiv.preimage_symm_preimage s

@[simp] lemma symm_preimage_preimage (e : α ≃o β) (s : set β) : e.symm ⁻¹' (e ⁻¹' s) = s :=
e.to_equiv.symm_preimage_preimage s

@[simp] lemma image_preimage (e : α ≃o β) (s : set β) : e '' (e ⁻¹' s) = s :=
e.to_equiv.image_preimage s

@[simp] lemma preimage_image (e : α ≃o β) (s : set α) : e ⁻¹' (e '' s) = s :=
e.to_equiv.preimage_image s

end has_le

open set

variables [preorder α] [preorder β] [preorder γ]

/-- Order isomorphism between two equal sets. -/
def set_congr (s t : set α) (h : s = t) : s ≃o t :=
{ to_equiv := equiv.set_congr h,
  map_rel_iff' := λ x y, iff.rfl }

/-- Order isomorphism between `univ : set α` and `α`. -/
def set.univ : (set.univ : set α) ≃o α :=
{ to_equiv := equiv.set.univ α,
  map_rel_iff' := λ x y, iff.rfl }

end order_iso

/-- If a function `f` is strictly monotone on a set `s`, then it defines an order isomorphism
between `s` and its image. -/
protected noncomputable def strict_mono_on.order_iso {α β} [linear_order α] [preorder β]
  (f : α → β) (s : set α) (hf : strict_mono_on f s) :
  s ≃o f '' s :=
{ to_equiv := hf.inj_on.bij_on_image.equiv _,
  map_rel_iff' := λ x y, hf.le_iff_le x.2 y.2 }

namespace strict_mono

variables {α β} [linear_order α] [preorder β]
variables (f : α → β) (h_mono : strict_mono f) (h_surj : function.surjective f)

/-- A strictly monotone function from a linear order is an order isomorphism between its domain and
its range. -/
@[simps apply] protected noncomputable def order_iso : α ≃o set.range f :=
{ to_equiv := equiv.of_injective f h_mono.injective,
  map_rel_iff' := λ a b, h_mono.le_iff_le }

/-- A strictly monotone surjective function from a linear order is an order isomorphism. -/
noncomputable def order_iso_of_surjective : α ≃o β :=
(h_mono.order_iso f).trans $ (order_iso.set_congr _ _ h_surj.range_eq).trans order_iso.set.univ

@[simp] lemma coe_order_iso_of_surjective :
  (order_iso_of_surjective f h_mono h_surj : α → β) = f :=
rfl

@[simp] lemma order_iso_of_surjective_symm_apply_self (a : α) :
  (order_iso_of_surjective f h_mono h_surj).symm (f a) = a :=
(order_iso_of_surjective f h_mono h_surj).symm_apply_apply _

lemma order_iso_of_surjective_self_symm_apply (b : β) :
  f ((order_iso_of_surjective f h_mono h_surj).symm b) = b :=
(order_iso_of_surjective f h_mono h_surj).apply_symm_apply _

end strict_mono

section boolean_algebra
variables (α) [boolean_algebra α]

/-- Taking complements as an order isomorphism to the order dual. -/
@[simps]
def order_iso.compl : α ≃o αᵒᵈ :=
{ to_fun := order_dual.to_dual ∘ compl,
  inv_fun := compl ∘ order_dual.of_dual,
  left_inv := compl_compl,
  right_inv := compl_compl,
  map_rel_iff' := λ x y, compl_le_compl_iff_le }

theorem compl_strict_anti : strict_anti (compl : α → α) :=
(order_iso.compl α).strict_mono

theorem compl_antitone : antitone (compl : α → α) :=
(order_iso.compl α).monotone

end boolean_algebra


import data.real.sqrt

inductive constructible : ℝ → Prop
| one : constructible 1
| add : ∀ ⦃x y⦄, constructible x → constructible y → constructible (x + y)
| neg : ∀ ⦃x⦄, constructible x → constructible (-x)
| mul : ∀ ⦃x y⦄, constructible x → constructible y → constructible (x * y)
| inv : ∀ ⦃x⦄, constructible x → constructible (x⁻¹)
| sqrt : ∀ ⦃x⦄, constructible x → constructible (real.sqrt x)

@[user_attribute]
meta def constructibility : user_attribute :=
{ name := `constructibility,
  descr := "lemmas used to prove constructibility" }

attribute [constructibility] constructible.one constructible.add constructible.neg constructible.mul
  constructible.inv constructible.sqrt

namespace tactic

meta def constructibility_core : tactic unit := apply_rules [``(constructibility)] 50 {}

namespace interactive

meta def constructibility : tactic unit := tactic.constructibility_core

end interactive

end tactic

-- meta def constructibility : tactic unit :=
-- `[ apply_rules [constructible.one, constructible.add, constructible.neg, constructible.mul,
--                 constructible.inv, constructible.sqrt] ]

@[constructibility]
lemma constructible_zero : constructible 0 :=
begin
  rw ←add_neg_self (1 : ℝ),
  constructibility,
end

def constructible_number := {x // constructible x}

namespace constructible_number

local notation `C` := constructible_number

def zero : C := ⟨0, by constructibility⟩

instance : has_zero C := ⟨zero⟩

def one : C := ⟨1, by constructibility⟩

instance : has_one C := ⟨one⟩

def add : C → C → C
| ⟨a, ha⟩ ⟨b, hb⟩ := ⟨a + b, by constructibility⟩

instance : has_add C := ⟨add⟩

def neg : C → C
| ⟨a, ha⟩ := ⟨-a, by constructibility⟩

instance : has_neg C := ⟨neg⟩

instance : add_comm_group C :=
{ add_assoc := λ ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, subtype.ext $ add_assoc a b c,
  zero_add := λ ⟨a, ha⟩, subtype.ext $ zero_add a,
  add_zero := λ ⟨a, ha⟩, subtype.ext $ add_zero a,
  add_comm := λ ⟨a, ha⟩ ⟨b, hb⟩, subtype.ext $ add_comm a b,
  add_left_neg := λ ⟨a, ha⟩, subtype.ext $ add_left_neg a,
  sub := λ a b, a + - b,
  sub_eq_add_neg := λ ⟨a, ha⟩ ⟨b, hb⟩, rfl,
  ..constructible_number.has_add, ..constructible_number.has_zero, ..constructible_number.has_neg }

def mul : C → C → C
| ⟨a, ha⟩ ⟨b, hb⟩ := ⟨a * b, by constructibility⟩

instance : has_mul C := ⟨mul⟩

instance : comm_ring C :=
{ mul_assoc := λ ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, subtype.ext $ mul_assoc a b c,
  one_mul := λ ⟨a, ha⟩, subtype.ext $ one_mul a,
  mul_one := λ ⟨a, ha⟩, subtype.ext $ mul_one a,
  left_distrib := λ ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, subtype.ext $ left_distrib a b c,
  right_distrib := λ ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, subtype.ext $ right_distrib a b c,
  mul_comm := λ ⟨a, ha⟩ ⟨b, hb⟩, subtype.ext $ mul_comm a b,
  ..constructible_number.add_comm_group, ..constructible_number.has_mul, ..constructible_number.has_one }

noncomputable def inv : C → C
| ⟨a, ha⟩ := ⟨a⁻¹, by constructibility⟩

noncomputable instance : has_inv C := ⟨inv⟩

example {α β : Type} (f : α → β) (hf : function.injective f) (a b : α) (hab : a ≠ b) : f a ≠ f b :=
begin
  exact function.injective.ne hf hab
end

noncomputable instance : field C :=
{ exists_pair_ne := ⟨0, 1, subtype.ne_of_val_ne zero_ne_one⟩,
  mul_inv_cancel := λ ⟨a, ha⟩ h, subtype.ext $ mul_inv_cancel $ subtype.val_injective.ne h,
  inv_zero := subtype.ext inv_zero,
  ..constructible_number.comm_ring, ..constructible_number.has_inv }

end constructible_number