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

import tactic.interval_cases
import .primes
import .edwards

/-!
# Fermat's Last Theorem for the case n = 3

There are no non-zero integers `a`, `b` and `c` such that `a ^ 3 + b ^ 3 = c ^ 3`.

This follows the proof by Euler as presented by H. M. Edwards in
*Fermat's Last Theorem: A Genetic Introduction to Algebraic Number Theory*, pp. 39-54.
-/

/-- solutions to Fermat's last theorem for the exponent `3`. -/
def flt_solution
  (n : ℕ)
  (a b c : ℤ) :=
  a ≠ 0 ∧ b ≠ 0 ∧ c ≠ 0 ∧
  a ^ n + b ^ n = c ^ n

/-- Coprime solutions to Fermat's last theorem for the exponent `3`. -/
def flt_coprime
  (n : ℕ)
  (a b c : ℤ) :=
  flt_solution n a b c ∧
  is_coprime a b ∧
  is_coprime a c ∧
  is_coprime b c

lemma exists_coprime
  {n : ℕ}
  (hn : 0 < n)
  {a b c : ℤ}
  (ha' : a ≠ 0)
  (hb' : b ≠ 0)
  (hc' : c ≠ 0)
  (h : a ^ n + b ^ n = c ^ n) :
  ∃ a' b' c' : ℤ,
    a'.nat_abs ≤ a.nat_abs ∧ b'.nat_abs ≤ b.nat_abs ∧ c'.nat_abs ≤ c.nat_abs ∧
    flt_coprime n a' b' c' :=
begin
  set d := int.gcd a b with hd',
  obtain ⟨A, HA⟩ : ↑d ∣ a := int.gcd_dvd_left a b,
  obtain ⟨B, HB⟩ : ↑d ∣ b := int.gcd_dvd_right a b,
  obtain ⟨C, HC⟩ : ↑d ∣ c,
  { rw [←int.pow_dvd_pow_iff hn, ←h, HA, HB, mul_pow, mul_pow, ←mul_add],
    exact dvd_mul_right (↑d ^ n) (A ^ n + B ^ n) },
  have hdpos : 0 < d := int.gcd_pos_of_non_zero_left _ ha',
  have hd := int.coe_nat_ne_zero_iff_pos.mpr hdpos,
  have hsoln : A ^ n + B ^ n = C ^ n,
  { apply int.eq_of_mul_eq_mul_left (pow_ne_zero n hd),
    simp only [mul_add, ←mul_pow, ←HA, ←HB, ←HC, h] },
  have hsoln' : B ^ n + A ^ n = C ^ n,
  { rwa add_comm at hsoln },
  have hcoprime : is_coprime A B,
  { rw ←int.gcd_eq_one_iff_coprime,
    apply nat.eq_of_mul_eq_mul_left hdpos,
    rw [←int.nat_abs_of_nat d, ←int.gcd_mul_left, ←HA, ←HB, hd', int.nat_abs_of_nat, mul_one] },
  have HA' : A.nat_abs ≤ a.nat_abs,
  { rw HA,
    simp only [int.nat_abs_of_nat, int.nat_abs_mul],
    exact le_mul_of_one_le_left' (nat.succ_le_iff.mpr hdpos) },
  have HB' : B.nat_abs ≤ b.nat_abs,
  { rw HB,
    simp only [int.nat_abs_of_nat, int.nat_abs_mul],
    exact le_mul_of_one_le_left' (nat.succ_le_iff.mpr hdpos) },
  have HC' : C.nat_abs ≤ c.nat_abs,
  { rw HC,
    simp only [int.nat_abs_of_nat, int.nat_abs_mul],
    exact le_mul_of_one_le_left' (nat.succ_le_iff.mpr hdpos) },
  exact ⟨
    A,
    B,
    C,
    HA',
    HB',
    HC',
    ⟨
      right_ne_zero_of_mul (by rwa HA at ha'),
      right_ne_zero_of_mul (by rwa HB at hb'),
      right_ne_zero_of_mul (by rwa HC at hc'),
      hsoln
    ⟩,
    hcoprime,
    coprime_add_self_pow hn hsoln hcoprime,
    coprime_add_self_pow hn hsoln' hcoprime.symm
  ⟩,
end

lemma descent1a {a b c : ℤ}
  (h : a ^ 3 + b ^ 3 = c ^ 3)
  (habcoprime : is_coprime a b)
  (haccoprime : is_coprime a c)
  (hbccoprime : is_coprime b c) :
  (even a ∧ ¬even b ∧ ¬even c ∨
   ¬even a ∧ even b ∧ ¬even c) ∨
  ¬even a ∧ ¬even b ∧ even c :=
begin
  have contra : ∀ {x y : ℤ}, is_coprime x y → even x → even y → false,
  { intros x y hcoprime hx hy,
    rw even_iff_two_dvd at hx hy,
    have := int.is_unit_eq_one_or (hcoprime.is_unit_of_dvd' hx hy),
    norm_num at this },
  by_cases haparity : even a;
  by_cases hbparity : even b;
  by_cases hcparity : even c,
  { exact false.elim (contra habcoprime ‹_› ‹_›) },
  { exact false.elim (contra habcoprime ‹_› ‹_›) },
  { exact false.elim (contra haccoprime ‹_› ‹_›) },
  { tauto },
  { exact false.elim (contra hbccoprime ‹_› ‹_›) },
  { tauto },
  { tauto },
  { exfalso,
    apply hcparity,
    rw [←int.even_pow' three_ne_zero, ←h],
    simp [haparity, hbparity, three_ne_zero] with parity_simps },
end

lemma flt_not_add_self {a b c : ℤ} (ha : a ≠ 0) (h : a ^ 3 + b ^ 3 = c ^ 3) : a ≠ b :=
begin
  rintro rfl,
  rw ←mul_two at h,
  obtain ⟨d, rfl⟩ : a ∣ c,
  { rw [←int.pow_dvd_pow_iff (by norm_num : 0 < 3), ←h],
    apply dvd_mul_right },
  apply int.two_not_cube d,
  rwa [mul_pow, mul_right_inj' (pow_ne_zero 3 ha), eq_comm] at h,
end

lemma descent1left {a b c : ℤ}
  (hapos : a ≠ 0)
  (h : a ^ 3 + b ^ 3 = c ^ 3)
  (hbccoprime : is_coprime b c)
  (hb : ¬even b)
  (hc : ¬even c) :
  ∃ (p q : ℤ),
    p ≠ 0 ∧
      q ≠ 0 ∧
        is_coprime p q ∧
          (even p ↔ ¬even q) ∧
            2 * p * (p ^ 2 + 3 * q ^ 2) = a ^ 3 :=
begin
  obtain ⟨p, hp⟩ : even (c - b),
  { simp [hb, hc] with parity_simps},
  obtain ⟨q, hq⟩ : even (c + b),
  { simp [hb, hc] with parity_simps},
  rw ←two_mul at hp hq,
  obtain rfl : p + q = c,
  { apply int.eq_of_mul_eq_mul_left two_ne_zero,
    rw [mul_add, ←hp, ←hq],
    ring },
  obtain rfl : q - p = b,
  { apply int.eq_of_mul_eq_mul_left two_ne_zero,
    rw [mul_sub, ←hp, ←hq],
    ring },
  have hpnezero : p ≠ 0,
  { rintro rfl,
    rw [sub_zero, zero_add, add_left_eq_self] at h,
    exact hapos (pow_eq_zero h) },

  have hqnezero : q ≠ 0,
  { rintro rfl,
    rw [zero_sub, add_zero, neg_pow_bit1, ←sub_eq_add_neg, sub_eq_iff_eq_add] at h,
    exact flt_not_add_self hpnezero h.symm rfl },

  refine ⟨p, q, hpnezero, hqnezero, _, _, _⟩,
  { apply is_coprime_of_dvd _ _ (not_and_of_not_left _ hpnezero),
    intros z hznu hznz hzp hzq,
    apply hznu,
    exact hbccoprime.is_unit_of_dvd' (dvd_sub hzq hzp) (dvd_add hzp hzq) },
  { split; intro H; simpa [H] with parity_simps using hc },
  { rw [eq_sub_of_add_eq h],
    ring },
end

lemma descent1 (a b c : ℤ)
  (h : flt_coprime 3 a b c) :
  ∃ (p q : ℤ),
    p ≠ 0 ∧
    q ≠ 0 ∧
    is_coprime p q ∧
    (even p ↔ ¬even q) ∧
    (2 * p * (p ^ 2 + 3 * q ^ 2) = a ^ 3 ∨
     2 * p * (p ^ 2 + 3 * q ^ 2) = b ^ 3 ∨
     2 * p * (p ^ 2 + 3 * q ^ 2) = c ^ 3) :=
begin
  obtain ⟨⟨hapos, hbpos, hcpos, h⟩, habcoprime, haccoprime, hbccoprime⟩ := h,

  obtain (⟨ha, hb, hc⟩|⟨ha, hb, hc⟩)|⟨ha, hb, hc⟩ := descent1a h habcoprime haccoprime hbccoprime,
  { obtain ⟨p, q, hp, hq, hcoprime, hodd, hcube⟩ := descent1left hapos h hbccoprime hb hc,
    exact ⟨p, q, hp, hq, hcoprime, hodd, or.inl hcube⟩ },
  { rw add_comm at h,
    obtain ⟨p, q, hp, hq, hcoprime, hodd, hcube⟩ := descent1left hbpos h haccoprime ha hc,
    refine ⟨p, q, hp, hq, hcoprime, hodd, or.inr $ or.inl hcube⟩ },
  { obtain ⟨p, q, hp, hq, hcoprime, hodd, hcube⟩ := descent1left hcpos _ habcoprime.neg_left _ hb,
    exact ⟨p, q, hp, hq, hcoprime, hodd, or.inr $ or.inr hcube⟩,
    { rw ←h, ring },
    { simp [ha] with parity_simps } },
end

lemma descent11 {a b c d : ℤ} (h : d = a ∨ d = b ∨ d = c) : d ∣ (a * b * c) :=
begin
  rcases h with rfl | rfl | rfl,
  { exact (dvd_mul_right _ _).mul_right _ },
  { exact (dvd_mul_left _ _).mul_right _ },
  { exact dvd_mul_left _ _ }
end

lemma descent2 (a b c : ℤ)
  (h : flt_coprime 3 a b c) :
  ∃ (p q : ℤ),
    p ≠ 0 ∧
    q ≠ 0 ∧
    is_coprime p q ∧
    (even p ↔ ¬even q) ∧
    (2 * p * (p ^ 2 + 3 * q ^ 2) = a ^ 3 ∨
     2 * p * (p ^ 2 + 3 * q ^ 2) = b ^ 3 ∨
     2 * p * (p ^ 2 + 3 * q ^ 2) = c ^ 3) ∧
    ((2 * p).nat_abs < (a ^ 3 * b ^ 3 * c ^ 3).nat_abs) :=
begin
  obtain ⟨p, q, hp, hq, hcoprime, hodd, hcube⟩ := descent1 a b c h,
  refine ⟨p, q, hp, hq, hcoprime, hodd, hcube, _⟩,

  obtain ⟨⟨hapos, hbpos, hcpos, h⟩, -⟩ := h,
  set P : ℤ√-3 := ⟨p, q⟩,
  calc (2 * p).nat_abs < (2 * p * P.norm).nat_abs : _
  ... ≤ (a ^ 3 * b ^ 3 * c ^ 3).nat_abs : _,
  { rw [int.nat_abs_mul (2 * p)],
    apply lt_mul_of_one_lt_right (int.nat_abs_pos_of_ne_zero (mul_ne_zero two_ne_zero hp)),
    rw [← int.coe_nat_lt_coe_nat_iff],
    rw int.nat_abs_of_nonneg (zsqrtd.norm_nonneg (by norm_num) P),
    exact spts.one_lt_of_im_ne_zero ⟨p, q⟩ hq },
  { apply nat.le_of_dvd,
    { rw [pos_iff_ne_zero, int.nat_abs_ne_zero, ←mul_pow, ←mul_pow],
      exact pow_ne_zero 3 (mul_ne_zero (mul_ne_zero hapos hbpos) hcpos) },
    { rw int.nat_abs_dvd_iff_dvd,
      convert descent11 hcube,
      rw [zsqrtd.norm],
      ring } }
end

lemma gcd1or3
  (p q : ℤ)
  (hp : p ≠ 0)
  (hcoprime : is_coprime p q)
  (hparity : even p ↔ ¬even q) :
  int.gcd (2 * p) (p ^ 2 + 3 * q ^ 2) = 1 ∨ int.gcd (2 * p) (p ^ 2 + 3 * q ^ 2) = 3 :=
begin
  set g := int.gcd (2 * p) (p ^ 2 + 3 * q ^ 2) with hg',
  suffices H : ∃ k, g = 3 ^ k ∧ k < 2,
  { obtain ⟨k, hg, hk⟩ := H,
    interval_cases k,
    { left, rw pow_zero at hg, exact hg },
    { right, rw pow_one at hg, exact hg } },

  have basic : ∀ f, nat.prime f → (f : ℤ) ∣ 2 * p → (f : ℤ) ∣ (p ^ 2 + 3 * q ^ 2) → f = 3,
  { intros d hdprime hdleft hdright,
    by_contra hne3,
    rw ←ne.def at hne3,
    apply (nat.prime_iff_prime_int.mp hdprime).not_unit,

    have hne2 : d ≠ 2,
    { rintro rfl,
      rw [int.coe_nat_bit0, int.coe_nat_one, ←even_iff_two_dvd] at hdright,
      simpa [hparity, two_ne_zero] with parity_simps using hdright },
    have : 2 < d := lt_of_le_of_ne (hdprime.two_le) hne2.symm,
    have : 3 < d := lt_of_le_of_ne (this) hne3.symm,
    obtain ⟨P, hP⟩ := hdleft,
    obtain ⟨Q, hQ⟩ := hdright,
    obtain ⟨H, hH⟩ : 2 ∣ P,
    { have H := dvd_mul_right 2 p,
      rw [hP] at H,
      apply (prime.dvd_or_dvd int.prime_two H).resolve_left,
      rw int.coe_nat_dvd_right,
      change ¬(2 ∣ d),
      rw nat.prime_dvd_prime_iff_eq nat.prime_two hdprime,
      exact hne2.symm },
    have hp : p = d * H,
    { rw [←mul_right_inj' (two_ne_zero' ℤ), hP, hH, mul_left_comm] },

    apply hcoprime.is_unit_of_dvd',
    { rw hp, exact dvd_mul_right d H },
    { have h000 : d ∣ 3 * q.nat_abs ^ 2,
      { rw [←int.coe_nat_dvd, int.coe_nat_mul, int.coe_nat_pow, int.nat_abs_sq, int.coe_nat_bit1,
          int.coe_nat_one],
        use (Q - d * H ^ 2),
        rw [mul_sub, ←hQ, hp],
        ring },
      cases (nat.prime.dvd_mul hdprime).mp h000 with h000 h000,
      { rw nat.prime_dvd_prime_iff_eq hdprime nat.prime_three at h000,
        exact absurd h000 hne3 },
      { rw int.coe_nat_dvd_left,
        exact nat.prime.dvd_of_dvd_pow hdprime h000 } } },

  set k := g.factors.length,
  have hg : g = 3 ^ k,
  { apply nat.eq_prime_pow_of_unique_prime_dvd,
    { apply ne_of_gt,
      apply nat.gcd_pos_of_pos_left,
      rw int.nat_abs_mul,
      apply nat.mul_pos zero_lt_two,
      rwa [pos_iff_ne_zero, int.nat_abs_ne_zero], },
    intros d hdprime hddvdg,
    rw ←int.coe_nat_dvd at hddvdg,
    apply basic _ hdprime; apply dvd_trans hddvdg; rw hg',
    exacts [int.gcd_dvd_left _ _, int.gcd_dvd_right _ _] },
  refine ⟨k, hg, _⟩,
  by_contra' H,
  rw ←pow_mul_pow_sub _ H at hg,
  have : ¬is_unit (3 : ℤ),
  { rw int.is_unit_iff_nat_abs_eq, norm_num },
  apply this,
  have hdvdp : 3 ∣ p,
  { suffices : 3 ∣ 2 * p,
    { apply int.dvd_mul_cancel_prime' _ dvd_rfl int.prime_two this,
      norm_num, },
    have : 3 ∣ (g : ℤ),
    { rw [hg, pow_two, mul_assoc, int.coe_nat_mul],
      apply dvd_mul_right },
    exact dvd_trans this (int.gcd_dvd_left _ _) },
  apply is_coprime.is_unit_of_dvd' hcoprime hdvdp,
  { rw ←int.pow_dvd_pow_iff zero_lt_two at hdvdp,
    apply prime.dvd_of_dvd_pow int.prime_three,
    rw [←mul_dvd_mul_iff_left (three_ne_zero' ℤ), ←pow_two, dvd_add_iff_right hdvdp],
    refine dvd_trans _ (int.gcd_dvd_right (2 * p) (p ^ 2 + 3 * q ^ 2)),
    rw [←hg', hg, int.coe_nat_mul],
    apply dvd_mul_right }
end

lemma obscure'
  (p q : ℤ)
  (hp : p ≠ 0)
  (hcoprime : is_coprime p q)
  (hparity : even p ↔ ¬even q)
  (hcube : ∃ r, p ^ 2 + 3 * q ^ 2 = r ^ 3) :
  ∃ a b,
    p = a * (a - 3 * b) * (a + 3 * b) ∧
    q = 3 * b * (a - b) * (a + b) ∧
    is_coprime a b ∧
    (even a ↔ ¬even b) :=
begin
  obtain ⟨u, hu⟩ := hcube,

  obtain ⟨a, b, hp', hq'⟩ := step6 p q u hcoprime hu.symm,
  refine ⟨a, b, _, _, _, _⟩,
  { rw hp', ring },
  { rw hq', ring },
  { apply is_coprime_of_dvd,
    { rintro ⟨rfl, rfl⟩,
      norm_num at hp' },

    intros k hknu hknezero hkdvdleft hkdvdright,
    apply hknu,
    apply hcoprime.is_unit_of_dvd',
    { rw hp',
      apply dvd_sub,
      { exact dvd_pow hkdvdleft (by norm_num) },
      { rw [mul_comm (9 : ℤ), mul_assoc],
        exact hkdvdleft.mul_right _ } },
    { rw hq',
      apply dvd_sub,
      { exact hkdvdright.mul_left _ },
      { exact (hkdvdright.pow (by norm_num)).mul_left _ } } },

  { by_cases haparity : even a; by_cases hbparity : even b;
    [skip, tauto, tauto, skip];
    { exfalso,
      have : even p,
      { rw [hp'],
        simp [haparity, hbparity, three_ne_zero] with parity_simps },
      have : even q,
      { rw [hq'],
        simp [haparity, hbparity, three_ne_zero] with parity_simps },
      tauto } }
end

lemma int.cube_of_coprime (a b c s : ℤ)
  (ha : a ≠ 0)
  (hb : b ≠ 0)
  (hc : c ≠ 0)
  (hcoprimeab : is_coprime a b)
  (hcoprimeac : is_coprime a c)
  (hcoprimebc : is_coprime b c)
  (hs : a * b * c = s ^ 3) :
  ∃ A B C, A ≠ 0 ∧ B ≠ 0 ∧ C ≠ 0 ∧ a = A ^ 3 ∧ b = B ^ 3 ∧ c = C ^ 3 :=
begin
  obtain ⟨⟨AB, HAB⟩, ⟨C, HC⟩⟩ := int.eq_pow_of_mul_eq_pow_bit1
    (is_coprime.mul_left hcoprimeac hcoprimebc) hs,
  obtain ⟨⟨A, HA⟩, ⟨B, HB⟩⟩ := int.eq_pow_of_mul_eq_pow_bit1 hcoprimeab HAB,
  refine ⟨A, B, C, _, _, _, HA, HB, HC⟩; apply ne_zero_pow three_ne_zero,
  { rwa [←HA] },
  { rwa [←HB] },
  { rwa [←HC] },
end

lemma int.gcd1_coprime12 (u v : ℤ)
  (huvcoprime : is_coprime u v)
  (notdvd_2_2 : ¬2 ∣ u - 3 * v)
  (not_3_dvd_2 : ¬3 ∣ u - 3 * v) :
  is_coprime (2 * u) (u - 3 * v) :=
begin
  apply is_coprime_of_prime_dvd,
  { rintro ⟨-, h2⟩,
    norm_num [h2] at notdvd_2_2 },
  intros k hkprime hkdvdleft hkdvdright,
  apply hkprime.not_unit,
  apply huvcoprime.is_unit_of_dvd',
  { exact int.dvd_mul_cancel_prime' notdvd_2_2 hkdvdright int.prime_two hkdvdleft },
  { apply int.dvd_mul_cancel_prime' not_3_dvd_2 hkdvdright int.prime_three,
    apply int.dvd_mul_cancel_prime' notdvd_2_2 hkdvdright int.prime_two,
    convert dvd_sub hkdvdleft (hkdvdright.mul_left 2),
    ring },
end

lemma int.gcd1_coprime13 (u v : ℤ)
  (huvcoprime : is_coprime u v)
  (this : ¬even (u + 3 * v))
  (notdvd_3_3 : ¬3 ∣ u + 3 * v) :
  is_coprime (2 * u) (u + 3 * v) :=
begin
  rw even_iff_two_dvd at this,
  apply is_coprime_of_prime_dvd,
  { rintro ⟨-, h2⟩,
    norm_num [h2] at this },
  intros k hkprime hkdvdleft hkdvdright,
  apply hkprime.not_unit,
  apply huvcoprime.is_unit_of_dvd',
  { exact int.dvd_mul_cancel_prime' this hkdvdright int.prime_two hkdvdleft },
  { apply int.dvd_mul_cancel_prime' notdvd_3_3 hkdvdright int.prime_three,
    apply int.dvd_mul_cancel_prime' this hkdvdright int.prime_two,
    convert dvd_sub (hkdvdright.mul_left 2) hkdvdleft,
    ring },
end

lemma int.gcd1_coprime23 (u v : ℤ)
  (huvcoprime : is_coprime u v)
  (notdvd_2_2 : ¬2 ∣ u - 3 * v)
  (notdvd_3_3 : ¬3 ∣ u + 3 * v) :
  is_coprime (u - 3 * v) (u + 3 * v) :=
begin
  apply is_coprime_of_prime_dvd,
  { rintro ⟨h1, -⟩,
    norm_num [h1] at notdvd_2_2 },
  intros k hkprime hkdvdleft hkdvdright,
  apply hkprime.not_unit,
  apply huvcoprime.is_unit_of_dvd',
  { apply int.dvd_mul_cancel_prime' notdvd_2_2 hkdvdleft int.prime_two,
    convert dvd_add hkdvdleft hkdvdright,
    ring },
  { apply int.dvd_mul_cancel_prime' notdvd_3_3 hkdvdright int.prime_three,
    apply int.dvd_mul_cancel_prime' notdvd_2_2 hkdvdleft int.prime_two,
    convert dvd_sub hkdvdright hkdvdleft,
    ring },
end

lemma descent_gcd1 (a b c p q : ℤ)
  (hp : p ≠ 0)
  (hcoprime : is_coprime p q)
  (hodd : even p ↔ ¬even q)
  (hcube : 2 * p * (p ^ 2 + 3 * q ^ 2) = a ^ 3 ∨
             2 * p * (p ^ 2 + 3 * q ^ 2) = b ^ 3 ∨
               2 * p * (p ^ 2 + 3 * q ^ 2) = c ^ 3)
  (h : flt_coprime 3 a b c)
  (hgcd : is_coprime (2 * p) (p ^ 2 + 3 * q ^ 2)) :
  ∃ (a' b' c' : ℤ),
    a' ≠ 0 ∧ b' ≠ 0 ∧ c' ≠ 0 ∧
    (a' ^ 3 * b' ^ 3 * c' ^ 3).nat_abs ≤ (2 * p).nat_abs ∧
    a' ^ 3 + b' ^ 3 = c' ^ 3 :=
begin
  -- 2.
  have h' := h,
  obtain ⟨⟨hapos, hbpos, hcpos, h⟩, habcoprime, haccoprime, hbccoprime⟩ := h,
  -- 5.
  obtain ⟨r, hr⟩ : ∃ r, 2 * p * (p ^ 2 + 3 * q ^ 2) = r ^ 3,
  { rcases hcube with (_|_|_);
    [use a, use b, use c];
    exact hcube },
  obtain ⟨hcubeleft, hcuberight⟩ := int.eq_pow_of_mul_eq_pow_bit1 hgcd hr,
  -- todo shadowing hq
  obtain ⟨u, v, hpfactor, hq, huvcoprime, huvodd⟩ := obscure' p q hp hcoprime hodd hcuberight,
  have u_ne_zero : u ≠ 0,
  { rintro rfl,
    rw [zero_mul, zero_mul] at hpfactor,
    contradiction },
  have haaa : 2 * p = (2 * u) * (u - 3 * v) * (u + 3 * v),
  { rw hpfactor, ring },
  have : ¬even (u - 3 * v),
  { simp [huvodd] with parity_simps },
  have : ¬even (u + 3 * v),
  { simp [huvodd] with parity_simps },
  have notdvd_2_2 : ¬(2 ∣ u - 3 * v),
  { rw ←even_iff_two_dvd,
    exact ‹¬even (u - 3 * v)› },
  have hddd : ¬(3 ∣ p),
  { intro H,
    have : 3 ∣ p ^ 2 + 3 * q ^ 2,
    { apply dvd_add,
      { rw pow_two,
        exact H.mul_left _ },
      { apply dvd_mul_right } },
    have : 3 ∣ 2 * p := H.mul_left 2,
    have := is_coprime.is_unit_of_dvd' hgcd ‹_› ‹_›,
    rw is_unit_iff_dvd_one at this,
    norm_num at this },
  have not_3_dvd_2 : ¬(3 ∣ (u - 3 * v)),
  { intro hd2,
    apply hddd,
    rw hpfactor,
    exact (hd2.mul_left _).mul_right _ },
  have notdvd_3_3 : ¬(3 ∣ (u + 3 * v)),
  { intro hd3,
    apply hddd,
    rw hpfactor,
    exact hd3.mul_left _ },

  obtain ⟨s, hs⟩ := hcubeleft,
  obtain ⟨C, A, B, HCpos, HApos, HBpos, HC, HA, HB⟩ : ∃ X Y Z : ℤ,
    X ≠ 0 ∧ Y ≠ 0 ∧ Z ≠ 0 ∧
    2 * u = X ^ 3 ∧ u - 3 * v = Y ^ 3 ∧ u + 3 * v = Z ^ 3,
  { apply int.cube_of_coprime (2 * u) (u - 3 * v) (u + 3 * v) s,
    { apply mul_ne_zero two_ne_zero u_ne_zero },
    { rw sub_ne_zero,
      rintro rfl,
      simpa only [int.not_even_bit1, false_or, iff_not_self] with parity_simps using huvodd },
    { intro H,
      rw add_eq_zero_iff_eq_neg at H,
      simpa [H] with parity_simps using huvodd },
    { apply int.gcd1_coprime12 u v; assumption },
    { apply int.gcd1_coprime13 u v; assumption },
    { apply int.gcd1_coprime23 u v; assumption },
    { rw ←haaa, exact hs } },

  refine ⟨A, B, C, HApos, HBpos, HCpos, _, _⟩,
  { rw [mul_comm, ←mul_assoc (C ^ 3), ←HA, ←HB, ←HC, ←haaa] },
  { rw [←HA, ←HB, ←HC], ring },
end

lemma gcd3_coprime
  {u v : ℤ}
  (huvcoprime: is_coprime u v)
  (huvodd : even u ↔ ¬even v) :
  is_coprime (2 * v) (u + v) ∧ is_coprime (2 * v) (u - v) ∧ is_coprime (u - v) (u + v) :=
begin
  have haddodd : ¬even (u + v),
  { simp [huvodd] with parity_simps },
  have hsubodd : ¬even (u - v),
  { simp [huvodd] with parity_simps },

  have haddcoprime : is_coprime (u + v) (2 * v),
  { apply is_coprime_of_prime_dvd,
    { rintro ⟨h1, -⟩,
      norm_num [h1] at haddodd },
    intros k hkprime hkdvdleft hkdvdright,
    apply hkprime.not_unit,
    have hkdvdright' : k ∣ v,
    { rw even_iff_two_dvd at haddodd,
      exact int.dvd_mul_cancel_prime' haddodd hkdvdleft int.prime_two hkdvdright },

    apply huvcoprime.is_unit_of_dvd' _ hkdvdright',
    rw [←add_sub_cancel u v],
    apply dvd_sub hkdvdleft hkdvdright' },
  have hsubcoprime : is_coprime (u - v) (2 * v),
  { apply is_coprime_of_prime_dvd,
    { rintro ⟨h1, -⟩,
      norm_num [h1] at hsubodd },
    intros k hkprime hkdvdleft hkdvdright,
    apply hkprime.not_unit,

    have hkdvdright' : k ∣ v,
    { rw even_iff_two_dvd at hsubodd,
      exact int.dvd_mul_cancel_prime' hsubodd hkdvdleft int.prime_two hkdvdright },

    apply huvcoprime.is_unit_of_dvd' _ hkdvdright',
    rw [←sub_add_cancel u v],
    exact dvd_add hkdvdleft hkdvdright' },
  have haddsubcoprime : is_coprime (u + v) (u - v),
  { apply is_coprime_of_prime_dvd,
    { rintro ⟨h1, -⟩,
      norm_num [h1] at haddodd },
    intros k hkprime hkdvdleft hkdvdright,
    apply hkprime.not_unit,
    rw even_iff_two_dvd at haddodd,
    apply huvcoprime.is_unit_of_dvd';
      apply int.dvd_mul_cancel_prime' haddodd hkdvdleft int.prime_two,

    { convert dvd_add hkdvdleft hkdvdright,
      ring },
    { convert dvd_sub hkdvdleft hkdvdright,
      ring } },
  exact ⟨haddcoprime.symm, hsubcoprime.symm, haddsubcoprime.symm⟩,
end

lemma descent_gcd3_coprime {q s : ℤ}
  (h3_ndvd_q : ¬3 ∣ q)
  (hspos : s ≠ 0)
  (hcoprime' : is_coprime s q)
  (hodd' : even q ↔ ¬even s) :
  is_coprime (3 ^ 2 * 2 * s) (q ^ 2 + 3 * s ^ 2) :=
begin
  have h2ndvd : ¬(2 ∣ (q ^ 2 + 3 * s ^ 2)),
  { rw ←even_iff_two_dvd,
    simp [two_ne_zero, hodd'] with parity_simps },

  have h3ndvd : ¬(3 ∣ (q ^ 2 + 3 * s ^ 2)),
  { intro H,
    apply h3_ndvd_q,
    rw ←dvd_add_iff_left (dvd_mul_right _ _) at H,
    exact prime.dvd_of_dvd_pow int.prime_three H },

  apply is_coprime_of_prime_dvd,
  { rintro ⟨h1, -⟩,
    rw mul_eq_zero at h1,
    exact hspos (h1.resolve_left (by norm_num)) },
  intros k hkprime hkdvdleft hkdvdright,
  apply hkprime.not_unit,
  have : k ∣ s,
  { apply int.dvd_mul_cancel_prime' h2ndvd hkdvdright int.prime_two,
    apply int.dvd_mul_cancel_prime' h3ndvd hkdvdright int.prime_three,
    apply int.dvd_mul_cancel_prime' h3ndvd hkdvdright int.prime_three,
    convert hkdvdleft using 1,
    ring },
  apply hcoprime'.is_unit_of_dvd' this,
  apply hkprime.dvd_of_dvd_pow,
  rw dvd_add_iff_left ((this.pow two_ne_zero).mul_left _),
  exact hkdvdright
end

lemma descent_gcd3 (a b c p q : ℤ)
  (hp : p ≠ 0)
  (hq : q ≠ 0)
  (hcoprime : is_coprime p q)
  (hodd : even p ↔ ¬even q)
  (hcube : 2 * p * (p ^ 2 + 3 * q ^ 2) = a ^ 3 ∨
             2 * p * (p ^ 2 + 3 * q ^ 2) = b ^ 3 ∨
               2 * p * (p ^ 2 + 3 * q ^ 2) = c ^ 3)
  (h : flt_coprime 3 a b c)
  (hgcd : (2 * p).gcd (p ^ 2 + 3 * q ^ 2) = 3) :
  ∃ (a' b' c' : ℤ),
    a' ≠ 0 ∧ b' ≠ 0 ∧ c' ≠ 0 ∧
    (a' ^ 3 * b' ^ 3 * c' ^ 3).nat_abs ≤ (2 * p).nat_abs ∧
    a' ^ 3 + b' ^ 3 = c' ^ 3 :=
begin
  obtain ⟨⟨hapos, hbpos, hcpos, h⟩, habcoprime, haccoprime, hbccoprime⟩ := h,
  -- 1.
  have h3_dvd_p : 3 ∣ p,
  { apply int.dvd_mul_cancel_prime' _ dvd_rfl int.prime_two,
    { zify at hgcd,
      rw ← hgcd,
      exact int.gcd_dvd_left _ _},
    { norm_num } },
  have h3_ndvd_q : ¬(3 ∣ q),
  { intro H,
    have := hcoprime.is_unit_of_dvd' h3_dvd_p H,
    rw int.is_unit_iff_nat_abs_eq at this,
    norm_num at this },
  -- 2.
  obtain ⟨s, rfl⟩ := h3_dvd_p,
  have hspos : s ≠ 0 := right_ne_zero_of_mul hp,
  have hps : 2 * (3 * s) * ((3 * s) ^ 2 + 3 * q ^ 2) = 3 ^ 2 * 2 * s * (q ^ 2 + 3 * s ^ 2),
  { ring },
  -- 3.
  have hcoprime' : is_coprime s q,
  { apply is_coprime_of_prime_dvd,
    { rintro ⟨h1, -⟩,
      exact hspos h1 },
    intros k hkprime hkdvdleft hkdvdright,
    apply hkprime.not_unit,
    apply hcoprime.is_unit_of_dvd' _ hkdvdright,
    exact hkdvdleft.mul_left 3 },

  have hodd' : even q ↔ ¬even s,
  { rw [iff.comm, not_iff_comm, iff.comm],
  simpa with parity_simps using hodd },
  have hcoprime'' : is_coprime (3^2 * 2 * s) (q ^ 2 + 3 * s ^ 2),
  { exact descent_gcd3_coprime h3_ndvd_q hspos hcoprime' hodd' },
  -- 4.
  obtain ⟨r, hr⟩ : ∃ r, 2 * (3 * s) * ((3 * s) ^ 2 + 3 * q ^ 2) = r ^ 3,
  { rcases hcube with (_|_|_);
    [use a, use b, use c];
    exact hcube },
  rw hps at hr,
  obtain ⟨hcubeleft, hcuberight⟩ := int.eq_pow_of_mul_eq_pow_bit1 hcoprime'' hr,

  -- 5.
  -- todo shadows hq hq
  obtain ⟨u, v, hq, hs, huvcoprime, huvodd⟩ := obscure' q s hq hcoprime'.symm hodd' hcuberight,
  have hu : u ≠ 0,
  { rintro rfl,
    norm_num at hq },
  have hv : v ≠ 0,
  { rintro rfl,
    norm_num at hs },

  -- 6.
  obtain ⟨haddcoprime, hsubcoprime, haddsubcoprime⟩ := gcd3_coprime huvcoprime huvodd,

  -- 7.
  obtain ⟨e, he⟩ := hcubeleft,
  obtain ⟨t, rfl⟩ : 3 ∣ e,
  { rw [←int.pow_dvd_pow_iff (by norm_num : 0 < 3), ←he, hs],
    convert dvd_mul_right _ (2 * v * (u - v) * (u + v)) using 1,
    norm_num,
    ring },
  have ht : 2 * v * (u - v) * (u + v) = t ^ 3,
  { have : (3 ^ 3 : ℤ) ≠ 0,
    { norm_num },
    rw [←mul_right_inj' this, ←mul_pow, ←he, hs],
    ring },

  obtain ⟨A, B, C, HApos, HBpos, HCpos, HA, HB, HC⟩ : ∃ X Y Z : ℤ,
    X ≠ 0 ∧ Y ≠ 0 ∧ Z ≠ 0 ∧
    2 * v = X ^ 3 ∧ u - v = Y ^ 3 ∧ u + v = Z ^ 3,
  { apply int.cube_of_coprime,
    { exact mul_ne_zero two_ne_zero hv, },
    { intro H, rw sub_eq_zero at H, simpa [H] with parity_simps using huvodd, },
    { intro H, rw add_eq_zero_iff_eq_neg at H, simpa [H] with parity_simps using huvodd },
    { exact hsubcoprime },
    { exact haddcoprime },
    { exact haddsubcoprime },
    { exact ht } },

  refine ⟨A, B, C, HApos, HBpos, HCpos, _, _⟩,
  -- 9.
  { rw [←mul_assoc, mul_comm, ←mul_assoc (C ^ 3), ←HA, ←HB, ←HC],
    set x := v * (u - v) * (u + v) with hx,
    calc ((u + v) * (2 * v) * (u - v)).nat_abs
        = (2 * x).nat_abs : by { rw hx, congr' 1, ring }
    ... = 2 * x.nat_abs : by { rw [int.nat_abs_mul 2], refl }
    ... ≤ 3 * x.nat_abs : nat.mul_le_mul_right _ (by norm_num)
    ... = (3 * x).nat_abs : by { rw [int.nat_abs_mul 3], refl }
    ... = s.nat_abs : by { rw [hx, hs], congr' 1, ring }
    ... ≤ (2 * 3) * s.nat_abs : nat.le_mul_of_pos_left (by norm_num)
    ... = (2 * 3 * s).nat_abs : by { rw [int.nat_abs_mul (2 * 3)], refl } },
  { rw [←HA, ←HB, ←HC], ring },
end

lemma descent
  (a b c : ℤ)
  (h : flt_coprime 3 a b c) :
  ∃ a' b' c' : ℤ,
    a' ≠ 0 ∧ b' ≠ 0 ∧ c' ≠ 0 ∧
    (a' * b' * c').nat_abs < (a * b * c).nat_abs ∧
    a' ^ 3 + b' ^ 3 = c' ^ 3 :=
begin
  -- 3.
  have := descent2 a b c h,
  obtain ⟨p, q, hp, hq, hcoprime, hodd, hcube, haaa⟩ := this,

  suffices : ∃ a' b' c' : ℤ,
    a' ≠ 0 ∧ b' ≠ 0 ∧ c' ≠ 0 ∧
    (a' ^ 3 * b' ^ 3 * c' ^ 3).nat_abs ≤ (2 * p).nat_abs ∧
    a' ^ 3 + b' ^ 3 = c' ^ 3,
  { obtain ⟨a', b', c', ha', hb', hc', hsmaller, hsolution⟩ := this,
    refine ⟨a', b', c', ha', hb', hc', _, hsolution⟩,
    rw ←nat.pow_lt_iff_lt_left (by norm_num : 1 ≤ 3),
    convert lt_of_le_of_lt hsmaller haaa;
      simp [mul_pow, int.nat_abs_mul, int.nat_abs_pow] },

  -- 4.
  cases gcd1or3 p q hp hcoprime hodd with hgcd hgcd,
  -- 5.
  { rw int.gcd_eq_one_iff_coprime at hgcd,
    apply descent_gcd1 a b c p q hp hcoprime hodd hcube h hgcd },
  { apply descent_gcd3 a b c p q hp hq hcoprime hodd hcube h hgcd },
end

lemma flt_three
  {a b c : ℤ}
  (ha : a ≠ 0)
  (hb : b ≠ 0)
  (hc : c ≠ 0) :
  a ^ 3 + b ^ 3 ≠ c ^ 3 :=
begin
  induction h : (a * b * c).nat_abs using nat.strong_induction_on with k' IH generalizing a b c,
  intro H,
  obtain ⟨x'', y'', z'', hxle, hyle, hzle, hcoprime⟩ :=
    exists_coprime zero_lt_three ha hb hc H,
  obtain ⟨x', y', z', hx'pos, hy'pos, hz'pos, hsmaller, hsolution⟩ := descent x'' y'' z'' hcoprime,
  refine IH (x' * y' * z').nat_abs _ hx'pos hy'pos hz'pos rfl hsolution,
  apply lt_of_lt_of_le hsmaller,
  rw ←h,
  simp only [int.nat_abs_mul],
  exact nat.mul_le_mul (nat.mul_le_mul hxle hyle) hzle,
end


import for_mathlib.boolean_subalgebra
import for_mathlib.finite
import for_mathlib.order
import o_minimal.dunlo

/- Basic properties of tame sets. A tame set is a subset of a DUNLO
which is a finite union of points and intervals. They can also be described
as the boolean subalgebra generated by half-infinite intervals.
By definition, these are the definable sets in any o-minimal structure. -/

namespace o_minimal

variables {R : Type*} [DUNLO R]

/-- A (nonempty) open interval (possibly unbounded on one or both sides)
or a single point.
One of the building blocks of a tame set. -/
inductive interval_or_point : set R → Prop
| pt (r : R) : interval_or_point {r}
| Iii : interval_or_point set.univ
| Ioi (a : R) : interval_or_point (set.Ioi a)
| Iio (b : R) : interval_or_point (set.Iio b)
| Ioo (a b : R) (h : a < b) : interval_or_point (set.Ioo a b)

lemma interval_or_point.as_IOO {s : set R} (hs : interval_or_point s) :
  (∃ r, s = {r}) ∨
  (∃ (a : with_bot R) (b : with_top R), s = {x | a < ↑x ∧ ↑x < b}) :=
begin
  -- Use `induction` because `cases` does undesired definitional unfolding.
  induction hs with r a b a b;
  [ exact or.inl ⟨r, rfl⟩,
    refine or.inr ⟨⊥, ⊤, _⟩,
    refine or.inr ⟨a, ⊤, _⟩,
    refine or.inr ⟨⊥, b, _⟩,
    refine or.inr ⟨a, b, _⟩ ];
  { ext x, simp [with_bot.bot_lt_coe, with_top.coe_lt_top, with_bot.coe_lt_coe, with_top.coe_lt_coe] }
end

/-- A tame subset of `R` is one that can be expressed as
a finite union of intervals and points. -/
def tame : set R → Prop :=
finite_union_closure interval_or_point

lemma tame_iff {s : set R} : tame s ↔ ∃ (I : finset (set R)), (∀ i ∈ I, interval_or_point i) ∧ s = ⋃ i ∈ I, i :=
finite_union_closure_iff_bUnion

lemma tame_single {i : set R} (h : interval_or_point i) : tame i :=
finite_union_closure.basic h

lemma tame_empty : tame (∅ : set R) :=
finite_union_closure.empty

lemma tame_univ : tame (set.univ : set R) :=
tame_single interval_or_point.Iii

lemma tame_const {p : Prop} : tame {r : R | p} :=
begin
  by_cases h : p,
  { convert tame_univ, simp [h] },
  { convert tame_empty, simp [h], refl }
end

lemma tame.union {s t : set R} (hs : tame s) (ht : tame t) : tame (s ∪ t) :=
finite_union_closure.union hs ht

-- TODO: for_mathlib. after finset.singleton_inter_of_not_mem. Fix proof.
lemma set.singleton_inter_of_mem {α : Type*} {a : α} {s : set α} (h : a ∈ s) : {a} ∩ s = {a} :=
by { ext x, simp [h], intro H, rwa H }

-- Rather specialized lemma for use in closure under finite intersections.
lemma tame_singleton_inter (r : R) (s : set R) : tame ({r} ∩ s) :=
begin
  by_cases h : r ∈ s,
  { rw set.singleton_inter_of_mem h,
    exact tame_single (interval_or_point.pt r) },
  { rw set.singleton_inter_eq_empty.mpr h,
    exact finite_union_closure.empty }
end

lemma tame_IOO (a : with_bot R) (b : with_top R) :
  tame {x : R | a < ↑x ∧ ↑x < b} :=
begin
  induction a using with_bot.rec_bot_coe with a;
  induction b using with_top.rec_top_coe with b;
  simp [with_bot.bot_lt_coe, with_top.coe_lt_top, with_bot.coe_lt_coe, with_top.coe_lt_coe],
  all_goals { try { { apply tame_single, constructor } } }, -- { { } }, because only do it if we're done.
  by_cases h : a < b,
  { exact tame_single (interval_or_point.Ioo a b h) },
  { convert finite_union_closure.empty,
    rw set.eq_empty_iff_forall_not_mem,
    rintros x ⟨hx₁, hx₂⟩,
    exact h (lt_trans hx₁ hx₂) }
end

lemma closed_under_finite_inters_tame : closed_under_finite_inters (tame : set R → Prop) :=
begin
  apply closed_under_finite_inters_finite_union_closure,
  { exact tame_single interval_or_point.Iii },
  { intros s s' hs hs',
    rcases hs.as_IOO with ⟨r, rfl⟩ | ⟨a, b, rfl⟩, { apply tame_singleton_inter },
    rcases hs'.as_IOO with ⟨r', rfl⟩ | ⟨a', b', rfl⟩, { rw set.inter_comm, apply tame_singleton_inter },
    convert tame_IOO (a ⊔ a') (b ⊓ b') using 1,
    ext x,
    simp only [set.mem_inter_iff, set.mem_set_of_eq],
    rw [sup_lt_iff, lt_inf_iff],
    tauto }
end

-- TODO: A tame set has a normal form as the union of
-- a minimal list of nonoverlapping intervals and points, arranged in increasing order.
-- Is this useful?

/-- Induction principle:
Every tame set of R can be built up from the empty set
by repeatedly forming the union with a single interval or point. -/
-- TODO: Generalize this to finite_union_closure
lemma tame.induction {C : set R → Prop}
  (h₀ : C ∅) (h₁ : ∀ {s : set R} {i : set R}, /- tame_r s → -/ interval_or_point i → C s → C (i ∪ s)) :
  ∀ {s : set R}, tame s → C s :=
begin
  suffices : ∀ (I : finset (set R)), (∀ i ∈ I, interval_or_point i) → C (⋃ i ∈ I, i),
  { intros s hs, obtain ⟨I, hI, rfl⟩ := tame_iff.mp hs, exact this I hI },
  classical,
  refine finset.induction (by { intro, simpa }) _,
  intros i I hi IH hI,
  rw finset.bUnion_insert,
  exact h₁ (hI i (finset.mem_insert_self i I)) (IH (λ i' hi', hI i' (finset.mem_insert_of_mem hi')))
end

section
-- Tame sets as the boolean subalgebra of `set R`
-- generated by sets of the form (-∞, b) and (a, ∞).

@[simp] lemma le_and_le_iff_eq {α : Type*} [partial_order α]
  (x y : α) : (x ≤ y ∧ y ≤ x) ↔ x = y :=
le_antisymm_iff.symm

lemma tame_Iic (b : R) : tame (set.Iic b) :=
begin
  convert (tame_single (interval_or_point.Iio b)).union (tame_single (interval_or_point.pt b)),
  ext x, simp
end

lemma tame_Ici (a : R) : tame (set.Ici a) :=
begin
  convert (tame_single (interval_or_point.pt a)).union (tame_single (interval_or_point.Ioi a)),
  ext x, simp [le_iff_eq_or_lt, eq_comm]
end

-- TODO: We could avoid doing this work by using the simple o-minimal structure
lemma tame_compl_interval_or_pt {s : set R} (h : interval_or_point s) : tame (sᶜ) :=
begin
  induction h with r a b a b hab,
  { convert (tame_single (interval_or_point.Iio r)).union (tame_single (interval_or_point.Ioi r)),
    ext x,
    rw ←not_iff_not,
    simp [not_or_distrib, eq_comm] },
  { convert tame_empty, simp },
  { convert tame_Iic a, rw set.compl_Ioi },
  { convert tame_Ici b, rw set.compl_Iio },
  { convert (tame_Iic a).union (tame_Ici b),
    ext x,
    change ¬ (a < x ∧ x < b) ↔ x ≤ a ∨ b ≤ x,
    rw [not_and_distrib, not_lt, not_lt] }
end

lemma is_boolean_subalgebra_tame : is_boolean_subalgebra (tame : set R → Prop) :=
begin
  refine ⟨tame_empty, λ _ _, finite_union_closure.union, _⟩,
  apply closed_under_complements_finite_union_closure,
  { exact closed_under_finite_inters_tame.mem_univ },
  { intros s t hs ht,
    exact closed_under_finite_inters_tame.mem_inter (tame_single hs) (tame_single ht) },
  { intros s hs, exact tame_compl_interval_or_pt hs }
end

inductive half_infinite_interval : set R → Prop
| Iio (b : R) : half_infinite_interval (set.Iio b)
| Ioi (a : R) : half_infinite_interval (set.Ioi a)

open boolean_subalgebra half_infinite_interval

lemma tame_eq_gen_half_infinite_interval :
  (tame : set R → Prop) = gen half_infinite_interval :=
begin
  apply set.subset.antisymm,
  { unfold tame,
    refine set.subset.trans finite_union_closure_subset_gen _,
    rw gen_subset_gen_iff_subset_gen,
    intros s hs,
    induction hs with r a b a b hab,
    { convert gen.compl (gen.sup (gen.basic (Ioi r)) (gen.basic (Iio r))),
      ext x, simp },
    { convert gen.compl gen.bot,
      simp },
    { exact gen.basic (Ioi a) },
    { exact gen.basic (Iio b) },
    { convert gen.inf (gen.basic (Ioi a)) (gen.basic (Iio b)) } },
  { rw gen_subset_iff_subset is_boolean_subalgebra_tame,
    rintros _ (_|_); apply tame_single; constructor }
end

end

lemma interval_or_point.finite_or_contains_interval {i : set R} (h : interval_or_point i) :
  i.finite ∨ ∃ (a b : R), a < b ∧ set.Ioo a b ⊆ i :=
begin
  rcases h with _|_|⟨a⟩|⟨b⟩|⟨a,b,hab⟩,
  { exact or.inl (set.finite_singleton _) },
  all_goals { right },
  { have a : R := classical.arbitrary R, -- classical is unnecessary, but standard library is annoying here
    obtain ⟨b, h⟩ := no_top a,
    exact ⟨a, b, h, set.subset_univ _⟩ },
  { obtain ⟨b, h⟩ := no_top a,
    exact ⟨a, b, h, λ x ⟨hax, hxb⟩, hax⟩ },
  { obtain ⟨a, h⟩ := no_bot b,
    exact ⟨a, b, h, λ x ⟨hax, hxb⟩, hxb⟩ },
  { exact ⟨a, b, hab, set.subset.refl _⟩ }
end

/-- A dichotomy for tame sets: either they are finite
or they contain an entire interval. -/
lemma tame.finite_or_contains_interval {s : set R} (h : tame s) :
  s.finite ∨ ∃ (a b : R), a < b ∧ set.Ioo a b ⊆ s :=
begin
  revert h,
  refine tame.induction (or.inl set.finite_empty) _,
  clear s,
  rintros s i hi (fin|⟨a,b,ab,hab⟩),
  { rcases hi.finite_or_contains_interval with ifin|⟨ia,ib,iab,ih⟩,
    { left, exact set.finite.union ifin fin },
    { right, exact ⟨ia, ib, iab, set.subset.trans ih (set.subset_union_left _ _)⟩ } },
  { right, exact ⟨a, b, ab, set.subset.trans hab (set.subset_union_right _ _)⟩ }
end

end o_minimal


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl (CMU)
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.core
import Mathlib.PostPort

universes u

namespace Mathlib

theorem monotonicity.pi {α : Sort u} {p : α → Prop} {q : α → Prop} (h : ∀ (a : α), implies (p a) (q a)) : implies (∀ (a : α), p a) (∀ (a : α), q a) :=
  fun (h' : ∀ (a : α), p a) (a : α) => h a (h' a)

theorem monotonicity.imp {p : Prop} {p' : Prop} {q : Prop} {q' : Prop} (h₁ : implies p' q') (h₂ : implies q p) : implies (p → p') (q → q') :=
  fun (h : p → p') => h₁ ∘ h ∘ h₂

theorem monotonicity.const (p : Prop) : implies p p :=
  id

theorem monotonicity.true (p : Prop) : implies p True :=
  fun (_x : p) => trivial

theorem monotonicity.false (p : Prop) : implies False p :=
  false.elim

theorem monotonicity.exists {α : Sort u} {p : α → Prop} {q : α → Prop} (h : ∀ (a : α), implies (p a) (q a)) : implies (∃ (a : α), p a) (∃ (a : α), q a) :=
  exists_imp_exists h

theorem monotonicity.and {p : Prop} {p' : Prop} {q : Prop} {q' : Prop} (hp : implies p p') (hq : implies q q') : implies (p ∧ q) (p' ∧ q') :=
  and.imp hp hq

theorem monotonicity.or {p : Prop} {p' : Prop} {q : Prop} {q' : Prop} (hp : implies p p') (hq : implies q q') : implies (p ∨ q) (p' ∨ q') :=
  or.imp hp hq

theorem monotonicity.not {p : Prop} {q : Prop} (h : implies p q) : implies (¬q) (¬p) :=
  mt h


-- Limite_de_sucesion_menor_que_otra_sucesion.lean
-- Límite de sucesión menor que otra sucesión.
-- José A. Alonso Jiménez
-- Sevilla, 30 de julio de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- En Lean, una sucesión u₀, u₁, u₂, ... se puede representar mediante
-- una función (u : ℕ → ℝ) de forma que u(n) es uₙ.
--
-- Se define que a es el límite de la sucesión u, por
--    def limite : (ℕ → ℝ) → ℝ → Prop :=
--    λ u a, ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - a| < ε
-- donde se usa la notación |x| para el valor absoluto de x
--    notation `|`x`|` := abs x
--
-- Demostrar que si uₙ → a, vₙ → c y uₙ ≤ vₙ para todo n, entonces
-- a ≤ c.
-- ---------------------------------------------------------------------

import data.real.basic
import tactic

variables (u v : ℕ → ℝ)
variables (a c : ℝ)

notation `|`x`|` := abs x

def limite (u : ℕ → ℝ) (c : ℝ) :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - c| < ε

variable b : ℝ
example : b ≤ c → a + b ≤ a + c :=
-- by library_search
(add_le_add_iff_left a).mpr

-- 1ª demostración
example
  (hu : limite u a)
  (hv : limite v c)
  (hle : ∀ n, u n ≤ v n)
  : a ≤ c :=
begin
  apply le_of_not_lt,
  intro hlt,
  set ε := (a - c) /2 with hεac,
  have hε : 0 < ε :=
    half_pos (sub_pos.mpr hlt),
  cases hu ε hε with Nu HNu,
  cases hv ε hε with Nv HNv,
  let N := max Nu Nv,
  have HNu' : Nu ≤ N := le_max_left Nu Nv,
  have HNv' : Nv ≤ N := le_max_right Nu Nv,
  have Ha : |u N - a| < ε := HNu N HNu',
  have Hc : |v N - c| < ε := HNv N HNv',
  have HN : u N ≤ v N := hle N,
  have HN' : u N - c ≤ v N - c := sub_le_sub_right (hle N) c,
  apply lt_irrefl (a - c),
  calc a - c
       = (a - u N) + (u N - c)   : by ring
   ... ≤ (a - u N) + (v N - c)   : add_le_add_left HN' (a - u N)
   ... ≤ |(a - u N) + (v N - c)| : le_abs_self ((a - u N) + (v N - c))
   ... ≤ |a - u N| + |v N - c|   : abs_add (a - u N) (v N - c)
   ... = |u N - a| + |v N - c|   : by simp only [abs_sub_comm]
   ... < ε + ε                   : add_lt_add Ha Hc
   ... = a - c                   : add_halves (a - c),
end

-- 2ª demostración
example
  (hu : limite u a)
  (hv : limite v c)
  (hle : ∀ n, u n ≤ v n)
  : a ≤ c :=
begin
  apply le_of_not_lt,
  intro hlt,
  set ε := (a - c) /2 with hε,
  cases hu ε (by linarith) with Nu HNu,
  cases hv ε (by linarith) with Nv HNv,
  let N := max Nu Nv,
  have Ha : |u N - a| < ε :=
    HNu N (le_max_left Nu Nv),
  have Hc : |v N - c| < ε :=
    HNv N (le_max_right Nu Nv),
  have HN : u N ≤ v N := hle N,
  have HN' : u N - c ≤ v N - c := sub_le_sub_right (hle N) c,
  apply lt_irrefl (a - c),
  calc a - c
       = (a - u N) + (u N - c)   : by ring
   ... ≤ (a - u N) + (v N - c)   : add_le_add_left HN' (a - u N)
   ... ≤ |(a - u N) + (v N - c)| : le_abs_self ((a - u N) + (v N - c))
   ... ≤ |a - u N| + |v N - c|   : abs_add (a - u N) (v N - c)
   ... = |u N - a| + |v N - c|   : by simp only [abs_sub_comm]
   ... < ε + ε                   : add_lt_add Ha Hc
   ... = a - c                   : add_halves (a - c),
end

-- 3ª demostración
example
  (hu : limite u a)
  (hv : limite v c)
  (hle : ∀ n, u n ≤ v n)
  : a ≤ c :=
begin
  apply le_of_not_lt,
  intro hlt,
  set ε := (a - c) /2 with hε,
  cases hu ε (by linarith) with Nu HNu,
  cases hv ε (by linarith) with Nv HNv,
  let N := max Nu Nv,
  have Ha : |u N - a| < ε :=
    HNu N (le_max_left Nu Nv),
  have Hc : |v N - c| < ε :=
    HNv N (le_max_right Nu Nv),
  have HN : u N ≤ v N := hle N,
  have HN' : u N - c ≤ v N - c := sub_le_sub_right (hle N) c,
  apply lt_irrefl (a - c),
  calc a - c
       = (a - u N) + (u N - c)   : by ring
   ... ≤ (a - u N) + (v N - c)   : add_le_add_left HN' (a - u N)
   ... ≤ |(a - u N) + (v N - c)| : by simp [le_abs_self]
   ... ≤ |a - u N| + |v N - c|   : by simp [abs_add]
   ... = |u N - a| + |v N - c|   : by simp [abs_sub_comm]
   ... < ε + ε                   : add_lt_add Ha Hc
   ... = a - c                   : by simp,
end

-- 4ª demostración
example
  (hu : limite u a)
  (hv : limite v c)
  (hle : ∀ n, u n ≤ v n)
  : a ≤ c :=
begin
  apply le_of_not_lt,
  intro hlt,
  set ε := (a - c) /2 with hε,
  cases hu ε (by linarith) with Nu HNu,
  cases hv ε (by linarith) with Nv HNv,
  let N := max Nu Nv,
  have Ha : |u N - a| < ε :=
    HNu N (le_max_left Nu Nv),
  have Hc : |v N - c| < ε :=
    HNv N (le_max_right Nu Nv),
  have HN : u N ≤ v N := hle N,
  apply lt_irrefl (a - c),
  rw abs_lt at Ha Hc,
  linarith,
end


-- My collaborator of this final project is Derek Johnson.

import .functor
import .applicative
import .monad
universes u v

namespace hidden

/-
Functor const function for list
-/
def list_map_const
  {α β : Type u} :
    α → list β → list α
| a [] := []
| a (h::t) := a::list_map_const a t

/-
Provide a proof for Functor Identity Law
-/
theorem list_map_law1 : ∀ (T : Type u), list.map (@id T) = (@id (list T)) :=
begin
assume T,
apply funext,
assume listT,
rw id,
induction listT with e b h,
simp [list.map],
simp [list.map],
end

/-
Provide a proof for Functor Composition Law
-/
theorem list_map_law2:
  ∀ (α β γ: Type u) (f: α → β) (g: β → γ) ,
     list.map (g ∘ f) = list.map g ∘ (list.map f)   :=
begin
intros,
apply funext,
assume ListA,
simp [list.map],
end

/-
Create an instance of functor list
-/
instance: functor list := ⟨ @list.map,  @list_map_const , list_map_law1, list_map_law2  ⟩

/-
Local test
-/
local infixr ` <$> `:100 := functor.map
local infixr ` <$ `:100  := functor.map_const
local infixr ` $> `:100  := functor.map_const_rev

#reduce nat.succ <$> []
#reduce nat.succ <$> [1,2,3]
#reduce nat.add 4 <$> [4,5,6]
#reduce nat.add <$> [4,5,6]
#reduce id <$> [1,2,3]
#reduce string.length <$> ["Hello", "Lean!!!"]

#reduce nat.add <$> [1,2,3]

#reduce tt <$ [1,2,3]
#reduce 2 <$ [tt,ff,tt]
#reduce [1] <$ [tt,ff,tt]
#reduce [1,2,3] $> ff
#reduce [1,2,3] $> tt

--APPLICATIVE FUNCTOR

/-
Applicative functions for list
-/
def pure_list {α : Type u} : α → list α
| a := [a]

def seq_list : Π {α β : Type u}, list (α → β) → list α → list β
| α β list.nil _ := list.nil
| α β (hf::tf) l := list.append (functor.map hf l) (seq_list tf l)

def seq_list_left : Π {α β : Type u}, list α → list β → list α
| α β list.nil _ := list.nil
| α β (hf::tf) l := list.append (functor.map_const hf l  ) (seq_list_left tf l)

def seq_list_right : Π {α β : Type u}, list α → list β → list  β
| α β _ list.nil  := list.nil
| α β l (hf::tf)  := list.append (functor.map_const_rev l hf ) (seq_list_right l tf )

local infixl ` <*> `:60 := has_seq.seq
local infixl ` <* `:60  := has_seq_left.seq_left
local infixl ` *> `:60  := has_seq_right.seq_right

instance : has_pure list := ⟨ @pure_list ⟩
instance : has_seq list := ⟨ @seq_list ⟩
instance : has_seq_left list := ⟨ @seq_list_left ⟩
instance : has_seq_right list := ⟨ @seq_list_right ⟩

/-
Provide a proof for Applicative Identity Law
-/
theorem list_applicative_law1 : ∀ (T : Type u), seq_list (pure_list (@id T)) = @id (list T) :=
begin
assume T,
apply funext,
assume listT,
rw [id],
induction listT with a b c,
-- Base
simp [pure_list],
simp [seq_list],
simp [functor.map],
-- Induction Step
simp [pure_list],
simp [seq_list],
simp [functor.map],
apply list.append_nil,
end

/-
Provide a proof for Applicative Composition Law
-/
theorem list_applicative_law2 :  ∀ (α β γ: Type u) (func_g:  (α → β) )(func_f: (β → γ) ) (w:  α ),
pure_list func_f <*> (pure_list func_g <*> pure_list w )
= (pure_list (@function.comp α β γ))  <*> pure_list func_f   <*> pure_list func_g <*> pure_list w
:=
begin
intros,
simp [pure_list],
simp [has_seq.seq],
simp [seq_list],
simp [functor.map],
simp [seq_list],
simp [functor.map],
simp [seq_list],
simp [functor.map],
end

/-
Provide a proof for Applicative Homomorphism Law
-/
theorem list_applicative_law3 : ∀ (α β: Type u) (func_f: α → β) (x:α),
(pure_list func_f) <*> (pure_list x) = pure_list (func_f x )  :=
begin
intros,
simp [pure_list],
simp [has_seq.seq],
simp [seq_list],
simp [functor.map],
end

/-
Provide a proof for Applicative Interchange Law
-/
theorem list_applicative_law4 :  ∀ (α β: Type u) (y: α) (func_f:  α → β  ),
(pure_list func_f) <*> (pure_list y) = (pure_list (λ an_F: (α → β) , an_F y )  ) <*> (pure_list func_f) :=
begin
intros,
simp [pure_list],
simp [has_seq.seq],
simp [seq_list],
simp [functor.map],
end

/-
Create an instance of applicative list
-/
instance : applicative list := ⟨ list_applicative_law1, list_applicative_law2, list_applicative_law3, list_applicative_law4 ⟩

/-
Local test
-/
#reduce has_pure.pure (nat.add) <*> [1,3] <*> [5,6,7]
#reduce has_pure.pure (nat.add) <*> [1,2,3] <*> [0,1,2]
#reduce has_pure.pure (nat.mul) <*> [2] <*> [0,1,2]
#reduce has_pure.pure (nat.succ) <*> [2,3]

#reduce has_pure.pure (nat.add) <*> [] <*> [0,1,2]
#reduce has_pure.pure (nat.add) <*> [1,2,3]  <*> []

--Monad

def has_bind_list : Π {α β : Type u}, list α → (α → list β) → list β
| α β list.nil _ := list.nil
| α β (hf::tf) func := list.append (func hf) (has_bind_list tf func)

instance : has_bind list := ⟨@has_bind_list⟩

local infixl ` >>= `:55 := has_bind.bind
local infixl ` >> `:55  := has_bind.and_then

/-
Provide a proof for Monad Left Identity Law
-/
theorem list_monad_law1 :
∀ (α β: Type u) (func_f:  α → list β ) ( x: α  ),
     (pure_list x) >>= func_f  = func_f x  :=
begin
intros,
simp [pure_list],
simp [has_bind.bind],
simp [has_bind_list],
apply list.append_nil,
end

/-
Provide a proof for Monad Right Identity Law
-/
theorem list_monad_law2 :
∀ (α β: Type u)  (x: list α ),
    x >>= pure_list = x  :=
begin
intros,
simp [has_bind.bind],
induction x with a b c,
-- Base
simp [has_bind_list],
-- Induction Step
simp [has_bind_list],
simp [pure_list],
exact c,
end

/-
Provide a proof for Monad Associativity Law
-/

/-
This one is more complex because I need to show a commutative law of Monad list.
That is "list_monad_commutative2"
(a>>=f) + (b>>=f) = (a+b) >> f
To show this, I first show a micro version  "list_monad_commutative1" which is
f a +  (b>>=f) = (a::b) >> f
Also, I used list associativity which is
(a+b)+c = a+(b+c)
-/

-- Step1: (a+b)+c = a+(b+c)
lemma lemma_append_assoc:
 ∀ {β: Type u} (a b c:  list β ) ,
   (a.append(b)).append(c) = a.append(b.append(c))  :=
begin
intros,
apply list.append_assoc,
end

-- Step2: f a +  (b>>=f) = (a::b) >> f
lemma list_monad_commutative1:
 ∀ {α β: Type u} (a:  α ) (b: list α) (f:  (α → list β) ),
    has_bind_list (a :: b) f = (f a).append(has_bind_list b f) :=
begin
intros,
induction b with x y z,
-- Base
simp [has_bind_list],
-- Induction Step
simp [has_bind_list],
end

-- Step3: (a>>=f) + (b>>=f) = (a+b) >> f
lemma list_monad_commutative2:
 ∀ {α β: Type u} (a:  list α ) (b: list α) (f:  (α → list β) ),
   (has_bind_list a f).append(has_bind_list b f) = has_bind_list (a.append(b))  f  :=
begin
intros,
induction a with x y z,
-- Base
simp [has_bind.bind],
simp [has_bind_list],
-- Induction Step
rw list_monad_commutative1,
simp [has_bind.bind],
simp [has_bind_list],
rw lemma_append_assoc (f x) (has_bind_list y f) (has_bind_list b f),
rw z,
end

-- Final Step: Monad Associativity Law
theorem list_monad_law3 :
 ∀ (α β γ: Type u) (x: list α ) (f:  (α → list β) ) (g:  (β → list γ) ),
    x >>= f >>= g  = x  >>= (λ y, f y>>= g) :=
begin
intros,
simp [has_bind.bind],
induction x with a b c,
-- Base
simp [has_bind_list],
-- Induction Step
simp [has_bind_list],
rw <- c,
rw <- list_monad_commutative2 (f a) (has_bind_list b f) g,
end

/-
Create an instance of Monad option
-/
instance : monad list := ⟨ list_monad_law1, list_monad_law2, list_monad_law3 ⟩

#reduce [1,2,3] >>=  (λ x, has_pure.pure (x+1))
#reduce [] >>=  (λ x, has_pure.pure (x+1))
#reduce ["AAA","BB","CCCC"] >>=  (λ x, has_pure.pure (string.length x))
#reduce ["AAA"] >>=  (λ x,  has_pure.pure (string.length x))

end hidden


/-
Copyright (c) 2014 Floris van Doorn (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad, Mario Carneiro
-/
import algebra.order.ring.canonical
import data.nat.basic

/-!
# The natural numbers as a linearly ordered commutative semiring

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

We also have a variety of lemmas which have been deferred from `data.nat.basic` because it is
easier to prove them with this ordered semiring instance available.

You may find that some theorems can be moved back to `data.nat.basic` by modifying their proofs.
-/

universes u v

/-! ### instances -/

instance nat.order_bot : order_bot ℕ :=
{ bot := 0, bot_le := nat.zero_le }

instance : linear_ordered_comm_semiring ℕ :=
{ lt                      := nat.lt,
  add_le_add_left         := @nat.add_le_add_left,
  le_of_add_le_add_left   := @nat.le_of_add_le_add_left,
  zero_le_one             := nat.le_of_lt (nat.zero_lt_succ 0),
  mul_lt_mul_of_pos_left  := @nat.mul_lt_mul_of_pos_left,
  mul_lt_mul_of_pos_right := @nat.mul_lt_mul_of_pos_right,
  decidable_eq            := nat.decidable_eq,
  exists_pair_ne          := ⟨0, 1, ne_of_lt nat.zero_lt_one⟩,
  ..nat.comm_semiring, ..nat.linear_order }

instance : linear_ordered_comm_monoid_with_zero ℕ :=
{ mul_le_mul_left := λ a b h c, nat.mul_le_mul_left c h,
  ..nat.linear_ordered_comm_semiring,
  ..(infer_instance : comm_monoid_with_zero ℕ)}

/-! Extra instances to short-circuit type class resolution and ensure computability -/
-- Not using `infer_instance` avoids `classical.choice` in the following two
instance : linear_ordered_semiring ℕ      := infer_instance
instance : strict_ordered_semiring ℕ      := infer_instance
instance : strict_ordered_comm_semiring ℕ := infer_instance
instance : ordered_semiring ℕ             := strict_ordered_semiring.to_ordered_semiring'
instance : ordered_comm_semiring ℕ        := strict_ordered_comm_semiring.to_ordered_comm_semiring'

instance : linear_ordered_cancel_add_comm_monoid ℕ := infer_instance

instance : canonically_ordered_comm_semiring ℕ :=
{ exists_add_of_le                  := λ a b h, (nat.le.dest h).imp $ λ _, eq.symm,
  le_self_add                       := nat.le_add_right,
  eq_zero_or_eq_zero_of_mul_eq_zero := λ a b, nat.eq_zero_of_mul_eq_zero,
  .. nat.nontrivial,
  .. nat.order_bot,
  .. (infer_instance : ordered_add_comm_monoid ℕ),
  .. (infer_instance : linear_ordered_semiring ℕ),
  .. (infer_instance : comm_semiring ℕ) }

instance : canonically_linear_ordered_add_monoid ℕ :=
{ .. (infer_instance : canonically_ordered_add_monoid ℕ),
  .. nat.linear_order }

variables {m n k l : ℕ}
namespace nat

/-! ### Equalities and inequalities involving zero and one -/

lemma one_le_iff_ne_zero : 1 ≤ n ↔ n ≠ 0 :=
(show 1 ≤ n ↔ 0 < n, from iff.rfl).trans pos_iff_ne_zero

lemma one_lt_iff_ne_zero_and_ne_one : ∀ {n : ℕ}, 1 < n ↔ n ≠ 0 ∧ n ≠ 1
| 0     := dec_trivial
| 1     := dec_trivial
| (n+2) := dec_trivial

protected theorem mul_ne_zero (n0 : n ≠ 0) (m0 : m ≠ 0) : n * m ≠ 0
| nm := (eq_zero_of_mul_eq_zero nm).elim n0 m0

@[simp] protected theorem mul_eq_zero : m * n = 0 ↔ m = 0 ∨ n = 0 :=
iff.intro eq_zero_of_mul_eq_zero (by simp [or_imp_distrib] {contextual := tt})

@[simp] protected theorem zero_eq_mul : 0 = m * n ↔ m = 0 ∨ n = 0 :=
by rw [eq_comm, nat.mul_eq_zero]

lemma eq_zero_of_double_le (h : 2 * n ≤ n) : n = 0 :=
add_right_eq_self.mp $ le_antisymm ((two_mul n).symm.trans_le h) le_add_self

lemma eq_zero_of_mul_le (hb : 2 ≤ n) (h : n * m ≤ m) : m = 0 :=
eq_zero_of_double_le $ le_trans (nat.mul_le_mul_right _ hb) h

lemma zero_max : max 0 n = n := max_eq_right (zero_le _)

@[simp] lemma min_eq_zero_iff : min m n = 0 ↔ m = 0 ∨ n = 0 :=
begin
  split,
  { intro h,
    cases le_total m n with H H,
    { simpa [H] using or.inl h },
    { simpa [H] using or.inr h } },
  { rintro (rfl|rfl);
    simp }
end

@[simp] lemma max_eq_zero_iff : max m n = 0 ↔ m = 0 ∧ n = 0 :=
begin
  split,
  { intro h,
    cases le_total m n with H H,
    { simp only [H, max_eq_right] at h,
      exact ⟨le_antisymm (H.trans h.le) (zero_le _), h⟩ },
    { simp only [H, max_eq_left] at h,
      exact ⟨h, le_antisymm (H.trans h.le) (zero_le _)⟩ } },
  { rintro ⟨rfl, rfl⟩,
    simp }
end

lemma add_eq_max_iff : m + n = max m n ↔ m = 0 ∨ n = 0 :=
begin
  rw ←min_eq_zero_iff,
  cases le_total m n with H H;
  simp [H]
end

lemma add_eq_min_iff : m + n = min m n ↔ m = 0 ∧ n = 0 :=
begin
  rw ←max_eq_zero_iff,
  cases le_total m n with H H;
  simp [H]
end

theorem eq_one_of_mul_eq_one_right (H : m * n = 1) : m = 1 := eq_one_of_dvd_one ⟨n, H.symm⟩

theorem eq_one_of_mul_eq_one_left (H : m * n = 1) : n = 1 :=
eq_one_of_mul_eq_one_right (by rwa mul_comm)

/-! ### `succ` -/

lemma two_le_iff : ∀ n, 2 ≤ n ↔ n ≠ 0 ∧ n ≠ 1
| 0     := by simp
| 1     := by simp
| (n+2) := by simp

@[simp] lemma lt_one_iff {n : ℕ} : n < 1 ↔ n = 0 :=
lt_succ_iff.trans nonpos_iff_eq_zero

/-! ### `add` -/

theorem add_pos_left {m : ℕ} (h : 0 < m) (n : ℕ) : 0 < m + n :=
calc
  m + n > 0 + n : nat.add_lt_add_right h n
    ... = n     : nat.zero_add n
    ... ≥ 0     : zero_le n

theorem add_pos_right (m : ℕ) {n : ℕ} (h : 0 < n) : 0 < m + n :=
begin rw add_comm, exact add_pos_left h m end

theorem add_pos_iff_pos_or_pos (m n : ℕ) : 0 < m + n ↔ 0 < m ∨ 0 < n :=
iff.intro
  begin
    intro h,
    cases m with m,
    {simp [zero_add] at h, exact or.inr h},
    exact or.inl (succ_pos _)
  end
  begin
    intro h, cases h with mpos npos,
    { apply add_pos_left mpos },
    apply add_pos_right _ npos
  end

lemma add_eq_one_iff : m + n = 1 ↔ m = 0 ∧ n = 1 ∨ m = 1 ∧ n = 0 :=
by cases n; simp [succ_eq_add_one, ← add_assoc, succ_inj']

lemma add_eq_two_iff : m + n = 2 ↔ m = 0 ∧ n = 2 ∨ m = 1 ∧ n = 1 ∨ m = 2 ∧ n = 0 :=
by cases n; simp [(succ_ne_zero 1).symm, succ_eq_add_one, ← add_assoc, succ_inj', add_eq_one_iff]

lemma add_eq_three_iff :
  m + n = 3 ↔ m = 0 ∧ n = 3 ∨ m = 1 ∧ n = 2 ∨ m = 2 ∧ n = 1 ∨ m = 3 ∧ n = 0 :=
by cases n; simp [(succ_ne_zero 1).symm, succ_eq_add_one, ← add_assoc, succ_inj', add_eq_two_iff]

theorem le_add_one_iff : m ≤ n + 1 ↔ m ≤ n ∨ m = n + 1 :=
⟨λ h,
  match nat.eq_or_lt_of_le h with
  | or.inl h := or.inr h
  | or.inr h := or.inl $ nat.le_of_succ_le_succ h
  end,
  or.rec (λ h, le_trans h $ nat.le_add_right _ _) le_of_eq⟩

lemma le_and_le_add_one_iff : n ≤ m ∧ m ≤ n + 1 ↔ m = n ∨ m = n + 1 :=
begin
  rw [le_add_one_iff, and_or_distrib_left, ←le_antisymm_iff, eq_comm, and_iff_right_of_imp],
  rintro rfl,
  exact n.le_succ
end

lemma add_succ_lt_add (hab : m < n) (hcd : k < l) : m + k + 1 < n + l :=
begin
  rw add_assoc,
  exact add_lt_add_of_lt_of_le hab (nat.succ_le_iff.2 hcd)
end

/-! ### `pred` -/

lemma pred_le_iff : pred m ≤ n ↔ m ≤ succ n :=
⟨le_succ_of_pred_le, by { cases m, { exact λ _, zero_le n }, exact le_of_succ_le_succ }⟩

/-! ### `sub`

Most lemmas come from the `has_ordered_sub` instance on `ℕ`. -/

instance : has_ordered_sub ℕ :=
begin
  constructor,
  intros m n k,
  induction n with n ih generalizing k,
  { simp },
  { simp only [sub_succ, add_succ, succ_add, ih, pred_le_iff] }
end

lemma lt_pred_iff : n < pred m ↔ succ n < m := show n < m - 1 ↔ n + 1 < m, from lt_tsub_iff_right

lemma lt_of_lt_pred (h : m < n - 1) : m < n := lt_of_succ_lt (lt_pred_iff.1 h)

lemma le_or_le_of_add_eq_add_pred (h : k + l = m + n - 1) : m ≤ k ∨ n ≤ l :=
begin
  cases le_or_lt m k with h' h'; [left, right],
  { exact h' },
  { replace h' := add_lt_add_right h' l, rw h at h',
    cases n.eq_zero_or_pos with hn hn, { rw hn, exact zero_le l },
    rw [m.add_sub_assoc hn, add_lt_add_iff_left] at h',
    exact nat.le_of_pred_lt h' },
end

/-- A version of `nat.sub_succ` in the form `_ - 1` instead of `nat.pred _`. -/
lemma sub_succ' (m n : ℕ) : m - n.succ = m - n - 1 := rfl

/-! ### `mul` -/

lemma mul_eq_one_iff : ∀ {m n : ℕ}, m * n = 1 ↔ m = 1 ∧ n = 1
| 0     0     := dec_trivial
| 0     1     := dec_trivial
| 1     0     := dec_trivial
| (m+2) 0     := by simp
| 0     (n+2) := by simp
| (m+1) (n+1) := ⟨
  λ h, by simp only [add_mul, mul_add, mul_add, one_mul, mul_one,
    (add_assoc _ _ _).symm, nat.succ_inj', add_eq_zero_iff] at h; simp [h.1.2, h.2],
  λ h, by simp only [h, mul_one]⟩

lemma succ_mul_pos (m : ℕ) (hn : 0 < n) : 0 < (succ m) * n := mul_pos (succ_pos m) hn

theorem mul_self_le_mul_self (h : m ≤ n) : m * m ≤ n * n := mul_le_mul h h (zero_le _) (zero_le _)

theorem mul_self_lt_mul_self : Π {m n : ℕ}, m < n → m * m < n * n
| 0        n h := mul_pos h h
| (succ m) n h := mul_lt_mul h (le_of_lt h) (succ_pos _) (zero_le _)

theorem mul_self_le_mul_self_iff : m ≤ n ↔ m * m ≤ n * n :=
⟨mul_self_le_mul_self, le_imp_le_of_lt_imp_lt mul_self_lt_mul_self⟩

theorem mul_self_lt_mul_self_iff : m < n ↔ m * m < n * n :=
le_iff_le_iff_lt_iff_lt.1 mul_self_le_mul_self_iff

theorem le_mul_self : Π (n : ℕ), n ≤ n * n
| 0     := le_rfl
| (n+1) := by simp

lemma le_mul_of_pos_left (h : 0 < n) : m ≤ n * m :=
begin
  conv {to_lhs, rw [← one_mul(m)]},
  exact mul_le_mul_of_nonneg_right h.nat_succ_le dec_trivial,
end

lemma le_mul_of_pos_right (h : 0 < n) : m ≤ m * n :=
begin
  conv {to_lhs, rw [← mul_one(m)]},
  exact mul_le_mul_of_nonneg_left h.nat_succ_le dec_trivial,
end

theorem mul_self_inj : m * m = n * n ↔ m = n :=
le_antisymm_iff.trans (le_antisymm_iff.trans
  (and_congr mul_self_le_mul_self_iff mul_self_le_mul_self_iff)).symm

lemma le_add_pred_of_pos (n : ℕ) {i : ℕ} (hi : i ≠ 0) : n ≤ i + (n - 1) :=
begin
  refine le_trans _ (add_tsub_le_assoc),
  simp [add_comm, nat.add_sub_assoc, one_le_iff_ne_zero.2 hi]
end

@[simp] theorem lt_mul_self_iff : ∀ {n : ℕ}, n < n * n ↔ 1 < n
| 0 := iff_of_false (lt_irrefl _) zero_le_one.not_lt
| (n + 1) := lt_mul_iff_one_lt_left n.succ_pos

/-!
### Recursion and induction principles

This section is here due to dependencies -- the lemmas here require some of the lemmas
proved above, and some of the results in later sections depend on the definitions in this section.
-/

/-- Given a predicate on two naturals `P : ℕ → ℕ → Prop`, `P a b` is true for all `a < b` if
`P (a + 1) (a + 1)` is true for all `a`, `P 0 (b + 1)` is true for all `b` and for all
`a < b`, `P (a + 1) b` is true and `P a (b + 1)` is true implies `P (a + 1) (b + 1)` is true. -/
@[elab_as_eliminator]
lemma diag_induction (P : ℕ → ℕ → Prop) (ha : ∀ a, P (a + 1) (a + 1)) (hb : ∀ b, P 0 (b + 1))
  (hd : ∀ a b, a < b → P (a + 1) b → P a (b + 1) → P (a + 1) (b + 1)) :
  ∀ a b, a < b → P a b
| 0 (b + 1) h       := hb _
| (a + 1) (b + 1) h :=
begin
  apply hd _ _ ((add_lt_add_iff_right _).1 h),
  { have : a + 1 = b ∨ a + 1 < b,
    { rwa [← le_iff_eq_or_lt, ← nat.lt_succ_iff] },
    rcases this with rfl | _,
    { exact ha _ },
    apply diag_induction (a + 1) b this },
  apply diag_induction a (b + 1),
  apply lt_of_le_of_lt (nat.le_succ _) h,
end
using_well_founded { rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ p, p.1 + p.2.1)⟩] }

/-- A subset of `ℕ` containing `k : ℕ` and closed under `nat.succ` contains every `n ≥ k`. -/
lemma set_induction_bounded {S : set ℕ} (hk : k ∈ S) (h_ind: ∀ k : ℕ, k ∈ S → k + 1 ∈ S)
  (hnk : k ≤ n) : n ∈ S :=
@le_rec_on (λ n, n ∈ S) k n hnk h_ind hk

/-- A subset of `ℕ` containing zero and closed under `nat.succ` contains all of `ℕ`. -/
lemma set_induction {S : set ℕ} (hb : 0 ∈ S) (h_ind: ∀ k : ℕ, k ∈ S → k + 1 ∈ S) (n : ℕ) : n ∈ S :=
set_induction_bounded hb h_ind (zero_le n)

/-! ### `div` -/

protected lemma div_le_of_le_mul' (h : m ≤ k * n) : m / k ≤ n :=
(nat.eq_zero_or_pos k).elim
  (λ k0, by rw [k0, nat.div_zero]; apply zero_le)
  (λ k0, (mul_le_mul_left k0).1 $
    calc k * (m / k)
        ≤ m % k + k * (m / k) : nat.le_add_left _ _
    ... = m                   : mod_add_div _ _
    ... ≤ k * n               : h)

protected lemma div_le_self' (m n : ℕ) : m / n ≤ m :=
(nat.eq_zero_or_pos n).elim
  (λ n0, by rw [n0, nat.div_zero]; apply zero_le)
  (λ n0, nat.div_le_of_le_mul' $ calc
      m = 1 * m : (one_mul _).symm
    ... ≤ n * m : nat.mul_le_mul_right _ n0)

protected lemma div_lt_of_lt_mul (h : m < n * k) : m / n < k :=
lt_of_mul_lt_mul_left
  (calc n * (m / n) ≤ m % n + n * (m / n) : nat.le_add_left _ _
    ... = m : mod_add_div _ _
    ... < n * k : h)
  (nat.zero_le n)

lemma eq_zero_of_le_div (hn : 2 ≤ n) (h : m ≤ m / n) : m = 0 :=
eq_zero_of_mul_le hn $
  by rw mul_comm; exact (nat.le_div_iff_mul_le' (lt_of_lt_of_le dec_trivial hn)).1 h

lemma div_mul_div_le_div (m n k : ℕ) : ((m / k) * n) / m ≤ n / k :=
if hm0 : m = 0 then by simp [hm0]
else calc m / k * n / m ≤ n * m / k / m :
    nat.div_le_div_right (by rw [mul_comm];
        exact mul_div_le_mul_div_assoc _ _ _)
  ... = n / k : by rw [nat.div_div_eq_div_mul, mul_comm n, mul_comm k,
      nat.mul_div_mul _ _ (nat.pos_of_ne_zero hm0)]

lemma eq_zero_of_le_half (h : n ≤ n / 2) : n = 0 := eq_zero_of_le_div le_rfl h

lemma mul_div_mul_comm_of_dvd_dvd (hmk : k ∣ m) (hnl : l ∣ n) : m * n / (k * l) = m / k * (n / l) :=
begin
  rcases k.eq_zero_or_pos with rfl | hk0, { simp },
  rcases l.eq_zero_or_pos with rfl | hl0, { simp },
  obtain ⟨_, rfl⟩ := hmk,
  obtain ⟨_, rfl⟩ := hnl,
  rw [mul_mul_mul_comm, nat.mul_div_cancel_left _ hk0, nat.mul_div_cancel_left _ hl0,
      nat.mul_div_cancel_left _ (mul_pos hk0 hl0)]
end

lemma le_half_of_half_lt_sub {a b : ℕ} (h : a / 2 < a - b) : b ≤ a / 2 :=
begin
  rw nat.le_div_iff_mul_le two_pos,
  rw [nat.div_lt_iff_lt_mul two_pos, nat.mul_sub_right_distrib, lt_tsub_iff_right,
    mul_two a] at h,
  exact le_of_lt (nat.lt_of_add_lt_add_left h)
end

lemma half_le_of_sub_le_half {a b : ℕ} (h : a - b ≤ a / 2) : a / 2 ≤ b :=
begin
  rw [nat.le_div_iff_mul_le two_pos, nat.mul_sub_right_distrib, tsub_le_iff_right,
    mul_two, add_le_add_iff_left] at h,
  rw [← nat.mul_div_left b two_pos],
  exact nat.div_le_div_right h,
end

/-! ### `mod`, `dvd` -/

lemma two_mul_odd_div_two (hn : n % 2 = 1) : 2 * (n / 2) = n - 1 :=
by conv {to_rhs, rw [← nat.mod_add_div n 2, hn, add_tsub_cancel_left]}

lemma div_dvd_of_dvd (h : n ∣ m) : (m / n) ∣ m := ⟨n, (nat.div_mul_cancel h).symm⟩

protected lemma div_div_self (h : n ∣ m) (hm : m ≠ 0) : m / (m / n) = n :=
begin
  rcases h with ⟨_, rfl⟩,
  rw mul_ne_zero_iff at hm,
  rw [mul_div_right _ (nat.pos_of_ne_zero hm.1), mul_div_left _ (nat.pos_of_ne_zero hm.2)]
end

lemma mod_mul_right_div_self (m n k : ℕ) : m % (n * k) / n = (m / n) % k :=
begin
  rcases nat.eq_zero_or_pos n with rfl|hn, { simp },
  rcases nat.eq_zero_or_pos k with rfl|hk, { simp },
  conv_rhs { rw ← mod_add_div m (n * k) },
  rw [mul_assoc, add_mul_div_left _ _ hn, add_mul_mod_self_left,
    mod_eq_of_lt (nat.div_lt_of_lt_mul (mod_lt _ (mul_pos hn hk)))]
end

lemma mod_mul_left_div_self (m n k : ℕ) : m % (k * n) / n = (m / n) % k :=
by rw [mul_comm k, mod_mul_right_div_self]

lemma not_dvd_of_pos_of_lt (h1 : 0 < n) (h2 : n < m) : ¬ m ∣ n :=
begin
  rintros ⟨k, rfl⟩,
  rcases nat.eq_zero_or_pos k with (rfl | hk),
  { exact lt_irrefl 0 h1 },
  { exact not_lt.2 (le_mul_of_pos_right hk) h2 },
end

/--  If `m` and `n` are equal mod `k`, `m - n` is zero mod `k`. -/
lemma sub_mod_eq_zero_of_mod_eq (h : m % k = n % k) : (m - n) % k = 0 :=
by rw [←nat.mod_add_div m k, ←nat.mod_add_div n k, ←h, tsub_add_eq_tsub_tsub, add_tsub_cancel_left,
       ←mul_tsub, nat.mul_mod_right]

@[simp] lemma one_mod (n : ℕ) : 1 % (n + 2) = 1 := nat.mod_eq_of_lt (add_lt_add_right n.succ_pos 1)

lemma dvd_sub_mod (k : ℕ) : n ∣ (k - (k % n)) :=
⟨k / n, tsub_eq_of_eq_add_rev (nat.mod_add_div k n).symm⟩

lemma add_mod_eq_ite :
  (m + n) % k = if k ≤ m % k + n % k then m % k + n % k - k else m % k + n % k :=
begin
  cases k, { simp },
  rw nat.add_mod,
  split_ifs with h,
  { rw [nat.mod_eq_sub_mod h, nat.mod_eq_of_lt],
    exact (tsub_lt_iff_right h).mpr
        (nat.add_lt_add (m.mod_lt k.zero_lt_succ) (n.mod_lt k.zero_lt_succ)) },
  { exact nat.mod_eq_of_lt (lt_of_not_ge h) }
end

lemma div_mul_div_comm (hmn : n ∣ m) (hkl : l ∣ k) : (m / n) * (k / l) = (m * k) / (n * l) :=
have exi1 : ∃ x, m = n * x, from hmn,
have exi2 : ∃ y, k = l * y, from hkl,
if hn : n = 0 then by simp [hn]
else have 0 < n, from nat.pos_of_ne_zero hn,
if hl : l = 0 then by simp [hl]
else have 0 < l, from nat.pos_of_ne_zero hl,
begin
  cases exi1 with x hx, cases exi2 with y hy,
  rw [hx, hy, nat.mul_div_cancel_left, nat.mul_div_cancel_left],
  symmetry,
  apply nat.div_eq_of_eq_mul_left,
  apply mul_pos,
  repeat {assumption},
  cc
end

lemma div_eq_self : m / n = m ↔ m = 0 ∨ n = 1 :=
begin
  split,
  { intro,
    cases n,
    { simp * at * },
    { cases n,
      { right, refl },
      { left,
        have : m / (n + 2) ≤ m / 2 := div_le_div_left (by simp) dec_trivial,
        refine eq_zero_of_le_half _,
        simp * at * } } },
  { rintros (rfl|rfl); simp }
end

lemma div_eq_sub_mod_div : m / n = (m - m % n) / n :=
begin
  by_cases n0 : n = 0,
  { rw [n0, nat.div_zero, nat.div_zero] },
  { rw [← mod_add_div m n] { occs := occurrences.pos [2] },
    rw [add_tsub_cancel_left, mul_div_right _ (nat.pos_of_ne_zero n0)] }
end

/-- `m` is not divisible by `n` if it is between `n * k` and `n * (k + 1)` for some `k`. -/
lemma not_dvd_of_between_consec_multiples (h1 : n * k < m) (h2 : m < n * (k + 1)) : ¬ n ∣ m :=
begin
  rintro ⟨d, rfl⟩,
  exact monotone.ne_of_lt_of_lt_nat (covariant.monotone_of_const n) k h1 h2 d rfl
end

/-! ### `find` -/
section find

variables {p q : ℕ → Prop} [decidable_pred p] [decidable_pred q]

@[simp] lemma find_pos (h : ∃ n : ℕ, p n) : 0 < nat.find h ↔ ¬ p 0 :=
by rw [pos_iff_ne_zero, ne, nat.find_eq_zero]

lemma find_add {hₘ : ∃ m, p (m + n)} {hₙ : ∃ n, p n} (hn : n ≤ nat.find hₙ) :
  nat.find hₘ + n = nat.find hₙ :=
begin
  refine ((le_find_iff _ _).2 (λ m hm hpm, hm.not_le _)).antisymm _,
  { have hnm : n ≤ m := hn.trans (find_le hpm),
    refine add_le_of_le_tsub_right_of_le hnm (find_le _),
    rwa tsub_add_cancel_of_le hnm },
  { rw ←tsub_le_iff_right,
    refine (le_find_iff _ _).2 (λ m hm hpm, hm.not_le _),
    rw tsub_le_iff_right,
    exact find_le hpm }
end

end find

/-! ### `find_greatest` -/

section find_greatest

variables {P Q : ℕ → Prop} [decidable_pred P]

lemma find_greatest_eq_iff :
  nat.find_greatest P k = m ↔ m ≤ k ∧ (m ≠ 0 → P m) ∧ (∀ ⦃n⦄, m < n → n ≤ k → ¬P n) :=
begin
  induction k with k ihk generalizing m,
  { rw [eq_comm, iff.comm],
    simp only [nonpos_iff_eq_zero, ne.def, and_iff_left_iff_imp, find_greatest_zero],
    rintro rfl,
    exact ⟨λ h, (h rfl).elim, λ n hlt heq, (hlt.ne heq.symm).elim⟩ },
  { by_cases hk : P (k + 1),
    { rw [find_greatest_eq hk], split,
      { rintro rfl,
        exact ⟨le_rfl, λ _, hk, λ n hlt hle, (hlt.not_le hle).elim⟩ },
      { rintros ⟨hle, h0, hm⟩,
        rcases decidable.eq_or_lt_of_le hle with rfl|hlt,
        exacts [rfl, (hm hlt le_rfl hk).elim] } },
    { rw [find_greatest_of_not hk, ihk],
      split,
      { rintros ⟨hle, hP, hm⟩,
        refine ⟨hle.trans k.le_succ, hP, λ n hlt hle, _⟩,
        rcases decidable.eq_or_lt_of_le hle with rfl|hlt',
        exacts [hk, hm hlt $ lt_succ_iff.1 hlt'] },
      { rintros ⟨hle, hP, hm⟩,
        refine ⟨lt_succ_iff.1 (hle.lt_of_ne _), hP, λ n hlt hle, hm hlt (hle.trans k.le_succ)⟩,
        rintro rfl,
        exact hk (hP k.succ_ne_zero) } } }
end

lemma find_greatest_eq_zero_iff : nat.find_greatest P k = 0 ↔ ∀ ⦃n⦄, 0 < n → n ≤ k → ¬P n :=
by simp [find_greatest_eq_iff]

lemma find_greatest_spec (hmb : m ≤ n) (hm : P m) : P (nat.find_greatest P n) :=
begin
  by_cases h : nat.find_greatest P n = 0,
  { cases m, { rwa h },
    exact ((find_greatest_eq_zero_iff.1 h) m.zero_lt_succ hmb hm).elim },
  { exact (find_greatest_eq_iff.1 rfl).2.1 h }
end

lemma find_greatest_le (n : ℕ) : nat.find_greatest P n ≤ n := (find_greatest_eq_iff.1 rfl).1

lemma le_find_greatest (hmb : m ≤ n) (hm : P m) : m ≤ nat.find_greatest P n :=
le_of_not_lt $ λ hlt, (find_greatest_eq_iff.1 rfl).2.2 hlt hmb hm

lemma find_greatest_mono_right (P : ℕ → Prop) [decidable_pred P] : monotone (nat.find_greatest P) :=
begin
  refine monotone_nat_of_le_succ (λ n, _),
  rw [find_greatest_succ],
  split_ifs,
  { exact (find_greatest_le n).trans (le_succ _) },
  { refl }
end

lemma find_greatest_mono_left [decidable_pred Q] (hPQ : P ≤ Q) :
  nat.find_greatest P ≤ nat.find_greatest Q :=
begin
  intro n,
  induction n with n hn,
  { refl },
  by_cases P (n + 1),
  { rw [find_greatest_eq h, find_greatest_eq (hPQ _ h)] },
  { rw find_greatest_of_not h,
    exact hn.trans (nat.find_greatest_mono_right _ $ le_succ _) }
end

lemma find_greatest_mono [decidable_pred Q] (hPQ : P ≤ Q) (hmn : m ≤ n) :
  nat.find_greatest P m ≤ nat.find_greatest Q n :=
(nat.find_greatest_mono_right _ hmn).trans $ find_greatest_mono_left hPQ _

lemma find_greatest_is_greatest (hk : nat.find_greatest P n < k) (hkb : k ≤ n) : ¬ P k :=
(find_greatest_eq_iff.1 rfl).2.2 hk hkb

lemma find_greatest_of_ne_zero (h : nat.find_greatest P n = m) (h0 : m ≠ 0) : P m :=
(find_greatest_eq_iff.1 h).2.1 h0

end find_greatest

/-! ### `bit0` and `bit1` -/

protected theorem bit0_le {n m : ℕ} (h : n ≤ m) : bit0 n ≤ bit0 m := add_le_add h h

protected theorem bit1_le {n m : ℕ} (h : n ≤ m) : bit1 n ≤ bit1 m := succ_le_succ (add_le_add h h)

theorem bit_le : ∀ (b : bool) {m n : ℕ}, m ≤ n → bit b m ≤ bit b n
| tt _ _ h := nat.bit1_le h
| ff _ _ h := nat.bit0_le h

theorem bit0_le_bit : ∀ (b) {m n : ℕ}, m ≤ n → bit0 m ≤ bit b n
| tt _ _ h := le_of_lt $ nat.bit0_lt_bit1 h
| ff _ _ h := nat.bit0_le h

theorem bit_le_bit1 : ∀ (b) {m n : ℕ}, m ≤ n → bit b m ≤ bit1 n
| ff _ _ h := le_of_lt $ nat.bit0_lt_bit1 h
| tt _ _ h := nat.bit1_le h

theorem bit_lt_bit0 : ∀ (b) {m n : ℕ}, m < n → bit b m < bit0 n
| tt _ _ h := nat.bit1_lt_bit0 h
| ff _ _ h := nat.bit0_lt h

theorem bit_lt_bit (a b) (h : m < n) : bit a m < bit b n :=
lt_of_lt_of_le (bit_lt_bit0 _ h) (bit0_le_bit _ le_rfl)

@[simp] lemma bit0_le_bit1_iff : bit0 m ≤ bit1 n ↔ m ≤ n :=
⟨λ h, by rwa [← nat.lt_succ_iff, n.bit1_eq_succ_bit0, ← n.bit0_succ_eq,
  bit0_lt_bit0, nat.lt_succ_iff] at h, λ h, le_of_lt (nat.bit0_lt_bit1 h)⟩

@[simp] lemma bit0_lt_bit1_iff : bit0 m < bit1 n ↔ m ≤ n :=
⟨λ h, bit0_le_bit1_iff.1 (le_of_lt h), nat.bit0_lt_bit1⟩

@[simp] lemma bit1_le_bit0_iff : bit1 m ≤ bit0 n ↔ m < n :=
⟨λ h, by rwa [m.bit1_eq_succ_bit0, succ_le_iff, bit0_lt_bit0] at h,
  λ h, le_of_lt (nat.bit1_lt_bit0 h)⟩

@[simp] lemma bit1_lt_bit0_iff : bit1 m < bit0 n ↔ m < n :=
⟨λ h, bit1_le_bit0_iff.1 (le_of_lt h), nat.bit1_lt_bit0⟩

@[simp] lemma one_le_bit0_iff : 1 ≤ bit0 n ↔ 0 < n :=
by { convert bit1_le_bit0_iff, refl, }

@[simp] lemma one_lt_bit0_iff : 1 < bit0 n ↔ 1 ≤ n :=
by { convert bit1_lt_bit0_iff, refl, }

@[simp] lemma bit_le_bit_iff : ∀ {b : bool}, bit b m ≤ bit b n ↔ m ≤ n
| ff := bit0_le_bit0
| tt := bit1_le_bit1

@[simp] lemma bit_lt_bit_iff : ∀ {b : bool}, bit b m < bit b n ↔ m < n
| ff := bit0_lt_bit0
| tt := bit1_lt_bit1

@[simp] lemma bit_le_bit1_iff : ∀ {b : bool}, bit b m ≤ bit1 n ↔ m ≤ n
| ff := bit0_le_bit1_iff
| tt := bit1_le_bit1

/-! ### decidability of predicates -/

instance decidable_lo_hi (lo hi : ℕ) (P : ℕ → Prop) [H : decidable_pred P] :
  decidable (∀x, lo ≤ x → x < hi → P x) :=
decidable_of_iff (∀ x < hi - lo, P (lo + x))
⟨λal x hl hh, by { have := al (x - lo) ((tsub_lt_tsub_iff_right hl).mpr hh),
  rwa [add_tsub_cancel_of_le hl] at this, },
λal x h, al _ (nat.le_add_right _ _) (lt_tsub_iff_left.mp h)⟩

instance decidable_lo_hi_le (lo hi : ℕ) (P : ℕ → Prop) [H : decidable_pred P] :
  decidable (∀x, lo ≤ x → x ≤ hi → P x) :=
decidable_of_iff (∀x, lo ≤ x → x < hi + 1 → P x) $
ball_congr $ λ x hl, imp_congr lt_succ_iff iff.rfl

end nat


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

! This file was ported from Lean 3 source module order.bounded_order
! leanprover-community/mathlib commit 70d50ecfd4900dd6d328da39ab7ebd516abe4025
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Option.Basic
import Mathlib.Order.Lattice
import Mathlib.Tactic.Classical
import Mathlib.Tactic.Convert
import Mathlib.Tactic.PushNeg
import Mathlib.Tactic.SimpRw

/-!
# ⊤ and ⊥, bounded lattices and variants

This file defines top and bottom elements (greatest and least elements) of a type, the bounded
variants of different kinds of lattices, sets up the typeclass hierarchy between them and provides
instances for `Prop` and `fun`.

## Main declarations

* `<Top/Bot> α`: Typeclasses to declare the `⊤`/`⊥` notation.
* `Order<Top/Bot> α`: Order with a top/bottom element.
* `BoundedOrder α`: Order with a top and bottom element.

## Common lattices

* Distributive lattices with a bottom element. Notated by `[DistribLattice α] [OrderBot α]`
  It captures the properties of `Disjoint` that are common to `GeneralizedBooleanAlgebra` and
  `DistribLattice` when `OrderBot`.
* Bounded and distributive lattice. Notated by `[DistribLattice α] [BoundedOrder α]`.
  Typical examples include `Prop` and `Det α`.
-/

open Function OrderDual

universe u v

variable {α : Type u} {β : Type v} {γ δ : Type _}

/-! ### Top, bottom element -/

/-- Typeclass for the `⊤` (`\top`) notation -/
@[notation_class, ext]
class Top (α : Type u) where
  /-- The top (`⊤`, `\top`) element -/
  top : α
#align has_top Top

/-- Typeclass for the `⊥` (`\bot`) notation -/
@[notation_class, ext]
class Bot (α : Type u) where
  /-- The bot (`⊥`, `\bot`) element -/
  bot : α
#align has_bot Bot

/-- The top (`⊤`, `\top`) element -/
notation "⊤" => Top.top

/-- The bot (`⊥`, `\bot`) element -/
notation "⊥" => Bot.bot

instance (priority := 100) top_nonempty (α : Type u) [Top α] : Nonempty α :=
  ⟨⊤⟩
#align has_top_nonempty top_nonempty

instance (priority := 100) bot_nonempty (α : Type u) [Bot α] : Nonempty α :=
  ⟨⊥⟩
#align has_bot_nonempty bot_nonempty

attribute [match_pattern] Bot.bot Top.top

/-- An order is an `OrderTop` if it has a greatest element.
We state this using a data mixin, holding the value of `⊤` and the greatest element constraint. -/
class OrderTop (α : Type u) [LE α] extends Top α where
  /-- `⊤` is the greatest element -/
  le_top : ∀ a : α, a ≤ ⊤
#align order_top OrderTop

section OrderTop

/-- An order is (noncomputably) either an `OrderTop` or a `NoTopOrder`. Use as
`casesI topOrderOrNoTopOrder α`. -/
noncomputable def topOrderOrNoTopOrder (α : Type _) [LE α] : PSum (OrderTop α) (NoTopOrder α) := by
  by_cases H : ∀ a : α, ∃ b, ¬b ≤ a
  · exact PSum.inr ⟨H⟩

  · push_neg at H
    letI : Top α := ⟨Classical.choose H⟩
    exact PSum.inl ⟨Classical.choose_spec H⟩

#align top_order_or_no_top_order topOrderOrNoTopOrder

section LE

variable [LE α] [OrderTop α] {a : α}

@[simp]
theorem le_top : a ≤ ⊤ :=
  OrderTop.le_top a
#align le_top le_top

@[simp]
theorem isTop_top : IsTop (⊤ : α) := fun _ => le_top
#align is_top_top isTop_top

end LE

section Preorder

variable [Preorder α] [OrderTop α] {a b : α}

@[simp]
theorem isMax_top : IsMax (⊤ : α) :=
  isTop_top.isMax
#align is_max_top isMax_top

@[simp]
theorem not_top_lt : ¬⊤ < a :=
  isMax_top.not_lt
#align not_top_lt not_top_lt

theorem ne_top_of_lt (h : a < b) : a ≠ ⊤ :=
  (h.trans_le le_top).ne
#align ne_top_of_lt ne_top_of_lt

alias ne_top_of_lt ← LT.lt.ne_top

end Preorder

variable [PartialOrder α] [OrderTop α] [Preorder β] {f : α → β} {a b : α}

@[simp]
theorem isMax_iff_eq_top : IsMax a ↔ a = ⊤ :=
  ⟨fun h => h.eq_of_le le_top, fun h _ _ => h.symm ▸ le_top⟩
#align is_max_iff_eq_top isMax_iff_eq_top

@[simp]
theorem isTop_iff_eq_top : IsTop a ↔ a = ⊤ :=
  ⟨fun h => h.isMax.eq_of_le le_top, fun h _ => h.symm ▸ le_top⟩
#align is_top_iff_eq_top isTop_iff_eq_top

theorem not_isMax_iff_ne_top : ¬IsMax a ↔ a ≠ ⊤ :=
  isMax_iff_eq_top.not
#align not_is_max_iff_ne_top not_isMax_iff_ne_top

theorem not_isTop_iff_ne_top : ¬IsTop a ↔ a ≠ ⊤ :=
  isTop_iff_eq_top.not
#align not_is_top_iff_ne_top not_isTop_iff_ne_top

alias isMax_iff_eq_top ↔ IsMax.eq_top _
#align is_max.eq_top IsMax.eq_top

alias isTop_iff_eq_top ↔ IsTop.eq_top _
#align is_top.eq_top IsTop.eq_top

@[simp]
theorem top_le_iff : ⊤ ≤ a ↔ a = ⊤ :=
  le_top.le_iff_eq.trans eq_comm
#align top_le_iff top_le_iff

theorem top_unique (h : ⊤ ≤ a) : a = ⊤ :=
  le_top.antisymm h
#align top_unique top_unique

theorem eq_top_iff : a = ⊤ ↔ ⊤ ≤ a :=
  top_le_iff.symm
#align eq_top_iff eq_top_iff

theorem eq_top_mono (h : a ≤ b) (h₂ : a = ⊤) : b = ⊤ :=
  top_unique <| h₂ ▸ h
#align eq_top_mono eq_top_mono

theorem lt_top_iff_ne_top : a < ⊤ ↔ a ≠ ⊤ :=
  le_top.lt_iff_ne
#align lt_top_iff_ne_top lt_top_iff_ne_top

@[simp]
theorem not_lt_top_iff : ¬a < ⊤ ↔ a = ⊤ :=
  lt_top_iff_ne_top.not_left
#align not_lt_top_iff not_lt_top_iff

theorem eq_top_or_lt_top (a : α) : a = ⊤ ∨ a < ⊤ :=
  le_top.eq_or_lt
#align eq_top_or_lt_top eq_top_or_lt_top

theorem Ne.lt_top (h : a ≠ ⊤) : a < ⊤ :=
  lt_top_iff_ne_top.mpr h
#align ne.lt_top Ne.lt_top

theorem Ne.lt_top' (h : ⊤ ≠ a) : a < ⊤ :=
  h.symm.lt_top
#align ne.lt_top' Ne.lt_top'

theorem ne_top_of_le_ne_top (hb : b ≠ ⊤) (hab : a ≤ b) : a ≠ ⊤ :=
  (hab.trans_lt hb.lt_top).ne
#align ne_top_of_le_ne_top ne_top_of_le_ne_top

theorem StrictMono.apply_eq_top_iff (hf : StrictMono f) : f a = f ⊤ ↔ a = ⊤ :=
  ⟨fun h => not_lt_top_iff.1 fun ha => (hf ha).ne h, congr_arg _⟩
#align strict_mono.apply_eq_top_iff StrictMono.apply_eq_top_iff

theorem StrictAnti.apply_eq_top_iff (hf : StrictAnti f) : f a = f ⊤ ↔ a = ⊤ :=
  ⟨fun h => not_lt_top_iff.1 fun ha => (hf ha).ne' h, congr_arg _⟩
#align strict_anti.apply_eq_top_iff StrictAnti.apply_eq_top_iff

variable [Nontrivial α]

theorem not_isMin_top : ¬IsMin (⊤ : α) := fun h =>
  let ⟨_, ha⟩ := exists_ne (⊤ : α)
  ha <| top_le_iff.1 <| h le_top
#align not_is_min_top not_isMin_top

end OrderTop

theorem StrictMono.maximal_preimage_top [LinearOrder α] [Preorder β] [OrderTop β] {f : α → β}
    (H : StrictMono f) {a} (h_top : f a = ⊤) (x : α) : x ≤ a :=
  H.maximal_of_maximal_image
    (fun p => by
      rw [h_top]
      exact le_top)
    x
#align strict_mono.maximal_preimage_top StrictMono.maximal_preimage_top

theorem OrderTop.ext_top {α} {hA : PartialOrder α} (A : OrderTop α) {hB : PartialOrder α}
    (B : OrderTop α) (H : ∀ x y : α, (haveI := hA; x ≤ y) ↔ x ≤ y) :
    (@Top.top α (@OrderTop.toTop α hA.toLE A)) = (@Top.top α (@OrderTop.toTop α hB.toLE B)) := by
  cases PartialOrder.ext H
  apply top_unique
  exact @le_top _ _ A _
#align order_top.ext_top OrderTop.ext_top

theorem OrderTop.ext {α} [PartialOrder α] {A B : OrderTop α} : A = B := by
  rcases A with ⟨ha⟩
  rcases B with ⟨hb⟩
  congr
  ext
  exact le_antisymm (hb _) (ha _)
#align order_top.ext OrderTop.ext

/-- An order is an `OrderBot` if it has a least element.
We state this using a data mixin, holding the value of `⊥` and the least element constraint. -/
class OrderBot (α : Type u) [LE α] extends Bot α where
  /-- `⊥` is the least element -/
  bot_le : ∀ a : α, ⊥ ≤ a
#align order_bot OrderBot

section OrderBot

/-- An order is (noncomputably) either an `OrderBot` or a `NoBotOrder`. Use as
`casesI botOrderOrNoBotOrder α`. -/
noncomputable def botOrderOrNoBotOrder (α : Type _) [LE α] : PSum (OrderBot α) (NoBotOrder α) := by
  by_cases H : ∀ a : α, ∃ b, ¬a ≤ b
  · exact PSum.inr ⟨H⟩

  · push_neg at H
    letI : Bot α := ⟨Classical.choose H⟩
    exact PSum.inl ⟨Classical.choose_spec H⟩

#align bot_order_or_no_bot_order botOrderOrNoBotOrder

section LE

variable [LE α] [OrderBot α] {a : α}

@[simp]
theorem bot_le : ⊥ ≤ a :=
  OrderBot.bot_le a
#align bot_le bot_le

@[simp]
theorem isBot_bot : IsBot (⊥ : α) := fun _ => bot_le
#align is_bot_bot isBot_bot

end LE

namespace OrderDual

variable (α)

instance top [Bot α] : Top αᵒᵈ :=
  ⟨(⊥ : α)⟩

instance bot [Top α] : Bot αᵒᵈ :=
  ⟨(⊤ : α)⟩

instance orderTop [LE α] [OrderBot α] : OrderTop αᵒᵈ where
  __ := inferInstanceAs (Top αᵒᵈ)
  le_top := @bot_le α _ _

instance orderBot [LE α] [OrderTop α] : OrderBot αᵒᵈ where
  __ := inferInstanceAs (Bot αᵒᵈ)
  bot_le := @le_top α _ _

@[simp]
theorem ofDual_bot [Top α] : ofDual ⊥ = (⊤ : α) :=
  rfl
#align order_dual.of_dual_bot OrderDual.ofDual_bot

@[simp]
theorem ofDual_top [Bot α] : ofDual ⊤ = (⊥ : α) :=
  rfl
#align order_dual.of_dual_top OrderDual.ofDual_top

@[simp]
theorem toDual_bot [Bot α] : toDual (⊥ : α) = ⊤ :=
  rfl
#align order_dual.to_dual_bot OrderDual.toDual_bot

@[simp]
theorem toDual_top [Top α] : toDual (⊤ : α) = ⊥ :=
  rfl
#align order_dual.to_dual_top OrderDual.toDual_top

end OrderDual

section Preorder

variable [Preorder α] [OrderBot α] {a b : α}

@[simp]
theorem isMin_bot : IsMin (⊥ : α) :=
  isBot_bot.isMin
#align is_min_bot isMin_bot

@[simp]
theorem not_lt_bot : ¬a < ⊥ :=
  isMin_bot.not_lt
#align not_lt_bot not_lt_bot

theorem ne_bot_of_gt (h : a < b) : b ≠ ⊥ :=
  (bot_le.trans_lt h).ne'
#align ne_bot_of_gt ne_bot_of_gt

alias ne_bot_of_gt ← LT.lt.ne_bot

end Preorder

variable [PartialOrder α] [OrderBot α] [Preorder β] {f : α → β} {a b : α}

@[simp]
theorem isMin_iff_eq_bot : IsMin a ↔ a = ⊥ :=
  ⟨fun h => h.eq_of_ge bot_le, fun h _ _ => h.symm ▸ bot_le⟩
#align is_min_iff_eq_bot isMin_iff_eq_bot

@[simp]
theorem isBot_iff_eq_bot : IsBot a ↔ a = ⊥ :=
  ⟨fun h => h.isMin.eq_of_ge bot_le, fun h _ => h.symm ▸ bot_le⟩
#align is_bot_iff_eq_bot isBot_iff_eq_bot

theorem not_isMin_iff_ne_bot : ¬IsMin a ↔ a ≠ ⊥ :=
  isMin_iff_eq_bot.not
#align not_is_min_iff_ne_bot not_isMin_iff_ne_bot

theorem not_isBot_iff_ne_bot : ¬IsBot a ↔ a ≠ ⊥ :=
  isBot_iff_eq_bot.not
#align not_is_bot_iff_ne_bot not_isBot_iff_ne_bot

alias isMin_iff_eq_bot ↔ IsMin.eq_bot _
#align is_min.eq_bot IsMin.eq_bot

alias isBot_iff_eq_bot ↔ IsBot.eq_bot _
#align is_bot.eq_bot IsBot.eq_bot

@[simp]
theorem le_bot_iff : a ≤ ⊥ ↔ a = ⊥ :=
  bot_le.le_iff_eq
#align le_bot_iff le_bot_iff

theorem bot_unique (h : a ≤ ⊥) : a = ⊥ :=
  h.antisymm bot_le
#align bot_unique bot_unique

theorem eq_bot_iff : a = ⊥ ↔ a ≤ ⊥ :=
  le_bot_iff.symm
#align eq_bot_iff eq_bot_iff

theorem eq_bot_mono (h : a ≤ b) (h₂ : b = ⊥) : a = ⊥ :=
  bot_unique <| h₂ ▸ h
#align eq_bot_mono eq_bot_mono

theorem bot_lt_iff_ne_bot : ⊥ < a ↔ a ≠ ⊥ :=
  bot_le.lt_iff_ne.trans ne_comm
#align bot_lt_iff_ne_bot bot_lt_iff_ne_bot

@[simp]
theorem not_bot_lt_iff : ¬⊥ < a ↔ a = ⊥ :=
  bot_lt_iff_ne_bot.not_left
#align not_bot_lt_iff not_bot_lt_iff

theorem eq_bot_or_bot_lt (a : α) : a = ⊥ ∨ ⊥ < a :=
  bot_le.eq_or_gt
#align eq_bot_or_bot_lt eq_bot_or_bot_lt

theorem eq_bot_of_minimal (h : ∀ b, ¬b < a) : a = ⊥ :=
  (eq_bot_or_bot_lt a).resolve_right (h ⊥)
#align eq_bot_of_minimal eq_bot_of_minimal

theorem Ne.bot_lt (h : a ≠ ⊥) : ⊥ < a :=
  bot_lt_iff_ne_bot.mpr h
#align ne.bot_lt Ne.bot_lt

theorem Ne.bot_lt' (h : ⊥ ≠ a) : ⊥ < a :=
  h.symm.bot_lt
#align ne.bot_lt' Ne.bot_lt'

theorem ne_bot_of_le_ne_bot (hb : b ≠ ⊥) (hab : b ≤ a) : a ≠ ⊥ :=
  (hb.bot_lt.trans_le hab).ne'
#align ne_bot_of_le_ne_bot ne_bot_of_le_ne_bot

theorem StrictMono.apply_eq_bot_iff (hf : StrictMono f) : f a = f ⊥ ↔ a = ⊥ :=
  hf.dual.apply_eq_top_iff
#align strict_mono.apply_eq_bot_iff StrictMono.apply_eq_bot_iff

theorem StrictAnti.apply_eq_bot_iff (hf : StrictAnti f) : f a = f ⊥ ↔ a = ⊥ :=
  hf.dual.apply_eq_top_iff
#align strict_anti.apply_eq_bot_iff StrictAnti.apply_eq_bot_iff

variable [Nontrivial α]

theorem not_isMax_bot : ¬IsMax (⊥ : α) :=
  @not_isMin_top αᵒᵈ _ _ _
#align not_is_max_bot not_isMax_bot

end OrderBot

theorem StrictMono.minimal_preimage_bot [LinearOrder α] [PartialOrder β] [OrderBot β] {f : α → β}
    (H : StrictMono f) {a} (h_bot : f a = ⊥) (x : α) : a ≤ x :=
  H.minimal_of_minimal_image
    (fun p => by
      rw [h_bot]
      exact bot_le)
    x
#align strict_mono.minimal_preimage_bot StrictMono.minimal_preimage_bot

theorem OrderBot.ext_bot {α} {hA : PartialOrder α} (A : OrderBot α) {hB : PartialOrder α}
    (B : OrderBot α) (H : ∀ x y : α, (haveI := hA; x ≤ y) ↔ x ≤ y) :
    (@Bot.bot α (@OrderBot.toBot α hA.toLE A)) = (@Bot.bot α (@OrderBot.toBot α hB.toLE B)) := by
  cases PartialOrder.ext H
  apply bot_unique
  exact @bot_le _ _ A _
#align order_bot.ext_bot OrderBot.ext_bot

theorem OrderBot.ext {α} [PartialOrder α] {A B : OrderBot α} : A = B := by
  rcases A with ⟨ha⟩
  rcases B with ⟨hb⟩
  congr
  ext
  exact le_antisymm (ha _) (hb _)
#align order_bot.ext OrderBot.ext

section SemilatticeSupTop

variable [SemilatticeSup α] [OrderTop α] {a : α}

-- Porting note: Not simp because simp can prove it
theorem top_sup_eq : ⊤ ⊔ a = ⊤ :=
  sup_of_le_left le_top
#align top_sup_eq top_sup_eq

-- Porting note: Not simp because simp can prove it
theorem sup_top_eq : a ⊔ ⊤ = ⊤ :=
  sup_of_le_right le_top
#align sup_top_eq sup_top_eq

end SemilatticeSupTop

section SemilatticeSupBot

variable [SemilatticeSup α] [OrderBot α] {a b : α}

-- Porting note: Not simp because simp can prove it
theorem bot_sup_eq : ⊥ ⊔ a = a :=
  sup_of_le_right bot_le
#align bot_sup_eq bot_sup_eq

-- Porting note: Not simp because simp can prove it
theorem sup_bot_eq : a ⊔ ⊥ = a :=
  sup_of_le_left bot_le
#align sup_bot_eq sup_bot_eq

@[simp]
theorem sup_eq_bot_iff : a ⊔ b = ⊥ ↔ a = ⊥ ∧ b = ⊥ := by rw [eq_bot_iff, sup_le_iff]; simp
#align sup_eq_bot_iff sup_eq_bot_iff

end SemilatticeSupBot

section SemilatticeInfTop

variable [SemilatticeInf α] [OrderTop α] {a b : α}

-- Porting note: Not simp because simp can prove it
theorem top_inf_eq : ⊤ ⊓ a = a :=
  inf_of_le_right le_top
#align top_inf_eq top_inf_eq

-- Porting note: Not simp because simp can prove it
theorem inf_top_eq : a ⊓ ⊤ = a :=
  inf_of_le_left le_top
#align inf_top_eq inf_top_eq

@[simp]
theorem inf_eq_top_iff : a ⊓ b = ⊤ ↔ a = ⊤ ∧ b = ⊤ :=
  @sup_eq_bot_iff αᵒᵈ _ _ _ _
#align inf_eq_top_iff inf_eq_top_iff

end SemilatticeInfTop

section SemilatticeInfBot

variable [SemilatticeInf α] [OrderBot α] {a : α}

-- Porting note: Not simp because simp can prove it
theorem bot_inf_eq : ⊥ ⊓ a = ⊥ :=
  inf_of_le_left bot_le
#align bot_inf_eq bot_inf_eq

-- Porting note: Not simp because simp can prove it
theorem inf_bot_eq : a ⊓ ⊥ = ⊥ :=
  inf_of_le_right bot_le
#align inf_bot_eq inf_bot_eq

end SemilatticeInfBot

/-! ### Bounded order -/

/-- A bounded order describes an order `(≤)` with a top and bottom element,
  denoted `⊤` and `⊥` respectively. -/
class BoundedOrder (α : Type u) [LE α] extends OrderTop α, OrderBot α
#align bounded_order BoundedOrder

instance OrderDual.boundedOrder (α : Type u) [LE α] [BoundedOrder α] : BoundedOrder αᵒᵈ where
  __ := inferInstanceAs (OrderTop αᵒᵈ)
  __ := inferInstanceAs (OrderBot αᵒᵈ)

theorem BoundedOrder.ext {α} [PartialOrder α] {A B : BoundedOrder α} : A = B := by
  have ht : @BoundedOrder.toOrderTop α _ A = @BoundedOrder.toOrderTop α _ B := OrderTop.ext
  have hb : @BoundedOrder.toOrderBot α _ A = @BoundedOrder.toOrderBot α _ B := OrderBot.ext
  cases A
  cases B
  congr
#align bounded_order.ext BoundedOrder.ext

section Logic

/-!
#### In this section we prove some properties about monotone and antitone operations on `Prop`
-/

section Preorder

variable [Preorder α]

theorem monotone_and {p q : α → Prop} (m_p : Monotone p) (m_q : Monotone q) :
    Monotone fun x => p x ∧ q x :=
  fun _ _ h => And.imp (m_p h) (m_q h)
#align monotone_and monotone_and

-- Note: by finish [monotone] doesn't work
theorem monotone_or {p q : α → Prop} (m_p : Monotone p) (m_q : Monotone q) :
    Monotone fun x => p x ∨ q x :=
  fun _ _ h => Or.imp (m_p h) (m_q h)
#align monotone_or monotone_or

theorem monotone_le {x : α} : Monotone ((· ≤ ·) x) := fun _ _ h' h => h.trans h'
#align monotone_le monotone_le

theorem monotone_lt {x : α} : Monotone ((· < ·) x) := fun _ _ h' h => h.trans_le h'
#align monotone_lt monotone_lt

theorem antitone_le {x : α} : Antitone (· ≤ x) := fun _ _ h' h => h'.trans h
#align antitone_le antitone_le

theorem antitone_lt {x : α} : Antitone (· < x) := fun _ _ h' h => h'.trans_lt h
#align antitone_lt antitone_lt

theorem Monotone.forall {P : β → α → Prop} (hP : ∀ x, Monotone (P x)) :
    Monotone fun y => ∀ x, P x y :=
  fun _ _ hy h x => hP x hy <| h x
#align monotone.forall Monotone.forall

theorem Antitone.forall {P : β → α → Prop} (hP : ∀ x, Antitone (P x)) :
    Antitone fun y => ∀ x, P x y :=
  fun _ _ hy h x => hP x hy (h x)
#align antitone.forall Antitone.forall

theorem Monotone.ball {P : β → α → Prop} {s : Set β} (hP : ∀ x ∈ s, Monotone (P x)) :
    Monotone fun y => ∀ x ∈ s, P x y := fun _ _ hy h x hx => hP x hx hy (h x hx)
#align monotone.ball Monotone.ball

theorem Antitone.ball {P : β → α → Prop} {s : Set β} (hP : ∀ x ∈ s, Antitone (P x)) :
    Antitone fun y => ∀ x ∈ s, P x y := fun _ _ hy h x hx => hP x hx hy (h x hx)
#align antitone.ball Antitone.ball

end Preorder

section SemilatticeSup

variable [SemilatticeSup α]

theorem exists_ge_and_iff_exists {P : α → Prop} {x₀ : α} (hP : Monotone P) :
    (∃ x, x₀ ≤ x ∧ P x) ↔ ∃ x, P x :=
  ⟨fun h => h.imp fun _ h => h.2, fun ⟨x, hx⟩ => ⟨x ⊔ x₀, le_sup_right, hP le_sup_left hx⟩⟩
#align exists_ge_and_iff_exists exists_ge_and_iff_exists

end SemilatticeSup

section SemilatticeInf

variable [SemilatticeInf α]

-- Porting note: was `hP.dual_left`
theorem exists_le_and_iff_exists {P : α → Prop} {x₀ : α} (hP : Antitone P) :
    (∃ x, x ≤ x₀ ∧ P x) ↔ ∃ x, P x :=
  exists_ge_and_iff_exists <| Antitone.dual_left hP
#align exists_le_and_iff_exists exists_le_and_iff_exists

end SemilatticeInf

end Logic

/-! ### Function lattices -/

namespace Pi

variable {ι : Type _} {α' : ι → Type _}

instance [∀ i, Bot (α' i)] : Bot (∀ i, α' i) :=
  ⟨fun _ => ⊥⟩

@[simp]
theorem bot_apply [∀ i, Bot (α' i)] (i : ι) : (⊥ : ∀ i, α' i) i = ⊥ :=
  rfl
#align pi.bot_apply Pi.bot_apply

theorem bot_def [∀ i, Bot (α' i)] : (⊥ : ∀ i, α' i) = fun _ => ⊥ :=
  rfl
#align pi.bot_def Pi.bot_def

instance [∀ i, Top (α' i)] : Top (∀ i, α' i) :=
  ⟨fun _ => ⊤⟩

@[simp]
theorem top_apply [∀ i, Top (α' i)] (i : ι) : (⊤ : ∀ i, α' i) i = ⊤ :=
  rfl
#align pi.top_apply Pi.top_apply

theorem top_def [∀ i, Top (α' i)] : (⊤ : ∀ i, α' i) = fun _ => ⊤ :=
  rfl
#align pi.top_def Pi.top_def

instance orderTop [∀ i, LE (α' i)] [∀ i, OrderTop (α' i)] : OrderTop (∀ i, α' i) :=
  { inferInstanceAs (Top (∀ i, α' i)) with le_top := fun _ _ => le_top }

instance orderBot [∀ i, LE (α' i)] [∀ i, OrderBot (α' i)] : OrderBot (∀ i, α' i) :=
  { inferInstanceAs (Bot (∀ i, α' i)) with bot_le := fun _ _ => bot_le }

instance boundedOrder [∀ i, LE (α' i)] [∀ i, BoundedOrder (α' i)] : BoundedOrder (∀ i, α' i) where
  __ := inferInstanceAs (OrderTop (∀ i, α' i))
  __ := inferInstanceAs (OrderBot (∀ i, α' i))

end Pi

section Subsingleton

variable [PartialOrder α] [BoundedOrder α]

theorem eq_bot_of_bot_eq_top (hα : (⊥ : α) = ⊤) (x : α) : x = (⊥ : α) :=
  eq_bot_mono le_top (Eq.symm hα)
#align eq_bot_of_bot_eq_top eq_bot_of_bot_eq_top

theorem eq_top_of_bot_eq_top (hα : (⊥ : α) = ⊤) (x : α) : x = (⊤ : α) :=
  eq_top_mono bot_le hα
#align eq_top_of_bot_eq_top eq_top_of_bot_eq_top

theorem subsingleton_of_top_le_bot (h : (⊤ : α) ≤ (⊥ : α)) : Subsingleton α :=
  ⟨fun _ _ => le_antisymm
    (le_trans le_top <| le_trans h bot_le) (le_trans le_top <| le_trans h bot_le)⟩
#align subsingleton_of_top_le_bot subsingleton_of_top_le_bot

theorem subsingleton_of_bot_eq_top (hα : (⊥ : α) = (⊤ : α)) : Subsingleton α :=
  subsingleton_of_top_le_bot (ge_of_eq hα)
#align subsingleton_of_bot_eq_top subsingleton_of_bot_eq_top

theorem subsingleton_iff_bot_eq_top : (⊥ : α) = (⊤ : α) ↔ Subsingleton α :=
  ⟨subsingleton_of_bot_eq_top, fun _ => Subsingleton.elim ⊥ ⊤⟩
#align subsingleton_iff_bot_eq_top subsingleton_iff_bot_eq_top

end Subsingleton

section lift

-- See note [reducible non-instances]
/-- Pullback an `OrderTop`. -/
@[reducible]
def OrderTop.lift [LE α] [Top α] [LE β] [OrderTop β] (f : α → β)
    (map_le : ∀ a b, f a ≤ f b → a ≤ b) (map_top : f ⊤ = ⊤) : OrderTop α :=
  ⟨fun a =>
    map_le _ _ <| by
      rw [map_top]
      -- Porting note: lean3 didn't need the type annotation
      exact @le_top β _ _ _⟩
#align order_top.lift OrderTop.lift

-- See note [reducible non-instances]
/-- Pullback an `OrderBot`. -/
@[reducible]
def OrderBot.lift [LE α] [Bot α] [LE β] [OrderBot β] (f : α → β)
    (map_le : ∀ a b, f a ≤ f b → a ≤ b) (map_bot : f ⊥ = ⊥) : OrderBot α :=
  ⟨fun a =>
    map_le _ _ <| by
      rw [map_bot]
      -- Porting note: lean3 didn't need the type annotation
      exact @bot_le β _ _ _⟩
#align order_bot.lift OrderBot.lift

-- See note [reducible non-instances]
/-- Pullback a `BoundedOrder`. -/
@[reducible]
def BoundedOrder.lift [LE α] [Top α] [Bot α] [LE β] [BoundedOrder β] (f : α → β)
    (map_le : ∀ a b, f a ≤ f b → a ≤ b) (map_top : f ⊤ = ⊤) (map_bot : f ⊥ = ⊥) : BoundedOrder α :=
  { OrderTop.lift f map_le map_top, OrderBot.lift f map_le map_bot with }
#align bounded_order.lift BoundedOrder.lift

end lift

/-! ### Subtype, order dual, product lattices -/

namespace Subtype

variable {p : α → Prop}

-- See note [reducible non-instances]
/-- A subtype remains a `⊥`-order if the property holds at `⊥`. -/
@[reducible]
protected def orderBot [LE α] [OrderBot α] (hbot : p ⊥) : OrderBot { x : α // p x } where
  bot := ⟨⊥, hbot⟩
  bot_le _ := bot_le
#align subtype.order_bot Subtype.orderBot

-- See note [reducible non-instances]
/-- A subtype remains a `⊤`-order if the property holds at `⊤`. -/
@[reducible]
protected def orderTop [LE α] [OrderTop α] (htop : p ⊤) : OrderTop { x : α // p x } where
  top := ⟨⊤, htop⟩
  le_top _ := le_top
#align subtype.order_top Subtype.orderTop

-- See note [reducible non-instances]
/-- A subtype remains a bounded order if the property holds at `⊥` and `⊤`. -/
@[reducible]
protected def boundedOrder [LE α] [BoundedOrder α] (hbot : p ⊥) (htop : p ⊤) :
    BoundedOrder (Subtype p) :=
  { Subtype.orderTop htop, Subtype.orderBot hbot with }
#align subtype.bounded_order Subtype.boundedOrder

variable [PartialOrder α]

@[simp]
theorem mk_bot [OrderBot α] [OrderBot (Subtype p)] (hbot : p ⊥) : mk ⊥ hbot = ⊥ :=
  le_bot_iff.1 <| coe_le_coe.1 bot_le
#align subtype.mk_bot Subtype.mk_bot

@[simp]
theorem mk_top [OrderTop α] [OrderTop (Subtype p)] (htop : p ⊤) : mk ⊤ htop = ⊤ :=
  top_le_iff.1 <| coe_le_coe.1 le_top
#align subtype.mk_top Subtype.mk_top

theorem coe_bot [OrderBot α] [OrderBot (Subtype p)] (hbot : p ⊥) : ((⊥ : Subtype p) : α) = ⊥ :=
  congr_arg Subtype.val (mk_bot hbot).symm
#align subtype.coe_bot Subtype.coe_bot

theorem coe_top [OrderTop α] [OrderTop (Subtype p)] (htop : p ⊤) : ((⊤ : Subtype p) : α) = ⊤ :=
  congr_arg Subtype.val (mk_top htop).symm
#align subtype.coe_top Subtype.coe_top

@[simp]
theorem coe_eq_bot_iff [OrderBot α] [OrderBot (Subtype p)] (hbot : p ⊥) {x : { x // p x }} :
    (x : α) = ⊥ ↔ x = ⊥ := by
  rw [← coe_bot hbot, ext_iff]
#align subtype.coe_eq_bot_iff Subtype.coe_eq_bot_iff

@[simp]
theorem coe_eq_top_iff [OrderTop α] [OrderTop (Subtype p)] (htop : p ⊤) {x : { x // p x }} :
    (x : α) = ⊤ ↔ x = ⊤ := by
  rw [← coe_top htop, ext_iff]
#align subtype.coe_eq_top_iff Subtype.coe_eq_top_iff

@[simp]
theorem mk_eq_bot_iff [OrderBot α] [OrderBot (Subtype p)] (hbot : p ⊥) {x : α} (hx : p x) :
    (⟨x, hx⟩ : Subtype p) = ⊥ ↔ x = ⊥ :=
  (coe_eq_bot_iff hbot).symm
#align subtype.mk_eq_bot_iff Subtype.mk_eq_bot_iff

@[simp]
theorem mk_eq_top_iff [OrderTop α] [OrderTop (Subtype p)] (htop : p ⊤) {x : α} (hx : p x) :
    (⟨x, hx⟩ : Subtype p) = ⊤ ↔ x = ⊤ :=
  (coe_eq_top_iff htop).symm
#align subtype.mk_eq_top_iff Subtype.mk_eq_top_iff

end Subtype

namespace Prod

variable (α β)

instance top [Top α] [Top β] : Top (α × β) :=
  ⟨⟨⊤, ⊤⟩⟩

instance bot [Bot α] [Bot β] : Bot (α × β) :=
  ⟨⟨⊥, ⊥⟩⟩

instance orderTop [LE α] [LE β] [OrderTop α] [OrderTop β] : OrderTop (α × β) where
  __ := inferInstanceAs (Top (α × β))
  le_top _ := ⟨le_top, le_top⟩

instance orderBot [LE α] [LE β] [OrderBot α] [OrderBot β] : OrderBot (α × β) where
  __ := inferInstanceAs (Bot (α × β))
  bot_le _ := ⟨bot_le, bot_le⟩

instance boundedOrder [LE α] [LE β] [BoundedOrder α] [BoundedOrder β] : BoundedOrder (α × β) where
  __ := inferInstanceAs (OrderTop (α × β))
  __ := inferInstanceAs (OrderBot (α × β))

end Prod

section LinearOrder

variable [LinearOrder α]

-- `simp` can prove these, so they shouldn't be simp-lemmas.
theorem min_bot_left [OrderBot α] (a : α) : min ⊥ a = ⊥ :=
  bot_inf_eq
#align min_bot_left min_bot_left

theorem max_top_left [OrderTop α] (a : α) : max ⊤ a = ⊤ :=
  top_sup_eq
#align max_top_left max_top_left

theorem min_top_left [OrderTop α] (a : α) : min ⊤ a = a :=
  top_inf_eq
#align min_top_left min_top_left

theorem max_bot_left [OrderBot α] (a : α) : max ⊥ a = a :=
  bot_sup_eq
#align max_bot_left max_bot_left

theorem min_top_right [OrderTop α] (a : α) : min a ⊤ = a :=
  inf_top_eq
#align min_top_right min_top_right

theorem max_bot_right [OrderBot α] (a : α) : max a ⊥ = a :=
  sup_bot_eq
#align max_bot_right max_bot_right

theorem min_bot_right [OrderBot α] (a : α) : min a ⊥ = ⊥ :=
  inf_bot_eq
#align min_bot_right min_bot_right

theorem max_top_right [OrderTop α] (a : α) : max a ⊤ = ⊤ :=
  sup_top_eq
#align max_top_right max_top_right

@[simp]
theorem min_eq_bot [OrderBot α] {a b : α} : min a b = ⊥ ↔ a = ⊥ ∨ b = ⊥ := by
  simp only [← inf_eq_min, ← le_bot_iff, inf_le_iff]
#align min_eq_bot min_eq_bot

@[simp]
theorem max_eq_top [OrderTop α] {a b : α} : max a b = ⊤ ↔ a = ⊤ ∨ b = ⊤ :=
  @min_eq_bot αᵒᵈ _ _ a b
#align max_eq_top max_eq_top

@[simp]
theorem max_eq_bot [OrderBot α] {a b : α} : max a b = ⊥ ↔ a = ⊥ ∧ b = ⊥ :=
  sup_eq_bot_iff
#align max_eq_bot max_eq_bot

@[simp]
theorem min_eq_top [OrderTop α] {a b : α} : min a b = ⊤ ↔ a = ⊤ ∧ b = ⊤ :=
  inf_eq_top_iff
#align min_eq_top min_eq_top

end LinearOrder

section Nontrivial

variable [PartialOrder α] [BoundedOrder α] [Nontrivial α]

@[simp]
theorem bot_ne_top : (⊥ : α) ≠ ⊤ := fun h => not_subsingleton _ <| subsingleton_of_bot_eq_top h
#align bot_ne_top bot_ne_top

@[simp]
theorem top_ne_bot : (⊤ : α) ≠ ⊥ :=
  bot_ne_top.symm
#align top_ne_bot top_ne_bot

@[simp]
theorem bot_lt_top : (⊥ : α) < ⊤ :=
  lt_top_iff_ne_top.2 bot_ne_top
#align bot_lt_top bot_lt_top

end Nontrivial

section Bool

open Bool

instance Bool.boundedOrder : BoundedOrder Bool where
  top := true
  le_top _ := le_true
  bot := false
  bot_le _ := false_le

@[simp]
theorem top_eq_true : ⊤ = true :=
  rfl
#align top_eq_tt top_eq_true

@[simp]
theorem bot_eq_false : ⊥ = false :=
  rfl
#align bot_eq_ff bot_eq_false

end Bool