/-
Copyright (c) 2018 Guy Leroy. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sangwoo Jo (aka Jason), Guy Leroy, Johannes Hölzl, Mario Carneiro
-/
import data.nat.prime
/-!
# Extended GCD and divisibility over ℤ

## Main definitions

* Given `x y : ℕ`, `xgcd x y` computes the pair of integers `(a, b)` such that
  `gcd x y = x * a + y * b`. `gcd_a x y` and `gcd_b x y` are defined to be `a` and `b`,
  respectively.

## Main statements

* `gcd_eq_gcd_ab`: Bézout's lemma, given `x y : ℕ`, `gcd x y = x * gcd_a x y + y * gcd_b x y`.

-/

/-! ### Extended Euclidean algorithm -/
namespace nat

/-- Helper function for the extended GCD algorithm (`nat.xgcd`). -/
def xgcd_aux : ℕ → ℤ → ℤ → ℕ → ℤ → ℤ → ℕ × ℤ × ℤ
| 0          s t r' s' t' := (r', s', t')
| r@(succ _) s t r' s' t' :=
  have r' % r < r, from mod_lt _ $ succ_pos _,
  let q := r' / r in xgcd_aux (r' % r) (s' - q * s) (t' - q * t) r s t

@[simp] theorem xgcd_zero_left {s t r' s' t'} : xgcd_aux 0 s t r' s' t' = (r', s', t') :=
by simp [xgcd_aux]

theorem xgcd_aux_rec {r s t r' s' t'} (h : 0 < r) :
  xgcd_aux r s t r' s' t' = xgcd_aux (r' % r) (s' - (r' / r) * s) (t' - (r' / r) * t) r s t :=
by cases r; [exact absurd h (lt_irrefl _), {simp only [xgcd_aux], refl}]

/-- Use the extended GCD algorithm to generate the `a` and `b` values
  satisfying `gcd x y = x * a + y * b`. -/
def xgcd (x y : ℕ) : ℤ × ℤ := (xgcd_aux x 1 0 y 0 1).2

/-- The extended GCD `a` value in the equation `gcd x y = x * a + y * b`. -/
def gcd_a (x y : ℕ) : ℤ := (xgcd x y).1

/-- The extended GCD `b` value in the equation `gcd x y = x * a + y * b`. -/
def gcd_b (x y : ℕ) : ℤ := (xgcd x y).2

@[simp] theorem gcd_a_zero_left {s : ℕ} : gcd_a 0 s = 0 :=
by { unfold gcd_a, rw [xgcd, xgcd_zero_left] }

@[simp] theorem gcd_b_zero_left {s : ℕ} : gcd_b 0 s = 1 :=
by { unfold gcd_b, rw [xgcd, xgcd_zero_left] }

@[simp] theorem gcd_a_zero_right {s : ℕ} (h : s ≠ 0) : gcd_a s 0 = 1 :=
begin
  unfold gcd_a xgcd,
  induction s,
  { exact absurd rfl h, },
  { simp [xgcd_aux], }
end

@[simp] theorem gcd_b_zero_right {s : ℕ} (h : s ≠ 0) : gcd_b s 0 = 0 :=
begin
  unfold gcd_b xgcd,
  induction s,
  { exact absurd rfl h, },
  { simp [xgcd_aux], }
end

@[simp] theorem xgcd_aux_fst (x y) : ∀ s t s' t',
  (xgcd_aux x s t y s' t').1 = gcd x y :=
gcd.induction x y (by simp) (λ x y h IH s t s' t', by simp [xgcd_aux_rec, h, IH]; rw ← gcd_rec)

theorem xgcd_aux_val (x y) : xgcd_aux x 1 0 y 0 1 = (gcd x y, xgcd x y) :=
by rw [xgcd, ← xgcd_aux_fst x y 1 0 0 1]; cases xgcd_aux x 1 0 y 0 1; refl

theorem xgcd_val (x y) : xgcd x y = (gcd_a x y, gcd_b x y) :=
by unfold gcd_a gcd_b; cases xgcd x y; refl

section
parameters (x y : ℕ)

private def P : ℕ × ℤ × ℤ → Prop
| (r, s, t) := (r : ℤ) = x * s + y * t

theorem xgcd_aux_P {r r'} : ∀ {s t s' t'}, P (r, s, t) → P (r', s', t') →
  P (xgcd_aux r s t r' s' t') :=
gcd.induction r r' (by simp) $ λ a b h IH s t s' t' p p', begin
  rw [xgcd_aux_rec h], refine IH _ p, dsimp [P] at *,
  rw [int.mod_def], generalize : (b / a : ℤ) = k,
  rw [p, p'],
  simp [mul_add, mul_comm, mul_left_comm, add_comm, add_left_comm, sub_eq_neg_add, mul_assoc]
end

/-- Bézout's lemma: given `x y : ℕ`, `gcd x y = x * a + y * b`, where `a = gcd_a x y` and
`b = gcd_b x y` are computed by the extended Euclidean algorithm.
-/
theorem gcd_eq_gcd_ab : (gcd x y : ℤ) = x * gcd_a x y + y * gcd_b x y :=
by have := @xgcd_aux_P x y x y 1 0 0 1 (by simp [P]) (by simp [P]);
   rwa [xgcd_aux_val, xgcd_val] at this
end

lemma exists_mul_mod_eq_gcd {k n : ℕ} (hk : gcd n k < k) :
  ∃ m, n * m % k = gcd n k :=
begin
  have hk' := int.coe_nat_ne_zero.mpr (ne_of_gt (lt_of_le_of_lt (zero_le (gcd n k)) hk)),
  have key := congr_arg (λ m, int.nat_mod m k) (gcd_eq_gcd_ab n k),
  simp_rw int.nat_mod at key,
  rw [int.add_mul_mod_self_left, ←int.coe_nat_mod, int.to_nat_coe_nat, mod_eq_of_lt hk] at key,
  refine ⟨(n.gcd_a k % k).to_nat, eq.trans (int.coe_nat_inj _) key.symm⟩,
  rw [int.coe_nat_mod, int.coe_nat_mul, int.to_nat_of_nonneg (int.mod_nonneg _ hk'),
      int.to_nat_of_nonneg (int.mod_nonneg _ hk'), int.mul_mod, int.mod_mod, ←int.mul_mod],
end

lemma exists_mul_mod_eq_one_of_coprime {k n : ℕ} (hkn : coprime n k) (hk : 1 < k) :
  ∃ m, n * m % k = 1 :=
Exists.cases_on (exists_mul_mod_eq_gcd (lt_of_le_of_lt (le_of_eq hkn) hk))
  (λ m hm, ⟨m, hm.trans hkn⟩)

end nat

/-! ### Divisibility over ℤ -/
namespace int

/-- The extended GCD `a` value in the equation `gcd x y = x * a + y * b`. -/
def gcd_a : ℤ → ℤ → ℤ
| (of_nat m) n := m.gcd_a n.nat_abs
| -[1+ m]    n := -m.succ.gcd_a n.nat_abs

/-- The extended GCD `b` value in the equation `gcd x y = x * a + y * b`. -/
def gcd_b : ℤ → ℤ → ℤ
| m (of_nat n) := m.nat_abs.gcd_b n
| m -[1+ n]    := -m.nat_abs.gcd_b n.succ

theorem gcd_eq_gcd_ab : ∀ x y : ℤ, (gcd x y : ℤ) = x * gcd_a x y + y * gcd_b x y
| (m : ℕ) (n : ℕ) := nat.gcd_eq_gcd_ab _ _
| (m : ℕ) -[1+ n] := show (_ : ℤ) = _ + -(n+1) * -_, by rw neg_mul_neg; apply nat.gcd_eq_gcd_ab
| -[1+ m] (n : ℕ) := show (_ : ℤ) = -(m+1) * -_ + _ , by rw neg_mul_neg; apply nat.gcd_eq_gcd_ab
| -[1+ m] -[1+ n] := show (_ : ℤ) = -(m+1) * -_ + -(n+1) * -_,
  by { rw [neg_mul_neg, neg_mul_neg], apply nat.gcd_eq_gcd_ab }

theorem nat_abs_div (a b : ℤ) (H : b ∣ a) : nat_abs (a / b) = (nat_abs a) / (nat_abs b) :=
begin
  cases (nat.eq_zero_or_pos (nat_abs b)),
  {rw eq_zero_of_nat_abs_eq_zero h, simp [int.div_zero]},
  calc
  nat_abs (a / b) = nat_abs (a / b) * 1 : by rw mul_one
    ... = nat_abs (a / b) * (nat_abs b / nat_abs b) : by rw nat.div_self h
    ... = nat_abs (a / b) * nat_abs b / nat_abs b : by rw (nat.mul_div_assoc _ (dvd_refl _))
    ... = nat_abs (a / b * b) / nat_abs b : by rw (nat_abs_mul (a / b) b)
    ... = nat_abs a / nat_abs b : by rw int.div_mul_cancel H,
end

theorem nat_abs_dvd_abs_iff {i j : ℤ} : i.nat_abs ∣ j.nat_abs ↔ i ∣ j :=
⟨assume (H : i.nat_abs ∣ j.nat_abs), dvd_nat_abs.mp (nat_abs_dvd.mp (coe_nat_dvd.mpr H)),
assume H : (i ∣ j), coe_nat_dvd.mp (dvd_nat_abs.mpr (nat_abs_dvd.mpr H))⟩

lemma succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul {p : ℕ} (p_prime : nat.prime p) {m n : ℤ} {k l : ℕ}
      (hpm : ↑(p ^ k) ∣ m)
      (hpn : ↑(p ^ l) ∣ n) (hpmn : ↑(p ^ (k+l+1)) ∣ m*n) : ↑(p ^ (k+1)) ∣ m ∨ ↑(p ^ (l+1)) ∣ n :=
have hpm' : p ^ k ∣ m.nat_abs, from int.coe_nat_dvd.1 $ int.dvd_nat_abs.2 hpm,
have hpn' : p ^ l ∣ n.nat_abs, from int.coe_nat_dvd.1 $ int.dvd_nat_abs.2 hpn,
have hpmn' : (p ^ (k+l+1)) ∣ m.nat_abs*n.nat_abs,
  by rw ←int.nat_abs_mul; apply (int.coe_nat_dvd.1 $ int.dvd_nat_abs.2 hpmn),
let hsd := nat.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul p_prime hpm' hpn' hpmn' in
hsd.elim
  (λ hsd1, or.inl begin apply int.dvd_nat_abs.1, apply int.coe_nat_dvd.2 hsd1 end)
  (λ hsd2, or.inr begin apply int.dvd_nat_abs.1, apply int.coe_nat_dvd.2 hsd2 end)

theorem dvd_of_mul_dvd_mul_left {i j k : ℤ} (k_non_zero : k ≠ 0) (H : k * i ∣ k * j) : i ∣ j :=
dvd.elim H (λl H1, by rw mul_assoc at H1; exact ⟨_, mul_left_cancel' k_non_zero H1⟩)

theorem dvd_of_mul_dvd_mul_right {i j k : ℤ} (k_non_zero : k ≠ 0) (H : i * k ∣ j * k) : i ∣ j :=
by rw [mul_comm i k, mul_comm j k] at H; exact dvd_of_mul_dvd_mul_left k_non_zero H

lemma prime.dvd_nat_abs_of_coe_dvd_sq {p : ℕ} (hp : p.prime) (k : ℤ) (h : ↑p ∣ k ^ 2) :
  p ∣ k.nat_abs :=
begin
  apply @nat.prime.dvd_of_dvd_pow _ _ 2 hp,
  rwa [sq, ← nat_abs_mul, ← coe_nat_dvd_left, ← sq]
end

/-- ℤ specific version of least common multiple. -/
def lcm (i j : ℤ) : ℕ := nat.lcm (nat_abs i) (nat_abs j)

theorem lcm_def (i j : ℤ) : lcm i j = nat.lcm (nat_abs i) (nat_abs j) := rfl

theorem gcd_dvd_left (i j : ℤ) : (gcd i j : ℤ) ∣ i :=
dvd_nat_abs.mp $ coe_nat_dvd.mpr $ nat.gcd_dvd_left _ _

theorem gcd_dvd_right (i j : ℤ) : (gcd i j : ℤ) ∣ j :=
dvd_nat_abs.mp $ coe_nat_dvd.mpr $ nat.gcd_dvd_right _ _

theorem dvd_gcd {i j k : ℤ} (h1 : k ∣ i) (h2 : k ∣ j) : k ∣ gcd i j :=
nat_abs_dvd.1 $ coe_nat_dvd.2 $ nat.dvd_gcd (nat_abs_dvd_abs_iff.2 h1) (nat_abs_dvd_abs_iff.2 h2)

theorem gcd_mul_lcm (i j : ℤ) : gcd i j * lcm i j = nat_abs (i * j) :=
by rw [int.gcd, int.lcm, nat.gcd_mul_lcm, nat_abs_mul]

theorem gcd_comm (i j : ℤ) : gcd i j = gcd j i := nat.gcd_comm _ _

theorem gcd_assoc (i j k : ℤ) : gcd (gcd i j) k = gcd i (gcd j k) := nat.gcd_assoc _ _ _

@[simp] theorem gcd_self (i : ℤ) : gcd i i = nat_abs i := by simp [gcd]

@[simp] theorem gcd_zero_left (i : ℤ) : gcd 0 i = nat_abs i := by simp [gcd]

@[simp] theorem gcd_zero_right (i : ℤ) : gcd i 0 = nat_abs i := by simp [gcd]

@[simp] theorem gcd_one_left (i : ℤ) : gcd 1 i = 1 := nat.gcd_one_left _

@[simp] theorem gcd_one_right (i : ℤ) : gcd i 1 = 1 := nat.gcd_one_right _

theorem gcd_mul_left (i j k : ℤ) : gcd (i * j) (i * k) = nat_abs i * gcd j k :=
by { rw [int.gcd, int.gcd, nat_abs_mul, nat_abs_mul], apply nat.gcd_mul_left }

theorem gcd_mul_right (i j k : ℤ) : gcd (i * j) (k * j) = gcd i k * nat_abs j :=
by { rw [int.gcd, int.gcd, nat_abs_mul, nat_abs_mul], apply nat.gcd_mul_right }

theorem gcd_pos_of_non_zero_left {i : ℤ} (j : ℤ) (i_non_zero : i ≠ 0) : 0 < gcd i j :=
nat.gcd_pos_of_pos_left (nat_abs j) (nat_abs_pos_of_ne_zero i_non_zero)

theorem gcd_pos_of_non_zero_right (i : ℤ) {j : ℤ} (j_non_zero : j ≠ 0) : 0 < gcd i j :=
nat.gcd_pos_of_pos_right (nat_abs i) (nat_abs_pos_of_ne_zero j_non_zero)

theorem gcd_eq_zero_iff {i j : ℤ} : gcd i j = 0 ↔ i = 0 ∧ j = 0 :=
begin
  rw int.gcd,
  split,
  { intro h,
    exact ⟨nat_abs_eq_zero.mp (nat.eq_zero_of_gcd_eq_zero_left h),
      nat_abs_eq_zero.mp (nat.eq_zero_of_gcd_eq_zero_right h)⟩ },
  { intro h, rw [nat_abs_eq_zero.mpr h.left, nat_abs_eq_zero.mpr h.right],
    apply nat.gcd_zero_left }
end

theorem gcd_div {i j k : ℤ} (H1 : k ∣ i) (H2 : k ∣ j) :
  gcd (i / k) (j / k) = gcd i j / nat_abs k :=
by rw [gcd, nat_abs_div i k H1, nat_abs_div j k H2];
exact nat.gcd_div (nat_abs_dvd_abs_iff.mpr H1) (nat_abs_dvd_abs_iff.mpr H2)

theorem gcd_div_gcd_div_gcd {i j : ℤ} (H : 0 < gcd i j) :
  gcd (i / gcd i j) (j / gcd i j) = 1 :=
begin
  rw [gcd_div (gcd_dvd_left i j) (gcd_dvd_right i j)],
  rw [nat_abs_of_nat, nat.div_self H]
end

theorem gcd_dvd_gcd_of_dvd_left {i k : ℤ} (j : ℤ) (H : i ∣ k) : gcd i j ∣ gcd k j :=
int.coe_nat_dvd.1 $ dvd_gcd (dvd.trans (gcd_dvd_left i j) H) (gcd_dvd_right i j)

theorem gcd_dvd_gcd_of_dvd_right {i k : ℤ} (j : ℤ) (H : i ∣ k) : gcd j i ∣ gcd j k :=
int.coe_nat_dvd.1 $ dvd_gcd (gcd_dvd_left j i) (dvd.trans (gcd_dvd_right j i) H)

theorem gcd_dvd_gcd_mul_left (i j k : ℤ) : gcd i j ∣ gcd (k * i) j :=
gcd_dvd_gcd_of_dvd_left _ (dvd_mul_left _ _)

theorem gcd_dvd_gcd_mul_right (i j k : ℤ) : gcd i j ∣ gcd (i * k) j :=
gcd_dvd_gcd_of_dvd_left _ (dvd_mul_right _ _)

theorem gcd_dvd_gcd_mul_left_right (i j k : ℤ) : gcd i j ∣ gcd i (k * j) :=
gcd_dvd_gcd_of_dvd_right _ (dvd_mul_left _ _)

theorem gcd_dvd_gcd_mul_right_right (i j k : ℤ) : gcd i j ∣ gcd i (j * k) :=
gcd_dvd_gcd_of_dvd_right _ (dvd_mul_right _ _)

theorem gcd_eq_left {i j : ℤ} (H : i ∣ j) : gcd i j = nat_abs i :=
nat.dvd_antisymm (by unfold gcd; exact nat.gcd_dvd_left _ _)
                 (by unfold gcd; exact nat.dvd_gcd (dvd_refl _) (nat_abs_dvd_abs_iff.mpr H))

theorem gcd_eq_right {i j : ℤ} (H : j ∣ i) : gcd i j = nat_abs j :=
by rw [gcd_comm, gcd_eq_left H]

theorem ne_zero_of_gcd {x y : ℤ}
  (hc : gcd x y ≠ 0) : x ≠ 0 ∨ y ≠ 0 :=
begin
  contrapose! hc,
  rw [hc.left, hc.right, gcd_zero_right, nat_abs_zero]
end

theorem exists_gcd_one {m n : ℤ} (H : 0 < gcd m n) :
  ∃ (m' n' : ℤ), gcd m' n' = 1 ∧ m = m' * gcd m n ∧ n = n' * gcd m n :=
⟨_, _, gcd_div_gcd_div_gcd H,
  (int.div_mul_cancel (gcd_dvd_left m n)).symm,
  (int.div_mul_cancel (gcd_dvd_right m n)).symm⟩

theorem exists_gcd_one' {m n : ℤ} (H : 0 < gcd m n) :
  ∃ (g : ℕ) (m' n' : ℤ), 0 < g ∧ gcd m' n' = 1 ∧ m = m' * g ∧ n = n' * g :=
let ⟨m', n', h⟩ := exists_gcd_one H in ⟨_, m', n', H, h⟩

theorem pow_dvd_pow_iff {m n : ℤ} {k : ℕ} (k0 : 0 < k) : m ^ k ∣ n ^ k ↔ m ∣ n :=
begin
  refine ⟨λ h, _, λ h, pow_dvd_pow_of_dvd h _⟩,
  apply int.nat_abs_dvd_abs_iff.mp,
  apply (nat.pow_dvd_pow_iff k0).mp,
  rw [← int.nat_abs_pow, ← int.nat_abs_pow],
  exact int.nat_abs_dvd_abs_iff.mpr h
end

/-! ### lcm -/

theorem lcm_comm (i j : ℤ) : lcm i j = lcm j i :=
by { rw [int.lcm, int.lcm], exact nat.lcm_comm _ _ }

theorem lcm_assoc (i j k : ℤ) : lcm (lcm i j) k = lcm i (lcm j k) :=
by { rw [int.lcm, int.lcm, int.lcm, int.lcm, nat_abs_of_nat, nat_abs_of_nat], apply nat.lcm_assoc }

@[simp] theorem lcm_zero_left (i : ℤ) : lcm 0 i = 0 :=
by { rw [int.lcm], apply nat.lcm_zero_left }

@[simp] theorem lcm_zero_right (i : ℤ) : lcm i 0 = 0 :=
by { rw [int.lcm], apply nat.lcm_zero_right }

@[simp] theorem lcm_one_left (i : ℤ) : lcm 1 i = nat_abs i :=
by { rw int.lcm, apply nat.lcm_one_left }

@[simp] theorem lcm_one_right (i : ℤ) : lcm i 1 = nat_abs i :=
by { rw int.lcm, apply nat.lcm_one_right }

@[simp] theorem lcm_self (i : ℤ) : lcm i i = nat_abs i :=
by { rw int.lcm, apply nat.lcm_self }

theorem dvd_lcm_left (i j : ℤ) : i ∣ lcm i j :=
by { rw int.lcm, apply coe_nat_dvd_right.mpr, apply nat.dvd_lcm_left }

theorem dvd_lcm_right (i j : ℤ) : j ∣ lcm i j :=
by { rw int.lcm, apply coe_nat_dvd_right.mpr, apply nat.dvd_lcm_right }

theorem lcm_dvd {i j k : ℤ}  : i ∣ k → j ∣ k → (lcm i j : ℤ) ∣ k :=
begin
  rw int.lcm,
  intros hi hj,
  exact coe_nat_dvd_left.mpr
    (nat.lcm_dvd (nat_abs_dvd_abs_iff.mpr hi) (nat_abs_dvd_abs_iff.mpr hj))
end

end int

lemma pow_gcd_eq_one {M : Type*} [monoid M] (x : M) {m n : ℕ} (hm : x ^ m = 1) (hn : x ^ n = 1) :
  x ^ m.gcd n = 1 :=
begin
  cases m, { simp only [hn, nat.gcd_zero_left] },
  obtain ⟨x, rfl⟩ : is_unit x,
  { apply is_unit_of_pow_eq_one _ _ hm m.succ_pos },
  simp only [← units.coe_pow] at *,
  rw [← units.coe_one, ← gpow_coe_nat, ← units.ext_iff] at *,
  simp only [nat.gcd_eq_gcd_ab, gpow_add, gpow_mul, hm, hn, one_gpow, one_mul]
end

lemma gcd_nsmul_eq_zero {M : Type*} [add_monoid M] (x : M) {m n : ℕ} (hm : m • x = 0)
  (hn : n • x = 0) : (m.gcd n) • x = 0 :=
begin
  apply multiplicative.of_add.injective,
  rw [of_add_nsmul, of_add_zero, pow_gcd_eq_one];
  rwa [←of_add_nsmul, ←of_add_zero, equiv.apply_eq_iff_eq]
end


-- Divisibilidad_de_cuadrado.lean
-- Si x ∈ ℕ, entonces x ∣ x^2.
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 7-octubre-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que si x ∈ ℕ, entonces
--    x ∣ x^2
-- ----------------------------------------------------------------------

import data.nat.pow
variable x : ℕ

-- 1ª demostración
-- ===============

example : x ∣ x^2 :=
begin
  rw pow_two,
  apply dvd_mul_right,
end

-- 2ª demostración
-- ===============

example : x ∣ x^2 :=
by apply dvd_mul_right


import tactic.cancel_denoms
import tactic.ring

variables {α : Type} [linear_ordered_field α] (a b c d : α)

example (h : a / 5 + b / 4 < c) : 4*a + 5*b < 20*c :=
begin
  cancel_denoms at h,
  exact h
end

example (h : a > 0) : a / 5 > 0 :=
begin
  cancel_denoms,
  exact h
end

example (h : a + b = c) : a/5 + d*(b/4) = c - 4*a/5 + b*2*d/8 - b :=
begin
  cancel_denoms,
  rw ← h,
  ring,
end


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import solutions.section14polynomials.sheet03aux_ideal

/-!

This sheet contains a couple of trickier proofs about `aux_ideal`.

Here is an explanation of the first -- igt's called `coeff_span_lift_gens`.

Say R is Noetherian, and `c ∈ aux_ideal I n`. Recall that `hR.gens (aux_ideal I n)`
is a (finite) set which spans `aux_ideal I n` as an `R`-ideal. So in particular
we know that `c` is in the span of these generators.

The claim is that if we let `T : finset R[X]` be random `lift`s of these generators to `R[X]`,
then there's a polynomial `y` in the `R`-span of these lifts such that the coefficient of `X^n`
in `y` is `c` again.

One way of doing this would be to write `c` as a finite `R`-linear combination of the generators,
and then use the corresponding finite `R`-linear combination of the lifts. But that is a pain
to code.

The proof I came up with of this uses `submodule.span_image`, which says that the span
of the image equals the image of the span. In particular, the image of the lifts is just
the generators `hR.gens (aux_ideal I n)` again, so the image of the span is `aux_ideal I n`.
The theorem says that this means that the image of the `R`-span of the lifts in `R[X]` under
the `coeff` map is `aux_ideal I n` and so our element `y` comes for free.

A key intermediate step in my proof is

have h : (hR.gens (aux_ideal I n) : set R) ⊆ (polynomial.lcoeff R n)''
    (finset.image (λ (r : R), aux_ideal.lift I n r) (hR.gens (aux_ideal I n))),

saying that the generators are a subset of the image of the lift of the generators.
I don't need to prove equality. After that it's just `submodule.span_image` and unravelling.
More precisely, `hcI` tells us that `c` is in the span of the generators,
and `ideal.span_mono` reduces us to the case that `c` is in the span
of the image under an `R`-module map of some set (namely the image of `lift`),
By `submodule.span_image` we're now done.
-/

variables {R : Type} [comm_ring R] (I : ideal (polynomial R))
variables {n : ℕ} {r : R} [decidable (r ∈ aux_ideal I n)]

open polynomial

namespace aux_ideal

lemma coeff_span_lift_gens [∀ r, decidable (r ∈ aux_ideal I n)] [decidable_eq (polynomial R)]
  (hR : is_noetherian_ring R) {c : R} (hcI : c ∈ aux_ideal I n) :
∃ (y : polynomial R), y ∈ submodule.span R ((λ (r : R), lift I n r) '' ↑(hR.gens (aux_ideal I n))) ∧
  (lcoeff R n) y = c :=
begin
  -- so c ∈ span of the generators `hR.gens`
  have h : (hR.gens (aux_ideal I n) : set R) ⊆ (polynomial.lcoeff R n)''
    (finset.image (λ (r : R), aux_ideal.lift I n r) (hR.gens (aux_ideal I n))),
  { intros r hr,
    refine ⟨lift I n r, _, lift_spec _⟩,
    { simp, refine ⟨r, hr, rfl⟩ },
    { apply hR.gens_subset _ hr } },
  rw ← hR.span_gens (aux_ideal I n) at hcI,
  replace hcI := submodule.span_mono h hcI,
  rw submodule.span_image at hcI,
  rcases hcI with ⟨y, hy⟩,
  use y,
  simpa using hy,
end

/-

The conclusion of the previous lemma says that there's some polynomial
in `submodule.span R ((λ (r : R), lift I n r) '' ↑(hR.gens (aux_ideal I n)))`.
The below lemma shows that such a polynomial has degree at most `n`, and
the reason is simply that all the generators have degree at most `n`.
To solve this one you'll need to know `submodule.span_le` from mathlib
and `lift_nat_degree_le` from a previous sheet.
-/

lemma nat_deg_le_of_mem_span_lift_gens [∀ r, decidable (r ∈ aux_ideal I n)]
  (hR : is_noetherian_ring R) {p : polynomial R}
  (hp : p ∈ submodule.span R ((λ (r : R), lift I n r) '' (hR.gens (aux_ideal I n)))) :
p.nat_degree ≤ n :=
begin
  suffices : submodule.span R ((λ (r : R), lift I n r) '' ↑(hR.gens (aux_ideal I n))) ≤ M R n,
  { exact this hp, },
  rw submodule.span_le,
  intros f hf,
  simp at hf,
  rcases hf with ⟨r, hr, rfl⟩,
  apply lift_nat_degree_le,
end

end aux_ideal


/-
Copyright (c) 2021 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import analysis.special_functions.exp
import topology.continuous_function.basic
import analysis.normed.field.unit_ball

/-!
# The circle

This file defines `circle` to be the metric sphere (`metric.sphere`) in `ℂ` centred at `0` of
radius `1`.  We equip it with the following structure:

* a submonoid of `ℂ`
* a group
* a topological group

We furthermore define `exp_map_circle` to be the natural map `λ t, exp (t * I)` from `ℝ` to
`circle`, and show that this map is a group homomorphism.

## Implementation notes

Because later (in `geometry.manifold.instances.sphere`) one wants to equip the circle with a smooth
manifold structure borrowed from `metric.sphere`, the underlying set is
`{z : ℂ | abs (z - 0) = 1}`.  This prevents certain algebraic facts from working definitionally --
for example, the circle is not defeq to `{z : ℂ | abs z = 1}`, which is the kernel of `complex.abs`
considered as a homomorphism from `ℂ` to `ℝ`, nor is it defeq to `{z : ℂ | norm_sq z = 1}`, which
is the kernel of the homomorphism `complex.norm_sq` from `ℂ` to `ℝ`.

-/

noncomputable theory

open complex metric
open_locale complex_conjugate

/-- The unit circle in `ℂ`, here given the structure of a submonoid of `ℂ`. -/
def circle : submonoid ℂ := submonoid.unit_sphere ℂ

@[simp] lemma mem_circle_iff_abs {z : ℂ} : z ∈ circle ↔ abs z = 1 := mem_sphere_zero_iff_norm

lemma circle_def : ↑circle = {z : ℂ | abs z = 1} := set.ext $ λ z, mem_circle_iff_abs

@[simp] lemma abs_coe_circle (z : circle) : abs z = 1 :=
mem_circle_iff_abs.mp z.2

lemma mem_circle_iff_norm_sq {z : ℂ} : z ∈ circle ↔ norm_sq z = 1 :=
by simp [complex.abs]

@[simp] lemma norm_sq_eq_of_mem_circle (z : circle) : norm_sq z = 1 := by simp [norm_sq_eq_abs]

lemma ne_zero_of_mem_circle (z : circle) : (z:ℂ) ≠ 0 := ne_zero_of_mem_unit_sphere z

instance : comm_group circle := metric.sphere.comm_group

@[simp] lemma coe_inv_circle (z : circle) : ↑(z⁻¹) = (z : ℂ)⁻¹ := rfl

lemma coe_inv_circle_eq_conj (z : circle) : ↑(z⁻¹) = conj (z : ℂ) :=
by rw [coe_inv_circle, inv_def, norm_sq_eq_of_mem_circle, inv_one, of_real_one, mul_one]

@[simp] lemma coe_div_circle (z w : circle) : ↑(z / w) = (z:ℂ) / w :=
circle.subtype.map_div z w

/-- The elements of the circle embed into the units. -/
def circle.to_units : circle →* units ℂ := unit_sphere_to_units ℂ

-- written manually because `@[simps]` was slow and generated the wrong lemma
@[simp] lemma circle.to_units_apply (z : circle) :
  circle.to_units z = units.mk0 z (ne_zero_of_mem_circle z) := rfl

instance : compact_space circle := metric.sphere.compact_space _ _

instance : topological_group circle := metric.sphere.topological_group

/-- If `z` is a nonzero complex number, then `conj z / z` belongs to the unit circle. -/
@[simps] def circle.of_conj_div_self (z : ℂ) (hz : z ≠ 0) : circle :=
⟨conj z / z, mem_circle_iff_abs.2 $ by rw [map_div₀, abs_conj, div_self (complex.abs.ne_zero hz)]⟩

/-- The map `λ t, exp (t * I)` from `ℝ` to the unit circle in `ℂ`. -/
def exp_map_circle : C(ℝ, circle) :=
{ to_fun := λ t, ⟨exp (t * I), by simp [exp_mul_I, abs_cos_add_sin_mul_I]⟩ }

@[simp] lemma exp_map_circle_apply (t : ℝ) : ↑(exp_map_circle t) = complex.exp (t * complex.I) :=
rfl

@[simp] lemma exp_map_circle_zero : exp_map_circle 0 = 1 :=
subtype.ext $ by rw [exp_map_circle_apply, of_real_zero, zero_mul, exp_zero, submonoid.coe_one]

@[simp] lemma exp_map_circle_add (x y : ℝ) :
  exp_map_circle (x + y) = exp_map_circle x * exp_map_circle y :=
subtype.ext $ by simp only [exp_map_circle_apply, submonoid.coe_mul, of_real_add, add_mul,
  complex.exp_add]

/-- The map `λ t, exp (t * I)` from `ℝ` to the unit circle in `ℂ`, considered as a homomorphism of
groups. -/
@[simps]
def exp_map_circle_hom : ℝ →+ (additive circle) :=
{ to_fun := additive.of_mul ∘ exp_map_circle,
  map_zero' := exp_map_circle_zero,
  map_add' := exp_map_circle_add }

@[simp] lemma exp_map_circle_sub (x y : ℝ) :
  exp_map_circle (x - y) = exp_map_circle x / exp_map_circle y :=
exp_map_circle_hom.map_sub x y

@[simp] lemma exp_map_circle_neg (x : ℝ) : exp_map_circle (-x) = (exp_map_circle x)⁻¹ :=
exp_map_circle_hom.map_neg x


import algebra.category.CommRing.basic
import algebra.ring
import tactic
import data.polynomial
import algebra.ring
import category_theory.types
import data.int.basic
universes v u
open CommRing
open is_ring_hom
open category_theory
open polynomial
open int
/--
## The goal is study the set of solution of polynomial equation in one variable ! We form a functor  V_P : CommRing → Type v
##    For all ring
##
-/

variables(R : Type v)[comm_ring R](P : polynomial ℤ)
structure V  (R: Type v)[comm_ring R] :=      --  set of solution of P(x) = 0  with x in R
(x : R)                                       --  if φ : R → R' is a ring morphism then we have application
(certif : eval₂(int.cast) (x) (P) = 0 )       --  φ : V(P)(R) → V(P(R')
@[ext]lemma ext : ∀ {ζ1 ζ2 : V P R}, ζ1.x = ζ2.x →  ζ1 = ζ2 := λ ζ1 ζ2,
begin
  cases ζ1,
  cases ζ2,
  intro h,
  congr ; try { assumption },
end
definition map_V {R : Type v} [comm_ring R] {R' : Type v}[comm_ring R'] (f : R → R') [is_ring_hom f] : (V P R) → (V P R') := λ ζ,begin
exact  {x := f ζ.x, certif :=
begin
    have H : eval₂ (f ∘ int.cast) (f ζ.x) P = f (eval₂ int.cast (ζ.x) P),
        rw ←  hom_eval₂  P  int.cast f ζ.x,
    have G : f ∘ int.cast = int.cast,
        exact (int.eq_cast') (f ∘ int.cast),
    rw G at H,
    rw H,
    have cer : eval₂ int.cast ζ.x P =0,
        exact ζ.certif,
    rw cer,
    exact map_zero f,
    end}
end
lemma map_V_comp {R : Type v} [comm_ring R] {R' : Type v}[comm_ring R'] (f : R → R') [is_ring_hom f](ζ : V P R) : (map_V P f ζ).x = f ζ.x := rfl
def V_i : CommRing ⥤ Type v :=
{ obj := λ R, V P R,
  map := λ R R' f, map_V P  f,
  map_id' := λ R, begin
    apply funext,
    intro ζ,
    ext,
    rw types_id,
    rw map_V_comp,
    exact rfl,
   end,
  map_comp' := λ R R' R'' f g,
  begin
    apply funext,
    intro ζ,
    ext,
    rw map_V_comp,
    rw types_comp,
    rw map_V_comp,
    rw map_V_comp,
    exact rfl,
 end
}
def  F :=  (V_i P).obj
#print F


-- Try giving a definition of primes.
-- Includes establishing decidability.
-- Prove infinitude of primes using factorial.

import data.nat.basic
import algebra  -- Makes simp more powerful.

def myprime (n : ℕ) := 1 < n ∧ ∀ (k : ℕ), 1 < k → k < n → ¬(k ∣ n)

@[simp]
lemma not_prime_zero : ¬ myprime 0 :=
begin
  rw myprime, simp,
end

@[simp]
lemma not_prime_one : ¬ myprime 1 :=
begin
  rw myprime, simp,
end

lemma prime_to_one_lt {n : ℕ} : myprime n → 1 < n :=
begin
  rw myprime,
  cases n, simp,
  cases n, simp,
  simp,
end

-- Couldn't find this in mathlib and it makes things simpler.
lemma nat_succ_le_iff (m n : ℕ) : m < n ↔ m.succ ≤ n :=
begin
  apply iff.intro,
    intro h,
    apply has_lt.lt.nat_succ_le,
    assumption,
  intro h,
  apply has_lt.lt.nat_succ_le,
  assumption,  -- Weird? Equal by definition?
end

@[simp]
lemma prime_two : myprime 2 :=
begin
  rw myprime,
  simp,
  intro k,
  rw nat_succ_le_iff,
  intro h1,
  -- rw nat.lt_iff_add_one_le at h1,  -- Easier way to do this?
  intro h2,
  exfalso,
  apply has_le.le.not_lt h1,
  exact h2,
end

lemma prime_three : myprime 3 :=
begin
  rw myprime, simp,
  intro k,
  rw nat_succ_le_iff,
  rw nat.lt_succ_iff,
  intro hk,
  rw has_le.le.ge_iff_eq hk,
  intro h,
  rw ← h,
  simp,
end

-- If a non-trivial divisor exists, n is not prime.
-- This is just De Morgan's law (direction that doesn't require excluded middle).
lemma exists_dvd_to_not_prime {n : ℕ}
: (∃ (k : ℕ), 1 < k ∧ k < n ∧ k ∣ n) → ¬myprime n :=
begin
  intro h,
  rw myprime,
  intro h_prime,
  cases h with w h,
  clarify,
end

-- Now try to prove decidability!
-- (find_max_factor_below n k) returns largest divisor m such that m < k.
-- (find_max_factor_below n n) gives the largest factor of n.
def find_max_factor_below : ℕ → ℕ → ℕ
| _ 0 := 0
| n (k+1) := (if k ∣ n then k else (find_max_factor_below n k))

-- (find_max_factor n) = 1 is equivalent to being prime.
def find_max_factor (n : ℕ) := find_max_factor_below n n

-- Use ite_eq_iff to prove things with ite (if-then-else).
-- Use generalize to transform propositions about ite statements.

lemma max_factor_below_eq_zero_iff {n k : ℕ} :
  find_max_factor_below n k = 0 ↔ k < 2 :=
begin
  apply iff.intro,
    cases k, simp,
    cases k, simp,
    rw nat.succ_lt_succ_iff, simp,
    induction k with j hj,
      rw find_max_factor_below, simp,
    rw find_max_factor_below,
    rw ite_eq_iff,
    simp,
    intro h',
    assumption,
  cases k,
    simp, rw find_max_factor_below,
  cases k,
    simp, rw find_max_factor_below, rw find_max_factor_below, simp,
  rw nat.succ_lt_succ_iff, simp,
end

lemma max_factor_below_dvd {n k : ℕ} :
  1 < k → find_max_factor_below n k ∣ n :=
begin
  generalize hm : find_max_factor_below n k = m,
  cases k, simp,  -- k = 0
  cases k, simp,  -- k = 1
  simp,
  induction k with j hj,
    rw ← hm, rw find_max_factor_below, simp,
  rw find_max_factor_below at hm,
  rw ite_eq_iff at hm,
  cases hm,
    rw ← hm.right,
    exact hm.left,
  apply hj,
  exact hm.right,
end

lemma max_factor_below_lt {n k : ℕ} :
  0 < k → find_max_factor_below n k < k :=
begin
  generalize hm : find_max_factor_below n k = m,
  cases k, simp,
  simp,
  revert hm,
  induction k,
    rw find_max_factor_below,
    rw ite_eq_iff,
    rw find_max_factor_below, simp,
    rw ← or_and_distrib_right, simp,
    rw @eq_comm _ m,
    simp,
  rw find_max_factor_below,
  rw ite_eq_iff,
  intro hm,
  cases hm,
    rw ← hm.right,
    apply nat.lt_succ_self,
  apply lt_trans _ (nat.lt_succ_self _),
  apply k_ih,
  exact hm.right,
end

lemma one_lt_iff {n : ℕ} : 1 < n ↔ ¬(n = 0 ∨ n = 1) :=
begin
  apply iff.intro,
    cases n, simp,
    cases n, simp,
    simp,
  cases n, simp,
  cases n, simp,
  simp,
end

lemma one_lt_max_factor_below_to_exists {n k : ℕ} :
  1 < find_max_factor_below n k → ∃ (d : ℕ), 1 < d ∧ d < k ∧ d ∣ n :=
begin
  cases k,
    rw find_max_factor_below, simp,
  cases k,
    rw find_max_factor_below, simp,
    rw find_max_factor_below, simp,
  intro h,
  apply exists.intro (find_max_factor_below n k.succ.succ),
  apply and.intro, assumption,
  apply and.intro,
    apply max_factor_below_lt, simp,
  apply max_factor_below_dvd, simp,
end

lemma one_lt_max_factor_to_not_prime {n : ℕ} :
  1 < find_max_factor n → ¬myprime n :=
begin
  rw find_max_factor,
  assume h,
  apply exists_dvd_to_not_prime,
  apply one_lt_max_factor_below_to_exists,
  assumption,
end

lemma max_factor_below_eq_one_to_not_dvd {n k : ℕ} :
  find_max_factor_below n k = 1 → ∀ (m : ℕ), 1 < m → m < k → ¬(m ∣ n) :=
begin
  cases k,  -- k = 0
    rw find_max_factor_below, simp,
  cases k,  -- k = 1
    rw find_max_factor_below, simp,
    rw find_max_factor_below, simp,
  induction k with j hj,
    rw find_max_factor_below, simp,
    intro m, intro hm, intro hm',
    exfalso,
    -- 1 < m ↔ 1.succ ≤ m
    rw ← nat.succ_le_iff at hm,
    -- 1 ≤ m ↔ ¬(m < 1)
    rw nat.lt_iff_le_not_le at hm',
    apply hm'.right,
    assumption,
  rw find_max_factor_below,
  rw ite_eq_iff,
  simp,
  intro h, intro h',
  intro m, intro hm,
  rw nat.lt_succ_iff_lt_or_eq,
  intro hm',
  cases hm',
    apply hj h' m hm hm',
  rw hm', assumption,
end

theorem max_factor_eq_one_to_prime {n : ℕ} : find_max_factor n = 1 → myprime n :=
begin
  rw find_max_factor,
  cases n,  -- n = 0
    rw find_max_factor_below, simp,
  cases n,  -- n = 1
    rw find_max_factor_below,
    rw find_max_factor_below,
    simp,
  intro h,
  rw myprime,
  apply and.intro, simp,
  apply max_factor_below_eq_one_to_not_dvd,
  assumption,
end

lemma prime_to_max_factor_below_eq_one {n : ℕ} :
  myprime n → ∀ k : ℕ, 1 < k → k ≤ n → find_max_factor_below n k = 1 :=
begin
  rw myprime,
  intro h,
  intro k,
  cases k, simp,
  cases k, simp,
  intro hk1,
  intro hkn,
  induction k,
    rw find_max_factor_below, simp,
  rw find_max_factor_below,
  rw ite_eq_iff,
  simp,
  apply and.intro,
    apply h.right,
      dec_trivial,
    apply has_le.le.trans_lt' hkn,
    apply nat.lt_succ_self,
  apply k_ih,
    dec_trivial,
  apply has_lt.lt.trans (nat.lt_succ_self _),
  assumption,
end

theorem prime_to_max_factor_eq_one {n : ℕ} : myprime n → find_max_factor n = 1 :=
begin
  rw find_max_factor,
  intro h,
  apply prime_to_max_factor_below_eq_one,
      assumption,
    exact h.left,
  simp,
end

theorem prime_iff_max_factor_eq_one {n : ℕ} : myprime n ↔ find_max_factor n = 1 :=
begin
  apply iff.intro,
    apply prime_to_max_factor_eq_one,
  apply max_factor_eq_one_to_prime,
end

instance myprime_decidable {n : ℕ} : decidable (myprime n) :=
  decidable_of_iff' _ prime_iff_max_factor_eq_one

-- Now show that any number is prime or has a prime factor.
-- Uses decidability of myprime.

lemma zero_lt_max_factor_iff {n : ℕ} : 1 < n ↔ 0 < find_max_factor n :=
begin
  rw zero_lt_iff, rw find_max_factor, simp,
  rw max_factor_below_eq_zero_iff, simp,
  trivial,
end

theorem not_prime_iff_one_lt_max_factor {n : ℕ} :
  1 < n → (¬myprime n ↔ 1 < find_max_factor n) :=
begin
  cases n, simp,
  cases n, simp,
  intro hn,
  apply iff.intro,
    rw prime_iff_max_factor_eq_one,
    intro h,
    rw one_lt_iff,
    intro h_or,
    cases h_or,
      rw zero_lt_max_factor_iff at hn,
      rw h_or at hn,
      simp at hn, trivial,
    trivial,
  intro h,
  rw myprime,
  apply exists_dvd_to_not_prime,
  -- generalize hx : find_max_factor n.succ.succ = x,
  apply exists.intro (find_max_factor n.succ.succ),
  apply and.intro, assumption,
  apply and.intro,
    rw find_max_factor,
    apply @max_factor_below_lt _ n.succ.succ _, simp,
  rw find_max_factor,
  apply @max_factor_below_dvd _ n.succ.succ _, simp,
end

-- Need to use generalize, clear and revert.
theorem prime_or_has_prime_factor (n : ℕ) :
  1 < n → (myprime n ∨ ∃ (p : ℕ), myprime p ∧ p ∣ n) :=
begin
  -- Introduce m = n.
  generalize hm_eq : n = m,
  rw eq_comm at hm_eq,
  intro hm,
  cases n, revert hm, rw hm_eq, simp,
  cases n, revert hm, rw hm_eq, simp,
  -- Replace m = n with m ≤ n.
  have hm_le := le_of_eq hm_eq,
  clear hm_eq,
  -- Include all m ≤ n in induction.
  revert m,
  induction n with k hk,
    intro m, intro hm, intro hn,
    cases nat.eq_or_lt_of_le hn,
      rw h, simp,
    exfalso,
    apply not_lt_of_ge _ h, simp,
    apply has_lt.lt.nat_succ_le, assumption,
  intro m, intro hm, intro hn,
  cases decidable.em (myprime m),
    apply or.inl, assumption,
  -- m is not prime; look at its (non-trivial) factor
  apply or.inr,
  rw not_prime_iff_one_lt_max_factor hm at h,
  have hkx := hk (find_max_factor m) h _,
    cases hkx,
      -- (find max_factor m) is prime
      apply exists.intro (find_max_factor m),
      apply and.intro, assumption,
      rw find_max_factor,
      apply max_factor_below_dvd hm,
    -- (find max_factor m) is not prime; has a prime factor
    cases hkx with w hw,
    apply exists.intro w,
    apply and.intro hw.left,
    apply dvd_trans hw.right,
    rw find_max_factor,
    apply max_factor_below_dvd hm,
  rw ← nat.succ_le_succ_iff,
  apply le_trans _ hn,
  rw nat.succ_le_iff,
  rw find_max_factor,
  apply @max_factor_below_lt m,
  apply lt_trans _ hm, simp,
end

def factorial : ℕ → ℕ
| 0 := 1
| (n+1) := (n+1) * (factorial n)

example (n : ℕ) : 0 < n → n ∣ factorial n :=
begin
  cases n, simp,
  simp,
  rw factorial,
  simp,
end

-- Want to prove ∀ (n k : ℕ) : k > 0 → k ≤ n → k ∣ factorial n
-- What's the induction that we will use?
-- factorial n = n * (factorial (n-1))
--             = n * (n-1) * (factorial (n-2))
-- k ∣ factorial k
-- k ∣ (factorial k) * (k + 1) = factorial (k+1)
lemma dvd_factorial {n k : ℕ} : 0 < k → k ≤ n → k ∣ factorial n :=
begin
  cases k, simp,
  simp,
  intro hn,
  have hn := nat.le.dest hn,
  cases hn with d hd,
  rw ← hd,
  clear hn hd n,
  induction d with j hj,
    simp, rw factorial, simp,
  rw nat.add_succ,
  rw factorial,
  apply has_dvd.dvd.mul_left,
  assumption,
end

-- Use dvd_factorial to prove not divisor of factorial + 1.
lemma not_dvd_succ_factorial {n k : ℕ} :
  1 < k → k ≤ n → ¬(k ∣ (factorial n) + 1) :=
begin
  intro hk1,
  intro hkn,
  have hk0 : 0 < k := lt_trans nat.zero_lt_one hk1,  -- Used multiple times.
  have h := dvd_factorial hk0 hkn,
  cases h with a ha,
  rw ← (nat.not_dvd_iff_between_consec_multiples (factorial n + 1) hk0),
  rw ha,
  apply exists.intro a,
  apply and.intro,
    simp,
  simp [mul_add],
  exact hk1,
end

lemma zero_lt_factorial {n : ℕ} : 0 < factorial n :=
begin
  induction n with k hk,
    rw factorial, simp,
  rw factorial, simp, assumption,
end

lemma self_le_factorial {n : ℕ} : n ≤ factorial n :=
begin
  induction n with k hk,
    rw factorial, simp,
  rw factorial, simp,
  apply has_lt.lt.nat_succ_le,
  apply zero_lt_factorial,
end

theorem infinite_primes (n : ℕ) : ∃ (p : ℕ), n < p ∧ myprime p :=
begin
  -- Consider factors of factorial + 1.
  have h_or := prime_or_has_prime_factor (factorial n).succ _,
    cases h_or,
      apply exists.intro (factorial n).succ,
      apply and.intro,
        rw nat.lt_succ_iff,
        exact self_le_factorial,
      assumption,
    cases h_or with m hm,
    apply exists.intro m,
    apply and.intro,
      cases decidable.em (m ≤ n) with h_le h_not_le,
        exfalso,
        apply not_dvd_succ_factorial _ h_le hm.right,
        apply prime_to_one_lt,
        exact hm.left,
      simp at h_not_le,
      assumption,
    exact hm.left,
  rw nat.succ_lt_succ_iff,
  apply zero_lt_factorial,
end


import tactic
import data.set data.set.finite data.finset

structure simplicial_complex := mk ::
(vertices : Type*)
(deceq : decidable_eq vertices)
(simplices : set (finset vertices))
(nonempty : ∀ {σ : (finset vertices)}, σ ∈ simplices → finset.nonempty σ)
(singleton : ∀ v : vertices, {v} ∈ simplices)
(downwards : ∀ {σ τ : (finset vertices)}, σ ∈ simplices → τ ⊆ σ → τ.nonempty → τ ∈ simplices)

namespace simplicial_complex

variable {K : simplicial_complex}

instance : decidable_eq K.vertices := K.deceq

lemma nonempty' : ¬ ((∅ : finset K.vertices) ∈ K.simplices) := λ h,
  finset.not_nonempty_empty (K.nonempty h)

def singleton_simplex (v : K.vertices) : K.simplices :=
  ⟨{v}, K.singleton v⟩

def empty : simplicial_complex := {
  vertices := empty,
  deceq := by apply_instance,
  simplices := ∅,
  nonempty := λ σ h, (set.not_mem_empty σ h).elim,
  singleton := λ v, empty.elim v,
  downwards := λ σ τ hσ hτσ hτ, (set.not_mem_empty σ hσ).elim
}

def discrete (V : Type*) [decidable_eq V] : simplicial_complex := {
  vertices := V,
  deceq := by apply_instance,
  simplices := (set.univ : set V).image (λ (v : V), {v}),
  nonempty := λ σ h, begin
    rw[set.mem_image] at h, rcases h with ⟨v, v_in_univ, rfl⟩,
    use v, exact finset.mem_singleton_self v
  end,
  singleton := λ v, ⟨v,set.mem_univ v,rfl⟩,
  downwards := λ σ τ hσ hτσ hτ, begin
    rw[set.mem_image] at hσ ⊢,
    rcases hσ with ⟨v, v_in_univ, rfl⟩,
    rcases finset.subset_singleton_iff.mp hτσ with (rfl|rfl),
    { exfalso, exact finset.not_nonempty_empty hτ },
    { exact ⟨v, set.mem_univ v, rfl⟩ }
  end
}

def indiscrete (V : Type*) [decidable_eq V] : simplicial_complex := {
  vertices := V,
  deceq := by apply_instance,
  simplices := { σ : finset V | σ.nonempty },
  nonempty := λ σ h, h,
  singleton := λ v, finset.singleton_nonempty v,
  downwards := λ σ τ hσ hτσ hτ, hτ
}

def standard (n : ℕ) : simplicial_complex := indiscrete (fin n.succ)

def dim (σ : K.simplices) : ℕ := (σ : finset K.vertices).card.pred

lemma simplex_card (σ : K.simplices) :
   (σ : finset K.vertices).card = simplicial_complex.dim σ + 1 :=
begin
  rcases σ with ⟨σ, hσ⟩,
  symmetry,
  apply nat.succ_pred_eq_of_pos, apply nat.pos_of_ne_zero,
  change σ.card ≠ 0,
  intro h,
  rw[finset.card_eq_zero.mp h] at hσ,
  exact simplicial_complex.nonempty' hσ
end

def subdim (K : simplicial_complex) (n : ℕ) :=
  ∀ (σ : K.simplices), simplicial_complex.dim σ ≤ n

def supdim (K : simplicial_complex) (n : ℕ) :=
  ∃ (σ : K.simplices), simplicial_complex.dim σ ≥ n

def dimeq (K : simplicial_complex) (n : ℕ) :=
  subdim K n ∧ supdim K n

lemma dim_standard (n : ℕ) : dimeq (standard n) n :=
begin
  split,
  { rintro ⟨σ : finset (fin n.succ),hσ⟩, change σ.card.pred ≤ n,
    have := finset.card_le_univ σ,
    rw[fintype.card_fin, ← nat.pred_le_iff] at this,
    exact this
  }, {
    let σ : { s : finset (fin n.succ) | s.nonempty } :=
      ⟨finset.univ, ⟨0, finset.mem_univ 0⟩⟩,
    use σ,
    change finset.univ.card.pred ≥ n,
    rw[finset.card_univ],
    change (fintype.card (fin n.succ)).pred ≥ n,
    rw[fintype.card_fin, nat.pred_succ],
    exact le_refl n
  }
end

structure hom (K L : simplicial_complex) := mk ::
(to_fun : K.vertices → L.vertices)
(map_simplex : ∀ {σ : finset K.vertices} (h : σ ∈ K.simplices), σ.image to_fun ∈ L.simplices)

namespace hom

def to_fun' {K L : simplicial_complex} (f : hom K L) : K.simplices → L.simplices :=
  λ σ, ⟨(σ : finset K.vertices).image f.to_fun, f.map_simplex σ.property⟩

def id (K : simplicial_complex) : hom K K := {
  to_fun := id,
  map_simplex := λ σ h, by { rw[finset.image_id], exact h }
}

lemma id' (K : simplicial_complex) : (id K).to_fun' = (_root_.id : K.simplices → K.simplices) :=
begin
  funext σ, rcases σ with ⟨σ,h⟩, ext1,
  change σ.image _root_.id = σ, rw[finset.image_id]
end

def comp {K L M : simplicial_complex} (g : hom L M) (f : hom K L) : hom K M := {
  to_fun := g.to_fun ∘ f.to_fun,
  map_simplex := λ σ h,
  begin
    rw[← finset.image_image],
    exact g.map_simplex (f.map_simplex h)
  end
}

def comp' {K L M : simplicial_complex} (g : hom L M) (f : hom K L) :
  (comp g f).to_fun' = g.to_fun' ∘ f.to_fun' :=
begin
  funext σ, rcases σ with ⟨σ,h⟩, ext1,
  rw[function.comp],
  change σ.image (g.to_fun ∘ f.to_fun) = (σ.image f.to_fun).image g.to_fun,
  rw[finset.image_image]
end

def const (K : simplicial_complex) {L : simplicial_complex} (w : L.vertices) : hom K L := {
  to_fun := function.const K.vertices w,
  map_simplex := λ σ h, by {
    rw[finset.image_const (K.nonempty h) w], exact L.singleton w
  }
}

lemma const' (K : simplicial_complex) {L : simplicial_complex} (w : L.vertices) :
  (const K w).to_fun' = function.const K.simplices (simplicial_complex.singleton_simplex w) :=
begin
  funext σ, rcases σ with ⟨σ, h⟩, ext1,
  change σ.image (function.const _ w) = {w},
  rw[finset.image_const (K.nonempty h) w]
end

end hom

end simplicial_complex


/-
Copyright (c) 2021 Bryan Gin-ge Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz, Bryan Gin-ge Chen
-/

import order.boolean_algebra

/-!
# Symmetric difference

The symmetric difference or disjunctive union of sets `A` and `B` is the set of elements that are
in either `A` or `B` but not both. Translated into propositions, the symmetric difference is `xor`.

The symmetric difference operator (`symm_diff`) is defined in this file for any type with `⊔` and
`\` via the formula `(A \ B) ⊔ (B \ A)`, however the theorems proved about it only hold for
`generalized_boolean_algebra`s and `boolean_algebra`s.

The symmetric difference is the addition operator in the Boolean ring structure on Boolean algebras.

## Main declarations

* `symm_diff`: the symmetric difference operator, defined as `(A \ B) ⊔ (B \ A)`

In generalized Boolean algebras, the symmetric difference operator is:

* `symm_diff_comm`: commutative, and
* `symm_diff_assoc`: associative.

## Notations

* `a ∆ b`: `symm_diff a b`

## References

The proof of associativity follows the note "Associativity of the Symmetric Difference of Sets: A
Proof from the Book" by John McCuan:

* <https://people.math.gatech.edu/~mccuan/courses/4317/symmetricdifference.pdf>

## Tags
boolean ring, generalized boolean algebra, boolean algebra, symmetric differences
-/

open function

/-- The symmetric difference operator on a type with `⊔` and `\` is `(A \ B) ⊔ (B \ A)`. -/
def symm_diff {α : Type*} [has_sup α] [has_sdiff α] (A B : α) : α := (A \ B) ⊔ (B \ A)

/- This notation might conflict with the Laplacian once we have it. Feel free to put it in locale
`order` or `symm_diff` if that happens. -/
infix ` ∆ `:100 := symm_diff

lemma symm_diff_def {α : Type*} [has_sup α] [has_sdiff α] (A B : α) :
  A ∆ B = (A \ B) ⊔ (B \ A) :=
rfl

lemma symm_diff_eq_xor (p q : Prop) : p ∆ q = xor p q := rfl

@[simp] lemma bool.symm_diff_eq_bxor : ∀ p q : bool, p ∆ q = bxor p q := dec_trivial

section generalized_boolean_algebra
variables {α : Type*} [generalized_boolean_algebra α] (a b c d : α)

lemma symm_diff_comm : a ∆ b = b ∆ a := by simp only [(∆), sup_comm]

instance symm_diff_is_comm : is_commutative α (∆) := ⟨symm_diff_comm⟩

@[simp] lemma symm_diff_self : a ∆ a = ⊥ := by rw [(∆), sup_idem, sdiff_self]
@[simp] lemma symm_diff_bot : a ∆ ⊥ = a := by rw [(∆), sdiff_bot, bot_sdiff, sup_bot_eq]
@[simp] lemma bot_symm_diff : ⊥ ∆ a = a := by rw [symm_diff_comm, symm_diff_bot]

lemma symm_diff_eq_sup_sdiff_inf : a ∆ b = (a ⊔ b) \ (a ⊓ b) :=
by simp [sup_sdiff, sdiff_inf, sup_comm, (∆)]

@[simp] lemma sup_sdiff_symm_diff : (a ⊔ b) \ (a ∆ b) = a ⊓ b :=
sdiff_eq_symm inf_le_sup (by rw symm_diff_eq_sup_sdiff_inf)

lemma disjoint_symm_diff_inf : disjoint (a ∆ b) (a ⊓ b) :=
begin
  rw [symm_diff_eq_sup_sdiff_inf],
  exact disjoint_sdiff_self_left,
end

lemma symm_diff_le_sup : a ∆ b ≤ a ⊔ b := by { rw symm_diff_eq_sup_sdiff_inf, exact sdiff_le }

lemma inf_symm_diff_distrib_left : a ⊓ (b ∆ c) = (a ⊓ b) ∆ (a ⊓ c) :=
by rw [symm_diff_eq_sup_sdiff_inf, inf_sdiff_distrib_left, inf_sup_left, inf_inf_distrib_left,
  symm_diff_eq_sup_sdiff_inf]

lemma inf_symm_diff_distrib_right : (a ∆ b) ⊓ c = (a ⊓ c) ∆ (b ⊓ c) :=
by simp_rw [@inf_comm _ _ _ c, inf_symm_diff_distrib_left]

lemma sdiff_symm_diff : c \ (a ∆ b) = (c ⊓ a ⊓ b) ⊔ ((c \ a) ⊓ (c \ b)) :=
by simp only [(∆), sdiff_sdiff_sup_sdiff']

lemma sdiff_symm_diff' : c \ (a ∆ b) = (c ⊓ a ⊓ b) ⊔ (c \ (a ⊔ b)) :=
by rw [sdiff_symm_diff, sdiff_sup, sup_comm]

lemma symm_diff_sdiff : (a ∆ b) \ c = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) :=
by rw [symm_diff_def, sup_sdiff, sdiff_sdiff_left, sdiff_sdiff_left]

@[simp] lemma symm_diff_sdiff_left : (a ∆ b) \ a = b \ a :=
by rw [symm_diff_def, sup_sdiff, sdiff_idem, sdiff_sdiff_self, bot_sup_eq]

@[simp] lemma symm_diff_sdiff_right : (a ∆ b) \ b = a \ b :=
by rw [symm_diff_comm, symm_diff_sdiff_left]

@[simp] lemma sdiff_symm_diff_self : a \ (a ∆ b) = a ⊓ b := by simp [sdiff_symm_diff]

lemma symm_diff_eq_iff_sdiff_eq {a b c : α} (ha : a ≤ c) :
  a ∆ b = c ↔ c \ a = b :=
begin
  split; intro h,
  { have hba : disjoint (a ⊓ b) c := begin
      rw [←h, disjoint.comm],
      exact disjoint_symm_diff_inf _ _,
    end,
    have hca : _ := congr_arg (\ a) h,
    rw [symm_diff_sdiff_left] at hca,
    rw [←hca, sdiff_eq_self_iff_disjoint],
    exact hba.of_disjoint_inf_of_le ha },
  { have hd : disjoint a b := by { rw ←h, exact disjoint_sdiff_self_right },
    rw [symm_diff_def, hd.sdiff_eq_left, hd.sdiff_eq_right, ←h, sup_sdiff_cancel_right ha] }
end

lemma disjoint.symm_diff_eq_sup {a b : α} (h : disjoint a b) : a ∆ b = a ⊔ b :=
by rw [(∆), h.sdiff_eq_left, h.sdiff_eq_right]

lemma symm_diff_eq_sup : a ∆ b = a ⊔ b ↔ disjoint a b :=
begin
  split; intro h,
  { rw [symm_diff_eq_sup_sdiff_inf, sdiff_eq_self_iff_disjoint] at h,
    exact h.of_disjoint_inf_of_le le_sup_left, },
  { exact h.symm_diff_eq_sup, },
end

@[simp] lemma le_symm_diff_iff_left : a ≤ a ∆ b ↔ disjoint a b :=
begin
  refine ⟨λ h, _, λ h, h.symm_diff_eq_sup.symm ▸ le_sup_left⟩,
  rw symm_diff_eq_sup_sdiff_inf at h,
  exact (le_sdiff_iff.1 $ inf_le_of_left_le h).le,
end

@[simp] lemma le_symm_diff_iff_right : b ≤ a ∆ b ↔ disjoint a b :=
by rw [symm_diff_comm, le_symm_diff_iff_left, disjoint.comm]

lemma symm_diff_symm_diff_left :
  a ∆ b ∆ c = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) ⊔ (c \ (a ⊔ b)) ⊔ (a ⊓ b ⊓ c) :=
calc a ∆ b ∆ c = ((a ∆ b) \ c) ⊔ (c \ (a ∆ b))   : symm_diff_def _ _
           ... = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) ⊔
                   ((c \ (a ⊔ b)) ⊔ (c ⊓ a ⊓ b)) :
                                by rw [sdiff_symm_diff', @sup_comm _ _ (c ⊓ a ⊓ b), symm_diff_sdiff]
           ... = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) ⊔
                   (c \ (a ⊔ b)) ⊔ (a ⊓ b ⊓ c)   : by ac_refl

lemma symm_diff_symm_diff_right :
  a ∆ (b ∆ c) = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) ⊔ (c \ (a ⊔ b)) ⊔ (a ⊓ b ⊓ c) :=
calc a ∆ (b ∆ c) = (a \ (b ∆ c)) ⊔ ((b ∆ c) \ a) : symm_diff_def _ _
             ... = (a \ (b ⊔ c)) ⊔ (a ⊓ b ⊓ c) ⊔
                     (b \ (c ⊔ a) ⊔ c \ (b ⊔ a))   :
                                by rw [sdiff_symm_diff', @sup_comm _ _ (a ⊓ b ⊓ c), symm_diff_sdiff]
             ... = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) ⊔
                     (c \ (a ⊔ b)) ⊔ (a ⊓ b ⊓ c)   : by ac_refl

@[simp] lemma symm_diff_symm_diff_inf : a ∆ b ∆ (a ⊓ b) = a ⊔ b :=
by rw [symm_diff_eq_iff_sdiff_eq (symm_diff_le_sup _ _), sup_sdiff_symm_diff]

@[simp] lemma inf_symm_diff_symm_diff : (a ⊓ b) ∆ (a ∆ b) = a ⊔ b :=
by rw [symm_diff_comm, symm_diff_symm_diff_inf]

lemma symm_diff_triangle : a ∆ c ≤ a ∆ b ⊔ b ∆ c :=
begin
  refine (sup_le_sup (sdiff_triangle a b c) $ sdiff_triangle _ b _).trans_eq _,
  rw [@sup_comm _ _ (c \ b), sup_sup_sup_comm],
  refl,
end

lemma symm_diff_assoc : a ∆ b ∆ c = a ∆ (b ∆ c) :=
by rw [symm_diff_symm_diff_left, symm_diff_symm_diff_right]

instance symm_diff_is_assoc : is_associative α (∆) := ⟨symm_diff_assoc⟩

lemma symm_diff_left_comm : a ∆ (b ∆ c) = b ∆ (a ∆ c) :=
by simp_rw [←symm_diff_assoc, symm_diff_comm]

lemma symm_diff_right_comm : a ∆ b ∆ c = a ∆ c ∆ b := by simp_rw [symm_diff_assoc, symm_diff_comm]

lemma symm_diff_symm_diff_symm_diff_comm : (a ∆ b) ∆ (c ∆ d) = (a ∆ c) ∆ (b ∆ d) :=
by simp_rw [symm_diff_assoc, symm_diff_left_comm]

@[simp] lemma symm_diff_symm_diff_cancel_left : a ∆ (a ∆ b) = b := by simp [←symm_diff_assoc]
@[simp] lemma symm_diff_symm_diff_cancel_right : b ∆ a ∆ a = b := by simp [symm_diff_assoc]

@[simp] lemma symm_diff_symm_diff_self' : a ∆ b ∆ a = b :=
by rw [symm_diff_comm,symm_diff_symm_diff_cancel_left]

lemma symm_diff_left_involutive (a : α) : involutive (∆ a) := symm_diff_symm_diff_cancel_right _
lemma symm_diff_right_involutive (a : α) : involutive ((∆) a) := symm_diff_symm_diff_cancel_left _
lemma symm_diff_left_injective (a : α) : injective (∆ a) := (symm_diff_left_involutive _).injective
lemma symm_diff_right_injective (a : α) : injective ((∆) a) :=
(symm_diff_right_involutive _).injective
lemma symm_diff_left_surjective (a : α) : surjective (∆ a) :=
(symm_diff_left_involutive _).surjective
lemma symm_diff_right_surjective (a : α) : surjective ((∆) a) :=
(symm_diff_right_involutive _).surjective

variables {a b c}

@[simp] lemma symm_diff_left_inj : a ∆ b = c ∆ b ↔ a = c := (symm_diff_left_injective _).eq_iff
@[simp] lemma symm_diff_right_inj : a ∆ b = a ∆ c ↔ b = c := (symm_diff_right_injective _).eq_iff

@[simp] lemma symm_diff_eq_left : a ∆ b = a ↔ b = ⊥ :=
calc a ∆ b = a ↔ a ∆ b = a ∆ ⊥ : by rw symm_diff_bot
           ... ↔     b = ⊥     : by rw symm_diff_right_inj

@[simp] lemma symm_diff_eq_right : a ∆ b = b ↔ a = ⊥ := by rw [symm_diff_comm, symm_diff_eq_left]

@[simp] lemma symm_diff_eq_bot : a ∆ b = ⊥ ↔ a = b :=
calc a ∆ b = ⊥ ↔ a ∆ b = a ∆ a : by rw symm_diff_self
           ... ↔     a = b     : by rw [symm_diff_right_inj, eq_comm]

protected lemma disjoint.symm_diff_left (ha : disjoint a c) (hb : disjoint b c) :
  disjoint (a ∆ b) c :=
by { rw symm_diff_eq_sup_sdiff_inf, exact (ha.sup_left hb).disjoint_sdiff_left }

protected lemma disjoint.symm_diff_right (ha : disjoint a b) (hb : disjoint a c) :
  disjoint a (b ∆ c) :=
(ha.symm.symm_diff_left hb.symm).symm

end generalized_boolean_algebra

section boolean_algebra
variables {α : Type*} [boolean_algebra α] (a b c : α)

lemma symm_diff_eq : a ∆ b = (a ⊓ bᶜ) ⊔ (b ⊓ aᶜ) := by simp only [(∆), sdiff_eq]

@[simp] lemma symm_diff_top : a ∆ ⊤ = aᶜ := by simp [symm_diff_eq]
@[simp] lemma top_symm_diff : ⊤ ∆ a = aᶜ := by rw [symm_diff_comm, symm_diff_top]

lemma compl_symm_diff : (a ∆ b)ᶜ = (a ⊓ b) ⊔ (aᶜ ⊓ bᶜ) :=
by simp only [←top_sdiff, sdiff_symm_diff, top_inf_eq]

lemma symm_diff_eq_top_iff : a ∆ b = ⊤ ↔ is_compl a b :=
by rw [symm_diff_eq_iff_sdiff_eq le_top, top_sdiff, compl_eq_iff_is_compl]

lemma is_compl.symm_diff_eq_top (h : is_compl a b) : a ∆ b = ⊤ := (symm_diff_eq_top_iff a b).2 h

@[simp] lemma compl_symm_diff_self : aᶜ ∆ a = ⊤ :=
by simp only [symm_diff_eq, compl_compl, inf_idem, compl_sup_eq_top]

@[simp] lemma symm_diff_compl_self : a ∆ aᶜ = ⊤ := by rw [symm_diff_comm, compl_symm_diff_self]

lemma symm_diff_symm_diff_right' :
  a ∆ (b ∆ c) = (a ⊓ b ⊓ c) ⊔ (a ⊓ bᶜ ⊓ cᶜ) ⊔ (aᶜ ⊓ b ⊓ cᶜ) ⊔ (aᶜ ⊓ bᶜ ⊓ c) :=
calc a ∆ (b ∆ c) = (a ⊓ ((b ⊓ c) ⊔ (bᶜ ⊓ cᶜ))) ⊔
                     (((b ⊓ cᶜ) ⊔ (c ⊓ bᶜ)) ⊓ aᶜ)  : by rw [symm_diff_eq, compl_symm_diff,
                                                            symm_diff_eq]
             ... = (a ⊓ b ⊓ c) ⊔ (a ⊓ bᶜ ⊓ cᶜ) ⊔
                     (b ⊓ cᶜ ⊓ aᶜ) ⊔ (c ⊓ bᶜ ⊓ aᶜ) : by rw [inf_sup_left, inf_sup_right,
                                                            ←sup_assoc, ←inf_assoc, ←inf_assoc]
             ... = (a ⊓ b ⊓ c) ⊔ (a ⊓ bᶜ ⊓ cᶜ) ⊔
                     (aᶜ ⊓ b ⊓ cᶜ) ⊔ (aᶜ ⊓ bᶜ ⊓ c) : begin
                                                       congr' 1,
                                                       { congr' 1,
                                                         rw [inf_comm, inf_assoc], },
                                                       { apply inf_left_right_swap }
                                                     end

end boolean_algebra


import tactic
import data.set.finite
import data.real.basic -- for metrics
import .topologia
import .bases

open set
open topological_space

/- # Metric spaces -/
noncomputable theory

class metric_space_basic (X : Type) :=
  (dist : X → X → ℝ)
  (dist_eq_zero_iff : ∀ x y, dist x y = 0 ↔ x = y)
  (dist_symm : ∀ x y, dist x y = dist y x)
  (triangle : ∀ x y z, dist x z ≤ dist x y + dist y z)

namespace metric_space_basic

@[simp]
lemma dist_eq_zero_iff' {X : Type} (x y : X) [metric_space_basic X] :
  dist x y = 0 ↔ x = y := dist_eq_zero_iff x y

lemma dist_nonneg {X : Type} [metric_space_basic X] (x y : X) : 0 ≤ dist x y :=
begin
  have h1 : dist x x = 0,
    rw (dist_eq_zero_iff x x).2, refl,
  suffices : 0 ≤ dist x y + dist x y,
  { linarith },
  rw ← h1,
  nth_rewrite_rhs 1 dist_symm x y,
  exact triangle _ _ _,
end

@[simp]
lemma dist_self_zero {X : Type} [metric_space_basic X] {x : X} : dist x x = 0 := by simp

def ball {X : Type} [metric_space_basic X] (x : X) (r : ℝ) := {y | dist x y < r}

@[simp]
lemma ball_def {X : Type} [metric_space_basic X] (x : X) (r : ℝ) : ball x r = { y | dist x y < r} := rfl

@[simp]
lemma mem_center_ball_iff {X : Type} [metric_space_basic X] {x : X} {r : ℝ} :
  x ∈ ball x r ↔ 0 < r :=
begin
  split;
  { exact λ h, by simpa using h },
end

lemma ball_subset_ball {X : Type} [metric_space_basic X] {x : X} {r s : ℝ} (h : r ≤ s) :
  ball x r ⊆ ball x s :=
begin
  simp,
  intros a ha,
  linarith,
end

@[simp]
lemma ball_nonempty_iff {X : Type} [metric_space_basic X] {x : X} {r : ℝ} :
  ball x r ≠ ∅ ↔ 0 < r :=
begin
  simp,
  split,
  {
    intro h,
    obtain ⟨z, hz⟩ := h,
    have H := dist_nonneg x z,
    linarith,
  },
  {
    intro h,
    use x,
    rw dist_self_zero,
    exact h,
  }
end

lemma ball_around_interior_point {X : Type} [metric_space_basic X] {r : ℝ}
  {x y : X} (h: y ∈ ball x r) : ∃ s, 0 < s ∧ ball y s ⊆ ball x r :=
begin
  have : 0 < r,
  {
    have hne : ball x r ≠ ∅,
    {
      unfold ball,
      simp,
      use y,
      simpa using h,
    },
    apply (@ball_nonempty_iff X _ x r).1 hne,
  },
  use r - dist x y,
  split,
  { simpa using h },
  {
    simp,
    intros a ha,
    replace ha : dist x y + dist y a < r,
    { linarith },
    calc dist x a ≤ dist x y + dist y a : triangle x y a
      ... < r : ha,
  }
end

lemma balls_form_basis {X : Type} [metric_space_basic X] :
 basis_condition { B | ∃ (x : X) r, B = {y | dist x y < r} } :=
begin
  fconstructor,
  {
    intro x,
    simp,
    use {y | dist x y < 1},
    use x, use 1,
    simp [dist_eq_zero_iff],
  },
  {
    intros U V hU hV,
    obtain ⟨x, r, hU⟩ := hU,
    obtain ⟨y, s, hV⟩ := hV,
    subst hU, subst hV,
    intros z hz,
    -- here is the proof that if z in B x r ∩ B y s then one can find some ball B ⊆ B x r ∩ B y s
    simp at hz,
    use ball z (min (r - dist x z) (s - dist y z)),
    simp,
    split,
    {
      use z, use (min (r - dist x z) (s - dist y z)),
      simp,
    },
    {
      split,
      { assumption },
      split,
      {
        intros a ha1 ha2,
        calc dist x a ≤ dist x z + dist z a : triangle x z a
            ... < r : lt_sub_iff_add_lt'.mp ha1,
      },
      {
        intros a ha1 ha2,
        calc dist y a ≤ dist y z + dist z a : triangle y z a
          ... < s : lt_sub_iff_add_lt'.mp ha2,
      },
    }
  }
end

lemma metric_space_is_open_compatible {X : Type} [metric_space_basic X] {U : set X} :
@is_open X (generate_from_basis balls_form_basis) U ↔
(∀ x ∈ U, ∃ r, 0 < r ∧ {y | dist x y < r} ⊆ U) :=
begin
  simp [generate_from_basis_open_iff'],
  split,
  {
    intros h x hx,
    specialize h x hx,
    obtain ⟨B, ⟨⟨z, h, hB⟩, ⟨hz1, hz2⟩⟩⟩ := h,
    subst hB,
    simp at hz1 hz2,
    obtain ⟨s, hs, hsr⟩ := ball_around_interior_point hz1,
    use s,
    split,
    { exact hs },
    rw ←ball_def at hz2 ⊢,
    exact subset.trans hsr hz2,
  },
  {
    intros h x hx,
    obtain ⟨r, hr1, hr2⟩ := h x hx,
    use {y : X | dist x y < r},
    use x, use r,
    simp,
    tauto,
  }
end

end metric_space_basic

open metric_space_basic

instance prod.metric_space_basic (X Y : Type) [metric_space_basic X] [metric_space_basic Y] :
metric_space_basic (X × Y) :=
{ dist := λ u v, max (dist u.fst v.fst) (dist u.snd v.snd),
  dist_eq_zero_iff :=
  begin
    intro xy1,
    intro xy2,
    split,
    {
      intro h,
      have h1: dist xy1.fst xy2.fst ≥ 0 := dist_nonneg _ _,
      have h2: dist xy1.snd xy2.snd ≥ 0 := dist_nonneg _ _,
      have h3: dist xy1.fst xy2.fst = 0,
      begin
        have h5 : max (dist xy1.fst xy2.fst) (dist xy1.snd xy2.snd) ≤ 0 :=
          by linarith,
        have h4 := max_le_iff.mp h5,
        linarith,
      end,

      have h6: dist xy1.snd xy2.snd = 0,
      begin
        have h5 : max (dist xy1.fst xy2.fst) (dist xy1.snd xy2.snd) ≤ 0 := by linarith,
        have h4 := max_le_iff.mp h5,
        linarith,
      end,
      ext;
      {
        rw [←dist_eq_zero_iff _ _],
        tauto,
      },
     },
    {
      intro h,
      subst h,
      rw (dist_eq_zero_iff xy1.fst xy1.fst).mpr (refl _),
      rw (dist_eq_zero_iff xy1.snd xy1.snd).mpr (refl _),
      exact max_self 0,
    },
  end,
  dist_symm :=
  begin
    intros xy1 xy2,
    simp only [dist_symm],
  end,
  triangle :=
   begin
    intros x y z,
    let  xy_X := (dist x.fst y.fst),
    let  yz_X := (dist y.fst z.fst),
    let  xy_Y := (dist x.snd y.snd),
    let  yz_Y :=  (dist y.snd z.snd),

    -- We introduce a refinement.
    calc  max (dist x.fst z.fst) (dist x.snd z.snd) ≤ (max (xy_X + yz_X) ( xy_Y + yz_Y)): by { apply max_le_max; exact triangle _ _ _ }
        ... ≤ max (dist x.fst y.fst) (dist x.snd y.snd) + max (dist y.fst z.fst) (dist y.snd z.snd):
     begin
      refine max_le_iff.mpr _,
      split;
      {
        apply add_le_add;
        finish,
      },
    end,
   end,
}

@[simp]
lemma prod_balls_def (X Y : Type) [metric_space_basic X] [metric_space_basic Y] {x : X} {y : Y} {r : ℝ} :
  (ball x r).prod (ball y r) = ball (x,y) r :=
begin
  unfold ball,
  unfold dist,
  ext,
  simp,
end

@[simp]
lemma prod_balls_def' (X Y : Type) [metric_space_basic X] [metric_space_basic Y] {x : X} {y : Y} {r : ℝ} :
  {z | dist x z < r}.prod {z | dist y z < r} = {z | dist (x,y) z < r} :=
begin
  ext,
  unfold dist,
  simp,
end

class metric_space (X : Type) extends topological_space X, metric_space_basic X :=
  (compatible : ∀ (U : set X), is_open U ↔ (∀ x ∈ U, ∃ r, 0 < r ∧ {y | dist x y < r} ⊆ U))

namespace metric_space

open topological_space

/-
We would still like a way of making a `metric_space` just given a metric and some
properties it satisfies, i.e. a `metric_space_basic`, so we should setup a metric space
constructor from a `metric_space_basic` by setting the topology to be the induced one. -/

def of_basic {X : Type} (m : metric_space_basic X) : metric_space X :=
{ compatible := begin
  intros,
  rw generate_from_basis_open_iff',
  simp,
  split,
  all_goals {
    intro h,
    intros x hx,
  },
  {
    obtain ⟨B, ⟨a, r, har⟩, ⟨hB1, hB2⟩⟩ := h x hx,
    subst har,
    use (r - dist a x),
    simp at hB1 hB2,
    split,
    { linarith [hB1] },
    {
      apply subset.trans _ hB2,
      simp,
      intros z hz,
      calc dist a z ≤ dist a x + dist x z : triangle a x z
      ... < r : lt_sub_iff_add_lt'.mp hz,
    }
  },
  {
    obtain ⟨r, hr, hU⟩ := h x hx,
    use {y | dist x y < r},
    use x, use r,
    simp,
    split;
    simp [hr, hU],
  }
 end,
  ..m,
  ..generate_from_basis balls_form_basis
}

/-- Open balls are open -/
lemma open_of_ball {X : Type} [metric_space X] {x : X} {r : ℝ} :
  is_open (ball x r) :=
begin

  have H:= @generate_from_basis_open_iff' X _ balls_form_basis {y : X | dist x y < r},
  rw [ball_def, compatible, ←metric_space_is_open_compatible, H],
  intros y hy,
  use {y : X | dist x y < r},
  use x, use r,
  { tauto },
end

end metric_space


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Neil Strickland
-/
import data.nat.basic

/-!
# The positive natural numbers

This file defines the type `ℕ+` or `pnat`, the subtype of natural numbers that are positive.
-/

/-- `ℕ+` is the type of positive natural numbers. It is defined as a subtype,
  and the VM representation of `ℕ+` is the same as `ℕ` because the proof
  is not stored. -/
def pnat := {n : ℕ // 0 < n}
notation `ℕ+` := pnat

instance coe_pnat_nat : has_coe ℕ+ ℕ := ⟨subtype.val⟩
instance : has_repr ℕ+ := ⟨λ n, repr n.1⟩

/-- Predecessor of a `ℕ+`, as a `ℕ`. -/
def pnat.nat_pred (i : ℕ+) : ℕ := i - 1

@[simp] lemma pnat.one_add_nat_pred (n : ℕ+) : 1 + n.nat_pred = n :=
by rw [pnat.nat_pred, add_tsub_cancel_iff_le.mpr $ show 1 ≤ (n : ℕ), from n.2]

@[simp] lemma pnat.nat_pred_add_one (n : ℕ+) : n.nat_pred + 1 = n :=
(add_comm _ _).trans n.one_add_nat_pred

@[simp] lemma pnat.nat_pred_eq_pred {n : ℕ} (h : 0 < n) :
pnat.nat_pred (⟨n, h⟩ : ℕ+) = n.pred := rfl

namespace nat

/-- Convert a natural number to a positive natural number. The
  positivity assumption is inferred by `dec_trivial`. -/
def to_pnat (n : ℕ) (h : 0 < n . tactic.exact_dec_trivial) : ℕ+ := ⟨n, h⟩

/-- Write a successor as an element of `ℕ+`. -/
def succ_pnat (n : ℕ) : ℕ+ := ⟨succ n, succ_pos n⟩

@[simp] theorem succ_pnat_coe (n : ℕ) : (succ_pnat n : ℕ) = succ n := rfl

theorem succ_pnat_inj {n m : ℕ} : succ_pnat n = succ_pnat m → n = m :=
λ h, by { let h' := congr_arg (coe : ℕ+ → ℕ) h, exact nat.succ.inj h' }

/-- Convert a natural number to a pnat. `n+1` is mapped to itself,
  and `0` becomes `1`. -/
def to_pnat' (n : ℕ) : ℕ+ := succ_pnat (pred n)

@[simp] theorem to_pnat'_coe : ∀ (n : ℕ),
 ((to_pnat' n) : ℕ) = ite (0 < n) n 1
| 0 := rfl
| (m + 1) := by {rw [if_pos (succ_pos m)], refl}

end nat

namespace pnat

open nat

/-- We now define a long list of structures on ℕ+ induced by
 similar structures on ℕ. Most of these behave in a completely
 obvious way, but there are a few things to be said about
 subtraction, division and powers.
-/

instance : decidable_eq ℕ+ := λ (a b : ℕ+), by apply_instance

instance : linear_order ℕ+ :=
subtype.linear_order _

@[simp] lemma mk_le_mk (n k : ℕ) (hn : 0 < n) (hk : 0 < k) :
  (⟨n, hn⟩ : ℕ+) ≤ ⟨k, hk⟩ ↔ n ≤ k := iff.rfl

@[simp] lemma mk_lt_mk (n k : ℕ) (hn : 0 < n) (hk : 0 < k) :
  (⟨n, hn⟩ : ℕ+) < ⟨k, hk⟩ ↔ n < k := iff.rfl

@[simp, norm_cast] lemma coe_le_coe (n k : ℕ+) : (n : ℕ) ≤ k ↔ n ≤ k := iff.rfl

@[simp, norm_cast] lemma coe_lt_coe (n k : ℕ+) : (n : ℕ) < k ↔ n < k := iff.rfl

@[simp] theorem pos (n : ℕ+) : 0 < (n : ℕ) := n.2

-- see note [fact non_instances]
lemma fact_pos (n : ℕ+) : fact (0 < ↑n) := ⟨n.pos⟩

theorem eq {m n : ℕ+} : (m : ℕ) = n → m = n := subtype.eq

@[simp] lemma coe_inj {m n : ℕ+} : (m : ℕ) = n ↔ m = n := set_coe.ext_iff

lemma coe_injective : function.injective (coe : ℕ+ → ℕ) := subtype.coe_injective

@[simp] theorem mk_coe (n h) : ((⟨n, h⟩ : ℕ+) : ℕ) = n := rfl

instance : has_add ℕ+ := ⟨λ a b, ⟨(a  + b : ℕ), add_pos a.pos b.pos⟩⟩

instance : add_comm_semigroup ℕ+ := coe_injective.add_comm_semigroup coe (λ _ _, rfl)

@[simp] theorem add_coe (m n : ℕ+) : ((m + n : ℕ+) : ℕ) = m + n := rfl

/-- `pnat.coe` promoted to an `add_hom`, that is, a morphism which preserves addition. -/
def coe_add_hom : add_hom ℕ+ ℕ :=
{ to_fun := coe,
  map_add' := add_coe }

instance : add_left_cancel_semigroup ℕ+ :=
coe_injective.add_left_cancel_semigroup coe (λ _ _, rfl)

instance : add_right_cancel_semigroup ℕ+ :=
coe_injective.add_right_cancel_semigroup coe (λ _ _, rfl)

@[simp] theorem ne_zero (n : ℕ+) : (n : ℕ) ≠ 0 := n.2.ne'

theorem to_pnat'_coe {n : ℕ} : 0 < n → (n.to_pnat' : ℕ) = n := succ_pred_eq_of_pos

@[simp] theorem coe_to_pnat' (n : ℕ+) : (n : ℕ).to_pnat' = n := eq (to_pnat'_coe n.pos)

instance : has_mul ℕ+ := ⟨λ m n, ⟨m.1 * n.1, mul_pos m.2 n.2⟩⟩
instance : has_one ℕ+ := ⟨succ_pnat 0⟩

instance : comm_monoid ℕ+ := coe_injective.comm_monoid coe rfl (λ _ _, rfl)

theorem lt_add_one_iff : ∀ {a b : ℕ+}, a < b + 1 ↔ a ≤ b :=
λ a b, nat.lt_add_one_iff

theorem add_one_le_iff : ∀ {a b : ℕ+}, a + 1 ≤ b ↔ a < b :=
λ a b, nat.add_one_le_iff

@[simp] lemma one_le (n : ℕ+) : (1 : ℕ+) ≤ n := n.2

instance : order_bot ℕ+ :=
{ bot := 1,
  bot_le := λ a, a.property }

@[simp] lemma bot_eq_one : (⊥ : ℕ+) = 1 := rfl

instance : inhabited ℕ+ := ⟨1⟩

-- Some lemmas that rewrite `pnat.mk n h`, for `n` an explicit numeral, into explicit numerals.
@[simp] lemma mk_one {h} : (⟨1, h⟩ : ℕ+) = (1 : ℕ+) := rfl
@[simp] lemma mk_bit0 (n) {h} : (⟨bit0 n, h⟩ : ℕ+) = (bit0 ⟨n, pos_of_bit0_pos h⟩ : ℕ+) := rfl
@[simp] lemma mk_bit1 (n) {h} {k} : (⟨bit1 n, h⟩ : ℕ+) = (bit1 ⟨n, k⟩ : ℕ+) := rfl

-- Some lemmas that rewrite inequalities between explicit numerals in `ℕ+`
-- into the corresponding inequalities in `ℕ`.
-- TODO: perhaps this should not be attempted by `simp`,
-- and instead we should expect `norm_num` to take care of these directly?
-- TODO: these lemmas are perhaps incomplete:
-- * 1 is not represented as a bit0 or bit1
-- * strict inequalities?
@[simp] lemma bit0_le_bit0 (n m : ℕ+) : (bit0 n) ≤ (bit0 m) ↔ (bit0 (n : ℕ)) ≤ (bit0 (m : ℕ)) :=
iff.rfl
@[simp] lemma bit0_le_bit1 (n m : ℕ+) : (bit0 n) ≤ (bit1 m) ↔ (bit0 (n : ℕ)) ≤ (bit1 (m : ℕ)) :=
iff.rfl
@[simp] lemma bit1_le_bit0 (n m : ℕ+) : (bit1 n) ≤ (bit0 m) ↔ (bit1 (n : ℕ)) ≤ (bit0 (m : ℕ)) :=
iff.rfl
@[simp] lemma bit1_le_bit1 (n m : ℕ+) : (bit1 n) ≤ (bit1 m) ↔ (bit1 (n : ℕ)) ≤ (bit1 (m : ℕ)) :=
iff.rfl

@[simp] theorem one_coe : ((1 : ℕ+) : ℕ) = 1 := rfl
@[simp] theorem mul_coe (m n : ℕ+) : ((m * n : ℕ+) : ℕ) = m * n := rfl

/-- `pnat.coe` promoted to a `monoid_hom`. -/
def coe_monoid_hom : ℕ+ →* ℕ :=
{ to_fun := coe,
  map_one' := one_coe,
  map_mul' := mul_coe }

@[simp] lemma coe_coe_monoid_hom : (coe_monoid_hom : ℕ+ → ℕ) = coe := rfl

@[simp]
lemma coe_eq_one_iff {m : ℕ+} :
(m : ℕ) = 1 ↔ m = 1 := by { split; intro h; try { apply pnat.eq}; rw h; simp }

@[simp] lemma coe_bit0 (a : ℕ+) : ((bit0 a : ℕ+) : ℕ) = bit0 (a : ℕ) := rfl
@[simp] lemma coe_bit1 (a : ℕ+) : ((bit1 a : ℕ+) : ℕ) = bit1 (a : ℕ) := rfl

@[simp] theorem pow_coe (m : ℕ+) (n : ℕ) : ((m ^ n : ℕ+) : ℕ) = (m : ℕ) ^ n :=
by induction n with n ih;
 [refl, rw [pow_succ', pow_succ, mul_coe, mul_comm, ih]]

instance : ordered_cancel_comm_monoid ℕ+ :=
{ mul_le_mul_left := by { intros, apply nat.mul_le_mul_left, assumption },
  le_of_mul_le_mul_left := by { intros a b c h, apply nat.le_of_mul_le_mul_left h a.property, },
  mul_left_cancel := λ a b c h, by
 { replace h := congr_arg (coe : ℕ+ → ℕ) h,
   exact eq ((nat.mul_right_inj a.pos).mp h)},
  .. pnat.comm_monoid,
  .. pnat.linear_order }

instance : distrib ℕ+ := coe_injective.distrib coe (λ _ _, rfl) (λ _ _, rfl)

/-- Subtraction a - b is defined in the obvious way when
  a > b, and by a - b = 1 if a ≤ b.
-/
instance : has_sub ℕ+ := ⟨λ a b, to_pnat' (a - b : ℕ)⟩

theorem sub_coe (a b : ℕ+) : ((a - b : ℕ+) : ℕ) = ite (b < a) (a - b : ℕ) 1 :=
begin
  change ((to_pnat' ((a : ℕ) - (b :  ℕ)) : ℕ)) =
    ite ((a : ℕ) > (b : ℕ)) ((a : ℕ) - (b : ℕ)) 1,
  split_ifs with h,
  { exact to_pnat'_coe (tsub_pos_of_lt h) },
  { rw [tsub_eq_zero_iff_le.mpr (le_of_not_gt h)], refl }
end

theorem add_sub_of_lt {a b : ℕ+} : a < b → a + (b - a) = b :=
 λ h, eq $ by { rw [add_coe, sub_coe, if_pos h],
                exact add_tsub_cancel_of_le h.le }

instance : has_well_founded ℕ+ := ⟨(<), measure_wf coe⟩

/-- Strong induction on `ℕ+`. -/
def strong_induction_on {p : ℕ+ → Sort*} : ∀ (n : ℕ+) (h : ∀ k, (∀ m, m < k → p m) → p k), p n
| n := λ IH, IH _ (λ a h, strong_induction_on a IH)
using_well_founded { dec_tac := `[assumption] }

/-- If `n : ℕ+` is different from `1`, then it is the successor of some `k : ℕ+`. -/
lemma exists_eq_succ_of_ne_one : ∀ {n : ℕ+} (h1 : n ≠ 1), ∃ (k : ℕ+), n = k + 1
| ⟨1, _⟩ h1 := false.elim $ h1 rfl
| ⟨n+2, _⟩ _ := ⟨⟨n+1, by simp⟩, rfl⟩

/-- Strong induction on `ℕ+`, with `n = 1` treated separately. -/
def case_strong_induction_on {p : ℕ+ → Sort*} (a : ℕ+) (hz : p 1)
  (hi : ∀ n, (∀ m, m ≤ n → p m) → p (n + 1)) : p a :=
begin
  apply strong_induction_on a,
  rintro ⟨k, kprop⟩ hk,
  cases k with k,
  { exact (lt_irrefl 0 kprop).elim },
  cases k with k,
  { exact hz },
  exact hi ⟨k.succ, nat.succ_pos _⟩ (λ m hm, hk _ (lt_succ_iff.2 hm)),
end

/-- An induction principle for `ℕ+`: it takes values in `Sort*`, so it applies also to Types,
not only to `Prop`. -/
@[elab_as_eliminator]
def rec_on (n : ℕ+) {p : ℕ+ → Sort*} (p1 : p 1) (hp : ∀ n, p n → p (n + 1)) : p n :=
begin
  rcases n with ⟨n, h⟩,
  induction n with n IH,
  { exact absurd h dec_trivial },
  { cases n with n,
    { exact p1 },
    { exact hp _ (IH n.succ_pos) } }
end

@[simp] theorem rec_on_one {p} (p1 hp) : @pnat.rec_on 1 p p1 hp = p1 := rfl

@[simp] theorem rec_on_succ (n : ℕ+) {p : ℕ+ → Sort*} (p1 hp) :
  @pnat.rec_on (n + 1) p p1 hp = hp n (@pnat.rec_on n p p1 hp) :=
by { cases n with n h, cases n; [exact absurd h dec_trivial, refl] }

/-- We define `m % k` and `m / k` in the same way as for `ℕ`
  except that when `m = n * k` we take `m % k = k` and
  `m / k = n - 1`.  This ensures that `m % k` is always positive
  and `m = (m % k) + k * (m / k)` in all cases.  Later we
  define a function `div_exact` which gives the usual `m / k`
  in the case where `k` divides `m`.
-/
def mod_div_aux : ℕ+ → ℕ → ℕ → ℕ+ × ℕ
| k 0 q := ⟨k, q.pred⟩
| k (r + 1) q := ⟨⟨r + 1, nat.succ_pos r⟩, q⟩

lemma mod_div_aux_spec : ∀ (k : ℕ+) (r q : ℕ) (h : ¬ (r = 0 ∧ q = 0)),
 (((mod_div_aux k r q).1 : ℕ) + k * (mod_div_aux k r q).2 = (r + k * q))
| k 0 0 h := (h ⟨rfl, rfl⟩).elim
| k 0 (q + 1) h := by
{ change (k : ℕ) + (k : ℕ) * (q + 1).pred = 0 + (k : ℕ) * (q + 1),
  rw [nat.pred_succ, nat.mul_succ, zero_add, add_comm]}
| k (r + 1) q h := rfl

/-- `mod_div m k = (m % k, m / k)`.
  We define `m % k` and `m / k` in the same way as for `ℕ`
  except that when `m = n * k` we take `m % k = k` and
  `m / k = n - 1`.  This ensures that `m % k` is always positive
  and `m = (m % k) + k * (m / k)` in all cases.  Later we
  define a function `div_exact` which gives the usual `m / k`
  in the case where `k` divides `m`.
-/
def mod_div (m k : ℕ+) : ℕ+ × ℕ := mod_div_aux k ((m : ℕ) % (k : ℕ)) ((m : ℕ) / (k : ℕ))

/-- We define `m % k` in the same way as for `ℕ`
  except that when `m = n * k` we take `m % k = k` This ensures that `m % k` is always positive.
-/
def mod (m k : ℕ+) : ℕ+ := (mod_div m k).1

/-- We define `m / k` in the same way as for `ℕ` except that when `m = n * k` we take
  `m / k = n - 1`. This ensures that `m = (m % k) + k * (m / k)` in all cases. Later we
  define a function `div_exact` which gives the usual `m / k` in the case where `k` divides `m`.
-/
def div (m k : ℕ+) : ℕ  := (mod_div m k).2

theorem mod_add_div (m k : ℕ+) : ((mod m k) + k * (div m k) : ℕ) = m :=
begin
  let h₀ := nat.mod_add_div (m : ℕ) (k : ℕ),
  have : ¬ ((m : ℕ) % (k : ℕ) = 0 ∧ (m : ℕ) / (k : ℕ) = 0),
  by { rintro ⟨hr, hq⟩, rw [hr, hq, mul_zero, zero_add] at h₀,
       exact (m.ne_zero h₀.symm).elim },
  have := mod_div_aux_spec k ((m : ℕ) % (k : ℕ)) ((m : ℕ) / (k : ℕ)) this,
  exact (this.trans h₀),
end

theorem div_add_mod (m k : ℕ+) : (k * (div m k) + mod m k : ℕ) = m :=
(add_comm _ _).trans (mod_add_div _ _)

lemma mod_add_div' (m k : ℕ+) : ((mod m k) + (div m k) * k : ℕ) = m :=
by { rw mul_comm, exact mod_add_div _ _ }

lemma div_add_mod' (m k : ℕ+) : ((div m k) * k + mod m k : ℕ) = m :=
by { rw mul_comm, exact div_add_mod _ _ }

theorem mod_coe (m k : ℕ+) :
 ((mod m k) : ℕ) = ite ((m : ℕ) % (k : ℕ) = 0) (k : ℕ) ((m : ℕ) % (k : ℕ)) :=
begin
  dsimp [mod, mod_div],
  cases (m : ℕ) % (k : ℕ),
  { rw [if_pos rfl], refl },
  { rw [if_neg n.succ_ne_zero], refl }
end

theorem div_coe (m k : ℕ+) :
 ((div m k) : ℕ) = ite ((m : ℕ) % (k : ℕ) = 0) ((m : ℕ) / (k : ℕ)).pred ((m : ℕ) / (k : ℕ)) :=
begin
  dsimp [div, mod_div],
  cases (m : ℕ) % (k : ℕ),
  { rw [if_pos rfl], refl },
  { rw [if_neg n.succ_ne_zero], refl }
end

theorem mod_le (m k : ℕ+) : mod m k ≤ m ∧ mod m k ≤ k :=
begin
  change ((mod m k) : ℕ) ≤ (m : ℕ) ∧ ((mod m k) : ℕ) ≤ (k : ℕ),
  rw [mod_coe], split_ifs,
  { have hm : (m : ℕ) > 0 := m.pos,
    rw [← nat.mod_add_div (m : ℕ) (k : ℕ), h, zero_add] at hm ⊢,
    by_cases h' : ((m : ℕ) / (k : ℕ)) = 0,
    { rw [h', mul_zero] at hm, exact (lt_irrefl _ hm).elim},
    { let h' := nat.mul_le_mul_left (k : ℕ)
             (nat.succ_le_of_lt (nat.pos_of_ne_zero h')),
      rw [mul_one] at h', exact ⟨h', le_refl (k : ℕ)⟩ } },
  { exact ⟨nat.mod_le (m : ℕ) (k : ℕ), (nat.mod_lt (m : ℕ) k.pos).le⟩ }
end

theorem dvd_iff {k m : ℕ+} : k ∣ m ↔ (k : ℕ) ∣ (m : ℕ) :=
begin
  split; intro h, rcases h with ⟨_, rfl⟩, apply dvd_mul_right,
  rcases h with ⟨a, h⟩, cases a, { contrapose h, apply ne_zero, },
  use a.succ, apply nat.succ_pos, rw [← coe_inj, h, mul_coe, mk_coe],
end

theorem dvd_iff' {k m : ℕ+} : k ∣ m ↔ mod m k = k :=
begin
  rw dvd_iff,
  rw [nat.dvd_iff_mod_eq_zero], split,
  { intro h, apply eq, rw [mod_coe, if_pos h] },
  { intro h, by_cases h' : (m : ℕ) % (k : ℕ) = 0,
    { exact h'},
    { replace h : ((mod m k) : ℕ) = (k : ℕ) := congr_arg _ h,
      rw [mod_coe, if_neg h'] at h,
      exact ((nat.mod_lt (m : ℕ) k.pos).ne h).elim } }
end

lemma le_of_dvd {m n : ℕ+} : m ∣ n → m ≤ n :=
by { rw dvd_iff', intro h, rw ← h, apply (mod_le n m).left }

/-- If `h : k | m`, then `k * (div_exact m k) = m`. Note that this is not equal to `m / k`. -/
def div_exact (m k : ℕ+) : ℕ+ :=
 ⟨(div m k).succ, nat.succ_pos _⟩

theorem mul_div_exact {m k : ℕ+} (h : k ∣ m) : k * (div_exact m k) = m :=
begin
 apply eq, rw [mul_coe],
 change (k : ℕ) * (div m k).succ = m,
 rw [← div_add_mod m k, dvd_iff'.mp h, nat.mul_succ]
end

theorem dvd_one_iff (n : ℕ+) : n ∣ 1 ↔ n = 1 :=
 ⟨λ h, dvd_antisymm h (one_dvd n), λ h, h.symm ▸ (dvd_refl 1)⟩

lemma pos_of_div_pos {n : ℕ+} {a : ℕ} (h : a ∣ n) : 0 < a :=
begin
  apply pos_iff_ne_zero.2,
  intro hzero,
  rw hzero at h,
  exact pnat.ne_zero n (eq_zero_of_zero_dvd h)
end

end pnat

section can_lift

instance nat.can_lift_pnat : can_lift ℕ ℕ+ :=
⟨coe, λ n, 0 < n, λ n hn, ⟨nat.to_pnat' n, pnat.to_pnat'_coe hn⟩⟩

instance int.can_lift_pnat : can_lift ℤ ℕ+ :=
⟨coe, λ n, 0 < n, λ n hn, ⟨nat.to_pnat' (int.nat_abs n),
  by rw [coe_coe, nat.to_pnat'_coe, if_pos (int.nat_abs_pos_of_ne_zero hn.ne'),
    int.nat_abs_of_nonneg hn.le]⟩⟩

end can_lift


-- A Formal Proof of the Lovasz Local Lemma and Symmetric Lovasz Local Lemma

-- This import covers everything we need; finsets, measure theory, ennreals, and probability theory.
import probability.independence

/-
  Since we are constantly dealing with finite sets, measures, and big products/intersections, it will make the proof
  much more readable if we open these libraries/locales.
-/
open finset measure_theory
open_locale big_operators

/-
  If the events Eᵢ are all independent and occur with probability less than 1, then it's obviously true that one can
  avoid them all with nonzero probability, simply due to the fact that a product of positive quantities is positive.
  The Lovasz Local Lemma says the same holds if the events are "almost independent", a notion captured by some
  "pseudo-probabilities" X and a dependency digraph Γ. I'm following the proof from these notes (and, for readability,
  using it's notation as well): https://theory.stanford.edu/~jvondrak/MATH233A-2018/Math233-lec02.pdf

  To be more precise, here is the full theorem statement in English: Suppose we have a probability space Ω with
  probability measure ℙ, as well as events E₁,…,Eₙ. Let G be a dependency digraph for these events, and let Γ(i) be
  the neighborhood of Eᵢ in G. In other words, Γ(i) lists all other event indices j such that j ≠ i and Eᵢ depends on
  Eⱼ. Also, assume that we have real numbers X₁,…,Xₙ in the open interval (0, 1) such that, for each i, we have that
  ℙ(Eᵢ) ≤ Xᵢ * (∏ j, 1 - Xⱼ), where the product is taken over all j ∈ Γ(i). Given all of this, theorem says that we
  can avoid all the events; the probability of the intersection of their complements is nonzero. In particular, it is
  bounded from below by (∏ j, 1 - Xⱼ), where the product is taken over all j ∈ {1,…,n}.
-/
theorem lovasz_local_lemma
  {Ω : Type*}
  [measurable_space Ω]
  {ℙ : measure Ω}
  [is_probability_measure ℙ]
  {n : ℕ}
  {E : fin n → set Ω}
  {h_events : ∀ i, measurable_set (E i)}
  {Γ : fin n → finset (fin n)}
  (h_no_self_loops : ∀ i, i ∉ Γ i)
  (h_dependency_digraph : ∀ i, ∀ J ⊆ ({i} ∪ (Γ i))ᶜ, probability_theory.indep_sets {E i} {⋂ j ∈ J, (E j)ᶜ} ℙ)
  {X : fin n → ennreal}
  (h_pseudo_probability : ∀ i, 0 < X i ∧ X i < 1)
  (h_independence_bound : ∀ i, ℙ (E i) ≤ X i * ∏ j in Γ i, (1 - X j)) :
ℙ (⋂ i, (E i)ᶜ) ≠ 0 ∧ ∏ i, (1 - X i) ≤ ℙ (⋂ i, (E i)ᶜ) :=
begin
  /-
    To make life easier, we make a few local definitions:
    - Firstly, we extend the dependency digraph Γ to include self-loops; after all, nontrivial
      events are dependent on themselves. Call this new digraph Γ'.
    - Secondly, we define shorthand for the intersection of the complements some subset of our events,
      since we'll be using it a lot.
    - Thirdly, we define shorthand for the probability of the above intersection.
  -/
  let Γ' : (fin n → finset (fin n)) := λ i, insert i (Γ i),
  let inter_over : (finset (fin n) → set Ω) := λ S, ⋂ i ∈ S, (E i)ᶜ,
  let P : (finset (fin n) → ennreal) := λ S, ℙ (inter_over S),

  /-
    We'll also prove a few helpful lemmas about these definitions and the definitions in the theorem statement.
    - 1. The probability of the empty intersection is 1.
    - 2. The intersection of more sets is smaller than the intersection of fewer sets.
    - 3. We have 0 < 1 - X i < 1 for all i.
    - 4. P finset.univ is the probability of the intersection of the complements.
    - 5. Given S, a ∈ S, and any set T, (S \ insert a T) is of course a subset of (S.erase a). We use this a lot.
    - 6. Given S, a ∈ S, and any set T, (S \ insert a T) is of course a strict subset of S. We also use this a lot.
    All of these lemmas have simple proofs, so I didn't think any annotations were necessary.
  -/
  have P_empty_eq_one : P ∅ = 1 :=
  begin
    have inter_over_empty_eq_univ : inter_over ∅ = set.univ :=
    begin
      rw set.Inter_eq_univ,
      intro i,
      ext x,
      split,
      {
        intro _,
        exact set.mem_univ x,
      },
      {
        intro _,
        rw set.mem_Inter,
        intro i_in_empty,
        exfalso,
        exact set.not_mem_empty i i_in_empty,
      },
    end,
    simp only [P],
    rw inter_over_empty_eq_univ,
    exact measure_univ,
  end,
  have inter_subset_of_supset : ∀ M N : finset (fin n), N ⊆ M → inter_over M ⊆ inter_over N :=
  begin
    intros M N N_subset_M,
    intros x hx,
    rw set.mem_Inter,
    intro i,
    rw set.mem_Inter,
    intro hi,
    rw set.mem_Inter at hx,
    specialize hx i,
    rw set.mem_Inter at hx,
    exact hx (mem_of_subset N_subset_M hi),
  end,
  have one_minus_pprob_is_pprob : ∀ i, 0 < 1 - X i ∧ 1 - X i < 1 :=
  begin
    intro i,
    split,
    {
      rw tsub_pos_iff_lt,
      exact (h_pseudo_probability i).2,
    },
    exact ennreal.sub_lt_self ennreal.one_ne_top one_ne_zero (ne_of_gt (h_pseudo_probability i).1),
  end,
  have P_univ_eq_prob_inter : P univ = ℙ (⋂ i, (E i)ᶜ) :=
  begin
    simp only [P, inter_over],
    simp only [mem_univ, set.Inter_true],
  end,
  have sdiff_subset : ∀ S : finset (fin n), ∀ a ∈ S, ∀ T : finset (fin n), S \ insert a T ⊆ S.erase a :=
  begin
    intros S a a_in_S T,
    rw ← sdiff_singleton_eq_erase,
    exact sdiff_subset_sdiff (subset_refl S) (singleton_subset_iff.2 (mem_insert_self a T)),
  end,
  have sdiff_ssubset : ∀ S : finset (fin n), ∀ a ∈ S, ∀ T : finset (fin n), S \ insert a T ⊂ S :=
  begin
    intros S a a_in_S T,
    apply finset.ssubset_of_subset_of_ssubset,
    exact sdiff_subset _ _ a_in_S _,
    exact erase_ssubset a_in_S,
  end,

  /-
    The bulk of the work is done by the following lemma: For all S ⊆ {1,...,n}, we have that the probability of
    avoiding all events Eₐ for a ∈ S is nonzero, as well as the fact that the probability of avoiding all events Eₐ
    for a ∈ S is more than (1 - Xₐ) times the probability of avoiding all events Eᵢ for i ∈ S \ {a}.
  -/
  have main_lemma : ∀ S : finset (fin n), P S ≠ 0 ∧ ∀ a ∈ S, P (S.erase a) * (1 - X a) ≤ P S :=
  begin
    -- We go by strong induction on S; the predicate we're trying to prove is of course:
    let predicate : (finset (fin n) → Prop) := λ S, P S ≠ 0 ∧ ∀ a ∈ S, P (S.erase a) * (1 - X a) ≤ P S,

    -- As is typical in strong induction, the induction step absorbs the base case.
    have induction_step : ∀ S : finset (fin n), (∀ T ⊂ S, predicate T) → predicate S :=
    begin
      -- Stop using predicate notation.
      simp only [predicate],
      clear predicate,

      -- Let S be arbitrary and assume the claim holds for all strictly smaller sets.
      intros S induction_hypothesis,

      /-
        We now prove the main part of our goal as a lemma, for convenience (it implies the other part). This section
        contains nearly all of the hard work for proving the Lovasz Local Lemma.
      -/
      have main_inequality : ∀ a ∈ S, P (S.erase a) * (1 - X a) ≤ P S :=
      begin
        -- Fortunately we can fix our element a right away.
        intros a a_in_S,

        -- First, we use independence and probability basics to get a lower bound on P S.
        have lower_bound : P (S.erase a) - ℙ (E a) * P (S \ Γ' a) ≤ P S :=
        begin
          -- We pull (E a)ᶜ out of the intersection over S.
          have inter_over_S_split : inter_over S = (E a)ᶜ ∩ inter_over (S.erase a) :=
          begin
            simp only [inter_over],
            rw [← insert_erase a_in_S, set_bInter_insert a (S.erase a), insert_erase a_in_S],
          end,

          -- Using the above, we pull (E a)ᶜ out and use complementary measure.
          have P_S_split : P S = P (S.erase a) - ℙ ((E a) ∩ inter_over (S.erase a)) :=
          begin
            simp only [P],
            rw inter_over_S_split,
            symmetry,
            apply ennreal.sub_eq_of_eq_add,
            {
              exact ne_of_lt (measure_lt_top ℙ _),
            },
            symmetry,
            rw [← set.diff_eq_compl_inter, set.inter_comm],
            apply measure_diff_add_inter,
            exact h_events a,
          end,

          -- We have a simple inequality arising from monotonicity of measure.
          have inequality : P (S.erase a) - ℙ ((E a) ∩ inter_over (S \ Γ' a)) ≤
                            P (S.erase a) - ℙ ((E a) ∩ inter_over (S.erase a)) :=
          begin
            -- This immediately follows from lemma (2).
            have subset : (E a) ∩ inter_over (S.erase a) ⊆
                          (E a) ∩ inter_over (S \ Γ' a) :=
            begin
              intros x hx,
              split,
              {
                exact hx.1,
              },
              have subset := sdiff_subset S a a_in_S (Γ a),
              exact set.mem_of_subset_of_mem (inter_subset_of_supset (S.erase a) (S \ Γ' a) subset) hx.2,
            end,
            exact tsub_le_tsub_left (measure_theory.outer_measure.mono' ℙ.to_outer_measure subset) _,
          end,

          -- Finally, we use independence to separate (E a) from its independent sets as given by S \ Γ' a.
          have prob_inter_eq_prod : ℙ ((E a) ∩ inter_over (S \ Γ' a)) = ℙ (E a) * P (S \ Γ' a) :=
          begin
            specialize h_dependency_digraph a (S \ Γ' a),
            have subset : S \ Γ' a ⊆ (Γ' a)ᶜ :=
            begin
              rw sdiff_eq_inter_compl,
              intros x hx,
              rw mem_inter at hx,
              exact hx.2,
            end,
            exact probability_theory.indep_sets_singleton_iff.1 (h_dependency_digraph subset),
          end,

          -- We combine the above to complete the proof.
          rw ← P_S_split at inequality,
          rwa ← prob_inter_eq_prod,
        end,

        /-
          Now, we write P (S \ Γ' a) / P (S.erase a) as a telescoping product, and apply induction_hypothesis to
          each of the terms. In practice, we'll do this one term at a time using another induction.
        -/
        have product_bound : P (S \ Γ' a) ≤ P (S.erase a) * (∏ i in (S ∩ (Γ a)), (1 - X i)⁻¹) :=
        begin
          -- We go by induction on T; the predicate we're trying to prove is:
          let predicate : (finset (fin n) → Prop) :=
            λ T, P (S \ Γ' a) ≤ P (S.erase a) * (∏ i in T, (1 - X i)⁻¹) * P (S \ Γ' a) * (P (S \ (insert a T)))⁻¹,

          have induction_lemma : predicate (S ∩ Γ a) :=
          begin
            -- The base case is more or less immediate.
            have base_case : predicate ∅ :=
            begin
              -- Stop using predicate notation.
              simp only [predicate],
              clear predicate,

              rw [
                insert_eq, prod_empty, mul_one, union_empty, sdiff_singleton_eq_erase a S, mul_comm, ← mul_assoc,
                ennreal.inv_mul_cancel
              ],
              {
                rw one_mul,
                exact le_refl _,
              },
              {
                exact (induction_hypothesis (S.erase a) (erase_ssubset a_in_S)).1,
              },
              exact ne_of_lt (measure_lt_top ℙ _),
            end,

            -- The induction step makes use of induction_hypothesis to show the upper bound for one more term.
            have induction_step : ∀ b, ∀ T, b ∈ S ∩ Γ a → T ⊆ S ∩ Γ a → b ∉ T → predicate T → predicate (insert b T) :=
            begin
              -- Stop using predicate notation.
              simp only [predicate],
              clear base_case,
              clear predicate,

              -- Let T and b be arbitrary such that b ∉ T, and assume the claim holds for S.
              intros b T b_in_S_cap_Gam_a T_subset b_notin_T ih_lem,

              -- First, we pull b out of the product.
              rw [prod_insert b_notin_T, mul_comm (1 - X b)⁻¹ _, mul_assoc],

              /-
                Next, (1 - X b)⁻¹ is lower bounded by the desired ratio; this follows from the inductive_hypothesis.
                Although this ends up being rather difficult in Lean, it's not anything mathematically interesting;
                it's an immediate application of the inductive hypothesis to (S \ insert a T) and basic inequality
                manipulation. So, I didn't feel it necessary to provide annotations here.
              -/
              have ih_lower_bound :  P (S \ insert a (insert b T)) * (P (S \ insert a T))⁻¹ ≤ (1 - X b)⁻¹ :=
              begin
                specialize induction_hypothesis (S \ insert a T) (sdiff_ssubset S a a_in_S T),
                have induction_bound := induction_hypothesis.2 b,
                rw [
                  ennreal.le_inv_iff_mul_le, mul_assoc, mul_comm _ (1 - X b), ← mul_assoc,
                  ← ennreal.le_inv_iff_mul_le, inv_inv
                ],
                repeat { rw insert_eq },
                rw ← sdiff_insert at induction_bound,
                repeat { rw insert_eq at induction_bound },
                rw [union_comm, union_assoc, union_comm T _],
                have b_in_set : b ∈ S \ ({a} ∪ T) :=
                begin
                  rw mem_sdiff,
                  split,
                  {
                    rw mem_inter at b_in_S_cap_Gam_a,
                    exact b_in_S_cap_Gam_a.1,
                  },
                  rw not_mem_union,
                  split,
                  {
                    rw not_mem_singleton,
                    by_contradiction b_eq_a,
                    rw b_eq_a at b_in_S_cap_Gam_a,
                    exact (not_mem_mono (inter_subset_right S (Γ a)) (h_no_self_loops a)) b_in_S_cap_Gam_a,
                  },
                  exact b_notin_T,
                end,
                exact induction_bound b_in_set,
              end,

              -- To make what follows easier, we move the term (1 - X b)⁻¹ all the way to the right.
              rw [mul_assoc, mul_assoc _ (1 - X b)⁻¹ _, mul_comm (1 - X b)⁻¹ _],
              repeat { rw ← mul_assoc },

              -- We can use transitivity with the lemma's induction hypothesis to reduce the inequality.
              transitivity',
              exact ih_lem,

              -- We split a ratio (i.e. use a/c = a/b * b/c) to prepare the inequality for applying ih_lower_bound.
              rw ← mul_one (P (S \ Γ' a)),
              have ne_zero : P (S \ insert a (insert b T)) ≠ 0 :=
                (induction_hypothesis (S \ insert a (insert b T)) (sdiff_ssubset S a a_in_S (insert b T))).1,
              have ne_top : P (S \ insert a (insert b T)) ≠ ⊤ := ne_of_lt (measure_lt_top ℙ _),
              nth_rewrite_lhs 0 [← ennreal.inv_mul_cancel ne_zero ne_top],
              rw mul_one,
              repeat { rw ← mul_assoc },
              rw mul_assoc _ _ (P (S \ insert a T))⁻¹,

              -- Finally, we apply ih_lower_bound, which completes the induction step.
              exact ennreal.mul_le_mul (le_refl _) ih_lower_bound,
            end,

            -- Invoking the induction theorem for finite sets completes the proof.
            exact finset.induction_on' (S ∩ Γ a) base_case induction_step,
          end,

          -- Stop using predicate notation.
          simp only [predicate] at induction_lemma,
          clear predicate,

          -- The desired bound follows easily from the induction_lemma; we just need to cancel the division.
          have same_set : S \ (insert a (S ∩ Γ a)) = S \ Γ' a :=
          begin
            simp only [Γ'],
            repeat { rw insert_eq },
            rw [
              union_distrib_left, sdiff_inter_distrib_right, sdiff_eq_empty_iff_subset.2 (subset_union_right _ _),
              empty_union _
            ],
          end,
          rwa [same_set, mul_assoc, ennreal.mul_inv_cancel, mul_one] at induction_lemma,
          {
            have ssubset := finset.ssubset_of_subset_of_ssubset (sdiff_subset S a a_in_S (Γ a)) (erase_ssubset a_in_S),
            exact (induction_hypothesis (S \ Γ' a) ssubset).1,
          },
          exact ne_of_lt (measure_lt_top ℙ _),
        end,

        -- The last big task is getting rid of the two products; we'll first need to combine them into one.
        have prod_cancel : (∏ i in Γ a, (1 - X i)) * (∏ i in S ∩ Γ a, (1 - X i)⁻¹) = ∏ i in Γ a \ S, (1 - X i) :=
        begin
          have prod_split : (∏ i in Γ a, (1 - X i)) = (∏ i in Γ a \ S, (1 - X i)) * (∏ i in S ∩ Γ a, (1 - X i)) :=
          begin
            rw [inter_comm, mul_comm],
            have piecewise_same := set.piecewise_same (↑S) (λ i, (1 - X i)),
            nth_rewrite 0 [← piecewise_same],
            rw [piecewise_coe, prod_piecewise],
          end,
          have cancel : ∀ i ∈ S ∩ Γ a, (1 - X i) * (1 - X i)⁻¹ = 1 :=
          begin
            intros i _,
            rw ennreal.mul_inv_cancel,
            exact ne_of_gt (one_minus_pprob_is_pprob i).1,
            exact ne_of_lt (lt_trans (one_minus_pprob_is_pprob i).2 ennreal.one_lt_top),
          end,
          rw [prod_split, mul_assoc, ← prod_mul_distrib, prod_eq_one cancel, mul_one],
        end,

        -- And now we can of course upper bound this resulting product by 1.
        have prod_le_one : (∏ i in Γ a \ S, (1 - X i)) ≤ 1 :=
        begin
          have le_one : ∀ i ∈ Γ a \ S, 1 - X i ≤ 1 :=
          begin
            intros i _,
            exact le_of_lt (one_minus_pprob_is_pprob i).2,
          end,
          exact prod_le_one' le_one,
        end,

        -- Using the above work, we combine the independence and product bounds and then simplify the big products.
        have two_products := ennreal.mul_le_mul (h_independence_bound a) product_bound,
        rw mul_comm (P (S.erase a)) _ at two_products,
        repeat { rw mul_assoc at two_products },
        rw [← mul_assoc _ _ (P (S.erase a)), prod_cancel] at two_products,

        -- From here, we can upper bound the product by 1 and conclude that P (S.erase a) * (1 - X a) ≤ P S.
        rw [mul_comm _ (P (S.erase a)), ← mul_assoc _ (P (S.erase a)) _, mul_comm _ (P (S.erase a))] at two_products,
        have no_products := ennreal.mul_le_mul (refl (P (S.erase a) * X a)) prod_le_one,
        rw mul_one at no_products,
        have final_inequality := le_trans two_products no_products,

        -- Combining the above with the lower bound from earlier, we complete the proof of the main inequality!
        rw ennreal.mul_sub,
        swap,
        {
          intros _ _,
          exact ne_of_lt (measure_lt_top ℙ _),
        },
        rw mul_one,
        exact le_trans (tsub_le_tsub_left final_inequality (P (S.erase a))) lower_bound,
      end,

      -- Using the main part of our goal, we can now quickly prove the easier part of our goal (that P S ≠ 0).
      split,
      {
        by_cases S_nonempty : S = ∅,
        {
          rw [S_nonempty, P_empty_eq_one],
          exact one_ne_zero,
        },
        cases nonempty_iff_ne_empty.2 S_nonempty with a a_in_S,
        apply ne_of_gt,
        specialize main_inequality a a_in_S,
        specialize induction_hypothesis (S.erase a) (erase_ssubset a_in_S),
        apply lt_of_le_of_lt',
        {
          exact main_inequality,
        },
        exact ennreal.mul_pos induction_hypothesis.1 (ne_of_gt (one_minus_pprob_is_pprob a).1),
      },

      -- Finally, we complete the proof; we've already finished proving the second part of the goal.
      exact main_inequality,
    end,

    -- Invoking the strong induction theorem for finite sets completes the proof.
    intro S,
    exact finset.strong_induction_on S induction_step,
  end,

  -- Now that we've proven the lemma, we can immediately conclude the first part the theorem.
  split,
  {
    have events_avoidable := (main_lemma univ).1,
    rwa P_univ_eq_prob_inter at events_avoidable,
  },

  /-
    We'll now use induction to create a stronger version of our lemma. NOTE: Unfortunately, as tempting as it was to
    use finset.prod_range_induction, I couldn't find a good way to deal with the fact that E : fin n → set Ω rather
    than E : ℕ → set Ω. In particular, that theorem has a hypothesis "∀ (k : ℕ), s (k + 1) = s k * f k", and I
    couldn't think of a good way to expand E to domain ℕ without breaking this hypothesis condition for k = n.
  -/
  have stronger_lemma : ∀ S : finset (fin n), P Sᶜ * ∏ i in S, (1 - X i) ≤ P univ :=
  begin
    -- We go by induction on S; the predicate we're trying to prove is of course:
    let predicate : (finset (fin n) → Prop) := λ S, P Sᶜ * ∏ i in S, (1 - X i) ≤ P univ,

    have base_case : predicate ∅ :=
    begin
      -- Stop using predicate notation.
      simp only [predicate],
      clear predicate,

      rw [finset.prod_empty, mul_one, compl_empty],
      exact le_refl _,
    end,

    have induction_step : ∀ a : fin n, ∀ S : finset (fin n), a ∉ S → predicate S → predicate (insert a S) :=
    begin
      -- Stop using predicate notation.
      simp only [predicate],
      clear base_case,
      clear predicate,

      -- Let S and a be arbitrary such that a ∉ S, and assume the claim holds for S.
      intros a S a_notin_S induction_hypothesis,

      -- We pull an element out of Sᶜ, which is the same as adding an element to S, and apply the main lemma to it.
      specialize main_lemma Sᶜ,
      have main_lemma_ineq := main_lemma.2,
      clear main_lemma,
      specialize main_lemma_ineq a (mem_compl.2 a_notin_S),
      rw ← compl_insert at main_lemma_ineq,

      -- Now we turn the product over (insert a S) into the product over S times the term at a
      rw [prod_insert a_notin_S, ← mul_assoc],

      -- Transitivity and multiplicativity of ≤ for nonnegative reals completes the proof.
      exact le_trans (ennreal.mul_le_mul main_lemma_ineq (refl _)) induction_hypothesis,
    end,

    -- Invoking the induction theorem for finite sets completes the proof.
    exact finset.induction base_case induction_step,
  end,

  -- Finally, we can use this stronger version to conclude the proof of the theorem!
  specialize stronger_lemma univ,
  rwa [P_univ_eq_prob_inter, ← compl_empty, compl_involutive, P_empty_eq_one, one_mul] at stronger_lemma,
end

/-
  There is also a "symmetric" version of the theorem, which is typically the one used in practice since it only
  deals with an upper the number of other events that an event is dependent on rather than the specific events.

  To be precise, it says if each event is individually avoidable (probability strictly less than 1, call it p), each
  event depends on at most d other events, and ep(d + 1) ≤ 1 (where e is Euler's number), then the events are
  collectively avoidable; the probability of the intersection of their complements is nonzero.

  NOTE: I couldn't find anything on Euler's number in Lean, so I decided to just use the slightly tighter bound
  p ≤ (1 - 1/(d + 1))^d / (d + 1). Indeed ep(d + 1) ≤ 1, we have p(d + 1) ≤ e^(-1) ≤ e^(-d/(d + 1)). By a classical
  inequality, this is at most (1 - 1/(d + 1))^d, so our assumption is indeed stronger.
-/
theorem symmetric_lovasz_local_lemma
  {Ω : Type*}
  [measurable_space Ω]
  {ℙ : measure Ω}
  [is_probability_measure ℙ]
  {n : ℕ}
  {E : fin n → set Ω}
  {h_events : ∀ i, measurable_set (E i)}
  {Γ : fin n → finset (fin n)}
  (h_no_self_loops : ∀ i, i ∉ Γ i)
  (h_dependency_digraph : ∀ i, ∀ J ⊆ ({i} ∪ (Γ i))ᶜ, probability_theory.indep_sets {E i} {⋂ j ∈ J, (E j)ᶜ} ℙ)
  (p : ennreal)
  (h_probability : 0 < p ∧ p < 1)
  (h_event_probability_bound : ∀ i, ℙ (E i) ≤ p)
  (d : ℕ)
  (h_d_pos : 1 ≤ d)
  (h_maximum_dependence : ∀ i, (Γ i).card ≤ d)
  (h_p_bound : p ≤ (d + 1)⁻¹ * (1 - (d + 1)⁻¹)^d) :
ℙ (⋂ i, (E i)ᶜ) ≠ 0 :=
begin
  -- We take our pseudo-probabiliies to be Xᵢ = 1 / (d + 1)
  let X : fin n → ennreal := λ _, (d + 1)⁻¹,

  -- First, we need to show that X actually gives pseudo-probabilities.
  have h_pseudo_probability : ∀ i, 0 < X i ∧ X i < 1 :=
  begin
    intro i,
    simp only [X],
    split,
    {
      simp,
    },
    rw ennreal.inv_lt_one,
    apply lt_of_lt_of_le,
    exact ennreal.one_lt_two,
    rw ← one_add_one_eq_two,
    apply' add_le_add,
    {
      norm_cast,
      exact h_d_pos,
    },
    exact le_refl _,
  end,

  -- The main work here is showing that X actually gives an independence bound; it uses a classical inequality.
  have h_independence_bound : ∀ i, ℙ (E i) ≤ X i * ∏ j in Γ i, (1 - X j) :=
  begin
    intro i,
    transitivity',
    exact h_event_probability_bound i,

    -- We upper bound p using the h_p_bound,
    transitivity',
    exact h_p_bound,

    -- We now simplify the right-hand side using the definition of X.
    simp only [X],
    apply' ennreal.mul_le_mul,
    exact le_refl _,

    -- Finally, we're just left with a constant product over Γ i.
    rw prod_const,
    have le_one : 1 - (ennreal.has_coe.coe d + 1)⁻¹ ≤ 1 := by simp,
    exact ennreal.pow_le_pow_of_le_one le_one (h_maximum_dependence i),
  end,

  -- From here, it's just a direct aplication of the (asymmetric) Lovasz Local Lemma.
  have result := lovasz_local_lemma h_no_self_loops h_dependency_digraph h_pseudo_probability h_independence_bound,
  swap,
  exact h_events,
  exact result.1,
end