variable (p q r : Prop)

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
  ⟨fun h : p ∧ q => ⟨h.right, h.left⟩,
   fun h : q ∧ p => ⟨h.right, h.left⟩⟩

example : p ∨ q ↔ q ∨ p :=
  ⟨fun h : p ∨ q => h.elim (fun hp : p => Or.inr hp) (fun hq : q => Or.inl hq),
   fun h : q ∨ p => h.elim (fun hq : q => Or.inr hq) (fun hp : p => Or.inl hp)⟩

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
  ⟨fun h : (p ∧ q) ∧ r => ⟨h.left.left, h.left.right, h.right⟩,
   fun h : p ∧ q ∧ r => ⟨⟨h.left, h.right.left⟩, h.right.right⟩⟩

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
  ⟨fun h : (p ∨ q) ∨ r => h.elim
    (fun h₁ : p ∨ q => h₁.elim (fun hp : p => Or.inl hp) (fun hq : q => Or.inr (Or.inl hq)))
     fun hr : r => Or.inr (Or.inr hr),
   fun h : p ∨ q ∨ r => h.elim
    (fun hp : p => Or.inl (Or.inl hp))
     fun h₁ : q ∨ r => h₁.elim (fun hq : q => Or.inl (Or.inr hq)) (fun hr : r => Or.inr hr)⟩

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  ⟨fun h : p ∧ (q ∨ r) => h.right.elim
    (fun hq : q => Or.inl ⟨h.left, hq⟩)
     fun hr : r => Or.inr ⟨h.left, hr⟩,
   fun h : p ∧ q ∨ p ∧ r => h.elim
    (fun hpq : p ∧ q => ⟨hpq.left, Or.inl hpq.right⟩)
     fun hpr : p ∧ r => ⟨hpr.left, Or.inr hpr.right⟩⟩

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
  ⟨fun h : p ∨ q ∧ r => h.elim
    (fun hp : p => ⟨Or.inl hp, Or.inl hp⟩)
     fun hqr : q ∧ r => ⟨Or.inr hqr.left, Or.inr hqr.right⟩,
   fun h : (p ∨ q) ∧ (p ∨ r) => h.left.elim
    (fun hp : p => Or.inl hp)
     fun hq : q => h.right.elim (fun hp : p => Or.inl hp) (fun hr : r => Or.inr ⟨hq, hr⟩)⟩

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
  ⟨fun h : p → q → r => (fun hpq : p ∧ q => h hpq.left hpq.right),
   fun h : p ∧ q → r => (fun hp : p => (fun hq : q => h ⟨hp, hq⟩))⟩

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
  ⟨fun h : p ∨ q → r => ⟨fun hp : p => h (Or.inl hp), (fun hq : q => h (Or.inr hq))⟩,
   fun h : (p → r) ∧ (q → r) =>
    (fun hpq : p ∨ q => hpq.elim (fun hp : p => h.left hp) (fun hq : q => h.right hq))⟩

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
  ⟨fun h : ¬(p ∨ q) => ⟨fun hp : p => h (Or.inl hp), (fun hq : q => h (Or.inr hq))⟩,
   fun h : ¬p ∧ ¬q => (fun hpq : p ∨ q => hpq.elim h.left h.right)⟩

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
  fun h : ¬p ∨ ¬q => fun hpq : p ∧ q => h.elim
    (fun hnp : ¬p => hnp hpq.left) (fun hnq : ¬q => hnq hpq.right)

example : ¬(p ∧ ¬p) :=
  fun h : p ∧ ¬p => h.right h.left

example : p ∧ ¬q → ¬(p → q) :=
  fun h : p ∧ ¬q => fun h₁ : p → q => h.right (h₁ h.left)

example : ¬p → (p → q) :=
  fun hnp : ¬p => fun hp : p => absurd hp hnp

example : (¬p ∨ q) → (p → q) :=
  fun h : ¬p ∨ q => fun hp : p => h.elim (fun hnp : ¬p => absurd hp hnp) id

example : p ∨ False ↔ p :=
  ⟨fun h : p ∨ False => h.elim id False.elim, fun hp : p => Or.inl hp⟩

example : p ∧ False ↔ False :=
  ⟨fun h : p ∧ False => h.right, False.elim⟩

example : (p → q) → (¬q → ¬p) :=
  fun h : p → q => fun hnq : ¬q => fun hp : p => hnq (h hp)

-- classical
open Classical

variable (p q r s : Prop)

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
  fun h : p → r ∨ s => (em p).elim
    (fun hp : p => (h hp).elim
      (fun hr : r => Or.inl fun hpp : p => hr) (fun hs : s => Or.inr fun hpp : p => hs))
    (fun hnp : ¬p => Or.inl fun hp : p => absurd hp hnp)

example : ¬(p ∧ q) → ¬p ∨ ¬q :=
  fun h : ¬(p ∧ q) => (em p).elim
    ((em q).elim (fun hq : q => fun hp : p => absurd ⟨hp, hq⟩ h)
      (fun hnq : ¬q => fun hp : p => Or.inr hnq))
    (fun hnp : ¬p => Or.inl hnp)

example : ¬(p → q) → p ∧ ¬q :=
  fun h : ¬(p → q) =>
    ⟨(em p).elim id (fun hnp : ¬p => absurd (fun hp : p => absurd hp hnp) h),
     (em q).elim (fun hq : q => absurd (fun hp : p => hq) h) id⟩

example : (p → q) → (¬p ∨ q) :=
  fun h : p → q => (em p).elim (fun hp : p => Or.inr (h hp)) (fun hnp : ¬p => Or.inl hnp)

example : (¬q → ¬p) → (p → q) :=
  fun h : ¬q → ¬p => fun hp : p => (em q).elim id (fun hnq : ¬q => absurd hp (h hnq))

example : p ∨ ¬p :=
  (em p).elim (fun hp : p => Or.inl hp) (fun hnp : ¬p => Or.inr hnp)

example : (((p → q) → p) → p) :=
  fun h : (p → q) → p => (em p).elim id (fun hnp : ¬p =>
    (em q).elim (fun hq : q => h fun hp : p => hq)
    (fun hnq : ¬q => absurd (h fun hp : p => absurd hp hnp) hnp))

-- iff not self (not classical)
example : ¬(p ↔ ¬p) :=
  fun h : p ↔ ¬p =>
  have hnp : ¬p := fun hp : p => h.mp hp hp
  hnp (h.mpr hnp)


import Mathlib
-- Credit to Alexander Bentkamp and Evgeniy Kuznetsov on the Lean zulip chat
-- for help cleaning up (really rewriting) these lemmas.

def merge : List Nat → List Nat → List Nat
| xs, [] => xs
| [], ys => ys
| (x :: xs), (y :: ys) => if x < y then x :: (merge xs (y :: ys))
                                   else y :: (merge (x :: xs) ys)
termination_by merge xs ys => xs.length + ys.length

-- When we (natural) divide the length of a list by 2, and the list has at
-- least 2 elements, then we get a number strictly smaller than the length of
-- the list.
lemma length_div_2 : List.length (x :: y :: ys) / 2 < List.length (x :: y :: ys) := by

  -- Let n be the length of the list, and k = 2.
  -- Then n / k < n when 1 < k and 0 < n.
  apply Nat.div_lt_self

  -- So now we must prove 1 < k and 0 < n.
  -- We do the latter first.
  · simp [Nat.zero_lt_succ]

  -- And then we prove 1 < k.
  · simp

lemma length_sub_div_2 : List.length (x :: y :: ys) - List.length (x :: y :: ys) / 2 < List.length (x :: y :: ys) := by

  -- Let `b` be the length of the list, and `a` be half the length of the list.
  -- If 0 < a and a ≤ b, then b - a < b.
  apply Nat.sub_lt_self

  -- Now we prove 0 < a.
  -- If n + 1 ≤ m, then n < m.
  apply Nat.lt_of_succ_le

  -- Multiply both sides of an `≤` by k (in this case, 2).
  rw [Nat.le_div_iff_mul_le]

  -- Simplify Nat.succ 0 * 2 → 2.
  simp only [Nat.succ_eq_one_add, Nat.add_zero, Nat.one_mul]

  -- Prove that 2 ≤ length of a list with length at least 2.
  simp only [Nat.succ_eq_one_add, ← add_assoc, Nat.le_add_right, List.length_cons]

  -- Show 0 < 2.
  apply Nat.zero_lt_succ

  -- Now our goal is basically exactly the statement of `length_div_2`.
  -- Since `length_div_2` is for `<`, convert it to `≤`.
  exact le_of_lt length_div_2

def first_half {α : Type} (xs : List α) : List α :=
  List.take (xs.length / 2) xs

def second_half {α : Type} (xs : List α) : List α :=
  List.drop (xs.length / 2) xs

lemma length_first_half : List.length (first_half (x :: y :: ys)) < List.length (x :: y :: ys) := by
  -- Use the definition of `first_half`, and the theorem that says that if we
  -- take `i` values from the beginning of a list, we'll get either `i` values
  -- or the entire list, whichever is smaller.
  --
  -- Then use the theorem that says that min(a, b) is `a` if a < b.
  -- Note that in our case, `b` is the length, and `a`is the length divided by
  -- two.
  rw [first_half, List.length_take, min_eq_left_of_lt]
  repeat exact length_div_2

lemma length_second_half : List.length (second_half (x :: y :: ys)) < List.length (x :: y :: ys) := by
  -- Use the definition of `second_half`, and then the theorem that says that
  -- after we drop the first `i` values from a list, the result has length
  -- `length - i` (natural subtraction).
  rw [second_half, List.length_drop]
  repeat exact length_sub_div_2

def mergesort : List Nat → List Nat
| [] => []
| [a] => [a]
| (x :: (y :: ys)) =>
  have : List.length (first_half (x :: (y :: ys))) < List.length (x :: (y :: ys)) := length_first_half
  have : List.length (second_half (x :: (y :: ys))) < List.length (x :: (y :: ys)) := length_second_half
  merge (mergesort <| first_half (x :: (y :: ys))) (mergesort <| second_half (x :: (y :: ys)))
termination_by mergesort xs => xs.length

def l := [1, 2, 3]
#eval (l).length
#eval l.length
#eval l.take 1

#eval mergesort [1, 3, 2]
#eval mergesort [3, 2, 1]
#eval mergesort [5, 4, 3, 1, 2]


import Experiments.FreeAbelianMeta

/-
This file contains examples of the abelian group simplification tactic in action.

This is still work in progress, so the verbose proofs below will eventually be bundled up together into a tactic and completely automated.

The purpose of this tactic is to simplify expressions in Abelian groups and prove basic equations.
The key idea here is that to prove an equation such as `{A : Type} → [AddCommGroup A] → ∀ x y : A, x + y - x - y + x = x` involving $n$ variables for all Abelian groups,
it suffices to verify it by direct computation in `ℤⁿ` for the $n$ basis elements `{(0, 0, …, i, 0, 0)}`. The reason is that `ℤⁿ` is a free group,
so given any elements `x₁, x₂, …, xₙ` in a specific group `A`, there is a unique homomorphism taking the generators of `ℤⁿ` to the chosen elements.

In the example above, it is easy to verify that `(1, 0) + (0, 1) - (1, 0) - (0, 1) + (1, 0) = (1, 0)` by a computation. Given any elements `a` and `b` in an Abelian group `A`,
applying the unique homomorphism `ϕ : ℤ² → A` taking `(1, 0)` to `a` and `(0, 1)` to `b` to this equation yields a proof that `a + b - a - b + a = a`. This allows one to prove equations in
Abelian groups without any explicit commutativity and associativity rewrites, and consequently the resulting proofs are quite short.
-/

/- This example shows that the expression on the left reduces to the one on the right -/
example {x y z : ℤ} : x + x + y - x - y + z - x = z := by
    have p := freeGroupEq# (x + x + y - x - y + z - x) -- a proof that the term is the image of the free group element `(0, 0, 1)`
    rw [p, map_free_elem] -- remove the induced homomorphism from the picture
    -- expand out and simplify (routine steps that can be automated)
    simp [List.sum]
    rw [SubNegMonoid.gsmul_zero', zero_add, SubNegMonoid.gsmul_zero', zero_add, SubNegMonoid.gsmul_one]

/- An example in a general Abelian group -/
example {A : Type _} [AddCommGroup A] {a b : A} : (a + b) - (b - a) - a = a := by
  have p := freeGroupEq# ((a + b) - (b - a) - a) -- a proof that the term is the image of the free group element `(1, 0)`
  rw [p, map_free_elem] -- remove the induced homomorphism from the picture
  -- routine simplification
  simp [List.sum, SubNegMonoid.gsmul_one]

/- An example where both sides of the equality are unreduced (not completely implemented) -/
example {a b : ℤ} : a + b - a - b = b - b + a - a := by
  have pₗ := freeGroupEq# (a + b - a - b) -- a simpler expression for the left side
  have pᵣ := freeGroupEq# (b - b + a - a) -- a simpler expression for the right side
  rw [pₗ, pᵣ, map_free_elem, map_free_elem] -- remove the induced homomorphisms from the picture
  -- routine simplification
  simp [List.sum]
  rw [SubNegMonoid.gsmul_zero', SubNegMonoid.gsmul_zero']

/- A more complicated example involving five variables -/
example {A : Type _} [AddCommGroup A] {a b c d e : A} : a + b - c - d + e - a + b + c - a - e + a - b + d - b = 0 := by
  have p := freeGroupEq# (a + b - c - d + e - a + b + c - a - e + a - b + d - b) -- a proof that the given expression is the image of `0 : ℤ⁵`
  rw [p, map_free_elem] -- removing the induced homomorphism from the picture
  -- routine simplification
  simp [List.sum]


/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : María Inés de Frutos-Fernández
-/

import sesion_4.soluciones.limites

import topology.instances.real

/-
# Límites de secuencias en Lean

Ahora que sabemos cómo utilizar filtros en Lean, podemos reescribir
las soluciones de los ejercicios de límites de la sesión 4.

-/

open filter

open_locale topology -- para acceder a la notación 𝓝

namespace limites

-- Nuestra definición `tends_to` es equivalente a `filter.tendsto`
lemma tends_to_iff_tendsto (a : ℕ → ℝ) (l : ℝ) :
  tends_to a l ↔ tendsto a at_top (𝓝 l) :=
begin
  rw metric.tendsto_at_top,
  rw tends_to,
  congr',
end

/-- El límite de la secuencia constante con valor `c` es `c`. -/
theorem tends_to_const (c : ℝ) : tends_to (λ n, c) c :=
begin
  rw tends_to_iff_tendsto,
  exact tendsto_const_nhds,
end

/-- Si `a(n)` tiende a `L` entonces `a(n) + c` tiende a `t + c` -/
theorem tends_to_add_const {a : ℕ → ℝ} {L : ℝ} (c : ℝ)
  (h : tends_to a L) :
  tends_to (λ n, a n + c) (L + c) :=
begin
  rw tends_to_iff_tendsto at *,
  exact tendsto.add_const c h,
end

/-- Si `a(n)` tiende a `L`, entonces `-a(n)` tiende a `-L`.
Si simplificar la expresión dentro del valor absoluto te está
dando problemas, ve a la hoja `reales.lean`.
-/
theorem tends_to_neg {a : ℕ → ℝ} {L : ℝ} (ha : tends_to a L) :
  tends_to (λ n, - a n) (-L) :=
begin
  rw tends_to_iff_tendsto at *,
  exact tendsto.neg ha,
end

/-- Si `a(n)` tiende a `La` y `b(n)` tiende a `Lb` entonces `a(n) + b(n)`
  tiende a `La + Lb`. -/
theorem tends_to_add {a b : ℕ → ℝ} {La Lb : ℝ}
  (ha : tends_to a La) (hb : tends_to b Lb) :
  tends_to (λ n, a n + b n) (La + Lb) :=
begin
  rw tends_to_iff_tendsto at *,
  exact tendsto.add ha hb,
end

/-- Si `a(n)` tiende a `La` y `b(n)` tiende a `Lb` entonces `a(n) - b(n)`
tiende a `La - Lb`. -/
theorem tends_to_sub {a b : ℕ → ℝ} {La Lb : ℝ}
  (ha : tends_to a La) (hb : tends_to b Lb) :
  tends_to (λ n, a n - b n) (La - Lb) :=
begin
  rw tends_to_iff_tendsto at *,
  exact tendsto.sub ha hb,
end

/-- Si `a(n)` tiende a `L`, entonces `c*a(n)` tiende a `c*L`.
Pista: tratad el caso `c = 0` por separado, utilizando `by_cases hc : c = 0`.
-/
lemma tends_to_mul_const_left {a : ℕ → ℝ} {L c : ℝ} (h : tends_to a L) :
  tends_to (λ n, c * (a n)) (c * L) :=
begin
  rw tends_to_iff_tendsto at *,
  exact tendsto.const_mul c h,
end

/- Lema del sandwich. -/
theorem sandwich (a b c : ℕ → ℝ) (L : ℝ) (ha : tends_to a L) (hc : tends_to c L)
  (hab : ∀ n, a n ≤ b n) (hbc : ∀ n, b n ≤ c n) :
  tends_to b L :=
begin
  rw tends_to_iff_tendsto at *,
  exact tendsto_of_tendsto_of_tendsto_of_le_of_le ha hc hab hbc,
  -- Buscando `sandwich` o `squeeze` en la documentación de mathlib, aparece este lema.
end

/-- Si `a(n)` tiende a `La` y `b(n)` tiende a `Lb` entonces `a(n) * b(n)`
  tiende a `La * Lb`. -/
theorem tends_to_mul {a b : ℕ → ℝ} {La Lb : ℝ}
  (ha : tends_to a La) (hb : tends_to b Lb) :
  tends_to (λ n, a n * b n) (La * Lb) :=
begin
  rw tends_to_iff_tendsto at *,
  exact tendsto.mul ha hb,
end

end limites


import game.limits.L01defs
import game.sup_inf.GLBprop_if_LUBprop

namespace xena -- hide

notation `|` x `|` := abs x -- hide

/-
Another basic result for working with sequences.
-/

/- Lemma
If $\lim_{n \to \infty} a_n = \alpha$ and $\lim_{n \to \infty} b_n = \beta$, then
 $\lim_{n \to \infty} (a_n + b_n) = \alpha + \beta$
-/
lemma lim_add (a : ℕ → ℝ) (b : ℕ → ℝ) (α β : ℝ)
    (ha : is_limit a α) (hb : is_limit b β) :
    is_limit ( λ n, (a n) + (b n) ) (α + β) :=
begin
   intros ε hε,
   set e := ε / 2 with hedef,
   have he : 0 < e, linarith,
   have Ha := ha e he,
   have Hb := hb e he,
   cases Ha with na hna,
   cases Hb with nb hnb,
   set m := max na nb with hm,
   have hm1 : m ≥ na, norm_num, left, linarith,
   have hm2 : m ≥ nb, norm_num, right, linarith,
   use m,
   intros n hn,
   have hn1 : n ≥ na, linarith,
   have hn2 : n ≥ nb, linarith,
   have H1 := hna n hn1,
   have H2 := hnb n hn2,
   have H := abs_add (a n - α) (b n - β),
   simp,
   have G : a n - α + (b n - β) = a n + b n - (α + β), linarith,
   rw G at H,
   have F : |a n - α| + |b n - β| < 2 * e, linarith,
   have E : |a n + b n - (α + β)| < 2 * e, linarith,
   have D : 2 * e = ε, linarith,
   rw D at E, exact E, done
end

end xena -- hide


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import data.polynomial.degree.definitions

/-!
# Cancel the leading terms of two polynomials

## Definition

* `cancel_leads p q`: the polynomial formed by multiplying `p` and `q` by monomials so that they
  have the same leading term, and then subtracting.

## Main Results
The degree of `cancel_leads` is less than that of the larger of the two polynomials being cancelled.
Thus it is useful for induction or minimal-degree arguments.
-/
namespace polynomial
noncomputable theory
open_locale polynomial

variables {R : Type*}

section comm_ring
variables [comm_ring R] (p q : R[X])

/-- `cancel_leads p q` is formed by multiplying `p` and `q` by monomials so that they
  have the same leading term, and then subtracting. -/
def cancel_leads : R[X] :=
C p.leading_coeff * X ^ (p.nat_degree - q.nat_degree) * q -
C q.leading_coeff * X ^ (q.nat_degree - p.nat_degree) * p

variables {p q}

@[simp] lemma neg_cancel_leads : - p.cancel_leads q = q.cancel_leads p := neg_sub _ _

lemma dvd_cancel_leads_of_dvd_of_dvd {r : R[X]} (pq : p ∣ q) (pr : p ∣ r) :
  p ∣ q.cancel_leads r :=
dvd_sub (pr.trans (dvd.intro_left _ rfl)) (pq.trans (dvd.intro_left _ rfl))

end comm_ring

lemma nat_degree_cancel_leads_lt_of_nat_degree_le_nat_degree [comm_ring R] [is_domain R]
  {p q : R[X]} (h : p.nat_degree ≤ q.nat_degree) (hq : 0 < q.nat_degree) :
  (p.cancel_leads q).nat_degree < q.nat_degree :=
begin
  by_cases hp : p = 0,
  { convert hq,
    simp [hp, cancel_leads], },
  rw [cancel_leads, sub_eq_add_neg, tsub_eq_zero_iff_le.mpr h, pow_zero, mul_one],
  by_cases h0 :
      C p.leading_coeff * q + -(C q.leading_coeff * X ^ (q.nat_degree - p.nat_degree) * p) = 0,
  { convert hq,
    simp only [h0, nat_degree_zero], },
  have hq0 : ¬ q = 0,
  { contrapose! hq,
    simp [hq] },
  apply lt_of_le_of_ne,
  { rw [← with_bot.coe_le_coe, ← degree_eq_nat_degree h0, ← degree_eq_nat_degree hq0],
    apply le_trans (degree_add_le _ _),
    rw ← leading_coeff_eq_zero at hp hq0,
    simp only [max_le_iff, degree_C hp, degree_C hq0, le_refl q.degree, true_and, nat.cast_with_bot,
      nsmul_one, degree_neg, degree_mul, zero_add, degree_X, degree_pow],
    rw leading_coeff_eq_zero at hp hq0,
    rw [degree_eq_nat_degree hp, degree_eq_nat_degree hq0, ← with_bot.coe_add, with_bot.coe_le_coe,
      tsub_add_cancel_of_le h], },
  { contrapose! h0,
    rw [← leading_coeff_eq_zero, leading_coeff, h0, mul_assoc, mul_comm _ p,
      ← tsub_add_cancel_of_le h, add_comm _ p.nat_degree],
    simp only [coeff_mul_X_pow, coeff_neg, coeff_C_mul, add_tsub_cancel_left, coeff_add],
    rw [add_comm p.nat_degree, tsub_add_cancel_of_le h, ← leading_coeff, ← leading_coeff,
      mul_comm _ q.leading_coeff, ← sub_eq_add_neg, ← mul_sub, sub_self, mul_zero] }
end

end polynomial


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import algebra.gcd_monoid.finset
import data.polynomial.field_division
import data.polynomial.erase_lead
import data.polynomial.cancel_leads

/-!
# GCD structures on polynomials

Definitions and basic results about polynomials over GCD domains, particularly their contents
and primitive polynomials.

## Main Definitions
Let `p : R[X]`.
 - `p.content` is the `gcd` of the coefficients of `p`.
 - `p.is_primitive` indicates that `p.content = 1`.

## Main Results
 - `polynomial.content_mul`:
  If `p q : R[X]`, then `(p * q).content = p.content * q.content`.
 - `polynomial.normalized_gcd_monoid`:
  The polynomial ring of a GCD domain is itself a GCD domain.

-/

namespace polynomial
open_locale polynomial

section primitive

variables {R : Type*} [comm_semiring R]

/-- A polynomial is primitive when the only constant polynomials dividing it are units -/
def is_primitive (p : R[X]) : Prop :=
∀ (r : R), C r ∣ p → is_unit r

lemma is_primitive_iff_is_unit_of_C_dvd {p : R[X]} :
  p.is_primitive ↔ ∀ (r : R), C r ∣ p → is_unit r :=
iff.rfl

@[simp]
lemma is_primitive_one : is_primitive (1 : R[X]) :=
λ r h, is_unit_C.mp (is_unit_of_dvd_one (C r) h)

lemma monic.is_primitive {p : R[X]} (hp : p.monic) : p.is_primitive :=
begin
  rintros r ⟨q, h⟩,
  exact is_unit_of_mul_eq_one r (q.coeff p.nat_degree) (by rwa [←coeff_C_mul, ←h]),
end

lemma is_primitive.ne_zero [nontrivial R] {p : R[X]} (hp : p.is_primitive) : p ≠ 0 :=
begin
  rintro rfl,
  exact (hp 0 (dvd_zero (C 0))).ne_zero rfl,
end

end primitive

variables {R : Type*} [comm_ring R] [is_domain R]

section normalized_gcd_monoid
variable [normalized_gcd_monoid R]

/-- `p.content` is the `gcd` of the coefficients of `p`. -/
def content (p : R[X]) : R := (p.support).gcd p.coeff

lemma content_dvd_coeff {p : R[X]} (n : ℕ) : p.content ∣ p.coeff n :=
begin
  by_cases h : n ∈ p.support,
  { apply finset.gcd_dvd h },
  rw [mem_support_iff, not_not] at h,
  rw h,
  apply dvd_zero,
end

@[simp] lemma content_C {r : R} : (C r).content = normalize r :=
begin
  rw content,
  by_cases h0 : r = 0,
  { simp [h0] },
  have h : (C r).support = {0} := support_monomial _ _ h0,
  simp [h],
end

@[simp] lemma content_zero : content (0 : R[X]) = 0 :=
by rw [← C_0, content_C, normalize_zero]

@[simp] lemma content_one : content (1 : R[X]) = 1 :=
by rw [← C_1, content_C, normalize_one]

lemma content_X_mul {p : R[X]} : content (X * p) = content p :=
begin
  rw [content, content, finset.gcd_def, finset.gcd_def],
  refine congr rfl _,
  have h : (X * p).support = p.support.map ⟨nat.succ, nat.succ_injective⟩,
  { ext a,
    simp only [exists_prop, finset.mem_map, function.embedding.coe_fn_mk, ne.def,
      mem_support_iff],
    cases a,
    { simp [coeff_X_mul_zero, nat.succ_ne_zero] },
    rw [mul_comm, coeff_mul_X],
    split,
    { intro h,
      use a,
      simp [h] },
    { rintros ⟨b, ⟨h1, h2⟩⟩,
      rw ← nat.succ_injective h2,
      apply h1 } },
  rw h,
  simp only [finset.map_val, function.comp_app, function.embedding.coe_fn_mk, multiset.map_map],
  refine congr (congr rfl _) rfl,
  ext a,
  rw mul_comm,
  simp [coeff_mul_X],
end

@[simp] lemma content_X_pow {k : ℕ} : content ((X : R[X]) ^ k) = 1 :=
begin
  induction k with k hi,
  { simp },
  rw [pow_succ, content_X_mul, hi]
end

@[simp] lemma content_X : content (X : R[X]) = 1 :=
by { rw [← mul_one X, content_X_mul, content_one] }

lemma content_C_mul (r : R) (p : R[X]) : (C r * p).content = normalize r * p.content :=
begin
  by_cases h0 : r = 0, { simp [h0] },
  rw content, rw content, rw ← finset.gcd_mul_left,
  refine congr (congr rfl _) _; ext; simp [h0, mem_support_iff]
end

@[simp] lemma content_monomial {r : R} {k : ℕ} : content (monomial k r) = normalize r :=
by { rw [monomial_eq_C_mul_X, content_C_mul, content_X_pow, mul_one] }

lemma content_eq_zero_iff {p : R[X]} : content p = 0 ↔ p = 0 :=
begin
  rw [content, finset.gcd_eq_zero_iff],
  split; intro h,
  { ext n,
    by_cases h0 : n ∈ p.support,
    { rw [h n h0, coeff_zero], },
    { rw mem_support_iff at h0,
      push_neg at h0,
      simp [h0] } },
  { intros x h0,
    simp [h] }
end

@[simp] lemma normalize_content {p : R[X]} : normalize p.content = p.content :=
finset.normalize_gcd

lemma content_eq_gcd_range_of_lt (p : R[X]) (n : ℕ) (h : p.nat_degree < n) :
  p.content = (finset.range n).gcd p.coeff :=
begin
  apply dvd_antisymm_of_normalize_eq normalize_content finset.normalize_gcd,
  { rw finset.dvd_gcd_iff,
    intros i hi,
    apply content_dvd_coeff _ },
  { apply finset.gcd_mono,
    intro i,
    simp only [nat.lt_succ_iff, mem_support_iff, ne.def, finset.mem_range],
    contrapose!,
    intro h1,
    apply coeff_eq_zero_of_nat_degree_lt (lt_of_lt_of_le h h1), }
end

lemma content_eq_gcd_leading_coeff_content_erase_lead (p : R[X]) :
  p.content = gcd_monoid.gcd p.leading_coeff (erase_lead p).content :=
begin
  by_cases h : p = 0,
  { simp [h] },
  rw [← leading_coeff_eq_zero, leading_coeff, ← ne.def, ← mem_support_iff] at h,
  rw [content, ← finset.insert_erase h, finset.gcd_insert, leading_coeff, content,
    erase_lead_support],
  refine congr rfl (finset.gcd_congr rfl (λ i hi, _)),
  rw finset.mem_erase at hi,
  rw [erase_lead_coeff, if_neg hi.1],
end

lemma dvd_content_iff_C_dvd {p : R[X]} {r : R} : r ∣ p.content ↔ C r ∣ p :=
begin
  rw C_dvd_iff_dvd_coeff,
  split,
  { intros h i,
    apply h.trans (content_dvd_coeff _) },
  { intro h,
    rw [content, finset.dvd_gcd_iff],
    intros i hi,
    apply h i }
end

lemma C_content_dvd (p : R[X]) : C p.content ∣ p :=
dvd_content_iff_C_dvd.1 dvd_rfl

lemma is_primitive_iff_content_eq_one {p : R[X]} : p.is_primitive ↔ p.content = 1 :=
begin
  rw [←normalize_content, normalize_eq_one, is_primitive],
  simp_rw [←dvd_content_iff_C_dvd],
  exact ⟨λ h, h p.content (dvd_refl p.content), λ h r hdvd, is_unit_of_dvd_unit hdvd h⟩,
end

lemma is_primitive.content_eq_one {p : R[X]} (hp : p.is_primitive) : p.content = 1 :=
is_primitive_iff_content_eq_one.mp hp

open_locale classical
noncomputable theory

section prim_part

/-- The primitive part of a polynomial `p` is the primitive polynomial gained by dividing `p` by
  `p.content`. If `p = 0`, then `p.prim_part = 1`.  -/
def prim_part (p : R[X]) : R[X] :=
if p = 0 then 1 else classical.some (C_content_dvd p)

lemma eq_C_content_mul_prim_part (p : R[X]) : p = C p.content * p.prim_part :=
begin
  by_cases h : p = 0, { simp [h] },
  rw [prim_part, if_neg h, ← classical.some_spec (C_content_dvd p)],
end

@[simp]
lemma prim_part_zero : prim_part (0 : R[X]) = 1 := if_pos rfl

lemma is_primitive_prim_part (p : R[X]) : p.prim_part.is_primitive :=
begin
  by_cases h : p = 0, { simp [h] },
  rw ← content_eq_zero_iff at h,
  rw is_primitive_iff_content_eq_one,
  apply mul_left_cancel₀ h,
  conv_rhs { rw [p.eq_C_content_mul_prim_part, mul_one, content_C_mul, normalize_content] }
end

lemma content_prim_part (p : R[X]) : p.prim_part.content = 1 :=
p.is_primitive_prim_part.content_eq_one

lemma prim_part_ne_zero (p : R[X]) : p.prim_part ≠ 0 := p.is_primitive_prim_part.ne_zero

lemma nat_degree_prim_part (p : R[X]) : p.prim_part.nat_degree = p.nat_degree :=
begin
  by_cases h : C p.content = 0,
  { rw [C_eq_zero, content_eq_zero_iff] at h, simp [h] },
  conv_rhs { rw [p.eq_C_content_mul_prim_part,
    nat_degree_mul h p.prim_part_ne_zero, nat_degree_C, zero_add] },
end

@[simp]
lemma is_primitive.prim_part_eq {p : R[X]} (hp : p.is_primitive) : p.prim_part = p :=
by rw [← one_mul p.prim_part, ← C_1, ← hp.content_eq_one, ← p.eq_C_content_mul_prim_part]

lemma is_unit_prim_part_C (r : R) : is_unit (C r).prim_part :=
begin
  by_cases h0 : r = 0,
  { simp [h0] },
  unfold is_unit,
  refine ⟨⟨C ↑(norm_unit r)⁻¹, C ↑(norm_unit r),
    by rw [← ring_hom.map_mul, units.inv_mul, C_1],
    by rw [← ring_hom.map_mul, units.mul_inv, C_1]⟩, _⟩,
  rw [← normalize_eq_zero, ← C_eq_zero] at h0,
  apply mul_left_cancel₀ h0,
  conv_rhs { rw [← content_C, ← (C r).eq_C_content_mul_prim_part], },
  simp only [units.coe_mk, normalize_apply, ring_hom.map_mul],
  rw [mul_assoc, ← ring_hom.map_mul, units.mul_inv, C_1, mul_one],
end

lemma prim_part_dvd (p : R[X]) : p.prim_part ∣ p :=
dvd.intro_left (C p.content) p.eq_C_content_mul_prim_part.symm

end prim_part

lemma gcd_content_eq_of_dvd_sub {a : R} {p q : R[X]} (h : C a ∣ p - q) :
  gcd_monoid.gcd a p.content = gcd_monoid.gcd a q.content :=
begin
  rw content_eq_gcd_range_of_lt p (max p.nat_degree q.nat_degree).succ
    (lt_of_le_of_lt (le_max_left _ _) (nat.lt_succ_self _)),
  rw content_eq_gcd_range_of_lt q (max p.nat_degree q.nat_degree).succ
    (lt_of_le_of_lt (le_max_right _ _) (nat.lt_succ_self _)),
  apply finset.gcd_eq_of_dvd_sub,
  intros x hx,
  cases h with w hw,
  use w.coeff x,
  rw [← coeff_sub, hw, coeff_C_mul]
end

lemma content_mul_aux {p q : R[X]} :
  gcd_monoid.gcd (p * q).erase_lead.content p.leading_coeff =
  gcd_monoid.gcd (p.erase_lead * q).content p.leading_coeff :=
begin
  rw [gcd_comm (content _) _, gcd_comm (content _) _],
  apply gcd_content_eq_of_dvd_sub,
  rw [← self_sub_C_mul_X_pow, ← self_sub_C_mul_X_pow, sub_mul, sub_sub, add_comm, sub_add,
    sub_sub_cancel, leading_coeff_mul, ring_hom.map_mul, mul_assoc, mul_assoc],
  apply dvd_sub (dvd.intro _ rfl) (dvd.intro _ rfl),
end

@[simp]
theorem content_mul {p q : R[X]} : (p * q).content = p.content * q.content :=
begin
  classical,
  suffices h : ∀ (n : ℕ) (p q : R[X]), ((p * q).degree < n) →
    (p * q).content = p.content * q.content,
  { apply h,
    apply (lt_of_le_of_lt degree_le_nat_degree (with_bot.coe_lt_coe.2 (nat.lt_succ_self _))) },
  intro n,
  induction n with n ih,
  { intros p q hpq,
    rw [with_bot.coe_zero, nat.with_bot.lt_zero_iff, degree_eq_bot, mul_eq_zero] at hpq,
    rcases hpq with rfl | rfl; simp },
  intros p q hpq,
  by_cases p0 : p = 0, { simp [p0] },
  by_cases q0 : q = 0, { simp [q0] },
  rw [degree_eq_nat_degree (mul_ne_zero p0 q0), with_bot.coe_lt_coe, nat.lt_succ_iff_lt_or_eq,
    ← with_bot.coe_lt_coe, ← degree_eq_nat_degree (mul_ne_zero p0 q0), nat_degree_mul p0 q0] at hpq,
  rcases hpq with hlt | heq, { apply ih _ _ hlt },
  rw [← p.nat_degree_prim_part, ← q.nat_degree_prim_part, ← with_bot.coe_eq_coe, with_bot.coe_add,
    ← degree_eq_nat_degree p.prim_part_ne_zero, ← degree_eq_nat_degree q.prim_part_ne_zero] at heq,
  rw [p.eq_C_content_mul_prim_part, q.eq_C_content_mul_prim_part],
  suffices h : (q.prim_part * p.prim_part).content = 1,
  { rw [mul_assoc, content_C_mul, content_C_mul, mul_comm p.prim_part, mul_assoc, content_C_mul,
    content_C_mul, h, mul_one, content_prim_part, content_prim_part, mul_one, mul_one] },
  rw [← normalize_content, normalize_eq_one, is_unit_iff_dvd_one,
      content_eq_gcd_leading_coeff_content_erase_lead, leading_coeff_mul, gcd_comm],
  apply (gcd_mul_dvd_mul_gcd _ _ _).trans,
  rw [content_mul_aux, ih, content_prim_part, mul_one, gcd_comm,
      ← content_eq_gcd_leading_coeff_content_erase_lead, content_prim_part, one_mul,
      mul_comm q.prim_part, content_mul_aux, ih, content_prim_part, mul_one, gcd_comm,
      ← content_eq_gcd_leading_coeff_content_erase_lead, content_prim_part],
  { rw [← heq, degree_mul, with_bot.add_lt_add_iff_right],
    { apply degree_erase_lt p.prim_part_ne_zero },
    { rw [ne.def, degree_eq_bot],
      apply q.prim_part_ne_zero } },
  { rw [mul_comm, ← heq, degree_mul, with_bot.add_lt_add_iff_left],
    { apply degree_erase_lt q.prim_part_ne_zero },
    { rw [ne.def, degree_eq_bot],
      apply p.prim_part_ne_zero } }
end

theorem is_primitive.mul {p q : R[X]} (hp : p.is_primitive) (hq : q.is_primitive) :
  (p * q).is_primitive :=
by rw [is_primitive_iff_content_eq_one, content_mul, hp.content_eq_one, hq.content_eq_one, mul_one]

@[simp]
theorem prim_part_mul {p q : R[X]} (h0 : p * q ≠ 0) :
  (p * q).prim_part = p.prim_part * q.prim_part :=
begin
  rw [ne.def, ← content_eq_zero_iff, ← C_eq_zero] at h0,
  apply mul_left_cancel₀ h0,
  conv_lhs { rw [← (p * q).eq_C_content_mul_prim_part,
    p.eq_C_content_mul_prim_part, q.eq_C_content_mul_prim_part] },
  rw [content_mul, ring_hom.map_mul],
  ring,
end

lemma is_primitive.is_primitive_of_dvd {p q : R[X]} (hp : p.is_primitive) (hdvd : q ∣ p) :
  q.is_primitive :=
begin
  rcases hdvd with ⟨r, rfl⟩,
  rw [is_primitive_iff_content_eq_one, ← normalize_content, normalize_eq_one, is_unit_iff_dvd_one],
  apply dvd.intro r.content,
  rwa [is_primitive_iff_content_eq_one, content_mul] at hp,
end

lemma is_primitive.dvd_prim_part_iff_dvd {p q : R[X]}
  (hp : p.is_primitive) (hq : q ≠ 0) :
  p ∣ q.prim_part ↔ p ∣ q :=
begin
  refine ⟨λ h, h.trans (dvd.intro_left _ q.eq_C_content_mul_prim_part.symm), λ h, _⟩,
  rcases h with ⟨r, rfl⟩,
  apply dvd.intro _,
  rw [prim_part_mul hq, hp.prim_part_eq],
end

theorem exists_primitive_lcm_of_is_primitive {p q : R[X]}
  (hp : p.is_primitive) (hq : q.is_primitive) :
  ∃ r : R[X], r.is_primitive ∧ (∀ s : R[X], p ∣ s ∧ q ∣ s ↔ r ∣ s) :=
begin
  classical,
  have h : ∃ (n : ℕ) (r : R[X]), r.nat_degree = n ∧ r.is_primitive ∧ p ∣ r ∧ q ∣ r :=
    ⟨(p * q).nat_degree, p * q, rfl, hp.mul hq, dvd_mul_right _ _, dvd_mul_left _ _⟩,
  rcases nat.find_spec h with ⟨r, rdeg, rprim, pr, qr⟩,
  refine ⟨r, rprim, λ s, ⟨_, λ rs, ⟨pr.trans rs, qr.trans rs⟩⟩⟩,
  suffices hs : ∀ (n : ℕ) (s : R[X]), s.nat_degree = n → (p ∣ s ∧ q ∣ s → r ∣ s),
  { apply hs s.nat_degree s rfl },
  clear s,
  by_contra' con,
  rcases nat.find_spec con with ⟨s, sdeg, ⟨ps, qs⟩, rs⟩,
  have s0 : s ≠ 0,
  { contrapose! rs, simp [rs] },
  have hs := nat.find_min' h ⟨_, s.nat_degree_prim_part, s.is_primitive_prim_part,
              (hp.dvd_prim_part_iff_dvd s0).2 ps, (hq.dvd_prim_part_iff_dvd s0).2 qs⟩,
  rw ← rdeg at hs,
  by_cases sC : s.nat_degree ≤ 0,
  { rw [eq_C_of_nat_degree_le_zero (le_trans hs sC), is_primitive_iff_content_eq_one,
      content_C, normalize_eq_one] at rprim,
    rw [eq_C_of_nat_degree_le_zero (le_trans hs sC), ← dvd_content_iff_C_dvd] at rs,
    apply rs rprim.dvd },
  have hcancel := nat_degree_cancel_leads_lt_of_nat_degree_le_nat_degree hs (lt_of_not_ge sC),
  rw sdeg at hcancel,
  apply nat.find_min con hcancel,
  refine ⟨_, rfl, ⟨dvd_cancel_leads_of_dvd_of_dvd pr ps, dvd_cancel_leads_of_dvd_of_dvd qr qs⟩,
      λ rcs, rs _⟩,
  rw ← rprim.dvd_prim_part_iff_dvd s0,
  rw [cancel_leads, tsub_eq_zero_iff_le.mpr hs, pow_zero, mul_one] at rcs,
  have h := dvd_add rcs (dvd.intro_left _ rfl),
  have hC0 := rprim.ne_zero,
  rw [ne.def, ← leading_coeff_eq_zero, ← C_eq_zero] at hC0,
  rw [sub_add_cancel, ← rprim.dvd_prim_part_iff_dvd (mul_ne_zero hC0 s0)] at h,
  rcases is_unit_prim_part_C r.leading_coeff with ⟨u, hu⟩,
  apply h.trans (associated.symm ⟨u, _⟩).dvd,
  rw [prim_part_mul (mul_ne_zero hC0 s0), hu, mul_comm],
end

lemma dvd_iff_content_dvd_content_and_prim_part_dvd_prim_part
  {p q : R[X]} (hq : q ≠ 0) :
  p ∣ q ↔ p.content ∣ q.content ∧ p.prim_part ∣ q.prim_part :=
begin
  split; intro h,
  { rcases h with ⟨r, rfl⟩,
    rw [content_mul, p.is_primitive_prim_part.dvd_prim_part_iff_dvd hq],
    exact ⟨dvd.intro _ rfl, p.prim_part_dvd.trans (dvd.intro _ rfl)⟩ },
  { rw [p.eq_C_content_mul_prim_part, q.eq_C_content_mul_prim_part],
    exact mul_dvd_mul (ring_hom.map_dvd C h.1) h.2 }
end

@[priority 100]
instance normalized_gcd_monoid : normalized_gcd_monoid R[X] :=
normalized_gcd_monoid_of_exists_lcm $ λ p q, begin
  rcases exists_primitive_lcm_of_is_primitive p.is_primitive_prim_part q.is_primitive_prim_part
    with ⟨r, rprim, hr⟩,
  refine ⟨C (lcm p.content q.content) * r, λ s, _⟩,
  by_cases hs : s = 0,
  { simp [hs] },
  by_cases hpq : C (lcm p.content q.content) = 0,
  { rw [C_eq_zero, lcm_eq_zero_iff, content_eq_zero_iff, content_eq_zero_iff] at hpq,
    rcases hpq with hpq | hpq; simp [hpq, hs] },
  iterate 3 { rw dvd_iff_content_dvd_content_and_prim_part_dvd_prim_part hs },
  rw [content_mul, rprim.content_eq_one, mul_one, content_C, normalize_lcm, lcm_dvd_iff,
    prim_part_mul (mul_ne_zero hpq rprim.ne_zero), rprim.prim_part_eq,
    is_unit.mul_left_dvd _ _ _ (is_unit_prim_part_C (lcm p.content q.content)), ← hr s.prim_part],
  tauto,
end

lemma degree_gcd_le_left {p : R[X]} (hp : p ≠ 0) (q) : (gcd p q).degree ≤ p.degree :=
begin
  have := nat_degree_le_iff_degree_le.mp
    (nat_degree_le_of_dvd (gcd_dvd_left p q) hp),
  rwa degree_eq_nat_degree hp
end

lemma degree_gcd_le_right (p) {q : R[X]} (hq : q ≠ 0) : (gcd p q).degree ≤ q.degree :=
by { rw [gcd_comm], exact degree_gcd_le_left hq p }

end normalized_gcd_monoid
end polynomial


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

import tactic -- imports all the Lean tactics
import order.filter.basic

/-!

# Filters

## What is a filter?

Morally, a filter on a type `α` is a "generalised subset of `α`". By this I mean that each subset
of `α` gives rise to a filter, but there are other "ideas", such as "an infinitesimal neighbourhood of
a point in a topological space" or "a neighbourhood of infinity in a totally ordered set", which can be
expressed as filters but not as sets (Isaac Newton might have wanted to have `dx` as "a real number
infinitesimally close to 0", but the modern treatments of real numbers don't allow `dx` as elements;
filters enable you to recover these thoughts)

The property which we want a "generalised subset" to have, is that it is uniquely determined
by the *actual* subsets which it's containined in. Let's use this point of view to figure
out the definition of a filter.

If `F` is a "generalised subset" of a type `α`, then then what properties should
the collection of *actual* subsets of `α` which contain `F` have?

1) If `S` contains `F` and `S ⊆ T` then `T` contains `F`.
2) If `S` and `T` contain `F`, then so does `S ∩ T`
3) The set `α` itself (or, in Lean speak, `set.univ : set α`) contains `F`.

The way that these "generalised subsets" of `α` are modelled is precisely as collections
of subsets of `α` satisfying these three axioms.

## The formal definition

structure filter (α : Type*) :=
(sets                   : set (set α))
(univ_sets              : set.univ ∈ sets)
(sets_of_superset {x y} : x ∈ sets → x ⊆ y → y ∈ sets)
(inter_sets {x y}       : x ∈ sets → y ∈ sets → x ∩ y ∈ sets)

In other words, to give a filter on a type `α` is to give a set of subsets of `α` satisfying
the three axioms above.

Some people add in an extra fourth axiom, saying that the empty set is not allowed to
be in `sets`. This is a way of saying that the empty set is not allowed to be a
generalised subset of `α`. But it's certainly a subset of `α`, so in mathlib we do not
include this fourth axiom. To me this missing axiom feels analogous to an axiom saying
that e.g. a ring is not allowed to be an ideal of itself; it might seem initially like
a good idea (because then "maximal ideals" really are maximal elements in the set of
ideals) but it causes a lot of confusion later on because you have to constantly deal
with the special case which you've disallowed.

## Notation, helpful tactics and helpful theorems

We are not going to build filters from first principles, we will be
using Lean's API for filters.

Say `α : Type` and `F : filter α` and `S : set α`. The notation `S ∈ F` is
defined to mean `S ∈ F.sets`. You should think of it as morally meaning `F ⊆ S`,
but this doesn't make sense because `F` is a filter, not a subset.

The `ext` tactic can be used to reduce a goal `F = G` to a goal of
the form `∀ S, S ∈ F ↔ S ∈ G`.

The fields of the structure mention things like `S ∈ F.sets`, so the
axioms are restated with different names, but using the `S ∈ F` notation.
The lemmas corresponding to the definitions are:

`univ_mem : univ ∈ F`
`mem_of_superset : S ∈ F → S ⊆ T → T ∈ F`
`inter_mem : S ∈ F → T ∈ F → S ∩ T ∈ F`

These lemmas in the `filter` namespace, i.e. their full names are
`filter.univ_mem_sets` etc. But we are about to say `open filter`
which means that you don't have to type this `filter.` thing in front of every
lemma you need about filters. In fact we'll also be using a bunch of
stuff about sets, like `set.inter_subset_left`, so why don't we `open set`
as well.
-/

open filter set

-- Variables!
-- let `α` be a type, let `F` be a filter on `α`, and let `S` and `T`
-- denote subsets of `α`.

variables (α : Type) (F : filter α) (S T : set α)

/-
Here's a lemma about filters: Two sets `S` and `T` are both in
a filter `F` if and only if their intersection is. See if you can deduce
it from the axioms of a filter.

For this one it's useful to know the following results (from the set namespace)
`inter_subset_left S T : S ∩ T ⊆ S`
and
`inter_subset_right S T : S ∩ T ⊆ S`
-/
example : S ∩ T ∈ F ↔ S ∈ F ∧ T ∈ F :=
begin
  split,
  { intro hST,
    split,
    { apply mem_of_superset hST,
      exact inter_subset_left S T },
    { apply mem_of_superset hST,
      exact inter_subset_right S T } },
  { rintros ⟨hS, hT⟩,
    exact inter_mem hS hT }
end

/-

## Principal filters

Surely a subset of `α` should be a generalised subset of `α`! So there
should be a map `set α → filter α`. It's called `principal` and it
has notation `𝓟`. The principal filter `𝓟 X` generated by `X : set α` is the
subsets of `α` which contain `X`. Prove that it's a filter.

Helpful for this exercise:
`mem_univ s : s ∈ univ`
`subset.trans : A ⊆ B → B ⊆ C → A ⊆ C`
`subset_inter : X ⊆ S → X ⊆ T → X ⊆ S ∩ T`
(note that you could probably prove those last two things directly yourself,
but we may as well use the interface for sets given that it's there)
`mem_set_of_eq : x ∈ {a : α | p a} = p x`
(this one is definitional, so you could use `change` instead, or just
not rewrite it at all)

-/

-- this is called `𝓟 X` in mathlib but let's just make it ourselves.
example (X : set α) : filter α :=
{ sets := {S : set α | X ⊆ S},
  univ_sets := begin
    intros a ha,
    exact mem_univ _,
  end,
  sets_of_superset := begin
    intros S T hS hT,
--    change X ⊆ T,
--    change X ⊆ S at hS,
    exact subset.trans hS hT,
  end,
  inter_sets := begin
    intros S T hS hT,
--    rw mem_set_of_eq at ⊢ hS hT,
    exact subset_inter hS hT,
  end }

-- The notation for the principal filter generated by `X : set α` is `𝓟 X`.
-- This notation is in the "filter locale", which is just a posh way
-- of saying that you have to type

open_locale filter

-- in order to get the notation.


#check @nat.rec_on

/-
nat.rec_on :
  Π {motive : ℕ → Sort u_1}
  (n : ℕ),
  motive 0 →
  (Π (n : ℕ), motive n → motive n.succ) →
  motive n
-/

def fac : ℕ → ℕ :=
begin
  assume n,
  apply nat.rec_on n,

  -- first machine, base case
  exact 1,

  -- inductive case
  assume n' facn',
  exact facn' * (n'+1)
end

example : fac 0 = 1 := rfl
example : fac 5 = 120 := rfl

def fac' : ℕ → ℕ
| 0 := 1
| (nat.succ n') := (nat.succ n') * (fac' n')

example : fac' 0 = 1 := rfl
example : fac' 5 = 120 := rfl

def sum_to : ℕ → ℕ
| 0 := 0
| (nat.succ n') := (nat.succ n') + (sum_to n')

example : sum_to 0 = 0 := rfl
example : sum_to 10 = 55 := rfl

theorem sum_thm :
∀ (n : ℕ), 2 * sum_to n = n * (nat.succ n) :=
begin
  assume n,
  apply nat.rec_on n,
  -- base case
  exact rfl,
  -- inductive
  assume n' h,
  --unfold sum_to,
  simp [sum_to],
end

/-
Let's looks at some induction principles
-/

#check @bool.rec_on

/-
inductive bool : Type
| tt
| ff

 Π {motive : bool → Sort u_1} (n : bool), motive ff → motive tt → motive n
 -/

#print punit
#check @punit.rec_on

/-
Π {motive : punit → Sort u_1} (n : punit), motive punit.star → motive n
-/

#check empty

/-
inductive empty : Type

Π {motive : empty → Sort u_1} (n : empty), motive n
-/

#check @punit.rec_on

/-
 Π {motive : punit → Sort u_1} (n : punit), motive
-/

axioms (e : empty) (purple : empty → Prop)

example : ∀ (e : empty), purple e :=
begin
  assume e,
  apply empty.rec_on,
end

/-
Case analysis vs induction
-/

example : ∀ (e : empty), purple e :=
begin
  assume e,
  cases e,
end

example : ∀ (b : bool), band b tt = b :=
begin
  assume b,
  cases b,
  repeat {exact rfl},
end

theorem sum_thm' :
∀ (n : ℕ), 2 * sum_to n = n * (nat.succ n) :=
begin
  assume n,
  cases n,
  exact rfl,
  apply linarith,
end


/-
Copyright (c) 2022 Rishikesh Vaishnav. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rishikesh Vaishnav
-/
import measure_theory.measure.measure_space

/-!
# Conditional Probability

This file defines conditional probability and includes basic results relating to it.

Given some measure `μ` defined on a measure space on some type `Ω` and some `s : set Ω`,
we define the measure of `μ` conditioned on `s` as the restricted measure scaled by
the inverse of the measure of `s`: `cond μ s = (μ s)⁻¹ • μ.restrict s`. The scaling
ensures that this is a probability measure (when `μ` is a finite measure).

From this definition, we derive the "axiomatic" definition of conditional probability
based on application: for any `s t : set Ω`, we have `μ[t|s] = (μ s)⁻¹ * μ (s ∩ t)`.

## Main Statements

* `cond_cond_eq_cond_inter`: conditioning on one set and then another is equivalent
  to conditioning on their intersection.
* `cond_eq_inv_mul_cond_mul`: Bayes' Theorem, `μ[t|s] = (μ s)⁻¹ * μ[s|t] * (μ t)`.

## Notations

This file uses the notation `μ[|s]` the measure of `μ` conditioned on `s`,
and `μ[t|s]` for the probability of `t` given `s` under `μ` (equivalent to the
application `μ[|s] t`).

These notations are contained in the locale `probability_theory`.

## Implementation notes

Because we have the alternative measure restriction application principles
`measure.restrict_apply` and `measure.restrict_apply'`, which require
measurability of the restricted and restricting sets, respectively,
many of the theorems here will have corresponding alternatives as well.
For the sake of brevity, we've chosen to only go with `measure.restrict_apply'`
for now, but the alternative theorems can be added if needed.

Use of `@[simp]` generally follows the rule of removing conditions on a measure
when possible.

Hypotheses that are used to "define" a conditional distribution by requiring that
the conditioning set has non-zero measure should be named using the abbreviation
"c" (which stands for "conditionable") rather than "nz". For example `(hci : μ (s ∩ t) ≠ 0)`
(rather than `hnzi`) should be used for a hypothesis ensuring that `μ[|s ∩ t]` is defined.

## Tags
conditional, conditioned, bayes
-/

noncomputable theory

open_locale ennreal

open measure_theory measurable_space

variables {Ω : Type*} {m : measurable_space Ω} (μ : measure Ω) {s t : set Ω}

namespace probability_theory

section definitions

/-- The conditional probability measure of measure `μ` on set `s` is `μ` restricted to `s`
and scaled by the inverse of `μ s` (to make it a probability measure):
`(μ s)⁻¹ • μ.restrict s`. -/
def cond (s : set Ω) : measure Ω :=
  (μ s)⁻¹ • μ.restrict s

end definitions

localized "notation (name := probability_theory.cond)
  μ `[` s `|` t `]` := probability_theory.cond μ t s" in probability_theory
localized "notation (name := probability_theory.cond_fn)
  μ `[|`:60 t`]` := probability_theory.cond μ t" in probability_theory

/-- The conditional probability measure of any finite measure on any set of positive measure
is a probability measure. -/

section bayes

@[simp] lemma cond_empty : μ[|∅] = 0 :=
by simp [cond]

@[simp] lemma cond_univ [is_probability_measure μ] :
  μ[|set.univ] = μ :=
by simp [cond, measure_univ, measure.restrict_univ]

/-- The axiomatic definition of conditional probability derived from a measure-theoretic one. -/
lemma cond_apply (hms : measurable_set s) (t : set Ω) :
  μ[t|s] = (μ s)⁻¹ * μ (s ∩ t) :=
by { rw [cond, measure.smul_apply, measure.restrict_apply' hms, set.inter_comm], refl }

lemma cond_inter_self (hms : measurable_set s) (t : set Ω) :
  μ[s ∩ t|s] = μ[t|s] :=
by rw [cond_apply _ hms, ← set.inter_assoc, set.inter_self, ← cond_apply _ hms]

lemma inter_pos_of_cond_ne_zero (hms : measurable_set s) (hcst : μ[t|s] ≠ 0) :
  0 < μ (s ∩ t) :=
begin
  refine pos_iff_ne_zero.mpr (right_ne_zero_of_mul _),
  { exact (μ s)⁻¹ },
  convert hcst,
  simp [hms, set.inter_comm]
end

lemma cond_pos_of_inter_ne_zero [is_finite_measure μ]
  (hms : measurable_set s) (hci : μ (s ∩ t) ≠ 0) :
  0 < μ[|s] t :=
begin
  rw cond_apply _ hms,
  refine ennreal.mul_pos _ hci,
  exact ennreal.inv_ne_zero.mpr (measure_ne_top _ _),
end

lemma cond_cond_eq_cond_inter'
  (hms : measurable_set s) (hmt : measurable_set t) (hcs : μ s ≠ ∞) (hci : μ (s ∩ t) ≠ 0) :
  μ[|s][|t] = μ[|s ∩ t] :=
begin
  have hcs : μ s ≠ 0 := (μ.to_outer_measure.pos_of_subset_ne_zero
    (set.inter_subset_left _ _) hci).ne',
  ext u,
  simp [*, hms.inter hmt, cond_apply, ← mul_assoc, ← set.inter_assoc,
    ennreal.mul_inv, mul_comm, ← mul_assoc, ennreal.inv_mul_cancel],
end

/-- Conditioning first on `s` and then on `t` results in the same measure as conditioning
on `s ∩ t`. -/
lemma cond_cond_eq_cond_inter [is_finite_measure μ]
  (hms : measurable_set s) (hmt : measurable_set t) (hci : μ (s ∩ t) ≠ 0) :
  μ[|s][|t] = μ[|s ∩ t] :=
cond_cond_eq_cond_inter' μ hms hmt (measure_ne_top μ s) hci

lemma cond_mul_eq_inter'
  (hms : measurable_set s) (hcs : μ s ≠ 0) (hcs' : μ s ≠ ∞) (t : set Ω) :
  μ[t|s] * μ s = μ (s ∩ t) :=
by rw [cond_apply μ hms t, mul_comm, ←mul_assoc,
  ennreal.mul_inv_cancel hcs hcs', one_mul]

lemma cond_mul_eq_inter [is_finite_measure μ]
  (hms : measurable_set s) (hcs : μ s ≠ 0) (t : set Ω) :
  μ[t|s] * μ s = μ (s ∩ t) :=
cond_mul_eq_inter' μ hms hcs (measure_ne_top _ s) t

/-- A version of the law of total probability. -/
lemma cond_add_cond_compl_eq [is_finite_measure μ]
  (hms : measurable_set s) (hcs : μ s ≠ 0) (hcs' : μ sᶜ ≠ 0) :
  μ[t|s] * μ s + μ[t|sᶜ] * μ sᶜ = μ t :=
begin
  rw [cond_mul_eq_inter μ hms hcs, cond_mul_eq_inter μ hms.compl hcs', set.inter_comm _ t,
    set.inter_comm _ t],
  exact measure_inter_add_diff t hms,
end

/-- **Bayes' Theorem** -/
theorem cond_eq_inv_mul_cond_mul [is_finite_measure μ]
  (hms : measurable_set s) (hmt : measurable_set t) :
  μ[t|s] = (μ s)⁻¹ * μ[s|t] * (μ t) :=
begin
  by_cases ht : μ t = 0,
  { simp [cond, ht, measure.restrict_apply hmt, or.inr (measure_inter_null_of_null_left s ht)] },
  { rw [mul_assoc, cond_mul_eq_inter μ hmt ht s, set.inter_comm, cond_apply _ hms] }
end

end bayes

end probability_theory


import definitions
import data.list.basic

definition fib_mod (m : ℕ) : ℕ → ℕ
| 0 := 0 % m
| 1 := 1 % m
| (n + 2) := ( (fib_mod n) + (fib_mod (n + 1)) ) % m

def luc_mod (m : ℕ) : ℕ → ℕ
| 0 := 2 % m
| 1 := 1 % m
| (n + 2) := ( (luc_mod n) + (luc_mod (n + 1)) ) % m

theorem luc_mod_is_luc (m : ℕ) : ∀ r : ℕ,
luc_mod m r = (luc r) % m
| 0 := rfl
| 1 := rfl
| (n + 2) := begin
have Hn := luc_mod_is_luc n,
have Hnp1 := luc_mod_is_luc (n + 1),
unfold luc_mod,
unfold luc,
rw Hn,
rw Hnp1,
show (luc n % m + luc (n + 1) % m) % m = (luc n + luc (n + 1)) % m,
apply nat.mod_add,
end

theorem fib_mod_eq (m n : ℕ) : (fib_mod m) n = (fib n) % m :=
nat.rec_on_two n (rfl) (rfl) (begin
  intros d Hd Hdplus1,
  unfold fib,
  unfold fib_mod,
  rw Hd,
  rw Hdplus1,
  exact nat.mod_add _ _ _
end)

theorem luc_mod_eq (m n : ℕ) : (luc_mod m) n = (luc n) % m :=
nat.rec_on_two n (rfl) (rfl) (begin
  intros d Hd Hdplus1,
  unfold luc,
  unfold luc_mod,
  rw Hd,
  rw Hdplus1,
  exact nat.mod_add _ _ _
end)

theorem fib_mod_16_aux (n : ℕ) : (fib_mod 16) (n + 24) = (fib_mod 16) n :=
nat.rec_on_two n (rfl) (rfl) (begin
  intros d Hd Hdplus1,
  show (fib_mod 16 (d + 24) + fib_mod 16 (nat.succ d + 24)) % 16 =
  (fib_mod 16 d + fib_mod 16 (nat.succ d)) % 16,
  rw Hd,rw Hdplus1,
end)

theorem fib_mod_16 (n : ℕ) : (fib_mod 16) n = (fib_mod 16) (n % 24) :=
begin
  have H : ∀ n k, fib_mod 16 (n + 24 * k) = (fib_mod 16) n,
  { intros n k,
    induction k with d Hd,
    -- base case
    { refl},
    -- inductive step
    { show fib_mod 16 (n + 24 * (d + 1)) = fib_mod 16 n,
      rwa [mul_add,←add_assoc,mul_one,fib_mod_16_aux],
    },
  },
  conv begin
    to_lhs,
    rw ←nat.mod_add_div n 24,
  end,
  rw H (n % 24) (n / 24)
end

theorem luc_mod_8_aux (n : ℕ) : (luc_mod 8) (n + 12) = (luc_mod 8) n :=
nat.rec_on_two n (rfl) (rfl) (begin
  intros d Hd Hdplus1,
  show (luc_mod 8 (d + 12) + luc_mod 8 (nat.succ d + 12)) % 8 =
  (luc_mod 8 d + luc_mod 8 (nat.succ d)) % 8,
  rw Hd,rw Hdplus1,
end)

theorem luc_mod_8 (n : ℕ) : (luc_mod 8) n = (luc_mod 8) (n % 12) :=
begin
  have H : ∀ n k, luc_mod 8 (n + 12 * k) = (luc_mod 8) n,
  { intros n k,
    induction k with d Hd,
    -- base case
    { refl},
    -- inductive step
    { show luc_mod 8 (n + 12 * (d + 1)) = luc_mod 8 n,
      rwa [mul_add,←add_assoc,mul_one,luc_mod_8_aux],
    },
  },
  conv begin
    to_lhs,
    rw ←nat.mod_add_div n 12,
  end,
  rw H (n % 12) (n / 12)
end

theorem luc_mod_3_aux (n : ℕ) : (luc_mod 3) (n + 8) = (luc_mod 3) n :=
nat.rec_on_two n (rfl) (rfl) (begin
  intros d Hd Hdplus1,
  show (luc_mod 3 (d + 8) + luc_mod 3 (nat.succ d + 8)) % 3 =
  (luc_mod 3 d + luc_mod 3 (nat.succ d)) % 3,
  rw Hd,rw Hdplus1,
end)

theorem luc_mod_3 (n : ℕ) : (luc_mod 3) n = (luc_mod 3) (n % 8) :=
begin
  have H : ∀ n k, luc_mod 3 (n + 8 * k) = (luc_mod 3) n,
  { intros n k,
    induction k with d Hd,
    -- base case
    { refl},
    -- inductive step
    { show luc_mod 3 (n + 8 * (d + 1)) = luc_mod 3 n,
      rwa [mul_add,←add_assoc,mul_one,luc_mod_3_aux],
    },
  },
  conv begin
    to_lhs,
    rw ←nat.mod_add_div n 8,
  end,
  rw H (n % 8) (n / 8)
end

theorem luc_mod_2_aux (n : ℕ) : (luc_mod 2) (n + 3) = (luc_mod 2) n :=
nat.rec_on_two n (rfl) (rfl) (begin
  intros d Hd Hdplus1,
  show (luc_mod 2 (d + 3) + luc_mod 2 (nat.succ d + 3)) % 2 =
  (luc_mod 2 d + luc_mod 2 (nat.succ d)) % 2,
  rw Hd,rw Hdplus1,
end)

theorem luc_mod_2 (n : ℕ) : (luc_mod 2) n = (luc_mod 2) (n % 3) :=
begin
  have H : ∀ n k, luc_mod 2 (n + 3 * k) = (luc_mod 2) n,
  { intros n k,
    induction k with d Hd,
    -- base case
    { refl},
    -- inductive step
    { show luc_mod 2 (n + 3 * (d + 1)) = luc_mod 2 n,
      rwa [mul_add,←add_assoc,mul_one,luc_mod_2_aux],
    },
  },
  conv begin
    to_lhs,
    rw ←nat.mod_add_div n 3,
  end,
  rw H (n % 3) (n / 3)
end


import Mathlib.Data.Nat.Log
import Mathlib.Tactic.Linarith
import Mathlib.Tactic.NormNum

theorem log_pred : ∀ (a : Nat) , Nat.log 2 a - 1 = Nat.log 2 (a / 2)
| 0 => by simp only [Nat.log_zero_right, Nat.zero_div]
| 1 => by norm_num
| (a + 2) => by
  rw [Nat.log]
  split_ifs with h
  { simp }
  simp at h

theorem log_2_val : Nat.log 2 2 = 1 := by rfl

theorem sum_2b (a b : Nat) : a ≤ 2 * b → a + 2 * b ≤ 4 * b := fun h =>
  calc a + 2 * b ≤ 2 * b + 2 * b := add_le_add h rfl.ge
       _         = 4 * b := by linarith

theorem log_2_times : ∀ (a : Nat), 2 * Nat.log 2 (a + 2) ≤ a + 2
| 0       => by { rw [log_2_val] }
| (a + 1) => by
  have tmp : (a + 1) / 2 < a + 1 := Nat.div_lt_self' a 0
  rw [Nat.log]
  split_ifs
  { have ih := log_2_times ((a + 1) / 2)
    rw [mul_add]
    cases a with
    | zero    => rw [Nat.log]; simp
    | succ a' =>
        cases a' with
        | zero     => norm_num; rw [log_2_val]
        | succ a'' =>
          norm_num
          have add_one :
            2 * Nat.log 2 ((a''.succ.succ + 1) / 2).succ ≤
            2 * Nat.log 2 (((a''.succ.succ + 1) / 2) + 2) :=
              by apply Nat.mul_le_mul_left 2
                 apply Nat.log_monotone
                 exact Nat.le_succ ((a''.succ.succ + 1) / 2 + 1)
          apply le_trans add_one
          apply le_trans ih
          have succ_succ_two : a''.succ.succ + 1 = a'' + 3 := rfl
          have two_div_two : ∀ {y}, (y + 2) / 2 = y / 2 + 1 := by
            intro y; rw [(y + 2).div_eq 2]; simp
          have three_eq_one_plus_two : ∀ {y}, y + 3 = y + 1 + 2 := by
            intro y; rfl
          rw [ succ_succ_two
             , two_div_two
             , three_eq_one_plus_two
             , ← three_eq_one_plus_two
             ]
          apply flip add_le_add (le_refl 3)
          exact Nat.lt_succ_iff.mp (Nat.div_lt_self' a'' 0)
  }
  simp

theorem div_two (b a : ℕ) : 2 * a ≤ b → a ≤ b / 2 :=
  by simp_rw [Nat.le_div_iff_mul_le zero_lt_two, mul_comm, imp_self]


import analysis.specific_limits.basic
import data.int.parity
import topology.sequences

attribute [instance] classical.prop_decidable

/-
Lemmas from that file were hidden in my course, or restating things which
were proved without name in previous files.
-/

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

-- The mathlib version is unusable because it is stated in terms of ≤
lemma ge_max_iff {α : Type*} [linear_order α] {p q r : α} : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q :=
max_le_iff

/- No idea why this is not in mathlib-/
lemma eq_of_abs_sub_le_all (x y : ℝ) : (∀ ε > 0, |x - y| ≤ ε) → x = y :=
begin
  intro h,
  apply eq_of_abs_sub_nonpos,
  by_contradiction H,
  push_neg at H,
  specialize h ( |x-y|/2) (by linarith),
  linarith,
end

def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

lemma unique_limit {u l l'} : seq_limit u l → seq_limit u l' → l = l' :=
begin
  intros hl hl',
  apply eq_of_abs_sub_le_all,
  intros ε ε_pos,
  specialize hl (ε/2) (by linarith),
  cases hl with N hN,
  specialize hl' (ε/2) (by linarith),
  cases hl' with N' hN',
  specialize hN (max N N') (le_max_left _ _),
  specialize hN' (max N N') (le_max_right _ _),
  calc |l - l'| = |(l-u (max N N')) + (u (max N N') -l')| : by ring_nf
  ... ≤ |l - u (max N N')| + |u (max N N') - l'| : by apply abs_add
  ... = |u (max N N') - l| + |u (max N N') - l'| : by rw abs_sub_comm
  ... ≤ ε/2 + ε/2 : by linarith
  ... = ε : by ring,
end

lemma le_of_le_add_all {x y : ℝ} :
  (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  contrapose!,
  intro h,
  use (y-x)/2,
  split ; linarith,
end

def upper_bound (A : set ℝ) (x : ℝ) := ∀ a ∈ A, a ≤ x

def is_sup (A : set ℝ) (x : ℝ) := upper_bound A x ∧ ∀ y, upper_bound A y → x ≤ y

lemma lt_sup {A : set ℝ} {x : ℝ} (hx : is_sup A x) :
∀ y, y < x → ∃ a ∈ A, y < a :=
begin
  intro y,
  contrapose!,
  exact hx.right y,
end

lemma squeeze {u v w : ℕ → ℝ} {l} (hu : seq_limit u l) (hw : seq_limit w l)
(h : ∀ n, u n ≤ v n)
(h' : ∀ n, v n ≤ w n) : seq_limit v l :=
begin
  intros ε ε_pos,
  cases hu ε ε_pos with N hN,
  cases hw ε ε_pos with N' hN',
  use max N N',
  intros n hn,
  rw ge_max_iff at hn,
  specialize hN n (by linarith),
  specialize hN' n (by linarith),
  specialize h n,
  specialize h' n,
  rw abs_le at *,
  split ; linarith
end

def extraction (φ : ℕ → ℕ) := ∀ n m, n < m → φ n < φ m

def tendsto_infinity (u : ℕ → ℝ) := ∀ A, ∃ N, ∀ n ≥ N, u n ≥ A

lemma lim_le {x y : ℝ} {u : ℕ → ℝ} (hu : seq_limit u x)
  (ineg : ∀ n, u n ≤ y) : x ≤ y :=
begin
  apply le_of_le_add_all,
  intros ε ε_pos,
  cases hu ε ε_pos with N hN,
  specialize hN N (by linarith),
  specialize ineg N,
  rw abs_le at hN,
  linarith,
end

lemma inv_succ_le_all :  ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, 1/(n + 1 : ℝ) ≤ ε :=
begin
  convert metric.tendsto_at_top.mp (tendsto_one_div_add_at_top_nhds_0_nat),
  apply propext,
  simp only [real.dist_eq, sub_zero],
  split,
    intros h ε ε_pos,
    cases h (ε/2) (by linarith) with N hN,
    use N,
    intros n hn,
    rw abs_of_pos (nat.one_div_pos_of_nat : 1/(n+1 : ℝ) > 0),
    specialize hN n hn,
    linarith,
  intros h ε ε_pos,
  cases h ε (by linarith) with N hN,
  use N,
  intros n hn,
  specialize hN n hn,
  rw abs_of_pos (@nat.one_div_pos_of_nat ℝ _ n) at hN,
  linarith,
end

lemma limit_const (x : ℝ) : seq_limit (λ n, x) x :=
λ ε ε_pos, ⟨0, λ _ _, by simp [le_of_lt ε_pos]⟩

lemma limit_of_sub_le_inv_succ {u : ℕ → ℝ} {x : ℝ} (h : ∀ n, |u n - x| ≤ 1/(n+1)) :
seq_limit u x :=
begin
  intros ε ε_pos,
  rcases inv_succ_le_all ε ε_pos with ⟨N, hN⟩,
  use N,
  intros n hn,
  specialize h n,
  specialize hN n hn,
  linarith,
end

lemma limit_const_add_inv_succ (x : ℝ) : seq_limit (λ n, x + 1/(n+1)) x :=
limit_of_sub_le_inv_succ (λ n, by rw abs_of_pos ; linarith [@nat.one_div_pos_of_nat ℝ _ n])

lemma limit_const_sub_inv_succ (x : ℝ) : seq_limit (λ n, x - 1/(n+1)) x :=
begin
  refine limit_of_sub_le_inv_succ (λ n, _),
  rw [show x - 1 / (n + 1) - x = -(1/(n+1)), by ring, abs_neg,  abs_of_pos],
  linarith [@nat.one_div_pos_of_nat ℝ _ n]
end

lemma id_le_extraction {φ}: extraction φ → ∀ n, n ≤ φ n :=
begin
  intros hyp n,
  induction n with n hn,
  { exact nat.zero_le _ },
  { exact nat.succ_le_of_lt (by linarith [hyp n (n+1) (by linarith)]) },
end

lemma seq_limit_id : tendsto_infinity (λ n, n) :=
begin
  intros A,
  cases exists_nat_gt A with N hN,
  use N,
  intros n hn,
  have : (n : ℝ) ≥ N, exact_mod_cast hn,
  linarith,
end

variables {u : ℕ → ℝ} {l : ℝ} {φ : ℕ → ℕ}

open set filter

def cluster_point (u : ℕ → ℝ) (a : ℝ) :=
∃ φ, extraction φ ∧ seq_limit (u ∘ φ) a

lemma bolzano_weierstrass {a b : ℝ} {u : ℕ → ℝ} (h : ∀ n, u n ∈ Icc a b) :
∃ c ∈ Icc a b, cluster_point u c :=
begin
  rcases (is_compact_Icc : is_compact (Icc a b)).tendsto_subseq h with ⟨c, c_in, φ, hφ, lim⟩,
  use [c, c_in, φ, hφ],
  simp_rw [metric.tendsto_nhds, eventually_at_top, real.dist_eq] at lim,
  intros ε ε_pos,
  rcases lim ε ε_pos with ⟨N, hN⟩,
  use N,
  intros n hn,
  exact le_of_lt (hN n hn)
end

lemma not_seq_limit_of_tendstoinfinity {u : ℕ → ℝ} :
  tendsto_infinity u → ∀ x, ¬ seq_limit u x :=
begin
  intros lim_infinie x lim_x,
  cases lim_x 1 (by linarith) with N hN,
  cases lim_infinie (x+2) with N' hN',
  let N₀ := max N N',
  specialize hN N₀ (le_max_left _ _),
  specialize hN' N₀ (le_max_right _ _),
  rw abs_le at hN,
  linarith,
end

open real

lemma sup_segment {a b : ℝ} {A : set ℝ} (hnonvide : ∃ x, x ∈ A) (h : A ⊆ Icc a b) :
  ∃ x ∈ Icc a b, is_sup A x :=
begin
  have b_maj :  ∀ (y : ℝ), y ∈ A → y ≤ b,
    from λ y y_in, (h y_in).2,
  have Sup_maj : upper_bound A (Sup A),
  { intro x,
    apply le_cSup,
    use [b, b_maj] } ,
  refine ⟨Sup A, _, _⟩,
  { split,
    { cases hnonvide with x x_in,
      exact le_trans (h x_in).1 (Sup_maj _ x_in) },
    { apply cSup_le hnonvide b_maj } },
  { exact ⟨Sup_maj, λ y, cSup_le hnonvide⟩ },
end

lemma subseq_tendsto_of_tendsto (h : seq_limit u l) (hφ : extraction φ) :
seq_limit (u ∘ φ) l :=
begin
  intros ε ε_pos,
  cases h ε ε_pos with N hN,
  use N,
  intros n hn,
  apply hN,
  calc N ≤ n   : hn
     ... ≤ φ n : id_le_extraction hφ n,
end
namespace tactic.interactive
open tactic

meta def check_me : tactic unit :=
`[ { repeat { unfold seq_limit},
   repeat { unfold continue_en },
   push_neg,
   try { simp only [exists_prop] },
   try { exact iff.rfl },
   done } <|> fail "That's not quite right. Please try again." ]

end tactic.interactive


/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Yaël Dillies
-/
import data.nat.pow
import tactic.by_contra

/-!
# Natural number logarithms

This file defines two `ℕ`-valued analogs of the logarithm of `n` with base `b`:
* `log b n`: Lower logarithm, or floor **log**. Greatest `k` such that `b^k ≤ n`.
* `clog b n`: Upper logarithm, or **c**eil **log**. Least `k` such that `n ≤ b^k`.

These are interesting because, for `1 < b`, `nat.log b` and `nat.clog b` are respectively right and
left adjoints of `nat.pow b`. See `pow_le_iff_le_log` and `le_pow_iff_clog_le`.
-/

namespace nat

/-! ### Floor logarithm -/

/-- `log b n`, is the logarithm of natural number `n` in base `b`. It returns the largest `k : ℕ`
such that `b^k ≤ n`, so if `b^k = n`, it returns exactly `k`. -/
@[pp_nodot] def log (b : ℕ) : ℕ → ℕ
| n :=
  if h : b ≤ n ∧ 1 < b then
    have n / b < n,
      from div_lt_self ((zero_lt_one.trans h.2).trans_le h.1) h.2,
    log (n / b) + 1
  else 0

lemma log_eq_zero {b n : ℕ} (hnb : n < b ∨ b ≤ 1) : log b n = 0 :=
begin
  rw [or_iff_not_and_not, not_lt, not_le] at hnb,
  rw [log, ←ite_not, if_pos hnb],
end

lemma log_of_one_lt_of_le {b n : ℕ} (h : 1 < b) (hn : b ≤ n) : log b n = log b (n / b) + 1 :=
begin
  rw log,
  exact if_pos ⟨hn, h⟩,
end

lemma log_of_lt {b n : ℕ} (hnb : n < b) : log b n = 0 :=
by rw [log, if_neg (λ h : b ≤ n ∧ 1 < b, h.1.not_lt hnb)]

lemma log_of_left_le_one {b n : ℕ} (hb : b ≤ 1) : log b n = 0 :=
by rw [log, if_neg (λ h : b ≤ n ∧ 1 < b, h.2.not_le hb)]

lemma log_eq_zero_iff {b n : ℕ} : log b n = 0 ↔ n < b ∨ b ≤ 1 :=
begin
  refine ⟨λ h_log, _, log_eq_zero⟩,
  by_contra' h,
  have := log_of_one_lt_of_le h.2 h.1,
  rw h_log at this,
  exact succ_ne_zero _ this.symm
end

lemma log_eq_one_iff {b n : ℕ} : log b n = 1 ↔ n < b * b ∧ 1 < b ∧ b ≤ n :=
-- This is best possible: if b = 2, n = 5, then 1 < b and b ≤ n but n > b * b.
begin
  refine ⟨λ h_log, _, _⟩,
  { have bound : 1 < b ∧ b ≤ n,
    { contrapose h_log,
      rw [not_and_distrib, not_lt, not_le, or_comm, ←log_eq_zero_iff] at h_log,
      rw h_log,
      exact nat.zero_ne_one, },
    cases bound with one_lt_b b_le_n,
    refine ⟨_, one_lt_b, b_le_n⟩,
    rw [log_of_one_lt_of_le one_lt_b b_le_n, succ_inj',
        log_eq_zero_iff, nat.div_lt_iff_lt_mul _ _ (lt_trans zero_lt_one one_lt_b)] at h_log,
    exact h_log.resolve_right (λ b_small, lt_irrefl _ (lt_of_lt_of_le one_lt_b b_small)), },
  { rintros ⟨h, one_lt_b, b_le_n⟩,
    rw [log_of_one_lt_of_le one_lt_b b_le_n, succ_inj',
        log_eq_zero_iff, nat.div_lt_iff_lt_mul _ _ (lt_trans zero_lt_one one_lt_b)],
    exact or.inl h, },
end

@[simp] lemma log_zero_left (n : ℕ) : log 0 n = 0 :=
log_of_left_le_one zero_le_one

@[simp] lemma log_zero_right (b : ℕ) : log b 0 = 0 :=
by { rw log, cases b; refl }

@[simp] lemma log_one_left (n : ℕ) : log 1 n = 0 :=
log_of_left_le_one le_rfl

@[simp] lemma log_one_right (b : ℕ) : log b 1 = 0 :=
if h : b ≤ 1 then
  log_of_left_le_one h
else
  log_of_lt (not_le.mp h)

/-- `pow b` and `log b` (almost) form a Galois connection. -/
lemma pow_le_iff_le_log {b : ℕ} (hb : 1 < b) {x y : ℕ} (hy : 0 < y) :
  b^x ≤ y ↔ x ≤ log b y :=
begin
  induction y using nat.strong_induction_on with y ih generalizing x,
  cases x,
  { exact iff_of_true hy (zero_le _) },
  rw log, split_ifs,
  { have b_pos : 0 < b := zero_le_one.trans_lt hb,
    rw [succ_eq_add_one, add_le_add_iff_right, ←ih (y / b) (div_lt_self hy hb)
      (nat.div_pos h.1 b_pos), le_div_iff_mul_le _ _ b_pos, pow_succ'] },
  { refine iff_of_false (λ hby, h ⟨le_trans _ hby, hb⟩) (not_succ_le_zero _),
    convert pow_mono hb.le (zero_lt_succ x),
    exact (pow_one b).symm }
end

lemma log_pow {b : ℕ} (hb : 1 < b) (x : ℕ) : log b (b ^ x) = x :=
eq_of_forall_le_iff $ λ z,
by { rw ←pow_le_iff_le_log hb (pow_pos (zero_lt_one.trans hb) _),
    exact (pow_right_strict_mono hb).le_iff_le }

lemma log_pos {b n : ℕ} (hb : 1 < b) (hn : b ≤ n) : 0 < log b n :=
by { rwa [←succ_le_iff, ←pow_le_iff_le_log hb (hb.le.trans hn), pow_one] }

lemma log_mul_base (b n : ℕ) (hb : 1 < b) (hn : 0 < n) : log b (n * b) = log b n + 1 :=
eq_of_forall_le_iff $ λ z,
begin
  cases z,
  { simp },
  have : 0 < b := zero_lt_one.trans hb,
  rw [←pow_le_iff_le_log hb, pow_succ', (strict_mono_mul_right_of_pos this).le_iff_le,
      pow_le_iff_le_log hb hn, nat.succ_le_succ_iff],
  simp [hn, this]
end

lemma lt_pow_succ_log_self {b : ℕ} (hb : 1 < b) {x : ℕ} (hx : 0 < x) :
  x < b ^ (log b x).succ :=
begin
  rw [←not_le, pow_le_iff_le_log hb hx, not_le],
  exact lt_succ_self _,
end

lemma pow_log_le_self {b : ℕ} (hb : 1 < b) {x : ℕ} (hx : 0 < x) : b ^ log b x ≤ x :=
(pow_le_iff_le_log hb hx).2 le_rfl

lemma log_le_log_of_le {b n m : ℕ} (h : n ≤ m) : log b n ≤ log b m :=
begin
  cases le_or_lt b 1 with hb hb,
  { rw log_of_left_le_one hb, exact zero_le _ },
  { cases nat.eq_zero_or_pos n with hn hn,
    { rw [hn, log_zero_right], exact zero_le _ },
    { rw ←pow_le_iff_le_log hb (hn.trans_le h),
      exact (pow_log_le_self hb hn).trans h } }
end

lemma log_le_log_of_left_ge {b c n : ℕ} (hc : 1 < c) (hb : c ≤ b) : log b n ≤ log c n :=
begin
  cases n, { simp },
  rw ← pow_le_iff_le_log hc (zero_lt_succ n),
  calc
    c ^ log b n.succ ≤ b ^ log b n.succ : pow_le_pow_of_le_left
                                            (le_of_lt $ zero_lt_one.trans hc) hb _
                 ... ≤ n.succ           : pow_log_le_self (lt_of_lt_of_le hc hb)
                                            (zero_lt_succ n)
end

lemma log_monotone {b : ℕ} : monotone (λ n : ℕ, log b n) :=
λ x y, log_le_log_of_le

lemma log_antitone_left {n : ℕ} : antitone_on (λ b, log b n) (set.Ioi 1) :=
λ _ hc _ _ hb, log_le_log_of_left_ge (set.mem_Iio.1 hc) hb

@[simp] lemma log_div_mul_self (b n : ℕ) : log b (n / b * b) = log b n :=
begin
  refine eq_of_forall_le_iff (λ z, _),
  split,
  { intro h,
    exact h.trans (log_monotone (div_mul_le_self _ _)) },
  { intro h,
    rcases b with _|_|b,
    { simpa using h },
    { simpa using h },
    rcases n.zero_le.eq_or_lt with rfl|hn,
    { simpa using h },
    cases le_or_lt b.succ.succ n with hb hb,
    { cases z,
      { simp },
      have : 0 < b.succ.succ := nat.succ_pos',
      rw [←pow_le_iff_le_log, pow_succ'] at h ⊢,
      { rwa [(strict_mono_mul_right_of_pos this).le_iff_le,
             nat.le_div_iff_mul_le _ _ nat.succ_pos'] },
      all_goals { simp [hn, nat.div_pos hb nat.succ_pos'] } },
    { simpa [div_eq_of_lt, hb, log_eq_zero] using h } }
end

@[simp] lemma log_div_base (b n : ℕ) : log b (n / b) = log b n - 1 :=
begin
  cases lt_or_le n b with h h,
  { simp [div_eq_of_lt, h, log_eq_zero] },
  rcases n.zero_le.eq_or_lt with rfl|hn,
  { simp },
  rcases b with _|_|b,
  { simp },
  { simp },
  rw [←succ_inj', ←succ_inj'],
  simp_rw succ_eq_add_one,
  rw [nat.sub_add_cancel, ←log_mul_base];
  { simp [succ_le_iff, log_pos, h, nat.div_pos] },
end

private lemma add_pred_div_lt {b n : ℕ} (hb : 1 < b) (hn : 2 ≤ n) : (n + b - 1)/b < n :=
begin
  rw [div_lt_iff_lt_mul _ _ (zero_lt_one.trans hb), ←succ_le_iff, ←pred_eq_sub_one,
    succ_pred_eq_of_pos (add_pos (zero_lt_one.trans hn) (zero_lt_one.trans hb))],
  exact add_le_mul hn hb,
end

/-! ### Ceil logarithm -/

/-- `clog b n`, is the upper logarithm of natural number `n` in base `b`. It returns the smallest
`k : ℕ` such that `n ≤ b^k`, so if `b^k = n`, it returns exactly `k`. -/
@[pp_nodot] def clog (b : ℕ) : ℕ → ℕ
| n :=
  if h : 1 < b ∧ 1 < n then
    have (n + b - 1)/b < n := add_pred_div_lt h.1 h.2,
    clog ((n + b - 1)/b) + 1
  else 0

lemma clog_of_left_le_one {b : ℕ} (hb : b ≤ 1) (n : ℕ) : clog b n = 0 :=
by rw [clog, if_neg (λ h : 1 < b ∧ 1 < n, h.1.not_le hb)]

lemma clog_of_right_le_one {n : ℕ} (hn : n ≤ 1) (b : ℕ) : clog b n = 0 :=
by rw [clog, if_neg (λ h : 1 < b ∧ 1 < n, h.2.not_le hn)]

@[simp] lemma clog_zero_left (n : ℕ) : clog 0 n = 0 :=
clog_of_left_le_one zero_le_one _

@[simp] lemma clog_zero_right (b : ℕ) : clog b 0 = 0 :=
clog_of_right_le_one zero_le_one _

@[simp] lemma clog_one_left (n : ℕ) : clog 1 n = 0 :=
clog_of_left_le_one le_rfl _

@[simp] lemma clog_one_right (b : ℕ) : clog b 1 = 0 :=
clog_of_right_le_one le_rfl _

lemma clog_of_two_le {b n : ℕ} (hb : 1 < b) (hn : 2 ≤ n) :
  clog b n = clog b ((n + b - 1)/b) + 1 :=
by rw [clog, if_pos (⟨hb, hn⟩ : 1 < b ∧ 1 < n)]

lemma clog_pos {b n : ℕ} (hb : 1 < b) (hn : 2 ≤ n) : 0 < clog b n :=
by { rw clog_of_two_le hb hn, exact zero_lt_succ _ }

lemma clog_eq_one {b n : ℕ} (hn : 2 ≤ n) (h : n ≤ b) : clog b n = 1 :=
begin
  rw [clog_of_two_le (hn.trans h) hn, clog_of_right_le_one],
  have n_pos : 0 < n := zero_lt_two.trans_le hn,
  rw [←lt_succ_iff, nat.div_lt_iff_lt_mul _ _ (n_pos.trans_le h), ←succ_le_iff,
    ←pred_eq_sub_one, succ_pred_eq_of_pos (add_pos n_pos (n_pos.trans_le h)), succ_mul, one_mul],
  exact add_le_add_right h _,
end

/--`clog b` and `pow b` form a Galois connection. -/
lemma le_pow_iff_clog_le {b : ℕ} (hb : 1 < b) {x y : ℕ} :
  x ≤ b^y ↔ clog b x ≤ y :=
begin
  induction x using nat.strong_induction_on with x ih generalizing y,
  cases y,
  { rw [pow_zero],
    refine ⟨λ h, (clog_of_right_le_one h b).le, _⟩,
    simp_rw ←not_lt,
    contrapose!,
    exact clog_pos hb },
  have b_pos : 0 < b := zero_lt_two.trans_le hb,
  rw clog, split_ifs,
  { rw [succ_eq_add_one, add_le_add_iff_right, ←ih ((x + b - 1)/b) (add_pred_div_lt hb h.2),
      nat.div_le_iff_le_mul_add_pred b_pos,
      ← pow_succ, add_tsub_assoc_of_le (nat.succ_le_of_lt b_pos), add_le_add_iff_right] },
  { exact iff_of_true ((not_lt.1 (not_and.1 h hb)).trans $ succ_le_of_lt $ pow_pos b_pos _)
    (zero_le _) }
end

lemma clog_pow (b x : ℕ) (hb : 1 < b) : clog b (b ^ x) = x :=
eq_of_forall_ge_iff $ λ z,
by { rw ←le_pow_iff_clog_le hb, exact (pow_right_strict_mono hb).le_iff_le }

lemma pow_pred_clog_lt_self {b : ℕ} (hb : 1 < b) {x : ℕ} (hx : 1 < x) :
  b ^ (clog b x).pred < x :=
begin
  rw [←not_le, le_pow_iff_clog_le hb, not_le],
  exact pred_lt (clog_pos hb hx).ne',
end

lemma le_pow_clog {b : ℕ} (hb : 1 < b) (x : ℕ) : x ≤ b ^ clog b x :=
(le_pow_iff_clog_le hb).2 le_rfl

lemma clog_le_clog_of_le (b : ℕ) {n m : ℕ} (h : n ≤ m) : clog b n ≤ clog b m :=
begin
  cases le_or_lt b 1 with hb hb,
  { rw clog_of_left_le_one hb, exact zero_le _ },
  { rw ←le_pow_iff_clog_le hb,
    exact h.trans (le_pow_clog hb _) }
end

lemma clog_le_clog_of_left_ge {b c n : ℕ} (hc : 1 < c) (hb : c ≤ b) : clog b n ≤ clog c n :=
begin
  cases n, { simp },
  rw ← le_pow_iff_clog_le (lt_of_lt_of_le hc hb),
  calc
    n.succ ≤ c ^ clog c n.succ : le_pow_clog hc _
       ... ≤ b ^ clog c n.succ : pow_le_pow_of_le_left (le_of_lt $ zero_lt_one.trans hc) hb _
end

lemma clog_monotone (b : ℕ) : monotone (clog b) :=
λ x y, clog_le_clog_of_le _

lemma clog_antitone_left {n : ℕ} : antitone_on (λ b : ℕ, clog b n) (set.Ioi 1) :=
λ _ hc _ _ hb, clog_le_clog_of_left_ge (set.mem_Iio.1 hc) hb

lemma log_le_clog (b n : ℕ) : log b n ≤ clog b n :=
begin
  obtain hb | hb := le_or_lt b 1,
  { rw log_of_left_le_one hb,
    exact zero_le _},
  cases n,
  { rw log_zero_right,
    exact zero_le _},
  exact (pow_right_strict_mono hb).le_iff_le.1 ((pow_log_le_self hb $ succ_pos _).trans $
    le_pow_clog hb _),
end

end nat


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import algebra.quaternion
import analysis.inner_product_space.basic

/-!
# Quaternions as a normed algebra

In this file we define the following structures on the space `ℍ := ℍ[ℝ]` of quaternions:

* inner product space;
* normed ring;
* normed space over `ℝ`.

## Notation

The following notation is available with `open_locale quaternion`:

* `ℍ` : quaternions

## Tags

quaternion, normed ring, normed space, normed algebra
-/

localized "notation `ℍ` := quaternion ℝ" in quaternion
open_locale real_inner_product_space

noncomputable theory

namespace quaternion

instance : has_inner ℝ ℍ := ⟨λ a b, (a * b.conj).re⟩

lemma inner_self (a : ℍ) : ⟪a, a⟫ = norm_sq a := rfl

lemma inner_def (a b : ℍ) : ⟪a, b⟫ = (a * b.conj).re := rfl

instance : inner_product_space ℝ ℍ :=
inner_product_space.of_core
{ inner := has_inner.inner,
  conj_sym := λ x y, by simp [inner_def, mul_comm],
  nonneg_re := λ x, norm_sq_nonneg,
  definite := λ x, norm_sq_eq_zero.1,
  add_left := λ x y z, by simp only [inner_def, add_mul, add_re],
  smul_left := λ x y r, by simp [inner_def] }

lemma norm_sq_eq_norm_sq (a : ℍ) : norm_sq a = ∥a∥ * ∥a∥ :=
by rw [← inner_self, real_inner_self_eq_norm_mul_norm]

instance : norm_one_class ℍ :=
⟨by rw [norm_eq_sqrt_real_inner, inner_self, norm_sq.map_one, real.sqrt_one]⟩

@[simp] lemma norm_mul (a b : ℍ) : ∥a * b∥ = ∥a∥ * ∥b∥ :=
begin
  simp only [norm_eq_sqrt_real_inner, inner_self, norm_sq.map_mul],
  exact real.sqrt_mul norm_sq_nonneg _
end

@[simp, norm_cast] lemma norm_coe (a : ℝ) : ∥(a : ℍ)∥ = ∥a∥ :=
by rw [norm_eq_sqrt_real_inner, inner_self, norm_sq_coe, real.sqrt_sq_eq_abs, real.norm_eq_abs]

noncomputable instance : normed_ring ℍ :=
{ dist_eq := λ _ _, rfl,
  norm_mul := λ a b, (norm_mul a b).le }

noncomputable instance : normed_algebra ℝ ℍ :=
{ norm_algebra_map_eq := norm_coe,
  to_algebra := quaternion.algebra }

instance : has_coe ℂ ℍ := ⟨λ z, ⟨z.re, z.im, 0, 0⟩⟩

@[simp, norm_cast]

@[simp, norm_cast] lemma coe_complex_add (z w : ℂ) : ↑(z + w) = (z + w : ℍ) := by ext; simp
@[simp, norm_cast] lemma coe_complex_mul (z w : ℂ) : ↑(z * w) = (z * w : ℍ) := by ext; simp
@[simp, norm_cast] lemma coe_complex_zero : ((0 : ℂ) : ℍ) = 0 := rfl
@[simp, norm_cast] lemma coe_complex_one : ((1 : ℂ) : ℍ) = 1 := rfl
@[simp, norm_cast] lemma coe_real_complex_mul (r : ℝ) (z : ℂ) : (r • z : ℍ) = ↑r * ↑z :=
by ext; simp
@[simp, norm_cast] lemma coe_complex_coe (r : ℝ) : ((r : ℂ) : ℍ) = r := rfl

/-- Coercion `ℂ →ₐ[ℝ] ℍ` as an algebra homomorphism. -/
def of_complex : ℂ →ₐ[ℝ] ℍ :=
{ to_fun := coe,
  map_one' := rfl,
  map_zero' := rfl,
  map_add' := coe_complex_add,
  map_mul' := coe_complex_mul,
  commutes' := λ x, rfl }

@[simp] lemma coe_of_complex : ⇑of_complex = coe := rfl

end quaternion


/-
Copyright 2019 Kevin Sullivan and Ben Hocking.
-/

/-
Inference rules. Introduction rules construct proofs that you don't yet have. Elimination rules extract information from proofs that you already have.
-/
namespace Introduction.ex1
-- introduction: construct a proof
def construct_a_proof
(P Q : Prop)
(p : P)
(q : Q)
: P ∧ Q
:= and.intro p q

-- elimination: use a proof
def use_a_proof
(P Q : Prop)
(p_and_q : P ∧ Q)
: P
:= and.elim_left p_and_q
end Introduction.ex1

/-
Binding of names to values and the evaluation of names that are already bound to values. Names can be bound to values only once. There are no "variables" (no "mutable state") in Lean.
-/
namespace Introduction.ex2
def x : nat := 5  -- bind the name x to the value, 5
#check x          -- the type of the term x is now nat
#reduce x         -- evaluating x yields the value 5
def x := 6        -- we cannot bind a new value to x
end Introduction.ex2

-- Function application expressions and evaluation
#reduce 3 * 4

/-
Terms have types, too.
-/
#check 3
#check 3 * 4

/-
Lean is stronly and statically typed. It will issue an error for the following code.
-/
#check 3 * "Hello, Lean!"

  /-
 Lean does type inference. Type inference means that you can leave out explicit type declarations in cases where Lean can figure out what the types must be from context.
  -/
namespace Introduction.ex3
def x : nat := (1 : nat)
def x' : nat := 1
def x'' := 1
#check x
#check x'
#check x''
end Introduction.ex3

/-
All terms in Lean have types.
-/
#check tt
#check ff
#check "Hello, Lean!"

/-
Types are values (terms) too
-/
#check nat
#check bool
#check string

/-
You can check out the entire type hierarchy yourself.
-/
#check 3
#check nat
#check Type
#check Type 0
#check Type 1

/-
Propositions are types and proofs are values of these types. This principle is the basis for automated proof checking in Lean and in other constructive logic proof assistants such as Coq and Agda.
-/
namespace Introduction.ex4
def p : true := true.intro
end Introduction.ex4

/-
Lean rejects proof terms that do not type check, just as it rejects ordinary computational values that do not typecheck, as illustrated in the example above. You will thus see an error in the following code.
-/
namespace Introduction.ex5
def p : false := true.intro
end Introduction.ex5

/-
A formalized rendition of the famous example in which it is deduced that Socrates is mortal. You are not expected to fully understand this code at this point.
-/
namespace Introduction.ex6
def modus_ponens
    (α : Type)
    (M : α → Prop)
    (h : ∀ a : α, M a)
    (w : α)
    : (M w)
    := (h w)

axiom Person : Type
axiom Mortal : Person → Prop
axiom EveryoneIsMortal : ∀ p : Person, Mortal p
axiom Socrates : Person

theorem aProof : Mortal Socrates :=
    modus_ponens Person Mortal EveryoneIsMortal Socrates
end Introduction.ex6


/-
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 linear_algebra.matrix.nonsingular_inverse

/-!
This file supplements things about matrix inverse, that were missing in mathlib.
-/

namespace matrix
universes u v
variables {n : Type u} [decidable_eq n] [fintype n] {α : Type v} [comm_ring α]
open_locale matrix big_operators
open equiv equiv.perm finset

variables (A : matrix n n α) (B : matrix n n α)

/- `is_unit_of_invertible A`
   converts the "stronger" condition `invertible A` to proposition `is_unit A`. -/

/-- `matrix.is_unit_det_of_invertible` converts `invertible A` to `is_unit A.det`. -/
lemma is_unit_det_of_invertible [invertible A] : is_unit A.det :=
@is_unit_of_invertible _ _ _(det_invertible_of_invertible A)

@[simp]
lemma inv_eq_nonsing_inv_of_invertible [invertible A] : ⅟ A = A⁻¹ :=
begin
  suffices : is_unit A,
  { rw [←this.mul_left_inj, inv_of_mul_self, matrix.mul_eq_mul, nonsing_inv_mul],
    rwa ←is_unit_iff_is_unit_det },
  exact is_unit_of_invertible _
end

variables {A} {B}

/- `is_unit.invertible` lifts the proposition `is_unit A` to a constructive inverse of `A`. -/

/-- "Lift" the proposition `is_unit A.det` to a constructive inverse of `A`. -/
noncomputable def invertible_of_is_unit_det  (h : is_unit A.det) : invertible A :=
⟨A⁻¹, nonsing_inv_mul A h, mul_nonsing_inv A h⟩

/-- If matrix A is left invertible, then its inverse equals its left inverse. -/
lemma inv_eq_left_inv (h : B ⬝ A = 1) : A⁻¹ = B :=
begin
  have h1 :=  (is_unit_det_of_left_inverse h),
  have h2 := matrix.invertible_of_is_unit_det h1,
  have := @inv_of_eq_left_inv (matrix n n α) (infer_instance) A B h2 h,
  simp* at *,
end

/-- If matrix A is right invertible, then its inverse equals its right inverse. -/
lemma inv_eq_right_inv (h : A ⬝ B = 1) : A⁻¹ = B :=
begin
  have h1 :=  (is_unit_det_of_right_inverse h),
  have h2 := matrix.invertible_of_is_unit_det h1,
  have := @inv_of_eq_right_inv (matrix n n α) (infer_instance) A B h2 h,
  simp* at *,
end

/-- We can construct an instance of invertible A if A has a left inverse. -/
def invertible_of_left_inverse (h: B ⬝ A = 1) : invertible A :=
⟨B, h, nonsing_inv_right_left h⟩

/-- We can construct an instance of invertible A if A has a right inverse. -/
def invertible_of_right_inverse (h: A ⬝ B = 1) : invertible A :=
⟨B, nonsing_inv_left_right h, h⟩

variables {C: matrix n n α}

/-- The left inverse of matrix A is unique when existing. -/
lemma left_inv_eq_left_inv (h: B ⬝ A = 1) (g: C ⬝ A = 1) : B = C :=
by rw [←(inv_eq_left_inv h), ←(inv_eq_left_inv g)]

/-- The right inverse of matrix A is unique when existing. -/
lemma right_inv_eq_right_inv (h: A ⬝ B = 1) (g: A ⬝ C = 1) : B = C :=
by rw [←(inv_eq_right_inv h), ←(inv_eq_right_inv g)]

/-- The right inverse of matrix A equals the left inverse of A when they exist. -/
lemma right_inv_eq_left_inv (h: A ⬝ B = 1) (g: C ⬝ A = 1) : B = C :=
by rw [←(inv_eq_right_inv h), ←(inv_eq_left_inv g)]

variable (A)

@[simp] lemma mul_inv_of_invertible [invertible A] : A ⬝ A⁻¹ = 1 :=
mul_nonsing_inv A (is_unit_det_of_invertible A)

@[simp] lemma inv_mul_of_invertible [invertible A] : A⁻¹ ⬝ A = 1 :=
nonsing_inv_mul A (is_unit_det_of_invertible A)

end matrix
-/


import tactic
import data.nat.lattice       -- for well-ordering for naturals
import data.set.basic         -- for creating sets

-- Define a set for the remainder of a/b :
-- remainder_set takes a and b and returns set of all possible nonnegative remainders of a/b

def remainder_set : ℤ → ℤ → set ℕ := λ a, λ b, { y | (∃ x : ℤ, ((y : ℤ) = a - b * x))}

-- LEMMAS

lemma mem_remainder_set_iff {a b : ℤ} {k : ℕ}  : (k ∈ remainder_set a b) ↔
  ∃ x : ℤ, (k : ℤ) = a - b * x :=
  begin
    split, {
      intro h,
      rw set.mem_def at h,
      exact h,
    }, {
      intro h,
      rw set.mem_def,
      exact h,
    }
  end

lemma pos_z_pos_nat { b : ℤ } (hb : b > 0 ) : (b.to_nat > 0) :=
begin
  have hb2 := (le_of_lt hb),
  rw ← (int.to_nat_of_nonneg hb2) at hb,
  exact int.coe_nat_pos.mp hb,
end

lemma nonneg_remainder_exists { a b : ℤ } (hb : b > 0) : a + b * |a| ≥ 0 :=
begin
  have ha := le_or_lt 0 a,
  cases ha,
  {
    rw abs_of_nonneg ha,
    nth_rewrite 0 ← one_mul a,
    rw ← add_mul,
    have hb2 : 1 + b ≥ 0 := by linarith,
    exact mul_nonneg hb2 ha,
  }, {
    rw [abs_of_neg ha, (neg_mul_comm b a).symm],
    nth_rewrite 0 ← one_mul a,
    rw ← add_mul,
    have hb2 : 1 + -b ≤ 0 := by linarith,
    have ha2 : a ≤ 0 := le_of_lt ha,
    exact mul_nonneg_of_nonpos_of_nonpos hb2 ha2,
  },
end

/-       PROOF SKETCH

  (1) Define remainder set, S
      -- let S = {a - bx : x ∈ ℤ ∧ a - bx ≥ 0}

  (2) Show S is nonempty
      -- use x = -|a|, and a + b |a| ≥ 0 to show S nonempty

  (3) Apply Well-ordering of naturals to show that S contains a minimum, r

  (4) Show r satisfies conditions of division algorithm
      -- show r < b, by contradiction if r - b ≥ 0

-/

lemma division_algorithm (a b : ℤ) (hb : b > 0) : (∃ q r : ℤ, ((a = b * q + r) ∧ (0 ≤ r) ∧ (r < b))) :=
begin
  -- (1) Define remainder set, S
  --     let S = {a - bx : x ∈ ℤ ∧ a - bx ≥ 0}
  -- ( remainder_set : ℤ → ℤ → set ℕ := λ a, λ b, { y | (∃ x : ℤ, ((y : ℤ) = a - b * x)) } )
  set S := remainder_set a b,
  set r := has_Inf.Inf S,

  -- (2) Show S is nonempty
  --     use x = -|a|, and a + b |a| ≥ 0 to show S nonempty
  have hns : S.nonempty,  -- we are asserting this is true, and proving it in the brackets
  {
    -- show that a + b * |a| ≥ 0 (using lemma proved above)
    have h1 : a + b * |a| ≥ 0 := nonneg_remainder_exists hb,
    -- set k = a + b * |a| ≥ 0 (and we want k ∈ ℕ)
    obtain ⟨k, hk⟩ := int.eq_coe_of_zero_le (h1), -- obtain = have + cases
    -- show k ∈ S
    have hk_mem : k ∈ S,
      {
        rw mem_remainder_set_iff,
        use (-|a|),
        linarith,
      },
    -- since k ∈ S, S ≠ ∅
    exact set.nonempty_of_mem hk_mem,
  },

  -- (3) Apply Well-ordering of naturals to show that S contains a minimum, r
  have hr : r ∈ S := Inf_mem hns,

  -- (4) Show r satisfies conditions of division algorithm
  --     show r < b, by contradiction: if r - b ≥ 0, then r - b ∈ S, so r - b ≤ r since r = Inf S.

  -- use definition of r ∈ S
  rw mem_remainder_set_iff at hr,
  -- get x and hx from existence in hypothesis
  cases hr with x hx,
  -- show x and r satisfy existence in target
  use [x, r],

  -- we need to prove both sides of conjunction (∧ is right associative)
  split, {
    -- r = a - b x, so a = b x + r
    linarith,
  }, {
    split, {
      -- r ∈ ℕ, so r ≥ 0
      exact int.of_nat_nonneg r,
    }, {
      -- suppose r ≥ b, prove false
      by_contra h,
      push_neg at h,
      rw ← int.to_nat_of_nonneg (le_of_lt hb) at h,

      -- prove that r - b ∈ S
      have h_r_sub_b_mem : (r - b.to_nat) ∈ S,
      {
        rw mem_remainder_set_iff,
        -- r = a - b x → r - b = a - b (x + 1)
        use (x + 1),
        -- remove coercions
        rw [int.coe_nat_sub (int.coe_nat_le.mp h), hx, int.to_nat_of_nonneg (le_of_lt hb)],
        linarith,
      },
      -- b > 0, so r - b < r
      have h_r_sub_b_le_r : r - b.to_nat < r := (b.to_nat).sub_lt_of_pos_le r (pos_z_pos_nat hb) (int.coe_nat_le.mp h),
      -- infimum of S is less than or equal to every member of S
      have h_mem_ge_inf : r ≤ r - b.to_nat := nat.Inf_le h_r_sub_b_mem,
      -- r - b < r and r ≤ r - b → false
      exact nat.lt_le_antisymm h_r_sub_b_le_r h_mem_ge_inf,
    },
  },
end

--#print division_algorithm -- theorem above is one big λ function!

-- EASY WAY
-- use ℤ is an instance of Euclidean Domain

theorem division_algorithm' (a b : ℤ) (hb : b > 0) :
(∃ q r : ℤ, ((a = b * q + r) ∧ (0 ≤ r) ∧ (r < b))) :=
begin
  have h := euclidean_domain.mod_add_div a b,  -- q, r not unique for general ED
  use [(a/b), a % b ], -- integer division and remainder : q = a/b ; r = a % b
  exact ⟨(euclidean_domain.quotient_mul_add_remainder_eq a b).symm, int.mod_nonneg a (ne_of_gt hb), int.mod_lt_of_pos a hb,⟩,
end

-- (5) Show uniqueness

lemma division_algorithm_uniqueness (a b q1 q2 r1 r2 : ℤ) (hr1 : (0 ≤ r1) ∧ (r1 < b)) (hr2 : (0 ≤ r2) ∧ (r2 < b))  (hb : b > 0) (hd1 : a = b * q1 + r1) (hd2 : a = b * q2 + r2) : (q1 = q2 ∧ r1 = r2) :=
begin
    have hq : q1 = q2,
    {
      rw hd2 at hd1,
      have j : b * (q2 - q1) = r1 - r2 := by linarith,

      have k : -b < -r2 ∧ -r2 ≤ 0,
      { split, { linarith, }, { linarith, },},

      have l : -b < r1 - r2 ∧ r1 - r2 < b,
      { split, { linarith,}, { linarith,},},

      have m : -b < b*(q2 - q1) ∧ b*(q2 - q1) < b,
      { split, {linarith,}, {linarith,},},

      have i : -1 < q2 - q1 ∧ q2 - q1 < 1,
      {split, {
        cases m,
        rw (show -b = b*(-1), by linarith) at m_left,
        exact (mul_lt_mul_left hb).mp m_left,
      }, {
        cases m,
        nth_rewrite 1 ← (mul_one b) at m_right,
        exact (mul_lt_mul_left hb).mp m_right,
      },},
      linarith,

    },
    split, {
      assumption,
    }, {
      rw hq at hd1,
      linarith,
    },
end


definition is_prime (x: ℕ): Prop
:= 1 < x ∧ ∀ y: ℕ, y ∣ x → y = 1 ∨ y = x

definition factorial: ℕ → ℕ
| 0 := 1
| (nat.succ n) := nat.succ n * factorial n

lemma pos_factorial (n: ℕ):
  factorial n > 0
:=
begin
  induction n with k ih,
  {
    simp [factorial],
    exact nat.succ_pos 0,
  },
  {
    simp [factorial],
    have hskpos: nat.succ k > 0, from nat.succ_pos k,
    have h: nat.succ k * 0 < nat.succ k * factorial k, from mul_lt_mul_of_pos_left ih hskpos,
    rw (mul_zero (nat.succ k)) at h,
    exact h
  }
end

lemma factorial_division (n: ℕ):
  ∀ m: ℕ, 1 ≤ m → m ≤ n → m ∣ factorial n
:=
begin
  intros m h1 h2,
  induction n with k h3,
    have le10: 1 ≤ 0 := le_trans h1 h2,
    exact absurd le10 (nat.not_succ_le_zero 0),
  simp [factorial],
  cases h2 with _ hlek,
  {
    simp
  },
  {
    apply dvd_mul_of_dvd_right,
    exact h3 hlek
  }
end

lemma construct_prime (n: ℕ) (h: 1 < n):
  ∃ p: ℕ, is_prime p ∧ p ∣ n
:=
begin
  let nontriv_factor := λx, 1 < x ∧ x ∣ n,
  have h: ∃ x: ℕ, nontriv_factor x, by {
    existsi n,
    split,
    exact h,
    simp
  },
  let p := nat.find h,
  let hp := nat.find_spec h,
  have defprev: nat.find h = p, by simp,
  rw [defprev] at hp,
  cases hp with hpos hdvd,
  existsi p,
  split,
  {
    simp [is_prime],
    split,
    {
      exact hpos,
    },
    {
      intros y hyp,
      cases lt_trichotomy 1 y with h1lty hrest,
      {
        right,
        have hpley: p ≤ y, from (nat.find_min' h) (and.intro h1lty (dvd_trans hyp hdvd)),
        have h0ltp: 0 < p, from lt_trans zero_lt_one hpos,
        have hylep: y ≤ p, from (nat.le_of_dvd h0ltp hyp),
        exact le_antisymm hylep hpley
      },
      cases hrest with h1eqy hylt1,
      {
        left,
        exact h1eqy.symm
      },
      {
        exfalso,
        have hyeq0: y = 0, by {
          apply nat.eq_zero_of_le_zero,
          apply nat.le_of_lt_succ,
          exact hylt1
        },
        rw hyeq0 at hyp,
        have hpeq0: p = 0, from eq_zero_of_zero_dvd hyp,
        have h1lt0: 1 < 0, by { rw hpeq0 at hpos, exact hpos },
        exact nat.not_lt_zero 1 h1lt0,
      }
    }
  },
  {
    exact hdvd
  }
end

theorem unbouded_primes:
  ∀ m: ℕ, ∃ p: ℕ, is_prime p ∧ m < p :=
begin
  intro m,
  let a := factorial m + 1,
  have h1lea: 1 < a, by {
    simp [a],
    refine nat.lt_add_of_pos_left _,
    exact pos_factorial m
  },
  have h: ∃ p: ℕ, is_prime p ∧ p ∣ a, from construct_prime a h1lea,
  cases h with p hp,
  cases hp with hprime hpdvda,
  existsi p,
  split,
  {
    exact hprime
  },
  {
    simp [is_prime] at hprime,
    cases lt_or_ge m p with hmltp hmgep,
    {
      exact hmltp,
    }, {
      exfalso,
      have h1ltp: 1 < p, from hprime.left,
      have hdvdfm: p ∣ factorial m, from factorial_division m p (le_of_lt h1ltp) hmgep,
      have hpdvd1: p ∣ 1, by {
        refine (nat.dvd_add_iff_right hdvdfm).mpr hpdvda,
      },
      have hpeq1: p = 1, from nat.eq_one_of_dvd_one hpdvd1,
      rw hpeq1 at h1ltp,
      exact lt_irrefl 1 h1ltp
    }
  }
end