/-
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
import data.int.order

/-!
# 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`.

## Tags

Bézout's lemma, Bezout's lemma
-/

/-! ### 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

protected lemma coe_nat_gcd (m n : ℕ) : int.gcd ↑m ↑n = nat.gcd m n := rfl

/-- 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

/-- **Bézout's lemma** -/
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_rfl)
    ... = 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

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

protected lemma coe_nat_lcm (m n : ℕ) : int.lcm ↑m ↑n = nat.lcm m n := 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_iff_dvd.2 h1) (nat_abs_dvd_iff_dvd.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_iff_dvd.mpr H1) (nat_abs_dvd_iff_dvd.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 ((gcd_dvd_left i j).trans 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) ((gcd_dvd_right j i).trans 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_rfl (nat_abs_dvd_iff_dvd.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_iff_dvd.mp,
  apply (nat.pow_dvd_pow_iff k0).mp,
  rw [← int.nat_abs_pow, ← int.nat_abs_pow],
  exact int.nat_abs_dvd_iff_dvd.mpr h
end

lemma gcd_dvd_iff {a b : ℤ} {n : ℕ} : gcd a b ∣ n ↔ ∃ x y : ℤ, ↑n = a * x + b * y :=
begin
  split,
  { intro h,
    rw [← nat.mul_div_cancel' h, int.coe_nat_mul, gcd_eq_gcd_ab, add_mul, mul_assoc, mul_assoc],
    refine ⟨_, _, rfl⟩, },
  { rintro ⟨x, y, h⟩,
    rw [←int.coe_nat_dvd, h],
    exact dvd_add (dvd_mul_of_dvd_left (gcd_dvd_left a b) _)
      (dvd_mul_of_dvd_left (gcd_dvd_right a b) y) }
end

lemma gcd_greatest {a b d : ℤ} (hd_pos : 0 ≤ d) (hda : d ∣ a) (hdb : d ∣ b)
  (hd : ∀ e : ℤ, e ∣ a → e ∣ b → e ∣ d) : d = gcd a b :=
dvd_antisymm hd_pos
  (coe_zero_le (gcd a b)) (dvd_gcd hda hdb) (hd _ (gcd_dvd_left a b) (gcd_dvd_right a b))

/-- Euclid's lemma: if `a ∣ b * c` and `gcd a c = 1` then `a ∣ b`.
Compare with `is_coprime.dvd_of_dvd_mul_left` and
`unique_factorization_monoid.dvd_of_dvd_mul_left_of_no_prime_factors` -/
lemma dvd_of_dvd_mul_left_of_gcd_one {a b c : ℤ} (habc : a ∣ b * c) (hab : gcd a c = 1) : a ∣ b :=
begin
  have := gcd_eq_gcd_ab a c,
  simp only [hab, int.coe_nat_zero, int.coe_nat_succ, zero_add] at this,
  have : b * a * gcd_a a c + b * c * gcd_b a c = b, { simp [mul_assoc, ←mul_add, ←this] },
  rw ←this,
  exact dvd_add (dvd_mul_of_dvd_left (dvd_mul_left a b) _) (dvd_mul_of_dvd_left habc _),
end

/-- Euclid's lemma: if `a ∣ b * c` and `gcd a b = 1` then `a ∣ c`.
Compare with `is_coprime.dvd_of_dvd_mul_right` and
`unique_factorization_monoid.dvd_of_dvd_mul_right_of_no_prime_factors` -/
lemma dvd_of_dvd_mul_right_of_gcd_one {a b c : ℤ} (habc : a ∣ b * c) (hab : gcd a b = 1) : a ∣ c :=
by { rw mul_comm at habc, exact dvd_of_dvd_mul_left_of_gcd_one habc hab }

/-- For nonzero integers `a` and `b`, `gcd a b` is the smallest positive natural number that can be
written in the form `a * x + b * y` for some pair of integers `x` and `y` -/
theorem gcd_least_linear {a b : ℤ} (ha : a ≠ 0) :
  is_least { n : ℕ | 0 < n ∧ ∃ x y : ℤ, ↑n = a * x + b * y } (a.gcd b) :=
begin
  simp_rw ←gcd_dvd_iff,
  split,
  { simpa [and_true, dvd_refl, set.mem_set_of_eq] using gcd_pos_of_non_zero_left b ha },
  { simp only [lower_bounds, and_imp, set.mem_set_of_eq],
    exact λ n hn_pos hn, nat.le_of_dvd hn_pos hn },
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_iff_dvd.mpr hi) (nat_abs_dvd_iff_dvd.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, ← zpow_coe_nat, ← units.ext_iff] at *,
  simp only [nat.gcd_eq_gcd_ab, zpow_add, zpow_mul, hm, hn, one_zpow, 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

attribute [to_additive gcd_nsmul_eq_zero] pow_gcd_eq_one

/-! ### GCD prover -/
open norm_num

namespace tactic
namespace norm_num

lemma int_gcd_helper' {d : ℕ} {x y a b : ℤ} (h₁ : (d:ℤ) ∣ x) (h₂ : (d:ℤ) ∣ y)
  (h₃ : x * a + y * b = d) : int.gcd x y = d :=
begin
  refine nat.dvd_antisymm _ (int.coe_nat_dvd.1 (int.dvd_gcd h₁ h₂)),
  rw [← int.coe_nat_dvd, ← h₃],
  apply dvd_add,
  { exact (int.gcd_dvd_left _ _).mul_right _ },
  { exact (int.gcd_dvd_right _ _).mul_right _ }
end

lemma nat_gcd_helper_dvd_left (x y a : ℕ) (h : x * a = y) : nat.gcd x y = x :=
nat.gcd_eq_left ⟨a, h.symm⟩

lemma nat_gcd_helper_dvd_right (x y a : ℕ) (h : y * a = x) : nat.gcd x y = y :=
nat.gcd_eq_right ⟨a, h.symm⟩

lemma nat_gcd_helper_2 (d x y a b u v tx ty : ℕ) (hu : d * u = x) (hv : d * v = y)
  (hx : x * a = tx) (hy : y * b = ty) (h : ty + d = tx) : nat.gcd x y = d :=
begin
  rw ← int.coe_nat_gcd, apply @int_gcd_helper' _ _ _ a (-b)
    (int.coe_nat_dvd.2 ⟨_, hu.symm⟩) (int.coe_nat_dvd.2 ⟨_, hv.symm⟩),
  rw [mul_neg_eq_neg_mul_symm, ← sub_eq_add_neg, sub_eq_iff_eq_add'],
  norm_cast, rw [hx, hy, h]
end

lemma nat_gcd_helper_1 (d x y a b u v tx ty : ℕ) (hu : d * u = x) (hv : d * v = y)
  (hx : x * a = tx) (hy : y * b = ty) (h : tx + d = ty) : nat.gcd x y = d :=
(nat.gcd_comm _ _).trans $ nat_gcd_helper_2 _ _ _ _ _ _ _ _ _ hv hu hy hx h

lemma nat_lcm_helper (x y d m n : ℕ) (hd : nat.gcd x y = d) (d0 : 0 < d)
  (xy : x * y = n) (dm : d * m = n) : nat.lcm x y = m :=
(nat.mul_right_inj d0).1 $ by rw [dm, ← xy, ← hd, nat.gcd_mul_lcm]

lemma nat_coprime_helper_zero_left (x : ℕ) (h : 1 < x) : ¬ nat.coprime 0 x :=
mt (nat.coprime_zero_left _).1 $ ne_of_gt h

lemma nat_coprime_helper_zero_right (x : ℕ) (h : 1 < x) : ¬ nat.coprime x 0 :=
mt (nat.coprime_zero_right _).1 $ ne_of_gt h

lemma nat_coprime_helper_2 (x y a b tx ty : ℕ)
  (hx : x * a = tx) (hy : y * b = ty) (h : ty + 1 = tx) : nat.coprime x y :=
nat_gcd_helper_2 _ _ _ _ _ _ _ _ _ (one_mul _) (one_mul _) hx hy h

lemma nat_not_coprime_helper (d x y u v : ℕ) (hu : d * u = x) (hv : d * v = y)
  (h : 1 < d) : ¬ nat.coprime x y :=
nat.not_coprime_of_dvd_of_dvd h ⟨_, hu.symm⟩ ⟨_, hv.symm⟩

lemma int_gcd_helper (x y : ℤ) (nx ny d : ℕ) (hx : (nx:ℤ) = x) (hy : (ny:ℤ) = y)
  (h : nat.gcd nx ny = d) : int.gcd x y = d :=
by rwa [← hx, ← hy, int.coe_nat_gcd]

lemma int_gcd_helper_neg_left (x y : ℤ) (d : ℕ) (h : int.gcd x y = d) : int.gcd (-x) y = d :=
by rw int.gcd at h ⊢; rwa int.nat_abs_neg

lemma int_gcd_helper_neg_right (x y : ℤ) (d : ℕ) (h : int.gcd x y = d) : int.gcd x (-y) = d :=
by rw int.gcd at h ⊢; rwa int.nat_abs_neg

lemma int_lcm_helper (x y : ℤ) (nx ny d : ℕ) (hx : (nx:ℤ) = x) (hy : (ny:ℤ) = y)
  (h : nat.lcm nx ny = d) : int.lcm x y = d :=
by rwa [← hx, ← hy, int.coe_nat_lcm]

lemma int_lcm_helper_neg_left (x y : ℤ) (d : ℕ) (h : int.lcm x y = d) : int.lcm (-x) y = d :=
by rw int.lcm at h ⊢; rwa int.nat_abs_neg

lemma int_lcm_helper_neg_right (x y : ℤ) (d : ℕ) (h : int.lcm x y = d) : int.lcm x (-y) = d :=
by rw int.lcm at h ⊢; rwa int.nat_abs_neg

/-- Evaluates the `nat.gcd` function. -/
meta def prove_gcd_nat (c : instance_cache) (ex ey : expr) :
  tactic (instance_cache × expr × expr) := do
  x ← ex.to_nat,
  y ← ey.to_nat,
  match x, y with
  | 0, _ := pure (c, ey, `(nat.gcd_zero_left).mk_app [ey])
  | _, 0 := pure (c, ex, `(nat.gcd_zero_right).mk_app [ex])
  | 1, _ := pure (c, `(1:ℕ), `(nat.gcd_one_left).mk_app [ey])
  | _, 1 := pure (c, `(1:ℕ), `(nat.gcd_one_right).mk_app [ex])
  | _, _ := do
    let (d, a, b) := nat.xgcd_aux x 1 0 y 0 1,
    if d = x then do
      (c, ea) ← c.of_nat (y / x),
      (c, _, p) ← prove_mul_nat c ex ea,
      pure (c, ex, `(nat_gcd_helper_dvd_left).mk_app [ex, ey, ea, p])
    else if d = y then do
      (c, ea) ← c.of_nat (x / y),
      (c, _, p) ← prove_mul_nat c ey ea,
      pure (c, ey, `(nat_gcd_helper_dvd_right).mk_app [ex, ey, ea, p])
    else do
      (c, ed) ← c.of_nat d,
      (c, ea) ← c.of_nat a.nat_abs,
      (c, eb) ← c.of_nat b.nat_abs,
      (c, eu) ← c.of_nat (x / d),
      (c, ev) ← c.of_nat (y / d),
      (c, _, pu) ← prove_mul_nat c ed eu,
      (c, _, pv) ← prove_mul_nat c ed ev,
      (c, etx, px) ← prove_mul_nat c ex ea,
      (c, ety, py) ← prove_mul_nat c ey eb,
      (c, p) ← if a ≥ 0 then prove_add_nat c ety ed etx else prove_add_nat c etx ed ety,
      let pf : expr := if a ≥ 0 then `(nat_gcd_helper_2) else `(nat_gcd_helper_1),
      pure (c, ed, pf.mk_app [ed, ex, ey, ea, eb, eu, ev, etx, ety, pu, pv, px, py, p])
  end

/-- Evaluates the `nat.lcm` function. -/
meta def prove_lcm_nat (c : instance_cache) (ex ey : expr) :
  tactic (instance_cache × expr × expr) := do
  x ← ex.to_nat,
  y ← ey.to_nat,
  match x, y with
  | 0, _ := pure (c, `(0:ℕ), `(nat.lcm_zero_left).mk_app [ey])
  | _, 0 := pure (c, `(0:ℕ), `(nat.lcm_zero_right).mk_app [ex])
  | 1, _ := pure (c, ey, `(nat.lcm_one_left).mk_app [ey])
  | _, 1 := pure (c, ex, `(nat.lcm_one_right).mk_app [ex])
  | _, _ := do
    (c, ed, pd) ← prove_gcd_nat c ex ey,
    (c, p0) ← prove_pos c ed,
    (c, en, xy) ← prove_mul_nat c ex ey,
    d ← ed.to_nat,
    (c, em) ← c.of_nat ((x * y) / d),
    (c, _, dm) ← prove_mul_nat c ed em,
    pure (c, em, `(nat_lcm_helper).mk_app [ex, ey, ed, em, en, pd, p0, xy, dm])
  end

/-- Evaluates the `int.gcd` function. -/
meta def prove_gcd_int (zc nc : instance_cache) : expr → expr →
  tactic (instance_cache × instance_cache × expr × expr)
| x y := match match_neg x with
  | some x := do
    (zc, nc, d, p) ← prove_gcd_int x y,
    pure (zc, nc, d, `(int_gcd_helper_neg_left).mk_app [x, y, d, p])
  | none := match match_neg y with
    | some y := do
      (zc, nc, d, p) ← prove_gcd_int x y,
      pure (zc, nc, d, `(int_gcd_helper_neg_right).mk_app [x, y, d, p])
    | none := do
      (zc, nc, nx, px) ← prove_nat_uncast zc nc x,
      (zc, nc, ny, py) ← prove_nat_uncast zc nc y,
      (nc, d, p) ← prove_gcd_nat nc nx ny,
      pure (zc, nc, d, `(int_gcd_helper).mk_app [x, y, nx, ny, d, px, py, p])
    end
  end

/-- Evaluates the `int.lcm` function. -/
meta def prove_lcm_int (zc nc : instance_cache) : expr → expr →
  tactic (instance_cache × instance_cache × expr × expr)
| x y := match match_neg x with
  | some x := do
    (zc, nc, d, p) ← prove_lcm_int x y,
    pure (zc, nc, d, `(int_lcm_helper_neg_left).mk_app [x, y, d, p])
  | none := match match_neg y with
    | some y := do
      (zc, nc, d, p) ← prove_lcm_int x y,
      pure (zc, nc, d, `(int_lcm_helper_neg_right).mk_app [x, y, d, p])
    | none := do
      (zc, nc, nx, px) ← prove_nat_uncast zc nc x,
      (zc, nc, ny, py) ← prove_nat_uncast zc nc y,
      (nc, d, p) ← prove_lcm_nat nc nx ny,
      pure (zc, nc, d, `(int_lcm_helper).mk_app [x, y, nx, ny, d, px, py, p])
    end
  end

/-- Evaluates the `nat.coprime` function. -/
meta def prove_coprime_nat (c : instance_cache) (ex ey : expr) :
  tactic (instance_cache × (expr ⊕ expr)) := do
  x ← ex.to_nat,
  y ← ey.to_nat,
  match x, y with
  | 1, _ := pure (c, sum.inl $ `(nat.coprime_one_left).mk_app [ey])
  | _, 1 := pure (c, sum.inl $ `(nat.coprime_one_right).mk_app [ex])
  | 0, 0 := pure (c, sum.inr `(nat.not_coprime_zero_zero))
  | 0, _ := do
    c ← mk_instance_cache `(ℕ),
    (c, p) ← prove_lt_nat c `(1) ey,
    pure (c, sum.inr $ `(nat_coprime_helper_zero_left).mk_app [ey, p])
  | _, 0 := do
    c ← mk_instance_cache `(ℕ),
    (c, p) ← prove_lt_nat c `(1) ex,
    pure (c, sum.inr $ `(nat_coprime_helper_zero_right).mk_app [ex, p])
  | _, _ := do
    c ← mk_instance_cache `(ℕ),
    let (d, a, b) := nat.xgcd_aux x 1 0 y 0 1,
    if d = 1 then do
      (c, ea) ← c.of_nat a.nat_abs,
      (c, eb) ← c.of_nat b.nat_abs,
      (c, etx, px) ← prove_mul_nat c ex ea,
      (c, ety, py) ← prove_mul_nat c ey eb,
      (c, p) ← if a ≥ 0 then prove_add_nat c ety `(1) etx else prove_add_nat c etx `(1) ety,
      let pf : expr := if a ≥ 0 then `(nat_coprime_helper_2) else `(nat_coprime_helper_1),
      pure (c, sum.inl $ pf.mk_app [ex, ey, ea, eb, etx, ety, px, py, p])
    else do
      (c, ed) ← c.of_nat d,
      (c, eu) ← c.of_nat (x / d),
      (c, ev) ← c.of_nat (y / d),
      (c, _, pu) ← prove_mul_nat c ed eu,
      (c, _, pv) ← prove_mul_nat c ed ev,
      (c, p) ← prove_lt_nat c `(1) ed,
      pure (c, sum.inr $ `(nat_not_coprime_helper).mk_app [ed, ex, ey, eu, ev, pu, pv, p])
  end

/-- Evaluates the `gcd`, `lcm`, and `coprime` functions. -/
@[norm_num] meta def eval_gcd : expr → tactic (expr × expr)
| `(nat.gcd %%ex %%ey) := do
    c ← mk_instance_cache `(ℕ),
    prod.snd <$> prove_gcd_nat c ex ey
| `(nat.lcm %%ex %%ey) := do
    c ← mk_instance_cache `(ℕ),
    prod.snd <$> prove_lcm_nat c ex ey
| `(nat.coprime %%ex %%ey) := do
    c ← mk_instance_cache `(ℕ),
    prove_coprime_nat c ex ey >>= sum.elim true_intro false_intro ∘ prod.snd
| `(int.gcd %%ex %%ey) := do
    zc ← mk_instance_cache `(ℤ),
    nc ← mk_instance_cache `(ℕ),
    (prod.snd ∘ prod.snd) <$> prove_gcd_int zc nc ex ey
| `(int.lcm %%ex %%ey) := do
    zc ← mk_instance_cache `(ℤ),
    nc ← mk_instance_cache `(ℕ),
    (prod.snd ∘ prod.snd) <$> prove_lcm_int zc nc ex ey
| _ := failed

end norm_num
end tactic


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/

import data.nat.sqrt data.int.basic

namespace int

/-- `sqrt n` is the square root of an integer `n`. If `n` is not a
  perfect square, and is positive, it returns the largest `k:ℤ` such
  that `k*k ≤ n`. If it is negative, it returns 0. For example,
  `sqrt 2 = 1` and `sqrt 1 = 1` and `sqrt (-1) = 0` -/
def sqrt (n : ℤ) : ℤ :=
nat.sqrt $ int.to_nat n

theorem sqrt_eq (n : ℤ) : sqrt (n*n) = n.nat_abs :=
by rw [sqrt, ← nat_abs_mul_self, to_nat_coe_nat, nat.sqrt_eq]

theorem exists_mul_self (x : ℤ) :
  (∃ n, n * n = x) ↔ sqrt x * sqrt x = x :=
⟨λ ⟨n, hn⟩, by rw [← hn, sqrt_eq, ← int.coe_nat_mul, nat_abs_mul_self],
λ h, ⟨sqrt x, h⟩⟩

theorem sqrt_nonneg (n : ℤ) : 0 ≤ sqrt n := trivial

end int


/-
Copyright (c) 2021 Lu-Ming Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Lu-Ming Zhang.
-/
import symmetric_matrix

/-!
# Circulant matrices

This file contains the definition and basic results about circulant matrices.

## Main results

- `matrix.cir`: introduce the definition of a circulant matrix generated by a given vector `v : I → α`.

## Implementation notes

`fin.foo` is the `fin n` version of `foo`.
Namely, the index type of the circulant matrices in discussion is `fin n`.

## Tags

cir, matrix
-/

variables {α I R : Type*} [fintype I] {n : ℕ}

namespace matrix
open_locale matrix big_operators

/-- Given the condition `[has_sub I]` and a vector `v : I → α`,
    we define `cir v` to be the circulant matrix generated by `v` of type `matrix I I α`. -/
def cir [has_sub I] (v : I → α) : matrix I I α
| i j := v (i - j)

/-- When `I` is an `add_group`, the 0th column of `cir v` is `v`. -/
lemma cir_col_zero_eq [add_group I] (v : I → α) :
(λ i, (cir v) i 0) = v := by ext; simp [cir]

/-- When `I` is an `add_group`, `cir v = cir w ↔ v = w`. -/
lemma cir_ext_iff [add_group I] {v w : I → α} :
cir v = cir w ↔ v = w :=
begin
  split,
  { intro h, rw [← cir_col_zero_eq v, ← cir_col_zero_eq w, h] },
  { rintro rfl, refl }
end

lemma fin.cir_ext_iff {v w : fin n → α} :
cir v = cir w ↔ v = w :=
begin
  induction n with n ih,
  {tidy},
  exact cir_ext_iff
end

/-- The sum of two circulant matrices `cir v` and `cir w` is also a circulant matrix `cir (v + w)`. -/
lemma cir_add [has_add α] [has_sub I] (v w : I → α) :
cir v + cir w = cir (v + w) := by ext; simp [cir]

/-- The product of two circulant matrices `cir v` and `cir w` is also a circulant matrix `cir (mul_vec (cir w) v)`. -/
lemma cir_mul [comm_semiring α] [add_comm_group I] (v w : I → α) :
cir v ⬝ cir w = cir (mul_vec (cir w) v) :=
begin
  ext i j,
  simp [mul_apply, mul_vec, cir, dot_product],
  refine fintype.sum_equiv ((equiv.add_left (-i)).trans (equiv.neg _)) _ _ _,
  simp [mul_comm],
  intro x,
  congr' 2; abel
end

lemma fin.cir_mul [comm_semiring α] (v w : fin n → α) :
cir v ⬝ cir w = cir (mul_vec (cir w) v) :=
begin
  induction n with n ih, {refl},
  exact cir_mul v w,
end

/-- Circulant matrices commute in multiplication under certain condations. -/
lemma cir_mul_comm
[comm_semigroup α] [add_comm_monoid α] [add_comm_group I] (v w : I → α) :
cir v ⬝ cir w = cir w ⬝ cir v :=
begin
  ext i j,
  simp [mul_apply, cir, mul_comm],
  refine fintype.sum_equiv (((equiv.add_right (-i)).trans (equiv.neg _)).trans (equiv.add_right j)) _ _ _,
  simp,
  intro x,
  congr' 2; abel
end

lemma fin.cir_mul_comm
[comm_semigroup α] [add_comm_monoid α] (v w : fin n → α) :
cir v ⬝ cir w = cir w ⬝ cir v :=
begin
  induction n with n ih, {refl},
  exact cir_mul_comm v w,
end

/-- `k • cir v` is another circluant matrix `cir (k • v)`. -/
lemma smul_cir [has_sub I] [has_scalar R α] {k : R} {v : I → α} :
k • cir v = cir (k • v) := by {ext, simp [cir]}

/-- The identity matrix is a circulant matrix. -/
lemma one_eq_cir [has_zero α] [has_one α] [decidable_eq I] [add_group I]:
(1 : matrix I I α) = cir (λ i, ite (i = 0) 1 0) :=
begin
  ext,
  simp [cir, one_apply],
  congr' 1,
  apply propext,
  exact sub_eq_zero.symm
end

/-- An alternative version of `one_eq_cir`. -/
lemma one_eq_cir' [has_zero α] [has_one α] [decidable_eq I] [add_group I]:
(1 : matrix I I α) = cir (λ i, (1 : matrix I I α) i 0) := one_eq_cir

lemma fin.one_eq_cir [has_zero α] [has_one α] :
(1 : matrix (fin n) (fin n) α) = cir (λ i, ite (i.1 = 0) 1 0) :=
begin
  induction n with n, {dec_trivial},
  convert one_eq_cir,
  ext, congr' 1,
  apply propext,
  exact (fin.ext_iff x 0).symm
end

/-- For a one-ary predicate `p`, `p` applied to every entry of `cir v` is true if `p` applied to every entry of `v` is true. -/
lemma pred_cir_entry_of_pred_vec_entry [has_sub I] {p : α → Prop} {v : I → α} :
(∀ k, p (v k)) → ∀ i j, p ((cir v) i j) :=
begin
  intros h i j,
  simp [cir],
  exact h (i - j),
end

/-- Given a set `S`, every entry of `cir v` is in `S` if every entry of `v` is in `S`. -/
lemma cir_entry_in_of_vec_entry_in [has_sub I] {S : set α} {v : I → α} :
(∀ k, v k ∈ S) → ∀ i j, (cir v) i j ∈ S :=
@pred_cir_entry_of_pred_vec_entry α I _ _ S v

/-- The circulant matrix `cir v` is symmetric iff `∀ i j, v (j - i) = v (i - j)`. -/
lemma cir_is_sym_ext_iff' [has_sub I] {v : I → α} :
(cir v).is_sym ↔ ∀ i j, v (j - i) = v (i - j) :=
by simp [is_sym.ext_iff, cir]

/-- The circulant matrix `cir v` is symmetric iff `v (- i) = v i` if `[add_group I]`. -/
lemma cir_is_sym_ext_iff [add_group I] {v : I → α} :
(cir v).is_sym ↔ ∀ i, v (- i) = v i :=
begin
  rw [cir_is_sym_ext_iff'],
  split,
  { intros h i, convert h i 0; simp },
  { intros h i j, convert h (i - j), simp }
end

lemma fin.cir_is_sym_ext_iff {v : fin n → α} :
(cir v).is_sym ↔ ∀ i, v (- i) = v i :=
begin
  induction n with n ih,
  { rw [cir_is_sym_ext_iff'],
    split;
    {intros h i, have :=i.2, simp* at *} },
  convert cir_is_sym_ext_iff,
end

/-- If `cir v` is symmetric, `∀ i j : I, v (j - i) = v (i - j)`. -/
lemma cir_is_sym_apply' [has_sub I] {v : I → α} (h : (cir v).is_sym) (i j : I) :
v (j - i) = v (i - j) := cir_is_sym_ext_iff'.1 h i j

/-- If `cir v` is symmetric, `∀ i j : I, v (- i) = v i`. -/
lemma cir_is_sym_apply [add_group I] {v : I → α} (h : (cir v).is_sym) (i : I) :
v (-i) = v i := cir_is_sym_ext_iff.1 h i

lemma fin.cir_is_sym_apply {v : fin n → α} (h : (cir v).is_sym) (i : fin n) :
v (-i) = v i := fin.cir_is_sym_ext_iff.1 h i

/-- The associated polynomial `(v 0) + (v 1) * X + ... + (v (n-1)) * X ^ (n-1)` to `cir v`.-/
noncomputable def cir_poly [semiring α] (v : fin n → α) : polynomial α :=
∑ i : fin n, polynomial.monomial i (v i)

/-- `cir_perm n` is the cyclic permutation over `fin n`. -/
def cir_perm : Π n, equiv.perm (fin n) := λ n, equiv.symm (fin_rotate n)

/-- `cir_P α n` is the cyclic permutation matrix of order `n` with entries of type `α`. -/
def cir_P (α) [has_zero α] [has_one α] (n : ℕ) :
matrix (fin n) (fin n) α := equiv.perm.to_matrix α (cir_perm n)

end matrix


/-
Copyright (c) 2020 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.degree.default
import Mathlib.data.polynomial.degree.trailing_degree
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Erase the leading term of a univariate polynomial

## Definition

* `erase_lead f`: the polynomial `f - leading term of f`

`erase_lead` serves as reduction step in an induction, shaving off one monomial from a polynomial.
The definition is set up so that it does not mention subtraction in the definition,
and thus works for polynomials over semirings as well as rings.
-/

namespace polynomial

/-- `erase_lead f` for a polynomial `f` is the polynomial obtained by
subtracting from `f` the leading term of `f`. -/
def erase_lead {R : Type u_1} [semiring R] (f : polynomial R) : polynomial R :=
  finsupp.erase (nat_degree f) f

theorem erase_lead_support {R : Type u_1} [semiring R] (f : polynomial R) : finsupp.support (erase_lead f) = finset.erase (finsupp.support f) (nat_degree f) := sorry

-- `rfl` fails because LHS uses `nat.decidable_eq` but RHS is classical.

theorem erase_lead_coeff {R : Type u_1} [semiring R] {f : polynomial R} (i : ℕ) : coeff (erase_lead f) i = ite (i = nat_degree f) 0 (coeff f i) := sorry

-- `rfl` fails because LHS uses `nat.decidable_eq` but RHS is classical.

@[simp] theorem erase_lead_coeff_nat_degree {R : Type u_1} [semiring R] {f : polynomial R} : coeff (erase_lead f) (nat_degree f) = 0 :=
  finsupp.erase_same

theorem erase_lead_coeff_of_ne {R : Type u_1} [semiring R] {f : polynomial R} (i : ℕ) (hi : i ≠ nat_degree f) : coeff (erase_lead f) i = coeff f i :=
  finsupp.erase_ne hi

@[simp] theorem erase_lead_zero {R : Type u_1} [semiring R] : erase_lead 0 = 0 :=
  finsupp.erase_zero (nat_degree 0)

@[simp] theorem erase_lead_add_monomial_nat_degree_leading_coeff {R : Type u_1} [semiring R] (f : polynomial R) : erase_lead f + coe_fn (monomial (nat_degree f)) (leading_coeff f) = f := sorry

@[simp] theorem erase_lead_add_C_mul_X_pow {R : Type u_1} [semiring R] (f : polynomial R) : erase_lead f + coe_fn C (leading_coeff f) * X ^ nat_degree f = f := sorry

@[simp] theorem self_sub_monomial_nat_degree_leading_coeff {R : Type u_1} [ring R] (f : polynomial R) : f - coe_fn (monomial (nat_degree f)) (leading_coeff f) = erase_lead f :=
  Eq.symm (iff.mpr eq_sub_iff_add_eq (erase_lead_add_monomial_nat_degree_leading_coeff f))

@[simp] theorem self_sub_C_mul_X_pow {R : Type u_1} [ring R] (f : polynomial R) : f - coe_fn C (leading_coeff f) * X ^ nat_degree f = erase_lead f := sorry

theorem erase_lead_ne_zero {R : Type u_1} [semiring R] {f : polynomial R} (f0 : bit0 1 ≤ finset.card (finsupp.support f)) : erase_lead f ≠ 0 := sorry

@[simp] theorem nat_degree_not_mem_erase_lead_support {R : Type u_1} [semiring R] {f : polynomial R} : ¬nat_degree f ∈ finsupp.support (erase_lead f) := sorry

theorem ne_nat_degree_of_mem_erase_lead_support {R : Type u_1} [semiring R] {f : polynomial R} {a : ℕ} (h : a ∈ finsupp.support (erase_lead f)) : a ≠ nat_degree f := sorry

theorem erase_lead_support_card_lt {R : Type u_1} [semiring R] {f : polynomial R} (h : f ≠ 0) : finset.card (finsupp.support (erase_lead f)) < finset.card (finsupp.support f) := sorry

theorem erase_lead_card_support {R : Type u_1} [semiring R] {f : polynomial R} {c : ℕ} (fc : finset.card (finsupp.support f) = c) : finset.card (finsupp.support (erase_lead f)) = c - 1 := sorry

theorem erase_lead_card_support' {R : Type u_1} [semiring R] {f : polynomial R} {c : ℕ} (fc : finset.card (finsupp.support f) = c + 1) : finset.card (finsupp.support (erase_lead f)) = c :=
  erase_lead_card_support fc

@[simp] theorem erase_lead_monomial {R : Type u_1} [semiring R] (i : ℕ) (r : R) : erase_lead (coe_fn (monomial i) r) = 0 := sorry

@[simp] theorem erase_lead_C {R : Type u_1} [semiring R] (r : R) : erase_lead (coe_fn C r) = 0 :=
  erase_lead_monomial 0 r

@[simp] theorem erase_lead_X {R : Type u_1} [semiring R] : erase_lead X = 0 :=
  erase_lead_monomial 1 1

@[simp] theorem erase_lead_X_pow {R : Type u_1} [semiring R] (n : ℕ) : erase_lead (X ^ n) = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (erase_lead (X ^ n) = 0)) (X_pow_eq_monomial n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (erase_lead (coe_fn (monomial n) 1) = 0)) (erase_lead_monomial n 1))) (Eq.refl 0))

@[simp] theorem erase_lead_C_mul_X_pow {R : Type u_1} [semiring R] (r : R) (n : ℕ) : erase_lead (coe_fn C r * X ^ n) = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (erase_lead (coe_fn C r * X ^ n) = 0)) (C_mul_X_pow_eq_monomial r n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (erase_lead (coe_fn (monomial n) r) = 0)) (erase_lead_monomial n r))) (Eq.refl 0))

theorem erase_lead_degree_le {R : Type u_1} [semiring R] {f : polynomial R} : degree (erase_lead f) ≤ degree f := sorry

theorem erase_lead_nat_degree_le {R : Type u_1} [semiring R] {f : polynomial R} : nat_degree (erase_lead f) ≤ nat_degree f :=
  nat_degree_le_nat_degree erase_lead_degree_le

theorem erase_lead_nat_degree_lt {R : Type u_1} [semiring R] {f : polynomial R} (f0 : bit0 1 ≤ finset.card (finsupp.support f)) : nat_degree (erase_lead f) < nat_degree f :=
  lt_of_le_of_ne erase_lead_nat_degree_le
    (ne_nat_degree_of_mem_erase_lead_support (nat_degree_mem_support_of_nonzero (erase_lead_ne_zero f0)))

theorem erase_lead_nat_degree_lt_or_erase_lead_eq_zero {R : Type u_1} [semiring R] (f : polynomial R) : nat_degree (erase_lead f) < nat_degree f ∨ erase_lead f = 0 := sorry

/-- An induction lemma for polynomials. It takes a natural number `N` as a parameter, that is
required to be at least as big as the `nat_degree` of the polynomial.  This is useful to prove
results where you want to change each term in a polynomial to something else depending on the
`nat_degree` of the polynomial itself and not on the specific `nat_degree` of each term. -/
theorem induction_with_nat_degree_le {R : Type u_1} [semiring R] {P : polynomial R → Prop} (N : ℕ) (P_0 : P 0) (P_C_mul_pow : ∀ (n : ℕ) (r : R), r ≠ 0 → n ≤ N → P (coe_fn C r * X ^ n)) (P_C_add : ∀ (f g : polynomial R), nat_degree f ≤ N → nat_degree g ≤ N → P f → P g → P (f + g)) (f : polynomial R) : nat_degree f ≤ N → P f := sorry


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import probability.probability_mass_function.uniform
import to_mathlib.pmf_stuff
import algebra.big_operators.fin

/-!
# Uniform constructions on pmf
-/

variables {α β : Type}

open_locale classical big_operators nnreal ennreal

namespace pmf

lemma to_outer_measure_uniform_of_fintype_apply' [fintype α] [nonempty α] (e : set α) [decidable_pred (∈ e)] :
  (pmf.uniform_of_fintype α).to_outer_measure e = (finset.univ.filter (∈ e)).card / fintype.card α :=
begin
  rw [to_outer_measure_uniform_of_fintype_apply, fintype.card_of_finset],
  congr,
end

-- NOTE: PR opened for this
section uniform_of_list

noncomputable def uniform_of_list (l : list α) (h : ¬ l.empty) : pmf α :=
pmf.of_multiset (quotient.mk l) (λ hl, h ((multiset.coe_eq_zero_iff_empty l).1 hl))

variables (l : list α) (h : ¬ l.empty)

@[simp] lemma support_uniform_of_list : (uniform_of_list l h).support = {x | x ∈ l} :=
trans (pmf.support_of_multiset _) (set.ext $ λ x, by simp only [multiset.quot_mk_to_coe,
  finset.mem_coe, multiset.mem_to_finset, multiset.mem_coe, set.mem_set_of_eq])

lemma mem_support_uniform_of_list_iff (a : α) : a ∈ (uniform_of_list l h).support ↔ a ∈ l :=
by simp only [support_uniform_of_list, set.mem_set_of_eq]

@[simp] lemma uniform_of_list_apply (a : α) : uniform_of_list l h a = l.count a / l.length :=
by rw [uniform_of_list, pmf.of_multiset_apply, multiset.quot_mk_to_coe,
  multiset.coe_count, multiset.coe_card]

lemma uniform_of_list_apply_of_not_mem (a : α) (ha : a ∉ l) : uniform_of_list l h a = 0 :=
(pmf.apply_eq_zero_iff _ a).2 (mt (mem_support_uniform_of_list_iff l h a).1 ha)

section measure

@[simp] lemma to_outer_measure_uniform_of_list_apply (t : set α) :
  (uniform_of_list l h).to_outer_measure t = l.countp t / l.length :=
calc (uniform_of_list l h).to_outer_measure t
  = (∑' x, (l.filter t).count x) / l.length : by simpa only [uniform_of_list,
    to_outer_measure_of_multiset_apply, list.length, multiset.quot_mk_to_coe, multiset.coe_filter,
    multiset.coe_count, multiset.coe_card]
  ... = (∑ x in l.to_finset, (l.filter t).count x) / l.length : begin
    refine congr_arg (λ x, x / (l.length : ℝ≥0∞)) (tsum_eq_sum $ λ y hy, _),
    rw [list.mem_to_finset] at hy,
    simpa only [nat.cast_eq_zero, list.count_eq_zero, list.mem_filter, not_and]
      using (false.elim ∘ hy),
  end
  ... = (∑ x in (l.to_finset.filter t), ↑(l.count x)) / l.length : begin
    refine congr_arg (λ x, x / (l.length : ℝ≥0∞)) _,
    rw [finset.sum_filter],
    refine finset.sum_congr rfl (λ x hx, _),
    split_ifs with hxt,
    { exact congr_arg coe (list.count_filter hxt) },
    { simp only [nat.cast_eq_zero, list.count_eq_zero, list.mem_filter,
        not_and, hxt, not_false_iff, imp_true_iff] }
  end
  ... = ↑(∑ x in (l.to_finset.filter t), l.count x) / l.length : by rw nat.cast_sum
  ... = l.countp t / l.length : by rw [finset.sum_filter_count_eq_countp]

@[simp]
lemma to_measure_uniform_of_list_apply (t : set α) [measurable_space α] (ht : measurable_set t) :
  (uniform_of_list l h).to_measure t = l.countp t / l.length :=
(to_measure_apply_eq_to_outer_measure_apply _ t ht).trans
  (to_outer_measure_uniform_of_list_apply l h t)

end measure

-- NOTE : NOT IN PR
lemma uniform_of_finset_eq_uniform_of_list_to_list (s : finset α) (h : s.nonempty) :
  uniform_of_finset s h = uniform_of_list s.to_list (finset.nonempty.not_empty_to_list h) :=
begin
  ext x,
  simp only [finset.count_to_list, div_eq_mul_inv, uniform_of_finset_apply, uniform_of_list_apply,
    nat.cast_ite, nat.cast_one, nat.cast_zero, finset.length_to_list, boole_mul],
end

end uniform_of_list

section uniform_of_vector

noncomputable def uniform_of_vector {n : ℕ} (v : vector α (n + 1)) : pmf α :=
uniform_of_list v.1 (vector.not_empty_to_list v)

variables {n : ℕ} (v : vector α (n + 1))

@[simp]
lemma support_uniform_of_vector : (uniform_of_vector v).support = {x | x ∈ v.to_list} :=
support_uniform_of_list v.1 (vector.not_empty_to_list v)

@[simp]
lemma uniform_of_vector_apply (a : α) : uniform_of_vector v a = v.to_list.count a / ↑(n + 1) :=
(uniform_of_list_apply v.1 _ a).trans (congr_arg (λ x, _ / x) (congr_arg coe v.length_coe))

lemma uniform_of_vector_eq_nth_map_uniform_of_fintype :
  uniform_of_vector v = pmf.map v.nth (uniform_of_fintype $ fin (n + 1)) :=
pmf.ext (λ x, by calc uniform_of_vector v x
  = v.to_list.count x / n.succ : uniform_of_vector_apply v x
  ... = ↑(∑ i, ite (x = v.nth i) 1 0) / n.succ :
    by rw [← fin.card_filter_univ_eq_vector_nth_eq_count,
      finset.card_eq_sum_ones, finset.sum_filter]
  ... = (∑ i, ite (x = v.nth i) 1 0) / n.succ : by simp only [finset.sum_boole, nat.cast_id]
  ... = (∑' i, ite (x = v.nth i) 1 0) / n.succ :
    congr_arg (λ z, z / (n.succ : ℝ≥0∞)) (tsum_eq_sum $ λ y hy, (hy $ finset.mem_univ y).elim).symm
  ... = pmf.map v.nth (uniform_of_fintype $ fin n.succ) x :
    by simp only [div_eq_mul_inv, ←ennreal.tsum_mul_right, boole_mul, map_apply,
      uniform_of_fintype_apply, fintype.card_fin])

section measure

@[simp]
lemma to_outer_measure_uniform_of_vector_apply (t : set α) :
  (uniform_of_vector v).to_outer_measure t = v.to_list.countp t / ↑(n + 1) :=
(to_outer_measure_uniform_of_list_apply v.1 _ t).trans
  (congr_arg (λ x, _ / x) (congr_arg coe v.length_coe))

@[simp]
lemma to_measure_uniform_of_vector_apply (t : set α) [measurable_space α] (ht : measurable_set t) :
  (uniform_of_vector v).to_measure t = v.to_list.countp t / ↑(n + 1) :=
(to_measure_apply_eq_to_outer_measure_apply _ t ht).trans
  (to_outer_measure_uniform_of_vector_apply v t)

end measure

end uniform_of_vector

end pmf

lemma sum_ite_eq_nth {β : Type} [add_comm_monoid_with_one β]
  (a : α) {n : ℕ} (v : vector α n) :
  ∑ i, ite (v.nth i = a) (1 : β) 0 = ↑(v.to_list.count a) :=
begin
  induction n with n hn,
  { simp [vector.eq_nil v] },
  { obtain ⟨x, xs, hxs⟩ := vector.exists_eq_cons v,
    suffices : ite (x = a) 1 0 + (list.count a xs.to_list : β) =
      ite (x = a) ((list.count a xs.to_list) + 1) (list.count a xs.to_list),
    by simpa only [hxs, fin.sum_univ_succ, vector.to_list_cons, list.count_cons,
      vector.nth_cons_zero, @eq_comm _ a, hn xs, fin.coe_eq_cast_succ, fin.coe_succ_eq_succ,
      vector.nth_cons_succ, nat.cast_ite, nat.cast_succ] using this,
    split_ifs,
    { exact add_comm _ _ },
    { exact zero_add _ } }
end

lemma tsum_ite_eq_vector_nth {β : Type} [add_comm_monoid_with_one β]
  [topological_space β] [t2_space β] {n : ℕ} (v : vector α n) (a : α) :
  ∑' (i : fin n), ite (v.nth i = a) (1 : β) 0 = ↑(v.to_list.count a) :=
calc ∑' (i : fin n), ite (v.nth i = a) (1 : β) 0
  = ∑ (i : fin n), ite (v.nth i = a) (1 : β) 0 :
    tsum_eq_sum (λ _ hb, (hb $ finset.mem_univ _).elim)
  ... = (v.to_list.count a) : (sum_ite_eq_nth a v)


/-
Finally we implement the function using a Java
style of syntax.
-/
namespace impl_cstyle

def sub1 (n : ℕ) : ℕ :=   -- first arg named to left of :
  match n with            -- match does case analysis after all
  | 0 := 0
  | (n' + 1) := n'
  end

def add2 (n : ℕ) := n+2   -- n+2 is short for succ(succ n)!

/-
Our tests suggest our functions are working yet again.
-/
example : sub1 0 = 0 := rfl
example : sub1 1 = 0 := rfl
example : sub1 2 = 1 := rfl
example : sub1 3 = 1 := rfl  -- bad test
example : add2 0 = 2 := rfl
example : add2 1 = 3 := rfl
example : add2 2 = 4 := rfl
example : add2 3 = 6 := rfl -- bad test

end impl_cstyle

/-
Next we define functions that implement
Boolean  "and." Note that in each case we
"pattern match" on both arguments.
-/

def my_bool_and : bool → bool → bool
| tt tt := tt
| tt ff := ff
| ff tt := ff
| ff ff := ff

/-
Evaluation of this "cases" syntax
is, again, in top-to-bottomorder:
if the arguments match the first
pattern (tt tt), this function return
the value expressed to the right of
that := (tt). If the arguments don't
match the first pattern, Lean moves
on to the next, until a match is found
and the corresponding result is returned.
Lean will tell you if you've forgotten
a possible combination of argument
values. Try it by commenting out one
of the cases.
-/

/-
A nice property of this syntax is that the
truth table for "Boolean and" is as clear as
day. That said, after the first of the rules,
the rest all return false. You can use the
"wildcard" character, _ (underscore) in Lean
to match any value to avoid having to write
the three rules separately.
 -/

def my_bool_and2 : bool → bool → bool
| tt tt := tt
| _ _ := ff

/-
Maybe at this point you're not sure that these
two functions have exactly the same meaning.
Let's check that by stating the proposition
that they return the same values for all of
the possible combinations of argument values,
and proving it. The proof is by case analysis
on the possible values of the arguments.
-/

example :
  ∀ (b1 b2 : bool),
    my_bool_and b1 b2 =
    my_bool_and2 b1 b2
  :=
begin
assume b1 b2, -- bind argument names

-- case analysis on b1
cases b1,

-- b1 false

-- case analysis on b2
cases b2,
-- b2 false
apply rfl,
-- b2 true
apply rfl,

-- b1 true

-- case analysis on b2
cases b2,
-- b2 false
apply rfl,
-- b2 true
apply rfl,
end

/-
Here are test cases
-/
example : my_bool_and tt tt = tt := rfl
example : my_bool_and tt ff = ff := rfl
example : my_bool_and ff tt = ff := rfl
example : my_bool_and ff ff = ff := rfl

/-
Functions in Lean must be "total," which means that
they must be defined to return values of the right
types for *all* possible combinations of arguments.
If you delete cases from the my_bool_and definition
you'll get a missing cases error and the following
evaluations will "block" on the undefined cases. Try
it!
-/


import plane_separation_world.level02 --hide
open IncidencePlane --hide

/-
# Plane Separation World

## Level 3: proving useful lemmas...

To solve the following levels, we may want to use the lemma that we are going to prove now. Here you have some hints that could help you to step through it!

**Hint 1:** Whenever you see the word `collinear`, the `unfold` tactic will make progress.

**Hint 2:** Whenever you find a goal or hypothesis of the form `∀ {X : Ω}, X ∈ {A, B, C} → X ∈ r`, the `simp` tactic will make progress.

**Hint 3:** To solve the first goal, you may want to use the theorem statement `incidence` with the `rewrite` tactic.
-/

/- Hint : Click here for a hint, in case you get stuck.
... Still bewildered? Click on "View source" (located on the top right
corner of the game screen) to see the solution.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide
variables {A B C P Q R : Ω} --hide
variables {ℓ r s t : Line Ω} --hide

/- Lemma :
Given three distinct points, they are on the same line if and only if they are collinear.
-/
lemma collinear_iff_on_line_through (h : A ≠ B) : collinear ({A, B, C} : set Ω) ↔ C ∈ line_through A B :=
begin
split,
{
  intro h1,
  unfold collinear at h1,
  cases h1 with ℓ hℓ,
  simp at hℓ,
  rw ← (incidence h hℓ.1 hℓ.2.1),
  exact hℓ.2.2,
},
{
  intro h1,
  unfold collinear,
  use line_through A B,
  simp,
  exact h1,
},
end


import data.real.basic
import data.real.irrational
import data.real.sqrt
import analysis.special_functions.pow

def rational (x : ℝ) := ∃ a b : ℤ, x = a / b

notation `√` a := real.sqrt a

/- Prove that there exist irrational numbers a and b such that a ^ b is rational.
   A paper-pencil proof:
   Let a = b = √2.
   Since a ^ b is either rational or not rational, we have two cases:
   Case 1, if a ^ b is rational, then the result is proved.
   Case 2, if a ^ b is irrational, take b' = √2.
      (a ^ b) ^ b' = (√2 ^ √2) ^ √2 = √2 ^ (√2 * √2) = 2, which is rational.
  In any case, we proved that there exist irrational numbers a and b such that a ^ b is rational.
  Q.E.D.
-/

lemma rational_two : rational 2 :=
begin
  use [2, 1],
  norm_num,
end

lemma irrational_of_not_rational {x : ℝ} (h : ¬ rational x) : irrational x :=
begin
  rw irrational_iff_ne_rational,
  rw rational at h,
  push_neg at h,
  exact h,
end

example : ∃ a b : ℝ, irrational a ∧ irrational b ∧ rational (a ^ b) :=
begin
  let a := √2,
  let b := √2,
  by_cases rational (a ^ b),
  { use [a, b],
    exact ⟨irrational_sqrt_two, irrational_sqrt_two, h⟩, },
  { let b' := √2,
    use [a ^ b, b'],
    have rational_exp : rational ((a ^ b) ^ b'),
    { have exp_eq_2 : (a ^ b) ^ b' = 2,
      calc (a ^ b) ^ b' = ((√2) ^ √2) ^ √2 : by refl
      ...               = (√2) ^ ((√2) * √2) : by rw ← real.rpow_mul (real.sqrt_nonneg 2)
      ...               = 2 : by simp,
      rw exp_eq_2,
      exact rational_two, },
      exact ⟨irrational_of_not_rational h, irrational_sqrt_two, rational_exp⟩,
    },
end


import algebra.big_operators data.fintype
import tactic.ring
import tidy.tidy

-- https://xenaproject.wordpress.com/2018/03/30/proofs-by-induction/

open nat

def odd : ℕ → ℕ := λ i, 2 * i + 1
def square : ℕ → ℕ := λ i, i * i
@[ematch] theorem odd_square_inductive_step (d : ℕ) :
   odd d + square d = square (d+1) :=
begin dsimp [square, odd], ring, end

namespace def1

definition my_sum_to_n (summand : ℕ → ℕ) : ℕ → ℕ
| 0     := 0
| (n+1) := my_sum_to_n n + summand n

-- TODO do we really need this? Can we write a tactic that unfolds a definition if it matches a case?
@[simp] theorem my_successor_theorem (summand : ℕ → ℕ) (n : ℕ) :
  my_sum_to_n summand (n+1) = my_sum_to_n summand n + summand n :=
by obviously

-- FIXME can't use obviously here: `abstract` causes problems.
theorem my_odd_square_theorem : ∀ (n : ℕ), my_sum_to_n odd n = square n
| 0     := rfl
| (n+1) := begin obviously'' end

end def1

namespace def2

definition my_sum_to_n (summand : ℕ → ℕ) : ℕ → ℕ :=
λ n, ((list.range n).map summand).sum

theorem my_zero_theorem (summand : ℕ → ℕ) :
  my_sum_to_n summand 0 = 0 :=
rfl

theorem my_successor_theorem (summand : ℕ → ℕ) (n : ℕ) :
  my_sum_to_n summand (succ n) = my_sum_to_n summand n + summand n :=
by unfold my_sum_to_n; simp [list.range_concat]

theorem my_odd_square_theorem : ∀ (n : ℕ), my_sum_to_n odd n = square n
| 0        := rfl
| (succ n) := by rw [my_successor_theorem, my_odd_square_theorem n]; simp; exact odd_square_inductive_step n

end def2

namespace def3

definition my_sum_to_n (summand : ℕ → ℕ) : ℕ → ℕ :=
λ n, (finset.range n).sum summand

theorem my_zero_theorem (summand : ℕ → ℕ) :
  my_sum_to_n summand 0 = 0 :=
rfl

theorem my_successor_theorem (summand : ℕ → ℕ) (n : ℕ) :
  my_sum_to_n summand (succ n) = my_sum_to_n summand n + summand n :=
by unfold my_sum_to_n; simp

theorem my_odd_square_theorem : ∀ (n : ℕ), my_sum_to_n odd n = square n
| 0        := rfl
| (succ n) := by rw [my_successor_theorem, my_odd_square_theorem n]; simp; exact odd_square_inductive_step n

end def3

namespace def4

open finset nat

-- Credits to Chris Hughes
theorem chris (n : ℕ) (f : ℕ → ℕ) (g : fin n → ℕ) (h : ∀ i : fin n, f i.1  = g i) :
    (range n).sum f = univ.sum g :=
sum_bij
  (λ i h, ⟨i, mem_range.1 h⟩)
  (λ i h, mem_univ _)
  (λ a ha, h ⟨a, _⟩)
  (λ _ _ _ _, fin.veq_of_eq)
  (λ ⟨b, hb⟩ _, ⟨b, mem_range.2 hb, rfl⟩)

definition my_sum_to_n (summand : ℕ → ℕ) : ℕ → ℕ :=
λ n, (@finset.univ (fin n) _).sum (summand ∘ fin.val)

theorem my_zero_theorem (summand : ℕ → ℕ) :
  my_sum_to_n summand 0 = 0 :=
rfl

-- Credits to Mario Carneiro
theorem my_successor_theorem (summand : ℕ → ℕ) (n : ℕ) :
  my_sum_to_n summand (succ n) = my_sum_to_n summand n + summand n :=
by unfold my_sum_to_n;
rw [← chris _ _ _ (λ _, rfl), ← chris _ _ _ (λ _, rfl)]; simp

theorem my_odd_square_theorem : ∀ (n : ℕ), my_sum_to_n odd n = square n
| 0        := rfl
| (succ n) := by rw [my_successor_theorem, my_odd_square_theorem n]; simp; exact odd_square_inductive_step n

end def4

namespace equality

theorem def12 : def1.my_sum_to_n = def2.my_sum_to_n :=
funext $ λ summand, funext $ λ n, nat.rec_on n rfl $
λ m ih, by rw [def1.my_successor_theorem, def2.my_successor_theorem, ih]

theorem def23 : def2.my_sum_to_n = def3.my_sum_to_n :=
funext $ λ summand, funext $ λ n, nat.rec_on n rfl $
λ m ih, by rw [def2.my_successor_theorem, def3.my_successor_theorem, ih]

theorem def34 : def3.my_sum_to_n = def4.my_sum_to_n :=
funext $ λ summand, funext $ λ n, nat.rec_on n rfl $
λ m ih, by rw [def3.my_successor_theorem, def4.my_successor_theorem, ih]

end equality


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

! This file was ported from Lean 3 source module ring_theory.prime
! leanprover-community/mathlib commit 008205aa645b3f194c1da47025c5f110c8406eab
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Associated
import Mathlib.Algebra.BigOperators.Basic

/-!
# Prime elements in rings
This file contains lemmas about prime elements of commutative rings.
-/

section CancelCommMonoidWithZero

variable {R : Type _} [CancelCommMonoidWithZero R]

open Finset

open BigOperators

/-- If `x * y = a * ∏ i in s, p i` where `p i` is always prime, then
  `x` and `y` can both be written as a divisor of `a` multiplied by
  a product over a subset of `s`  -/
theorem mul_eq_mul_prime_prod {α : Type _} [DecidableEq α] {x y a : R} {s : Finset α} {p : α → R}
    (hp : ∀ i ∈ s, Prime (p i)) (hx : x * y = a * ∏ i in s, p i) :
    ∃ (t u : Finset α)(b c : R),
      t ∪ u = s ∧ Disjoint t u ∧ a = b * c ∧ (x = b * ∏ i in t, p i) ∧ y = c * ∏ i in u, p i := by
  induction' s using Finset.induction with i s his ih generalizing x y a
  · exact ⟨∅, ∅, x, y, by simp [hx]⟩
  · rw [prod_insert his, ← mul_assoc] at hx
    have hpi : Prime (p i) := hp i (mem_insert_self _ _)
    rcases ih (fun i hi ↦ hp i (mem_insert_of_mem hi)) hx with
      ⟨t, u, b, c, htus, htu, hbc, rfl, rfl⟩
    have hit : i ∉ t := fun hit ↦ his (htus ▸ mem_union_left _ hit)
    have hiu : i ∉ u := fun hiu ↦ his (htus ▸ mem_union_right _ hiu)
    obtain ⟨d, rfl⟩ | ⟨d, rfl⟩ : p i ∣ b ∨ p i ∣ c
    exact hpi.dvd_or_dvd ⟨a, by rw [← hbc, mul_comm]⟩
    · rw [mul_assoc, mul_comm a, mul_right_inj' hpi.ne_zero] at hbc
      exact ⟨insert i t, u, d, c, by rw [insert_union, htus], disjoint_insert_left.2 ⟨hiu, htu⟩, by
          simp [hbc, prod_insert hit, mul_assoc, mul_comm, mul_left_comm]⟩
    · rw [← mul_assoc, mul_right_comm b, mul_left_inj' hpi.ne_zero] at hbc
      exact ⟨t, insert i u, b, d, by rw [union_insert, htus], disjoint_insert_right.2 ⟨hit, htu⟩, by
          simp [← hbc, prod_insert hiu, mul_assoc, mul_comm, mul_left_comm]⟩
#align mul_eq_mul_prime_prod mul_eq_mul_prime_prod

/-- If ` x * y = a * p ^ n` where `p` is prime, then `x` and `y` can both be written
  as the product of a power of `p` and a divisor of `a`. -/
theorem mul_eq_mul_prime_pow {x y a p : R} {n : ℕ} (hp : Prime p) (hx : x * y = a * p ^ n) :
    ∃ (i j : ℕ)(b c : R), i + j = n ∧ a = b * c ∧ x = b * p ^ i ∧ y = c * p ^ j := by
  rcases mul_eq_mul_prime_prod (fun _ _ ↦ hp)
    (show x * y = a * (range n).prod fun _ ↦ p by simpa) with
      ⟨t, u, b, c, htus, htu, rfl, rfl, rfl⟩
  exact ⟨t.card, u.card, b, c, by rw [← card_disjoint_union htu, htus, card_range], by simp⟩
#align mul_eq_mul_prime_pow mul_eq_mul_prime_pow

end CancelCommMonoidWithZero

section CommRing

variable {α : Type _} [CommRing α]

theorem Prime.neg {p : α} (hp : Prime p) : Prime (-p) := by
  obtain ⟨h1, h2, h3⟩ := hp
  exact ⟨neg_ne_zero.mpr h1, by rwa [IsUnit.neg_iff], by simpa [neg_dvd] using h3⟩
#align prime.neg Prime.neg

theorem Prime.abs [LinearOrder α] {p : α} (hp : Prime p) : Prime (abs p) := by
  obtain h | h := abs_choice p <;> rw [h]
  · exact hp
  · exact hp.neg
#align prime.abs Prime.abs

end CommRing


/-
Copyright (c) 2022 Pim Otte. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller, Pim Otte

! This file was ported from Lean 3 source module data.nat.factorial.big_operators
! leanprover-community/mathlib commit 1126441d6bccf98c81214a0780c73d499f6721fe
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.Factorial.Basic
import Mathlib.Algebra.BigOperators.Order

/-!
# Factorial with big operators

This file contains some lemmas on factorials in combination with big operators.

While in terms of semantics they could be in the `Basic.lean` file, importing
`Algebra.BigOperators.Basic` leads to a cyclic import.

-/

open Nat
open BigOperators

namespace Nat

variable {α : Type _} (s : Finset α) (f : α → ℕ)

theorem prod_factorial_pos : 0 < ∏ i in s, (f i)! :=
  Finset.prod_pos fun i _ => factorial_pos (f i)
#align nat.prod_factorial_pos Nat.prod_factorial_pos

theorem prod_factorial_dvd_factorial_sum : (∏ i in s, (f i)!) ∣ (∑ i in s, f i)! := by
  classical
    induction' s using Finset.induction with a' s' has ih
    · simp only [Finset.sum_empty, Finset.prod_empty, factorial]
    · simp only [Finset.prod_insert has, Finset.sum_insert has]
      refine' dvd_trans (mul_dvd_mul_left (f a')! ih) _
      apply Nat.factorial_mul_factorial_dvd_factorial_add
#align nat.prod_factorial_dvd_factorial_sum Nat.prod_factorial_dvd_factorial_sum

end Nat


import topology.metric_space.basic

def converges_to {X : Type*} [metric_space X] (s : ℕ → X) (x : X) :=
∀ (ε : ℝ) (hε : 0 < ε), ∃ N : ℕ, ∀ (n : ℕ) (hn : N ≤ n), dist x (s n) < ε

notation s ` ⟶ ` x := converges_to s x

--12
theorem limit_unique {X : Type*} [metric_space X] {s : ℕ → X}
  (x₀ x₁ : X) (h₀ : s ⟶ x₀) (h₁ : s ⟶ x₁) :
x₀ = x₁ :=
begin
  refine classical.by_contradiction _,
  intro h,
  have new_h := dist_pos.mpr h,
  rcases h₀ ((dist x₀ x₁)/2) (by linarith) with ⟨N,hN⟩,
  rcases h₁ ((dist x₀ x₁)/2) (by linarith) with ⟨N',hN'⟩,
  have nesda := dist_triangle_right x₀ x₁ (s (max N N')),
  have ans := add_lt_add (hN (max N N') (le_max_left _ _)) (hN' (max N N') (le_max_right _ _)),
  linarith
end


/-
Copyright (c) 2020 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.erase_lead
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Denominators of evaluation of polynomials at ratios

Let `i : R → K` be a homomorphism of semirings.  Assume that `K` is commutative.  If `a` and
`b` are elements of `R` such that `i b ∈ K` is invertible, then for any polynomial
`f ∈ polynomial R` the "mathematical" expression `b ^ f.nat_degree * f (a / b) ∈ K` is in
the image of the homomorphism `i`.
-/

-- TODO: use hypothesis (ub : is_unit (i b)) to work with localizations.

/-- `denoms_clearable` formalizes the property that `b ^ N * f (a / b)`
does not have denominators, if the inequality `f.nat_degree ≤ N` holds.

In the implementation, we also use provide an inverse in the existential.
-/
def denoms_clearable {R : Type u_1} {K : Type u_2} [semiring R] [comm_semiring K] (a : R) (b : R) (N : ℕ) (f : polynomial R) (i : R →+* K) :=
  ∃ (D : R),
    ∃ (bi : K), bi * coe_fn i b = 1 ∧ coe_fn i D = coe_fn i b ^ N * polynomial.eval (coe_fn i a * bi) (polynomial.map i f)

theorem denoms_clearable_zero {R : Type u_1} {K : Type u_2} [semiring R] [comm_semiring K] {i : R →+* K} {b : R} {bi : K} (N : ℕ) (a : R) (bu : bi * coe_fn i b = 1) : denoms_clearable a b N 0 i := sorry

theorem denoms_clearable_C_mul_X_pow {R : Type u_1} {K : Type u_2} [semiring R] [comm_semiring K] {i : R →+* K} {b : R} {bi : K} {N : ℕ} (a : R) (bu : bi * coe_fn i b = 1) {n : ℕ} (r : R) (nN : n ≤ N) : denoms_clearable a b N (coe_fn polynomial.C r * polynomial.X ^ n) i := sorry

theorem denoms_clearable.add {R : Type u_1} {K : Type u_2} [semiring R] [comm_semiring K] {i : R →+* K} {a : R} {b : R} {N : ℕ} {f : polynomial R} {g : polynomial R} : denoms_clearable a b N f i → denoms_clearable a b N g i → denoms_clearable a b N (f + g) i := sorry

theorem denoms_clearable_of_nat_degree_le {R : Type u_1} {K : Type u_2} [semiring R] [comm_semiring K] {i : R →+* K} {b : R} {bi : K} (N : ℕ) (a : R) (bu : bi * coe_fn i b = 1) (f : polynomial R) : polynomial.nat_degree f ≤ N → denoms_clearable a b N f i := sorry

/-- If `i : R → K` is a ring homomorphism, `f` is a polynomial with coefficients in `R`,
`a, b` are elements of `R`, with `i b` invertible, then there is a `D ∈ R` such that
`b ^ f.nat_degree * f (a / b)` equals `i D`. -/
theorem denoms_clearable_nat_degree {R : Type u_1} {K : Type u_2} [semiring R] [comm_semiring K] {b : R} {bi : K} (i : R →+* K) (f : polynomial R) (a : R) (bu : bi * coe_fn i b = 1) : denoms_clearable a b (polynomial.nat_degree f) f i :=
  denoms_clearable_of_nat_degree_le (polynomial.nat_degree f) a bu f le_rfl


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

import linear_algebra.bilinear_form
import ring_theory.power_basis

/-!
# Trace for (finite) ring extensions.

Suppose we have an `R`-algebra `S` with a finite basis. For each `s : S`,
the trace of the linear map given by multiplying by `s` gives information about
the roots of the minimal polynomial of `s` over `R`.

## Implementation notes

Typically, the trace is defined specifically for finite field extensions.
The definition is as general as possible and the assumption that we have
fields or that the extension is finite is added to the lemmas as needed.

We only define the trace for left multiplication (`algebra.left_mul_matrix`,
i.e. `algebra.lmul_left`).
For now, the definitions assume `S` is commutative, so the choice doesn't matter anyway.

## References

 * https://en.wikipedia.org/wiki/Field_trace

-/

universes u v w

variables {R S T : Type*} [comm_ring R] [comm_ring S] [comm_ring T]
variables [algebra R S] [algebra R T]
variables {K L : Type*} [field K] [field L] [algebra K L]
variables {ι : Type w} [fintype ι]

open finite_dimensional
open linear_map
open matrix

open_locale big_operators
open_locale matrix

namespace algebra

variables {b : ι → S} (hb : is_basis R b)

variables (R S)

/-- The trace of an element `s` of an `R`-algebra is the trace of `(*) s`,
as an `R`-linear map. -/
@[simps]
noncomputable def trace : S →ₗ[R] R :=
(linear_map.trace R S).comp (lmul R S).to_linear_map

variables {S}

lemma trace_eq_zero_of_not_exists_basis
  (h : ¬ ∃ s : finset S, is_basis R (λ x, x : (↑s : set S) → S)) : trace R S = 0 :=
by { ext s, simp [linear_map.trace, h] }

include hb

variables {R}

-- Can't be a `simp` lemma because it depends on a choice of basis
lemma trace_eq_matrix_trace [decidable_eq ι] (hb : is_basis R b) (s : S) :
  trace R S s = matrix.trace _ R _ (algebra.left_mul_matrix hb s) :=
by rw [trace_apply, linear_map.trace_eq_matrix_trace _ hb, to_matrix_lmul_eq]

/-- If `x` is in the base field `K`, then the trace is `[L : K] * x`. -/
lemma trace_algebra_map_of_basis (x : R) :
  trace R S (algebra_map R S x) = fintype.card ι • x :=
begin
  haveI := classical.dec_eq ι,
  rw [trace_apply, linear_map.trace_eq_matrix_trace R hb, trace_diag],
  convert finset.sum_const _,
  ext i,
  simp,
end
omit hb

/-- If `x` is in the base field `K`, then the trace is `[L : K] * x`.

(If `L` is not finite-dimensional over `K`, then `trace` and `finrank` return `0`.)
-/
@[simp]
lemma trace_algebra_map (x : K) : trace K L (algebra_map K L x) = finrank K L • x :=
begin
  by_cases H : ∃ s : finset L, is_basis K (λ x, x : (↑s : set L) → L),
  { rw [trace_algebra_map_of_basis H.some_spec, finrank_eq_card_basis H.some_spec] },
  { simp [trace_eq_zero_of_not_exists_basis K H, finrank_eq_zero_of_not_exists_basis H] },
end

section trace_form

variables (R S)

/-- The `trace_form` maps `x y : S` to the trace of `x * y`.
It is a symmetric bilinear form and is nondegenerate if the extension is separable. -/
noncomputable def trace_form : bilin_form R S :=
(linear_map.compr₂ (lmul R S).to_linear_map (trace R S)).to_bilin

variables {S}

-- This is a nicer lemma than the one produced by `@[simps] def trace_form`.
@[simp] lemma trace_form_apply (x y : S) : trace_form R S x y = trace R S (x * y) := rfl

lemma trace_form_is_sym : sym_bilin_form.is_sym (trace_form R S) :=
λ x y, congr_arg (trace R S) (mul_comm _ _)

lemma trace_form_to_matrix_power_basis (h : power_basis R S) :
  bilin_form.to_matrix h.is_basis (trace_form R S) = λ i j, (trace R S (h.gen ^ (i + j : ℕ))) :=
by { ext, rw [trace_form_to_matrix, pow_add] }

end trace_form

end algebra


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Violeta Hernández Palacios

! This file was ported from Lean 3 source module measure_theory.card_measurable_space
! leanprover-community/mathlib commit f2b108e8e97ba393f22bf794989984ddcc1da89b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.MeasureTheory.MeasurableSpaceDef
import Mathlib.SetTheory.Cardinal.Cofinality
import Mathlib.SetTheory.Cardinal.Continuum

/-!
# Cardinal of sigma-algebras

If a sigma-algebra is generated by a set of sets `s`, then the cardinality of the sigma-algebra is
bounded by `(max (#s) 2) ^ ℵ₀`. This is stated in `MeasurableSpace.cardinal_generate_measurable_le`
and `MeasurableSpace.cardinalMeasurableSet_le`.

In particular, if `#s ≤ 𝔠`, then the generated sigma-algebra has cardinality at most `𝔠`, see
`MeasurableSpace.cardinal_measurableSet_le_continuum`.

For the proof, we rely on an explicit inductive construction of the sigma-algebra generated by
`s` (instead of the inductive predicate `GenerateMeasurable`). This transfinite inductive
construction is parameterized by an ordinal `< ω₁`, and the cardinality bound is preserved along
each step of the construction. We show in `MeasurableSpace.generateMeasurable_eq_rec` that this
indeed generates this sigma-algebra.
-/

universe u

variable {α : Type u}

open Cardinal Set

-- porting note: fix universe below, not here
local notation "ω₁" => (WellOrder.α <| Quotient.out <| Cardinal.ord (aleph 1 : Cardinal))

namespace MeasurableSpace

/-- Transfinite induction construction of the sigma-algebra generated by a set of sets `s`. At each
step, we add all elements of `s`, the empty set, the complements of already constructed sets, and
countable unions of already constructed sets. We index this construction by an ordinal `< ω₁`, as
this will be enough to generate all sets in the sigma-algebra.

This construction is very similar to that of the Borel hierarchy. -/
def generateMeasurableRec (s : Set (Set α)) : (ω₁ : Type u) → Set (Set α)
  | i =>
    let S := ⋃ j : Iio i, generateMeasurableRec s (j.1)
    s ∪ {∅} ∪ compl '' S ∪ Set.range fun f : ℕ → S => ⋃ n, (f n).1
  termination_by generateMeasurableRec s i => i
  decreasing_by exact j.2
#align measurable_space.generate_measurable_rec MeasurableSpace.generateMeasurableRec

theorem self_subset_generateMeasurableRec (s : Set (Set α)) (i : ω₁) :
    s ⊆ generateMeasurableRec s i := by
  unfold generateMeasurableRec
  apply_rules [subset_union_of_subset_left]
  exact subset_rfl
#align measurable_space.self_subset_generate_measurable_rec MeasurableSpace.self_subset_generateMeasurableRec

theorem empty_mem_generateMeasurableRec (s : Set (Set α)) (i : ω₁) :
    ∅ ∈ generateMeasurableRec s i := by
  unfold generateMeasurableRec
  exact mem_union_left _ (mem_union_left _ (mem_union_right _ (mem_singleton ∅)))
#align measurable_space.empty_mem_generate_measurable_rec MeasurableSpace.empty_mem_generateMeasurableRec

theorem compl_mem_generateMeasurableRec {s : Set (Set α)} {i j : ω₁} (h : j < i) {t : Set α}
    (ht : t ∈ generateMeasurableRec s j) : tᶜ ∈ generateMeasurableRec s i := by
  unfold generateMeasurableRec
  exact mem_union_left _ (mem_union_right _ ⟨t, mem_unionᵢ.2 ⟨⟨j, h⟩, ht⟩, rfl⟩)
#align measurable_space.compl_mem_generate_measurable_rec MeasurableSpace.compl_mem_generateMeasurableRec

theorem unionᵢ_mem_generateMeasurableRec {s : Set (Set α)} {i : ω₁} {f : ℕ → Set α}
    (hf : ∀ n, ∃ j < i, f n ∈ generateMeasurableRec s j) :
    (⋃ n, f n) ∈ generateMeasurableRec s i := by
  unfold generateMeasurableRec
  exact mem_union_right _ ⟨fun n => ⟨f n, let ⟨j, hj, hf⟩ := hf n; mem_unionᵢ.2 ⟨⟨j, hj⟩, hf⟩⟩, rfl⟩
#align measurable_space.Union_mem_generate_measurable_rec MeasurableSpace.unionᵢ_mem_generateMeasurableRec

theorem generateMeasurableRec_subset (s : Set (Set α)) {i j : ω₁} (h : i ≤ j) :
    generateMeasurableRec s i ⊆ generateMeasurableRec s j := fun x hx => by
  rcases eq_or_lt_of_le h with (rfl | h)
  · exact hx
  · convert unionᵢ_mem_generateMeasurableRec fun _ => ⟨i, h, hx⟩
    exact (unionᵢ_const x).symm
#align measurable_space.generate_measurable_rec_subset MeasurableSpace.generateMeasurableRec_subset

/-- At each step of the inductive construction, the cardinality bound `≤ (max (#s) 2) ^ ℵ₀` holds.
-/
theorem cardinal_generateMeasurableRec_le (s : Set (Set α)) (i : ω₁) :
    (#generateMeasurableRec s i) ≤ max (#s) 2 ^ aleph0.{u} := by
  apply (aleph 1).ord.out.wo.wf.induction i
  intro i IH
  have A := aleph0_le_aleph 1
  have B : aleph 1 ≤ max (#s) 2 ^ aleph0.{u} :=
    aleph_one_le_continuum.trans (power_le_power_right (le_max_right _ _))
  have C : ℵ₀ ≤ max (#s) 2 ^ aleph0.{u} := A.trans B
  have J : (#⋃ j : Iio i, generateMeasurableRec s j.1) ≤ max (#s) 2 ^ aleph0.{u} := by
    refine (mk_unionᵢ_le _).trans ?_
    have D : (⨆ j : Iio i, #generateMeasurableRec s j) ≤ _ := csupᵢ_le' fun ⟨j, hj⟩ => IH j hj
    apply (mul_le_mul' ((mk_subtype_le _).trans (aleph 1).mk_ord_out.le) D).trans
    rw [mul_eq_max A C]
    exact max_le B le_rfl
  rw [generateMeasurableRec]
  apply_rules [(mk_union_le _ _).trans, add_le_of_le C, mk_image_le.trans]
  · exact (le_max_left _ _).trans (self_le_power _ one_lt_aleph0.le)
  · rw [mk_singleton]
    exact one_lt_aleph0.le.trans C
  · apply mk_range_le.trans
    simp only [mk_pi, prod_const, lift_uzero, mk_denumerable, lift_aleph0]
    have := @power_le_power_right _ _ ℵ₀ J
    rwa [← power_mul, aleph0_mul_aleph0] at this
#align measurable_space.cardinal_generate_measurable_rec_le MeasurableSpace.cardinal_generateMeasurableRec_le

/-- `generateMeasurableRec s` generates precisely the smallest sigma-algebra containing `s`. -/
theorem generateMeasurable_eq_rec (s : Set (Set α)) :
    { t | GenerateMeasurable s t } =
        ⋃ (i : (Quotient.out (aleph 1).ord).α), generateMeasurableRec s i := by
  ext t; refine' ⟨fun ht => _, fun ht => _⟩
  · inhabit ω₁
    induction' ht with u hu u _ IH f _ IH
    · exact mem_unionᵢ.2 ⟨default, self_subset_generateMeasurableRec s _ hu⟩
    · exact mem_unionᵢ.2 ⟨default, empty_mem_generateMeasurableRec s _⟩
    · rcases mem_unionᵢ.1 IH with ⟨i, hi⟩
      obtain ⟨j, hj⟩ := exists_gt i
      exact mem_unionᵢ.2 ⟨j, compl_mem_generateMeasurableRec hj hi⟩
    · have : ∀ n, ∃ i, f n ∈ generateMeasurableRec s i := fun n => by simpa using IH n
      choose I hI using this
      have : IsWellOrder (ω₁ : Type u) (· < ·) := isWellOrder_out_lt _
      refine' mem_unionᵢ.2
        ⟨Ordinal.enum (· < ·) (Ordinal.lsub fun n => Ordinal.typein.{u} (· < ·) (I n)) _,
          unionᵢ_mem_generateMeasurableRec fun n => ⟨I n, _, hI n⟩⟩
      · rw [Ordinal.type_lt]
        refine' Ordinal.lsub_lt_ord_lift _ fun i => Ordinal.typein_lt_self _
        rw [mk_denumerable, lift_aleph0, isRegular_aleph_one.cof_eq]
        exact aleph0_lt_aleph_one
      · rw [← Ordinal.typein_lt_typein (· < ·), Ordinal.typein_enum]
        apply Ordinal.lt_lsub fun n : ℕ => _
  · rcases ht with ⟨t, ⟨i, rfl⟩, hx⟩
    revert t
    apply (aleph 1).ord.out.wo.wf.induction i
    intro j H t ht
    unfold generateMeasurableRec at ht
    rcases ht with (((h | (rfl : t = ∅)) | ⟨u, ⟨-, ⟨⟨k, hk⟩, rfl⟩, hu⟩, rfl⟩) | ⟨f, rfl⟩)
    · exact .basic t h
    · exact .empty
    · exact .compl u (H k hk u hu)
    · refine .unionᵢ _ @fun n => ?_
      obtain ⟨-, ⟨⟨k, hk⟩, rfl⟩, hf⟩ := (f n).prop
      exact H k hk _ hf
#align measurable_space.generate_measurable_eq_rec MeasurableSpace.generateMeasurable_eq_rec

/-- If a sigma-algebra is generated by a set of sets `s`, then the sigma-algebra has cardinality at
most `(max (#s) 2) ^ ℵ₀`. -/
theorem cardinal_generateMeasurable_le (s : Set (Set α)) :
    (#{ t | GenerateMeasurable s t }) ≤ max (#s) 2 ^ aleph0.{u} := by
  rw [generateMeasurable_eq_rec]
  apply (mk_unionᵢ_le _).trans
  rw [(aleph 1).mk_ord_out]
  refine le_trans (mul_le_mul' aleph_one_le_continuum
      (csupᵢ_le' fun i => cardinal_generateMeasurableRec_le s i)) ?_
  refine (mul_le_max_of_aleph0_le_left aleph0_le_continuum).trans (max_le ?_ le_rfl)
  exact power_le_power_right (le_max_right _ _)
#align measurable_space.cardinal_generate_measurable_le MeasurableSpace.cardinal_generateMeasurable_le

/-- If a sigma-algebra is generated by a set of sets `s`, then the sigma
algebra has cardinality at most `(max (#s) 2) ^ ℵ₀`. -/
theorem cardinalMeasurableSet_le (s : Set (Set α)) :
    (#{ t | @MeasurableSet α (generateFrom s) t }) ≤ max (#s) 2 ^ aleph0.{u} :=
  cardinal_generateMeasurable_le s
#align measurable_space.cardinal_measurable_set_le MeasurableSpace.cardinalMeasurableSet_le

/-- If a sigma-algebra is generated by a set of sets `s` with cardinality at most the continuum,
then the sigma algebra has the same cardinality bound. -/
theorem cardinal_generateMeasurable_le_continuum {s : Set (Set α)} (hs : (#s) ≤ 𝔠) :
    (#{ t | GenerateMeasurable s t }) ≤ 𝔠 :=
  (cardinal_generateMeasurable_le s).trans
    (by
      rw [← continuum_power_aleph0]
      exact_mod_cast power_le_power_right (max_le hs (nat_lt_continuum 2).le))
#align measurable_space.cardinal_generate_measurable_le_continuum MeasurableSpace.cardinal_generateMeasurable_le_continuum

/-- If a sigma-algebra is generated by a set of sets `s` with cardinality at most the continuum,
then the sigma algebra has the same cardinality bound. -/
theorem cardinal_measurableSet_le_continuum {s : Set (Set α)} :
    (#s) ≤ 𝔠 → (#{ t | @MeasurableSet α (generateFrom s) t }) ≤ 𝔠 :=
  cardinal_generateMeasurable_le_continuum
#align measurable_space.cardinal_measurable_set_le_continuum MeasurableSpace.cardinal_measurableSet_le_continuum

end MeasurableSpace


import number_theory.sum_two_squares

/-!
# Sums of two squares

The goal of this project is to prove the following statement.

**Theorem.** Let n be a positive natural number. Then n can be written
as n = a² + b² with natural numbers a and b if and only if every prime
q ≡ 3 mod 4 occurs with an even exponent in the prime factorization of n.

mathlib has *Fermat's two-squares theorem* that says that a prime p ≡ 1 mod 4
is a sum of two squares.

theorem nat.prime.sq_add_sq {p : ℕ} [fact (nat.prime p)] (hp : p % 4 = 1) :
  ∃ (a b : ℕ), a ^ 2 + b ^ 2 = p

From this (and the facts that 2 is a sum of two squares and that the set
of sums of two squares is multiplicative), the "if" direction follows
fairly easily. For the "only if" direction, one has to show the following

**Lemma.** If q ≡ 3 mod 4 is a prime and q divides a² + b², then q
divides a and b (and hence q² divides a² + b²).

There are the following lemmas in mathlib, which might be helpful.

theorem zmod.exists_sq_eq_neg_one_iff {p : ℕ} [fact (nat.prime p)] :
  is_square (-1 : zmod p) ↔ p % 4 ≠ 3

theorem zmod.mod_four_ne_three_of_sq_eq_neg_sq' {p : ℕ} [fact (nat.prime p)]
  {x y : zmod p} (hy : y ≠ 0) (hxy : x ^ 2 = -y ^ 2) :
  p % 4 ≠ 3
-/


/-
Copyright (c) 2021 Sara Díaz Real. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sara Díaz Real
-/
import algebra.associated
import tactic.linarith
import tactic.linear_combination

/-!
# IMO 2001 Q6
Let $a$, $b$, $c$, $d$ be integers with $a > b > c > d > 0$. Suppose that

$$ a*c + b*d = (a + b - c + d) * (-a + b + c + d). $$

Prove that $a*b + c*d$ is not prime.

-/

variables {a b c d : ℤ}

theorem imo2001_q6 (hd : 0 < d) (hdc : d < c) (hcb : c < b) (hba : b < a)
  (h : a*c + b*d = (a + b - c + d) * (-a + b + c + d)) :
  ¬ prime (a*b + c*d) :=
begin
  assume h0 : prime (a*b + c*d),
  have ha : 0 < a, { linarith },
  have hb : 0 < b, { linarith },
  have hc : 0 < c, { linarith },
  -- the key step is to show that `a*c + b*d` divides the product `(a*b + c*d) * (a*d + b*c)`
  have dvd_mul : a*c + b*d ∣ (a*b + c*d) * (a*d + b*c),
  { use b^2 + b*d + d^2,
    linear_combination b*d*h },
  -- since `a*b + c*d` is prime (by assumption), it must divide `a*c + b*d` or `a*d + b*c`
  obtain (h1 : a*b + c*d ∣ a*c + b*d) | (h2 : a*c + b*d ∣ a*d + b*c) :=
    h0.left_dvd_or_dvd_right_of_dvd_mul dvd_mul,
  -- in both cases, we derive a contradiction
  { have aux : 0 < a*c + b*d,         { nlinarith only [ha, hb, hc, hd] },
    have : a*b + c*d ≤ a*c + b*d,     { from int.le_of_dvd aux h1 },
    nlinarith only [hba, hcb, hdc, h, this] },
  { have aux : 0 < a*d + b*c,         { nlinarith only [ha, hb, hc, hd] },
    have : a*c + b*d ≤ a*d + b*c,     { from int.le_of_dvd aux h2 },
    nlinarith only [hba, hdc, h, this] },
end


-- Versions of max

import analysis.convex.function
import data.real.basic
import topology.continuous_on
import topology.metric_space.basic

open set (univ)
noncomputable theory

-- max expression as a function on pairs
noncomputable def pair_max (p : ℝ × ℝ) := max p.fst p.snd
lemma pair_max_eq (x y : ℝ) : pair_max (x,y) = max x y := rfl
lemma convex_on_pair_max : convex_on ℝ univ pair_max := begin
  have e : pair_max = (λ p, p.fst) ⊔ (λ p, p.snd), { funext p, simp [pair_max, sup_eq_max] },
  rw e, apply convex_on.sup, {
    use convex_univ, intros, simp,
  }, {
    use convex_univ, intros, simp,
  }
end

-- The max of the first n+1 elements of a sequence (n+1 to avoid empty sets).
-- I ran into annoying technicalities due to finset.max', so writing out range_max inductively
noncomputable def range_max (s : ℕ → ℝ) : ℕ → ℝ
| 0 := s 0
| (n+1) := max (range_max n) (s (n+1))

@[simp] lemma range_max_zero (s : ℕ → ℝ) : range_max s 0 = s 0 := rfl
@[simp] lemma range_max_succ (s : ℕ → ℝ) (n : ℕ) : range_max s n.succ = max (range_max s n) (s n.succ) := by simp [range_max]
lemma monotone.range_max {s : ℕ → ℝ} : monotone (range_max s) := begin
  intros a b ab,
  generalize hd : b - a = d,
  have hd' : b = a + d, { rw ←hd, rw add_comm, rw nat.sub_add_cancel ab },
  rw hd', clear hd hd' ab b,
  induction d with d h, simp,
  apply trans h,
  have e : a + d.succ = (a + d).succ := rfl,
  simp [e]
end
lemma le_range_max_self (s : ℕ → ℝ) (n : ℕ) : s n ≤ range_max s n := begin induction n with n, simp, simp end
lemma le_range_max (s : ℕ → ℝ) {a : ℕ} {n : ℕ} (an : a ≤ n) : s a ≤ range_max s n := begin
  transitivity range_max s a, apply le_range_max_self, apply monotone.range_max an,
end
lemma range_max_le_iff (s : ℕ → ℝ) (n : ℕ) (x : ℝ) : range_max s n ≤ x ↔ ∀ k, k ≤ n → s k ≤ x := begin
  induction n with n h, simp, simp, constructor, {
    intros b k kn, by_cases kn' : k ≤ n, exact h.mp b.1 k kn',
    simp at kn',
    have e : k = n+1, { rw nat.succ_eq_add_one at b kn, linarith },
    rw e, exact b.2,
  }, {
    intro b, use [h.mpr (λ _ kn, b _ (trans kn (nat.le_succ _))), b n.succ (by simp)],
  },
end

lemma continuous_on.range_max {A : Type} [topological_space A] {f : ℕ → A → ℝ} {s : set A}
    (fc : ∀ n, continuous_on (f n) s) (n : ℕ)
    : continuous_on (λ x, range_max (λ k, f k x) n) s := begin
  induction n with n h, simp [fc 0], simp [←pair_max_eq], exact continuous_max.comp_continuous_on (h.prod (fc _)),
end


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Heather Macbeth
-/
import analysis.normed.field.unit_ball
import analysis.normed_space.basic

/-!
# Multiplicative actions of/on balls and spheres

Let `E` be a normed vector space over a normed field `𝕜`. In this file we define the following
multiplicative actions.

- The closed unit ball in `𝕜` acts on open balls and closed balls centered at `0` in `E`.
- The unit sphere in `𝕜` acts on open balls, closed balls, and spheres centered at `0` in `E`.
-/
open metric set
variables {𝕜 E : Type*} [normed_field 𝕜] [semi_normed_group E] [normed_space 𝕜 E] {r : ℝ}

section closed_ball

instance mul_action_closed_ball_ball : mul_action (closed_ball (0 : 𝕜) 1) (ball (0 : E) r) :=
{ smul := λ c x, ⟨(c : 𝕜) • x, mem_ball_zero_iff.2 $
    by simpa only [norm_smul, one_mul]
      using mul_lt_mul' (mem_closed_ball_zero_iff.1 c.2) (mem_ball_zero_iff.1 x.2)
        (norm_nonneg _) one_pos⟩,
  one_smul := λ x, subtype.ext $ one_smul 𝕜 _,
  mul_smul := λ c₁ c₂ x, subtype.ext $ mul_smul _ _ _ }

instance has_continuous_smul_closed_ball_ball :
  has_continuous_smul (closed_ball (0 : 𝕜) 1) (ball (0 : E) r) :=
⟨continuous_subtype_mk _ $ (continuous_subtype_val.comp continuous_fst).smul
  (continuous_subtype_val.comp continuous_snd)⟩

instance mul_action_closed_ball_closed_ball :
  mul_action (closed_ball (0 : 𝕜) 1) (closed_ball (0 : E) r) :=
{ smul := λ c x, ⟨(c : 𝕜) • x, mem_closed_ball_zero_iff.2 $
    by simpa only [norm_smul, one_mul]
      using mul_le_mul (mem_closed_ball_zero_iff.1 c.2) (mem_closed_ball_zero_iff.1 x.2)
        (norm_nonneg _) zero_le_one⟩,
  one_smul := λ x, subtype.ext $ one_smul 𝕜 _,
  mul_smul := λ c₁ c₂ x, subtype.ext $ mul_smul _ _ _ }

instance has_continuous_smul_closed_ball_closed_ball :
  has_continuous_smul (closed_ball (0 : 𝕜) 1) (closed_ball (0 : E) r) :=
⟨continuous_subtype_mk _ $ (continuous_subtype_val.comp continuous_fst).smul
  (continuous_subtype_val.comp continuous_snd)⟩

end closed_ball

section sphere

instance mul_action_sphere_ball : mul_action (sphere (0 : 𝕜) 1) (ball (0 : E) r) :=
{ smul := λ c x, inclusion sphere_subset_closed_ball c • x,
  one_smul := λ x, subtype.ext $ one_smul _ _,
  mul_smul := λ c₁ c₂ x, subtype.ext $ mul_smul _ _ _ }

instance has_continuous_smul_sphere_ball :
  has_continuous_smul (sphere (0 : 𝕜) 1) (ball (0 : E) r) :=
⟨continuous_subtype_mk _ $ (continuous_subtype_val.comp continuous_fst).smul
  (continuous_subtype_val.comp continuous_snd)⟩

instance mul_action_sphere_closed_ball : mul_action (sphere (0 : 𝕜) 1) (closed_ball (0 : E) r) :=
{ smul := λ c x, inclusion sphere_subset_closed_ball c • x,
  one_smul := λ x, subtype.ext $ one_smul _ _,
  mul_smul := λ c₁ c₂ x, subtype.ext $ mul_smul _ _ _ }

instance has_continuous_smul_sphere_closed_ball :
  has_continuous_smul (sphere (0 : 𝕜) 1) (closed_ball (0 : E) r) :=
⟨continuous_subtype_mk _ $ (continuous_subtype_val.comp continuous_fst).smul
  (continuous_subtype_val.comp continuous_snd)⟩

instance mul_action_sphere_sphere : mul_action (sphere (0 : 𝕜) 1) (sphere (0 : E) r) :=
{ smul := λ c x, ⟨(c : 𝕜) • x, mem_sphere_zero_iff_norm.2 $
    by rw [norm_smul, mem_sphere_zero_iff_norm.1 c.coe_prop, mem_sphere_zero_iff_norm.1 x.coe_prop,
      one_mul]⟩,
  one_smul := λ x, subtype.ext $ one_smul _ _,
  mul_smul := λ c₁ c₂ x, subtype.ext $ mul_smul _ _ _ }

instance has_continuous_smul_sphere_sphere :
  has_continuous_smul (sphere (0 : 𝕜) 1) (sphere (0 : E) r) :=
⟨continuous_subtype_mk _ $ (continuous_subtype_val.comp continuous_fst).smul
  (continuous_subtype_val.comp continuous_snd)⟩

end sphere

variables (𝕜) [char_zero 𝕜]

lemma ne_neg_of_mem_sphere {r : ℝ} (hr : r ≠ 0) (x : sphere (0:E) r) : x ≠ - x :=
λ h, ne_zero_of_mem_sphere hr x ((self_eq_neg 𝕜 _).mp (by { conv_lhs {rw h}, simp }))

lemma ne_neg_of_mem_unit_sphere (x : sphere (0:E) 1) : x ≠ - x :=
ne_neg_of_mem_sphere 𝕜 one_ne_zero x


/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Nat.Div

namespace Nat

private def gcdF (x : Nat) : (∀ x₁, x₁ < x → Nat → Nat) → Nat → Nat :=
  match x with
  | 0      => fun _ y => y
  | succ x => fun f y => f (y % succ x) (mod_lt _ (zero_lt_succ  _)) (succ x)

@[extern "lean_nat_gcd"]
def gcd (a b : @& Nat) : Nat :=
  WellFounded.fix (measure id).wf gcdF a b

@[simp] theorem gcd_zero_left (y : Nat) : gcd 0 y = y :=
  rfl

theorem gcd_succ (x y : Nat) : gcd (succ x) y = gcd (y % succ x) (succ x) :=
  rfl

@[simp] theorem gcd_one_left (n : Nat) : gcd 1 n = 1 := by
  rw [gcd_succ, mod_one]
  rfl

@[simp] theorem gcd_zero_right (n : Nat) : gcd n 0 = n := by
  cases n with
  | zero => simp [gcd_succ]
  | succ n =>
    -- `simp [gcd_succ]` produces an invalid term unless `gcd_succ` is proved with `id rfl` instead
    rw [gcd_succ]
    exact gcd_zero_left _

@[simp] theorem gcd_self (n : Nat) : gcd n n = n := by
  cases n <;> simp [gcd_succ]

end Nat