/-
Copyright (c) 2021 Tianchen Zhao. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tianchen Zhao
-/
import set_theory.zfc

/-!
# Incidence geometry

This file defines incidence geometry as a class and proves basic lemmas about
points, lines and collinearity.

## Main definitions

* `incidence_geometry` is a class satisfying the three axioms of incidence.

* `line`, with notation `-ₗ`, is the unique line determined by the given two points.

* `col` is a ternary relation among points meaning they lie on the same line.

* `noncol` is the opposite of `col`.

## References

* See [Geometry: Euclid and Beyond]

-/

universes u

/--An incidence geometry contains a type `pts` and a set `lines` that includes some sets of pts,
with the following axioms :
I1. Two distinct points uniquely define a line.
I2. Every line contains at least 2 distinct points.
I3. There exists 3 noncol points.
-/
class incidence_geometry :=
(pts : Type u) (lines : set (set pts))
(I1 : ∀ {a b : pts}, a ≠ b → ∃ l ∈ lines,
 a ∈ l ∧ b ∈ l ∧ (∀ l' ∈ lines, a ∈ l' → b ∈ l' → l' = l))
(I2 : ∀ l ∈ lines, ∃ a b : pts, a ≠ b ∧ a ∈ l ∧ b ∈ l)
(I3 : ∃ a b c : pts, a ≠ b ∧ a ≠ c ∧ b ≠ c ∧ ¬(∃ l ∈ lines, a ∈ l ∧ b ∈ l ∧ c ∈ l))

open incidence_geometry

variable [I : incidence_geometry]

include I

/--A line is a set of points defined given two points.
If two points are distinct, it is given by I1. Otherwise, it is defined as a singleton, but
this almost never occurs later.
-/
noncomputable def line (a b : pts) :
{ L : set pts // (a ≠ b → L ∈ lines) ∧ a ∈ L ∧ b ∈ L ∧ (a = b → L = {a}) } :=
begin
  by_cases hab : a = b, rw hab,
  exact ⟨{b}, λ hf, absurd rfl hf, by simp⟩,
  choose l hl ha hb h using (I1 hab),
  exact ⟨l, λ h, hl, ha, hb, λh, absurd h hab⟩
end

notation a`-ₗ`b := (line a b : set pts)

/--Two sets of points intersect if their intersection is nonempty. -/
def intersect [I : incidence_geometry] (m n : set pts) : Prop := (m ∩ n).nonempty

notation m`♥`n := intersect m n

lemma intersect_symm {m n : set pts} :
(m ♥ n) → (n ♥ m) :=
by {unfold intersect, rw set.inter_comm, simp only [imp_self]}

/--Two lines are parallel if they have no intersection. -/
def parallel (l₁ l₂ : set pts) : Prop :=
¬(l₁ ♥ l₂) ∧ (l₁ ∈ lines) ∧ (l₂ ∈ lines)

notation l₁`∥ₗ`l₂ := parallel l₁ l₂

lemma parallel_symm {l₁ l₂ : set pts} :
(l₁ ∥ₗ l₂) → (l₂ ∥ₗ l₁) :=
begin
  rintros ⟨hl₁l₂, hl₁, hl₂⟩,
  exact ⟨λhf, hl₁l₂ (intersect_symm hf), hl₂, hl₁⟩
end

lemma line_in_lines {a b : pts} (hab : a ≠ b) :
(a-ₗb) ∈ lines := (line a b).2.1 hab

lemma pt_left_in_line (a b : pts) :
a ∈ (a-ₗb) := (line a b).2.2.1

lemma pt_right_in_line (a b : pts) :
b ∈ (a-ₗb) := (line a b).2.2.2.1

lemma one_pt_line (a : pts) : ∃ l ∈ lines, a ∈ l :=
begin
  have : ∃ b : pts, a ≠ b,
    by_contra hf, push_neg at hf,
    rcases I3 with ⟨x, y, z, h, -⟩, exact h ((hf x).symm.trans (hf y)),
  cases this with b hab,
  exact ⟨line a b, line_in_lines hab, pt_left_in_line a b⟩
end

lemma two_pt_line_unique {a b : pts} (hab : a ≠ b)
{l : set pts} (hl : l ∈ lines) (ha : a ∈ l) (hb : b ∈ l) : l = (a-ₗb) :=
begin
  rcases (I1 hab) with ⟨n, hn, -, -, key⟩,
  rw [key l hl ha hb,
      key (a-ₗb) (line_in_lines hab) (pt_left_in_line a b) (pt_right_in_line a b)]
end

lemma two_pt_on_one_line {l : set pts} (hl : l ∈ lines) :
∃ a b : pts, a ≠ b ∧ a ∈ l ∧ b ∈ l := I2 l hl

lemma line_two_pt {a b : pts} (hl : (a-ₗb) ∈ lines) : a ≠ b :=
begin
  intro hf,
  rw [hf, ←subtype.val_eq_coe, (line b b).2.2.2.2 rfl] at hl,
  rcases two_pt_on_one_line hl with ⟨x, y, hxy, hx, hy⟩,
  rw set.mem_singleton_iff at hx hy,
  rw [hx, hy] at hxy,
  exact hxy rfl
end

-- this would be much better as a ∈ l → b ∈ l → a ∈ m → ... (all before the colon!)
lemma two_pt_one_line {l m : set pts} (hl : l ∈ lines) (hm : m ∈ lines)
{a b : pts} (hab : a ≠ b) (hal : a ∈ l) (hbl : b ∈ l) (ham : a ∈ m) (hbm : b ∈ m) : l = m :=
(two_pt_line_unique hab hl hal hbl).trans(two_pt_line_unique hab hm ham hbm).symm

lemma line_symm (a b : pts) : (a-ₗb) = (b-ₗa) :=
begin
  by_cases a = b, rw h,
  exact two_pt_one_line (line_in_lines h) (line_in_lines (ne.symm h))
    h (pt_left_in_line a b) (pt_right_in_line a b) (pt_right_in_line b a) (pt_left_in_line b a)
end

lemma two_line_one_pt {l₁ l₂ : set pts} (hl₁ : l₁ ∈ lines) (hl₂ : l₂ ∈ lines) :
∀ {a b : pts}, l₁ ≠ l₂ → a ∈ l₁ → a ∈ l₂ → b ∈ l₁ → b ∈ l₂ → a = b :=
begin
  intros a b hll ha₁ ha₂ hb₁ hb₂,
  by_cases hab : a = b, exact hab,
  rcases (I1 hab) with ⟨l, hl, -, -, key⟩,
  exact absurd ((key l₁ hl₁ ha₁ hb₁).trans (key l₂ hl₂ ha₂ hb₂).symm) hll
end

/--Three points are col if there are on the same line. -/
def col (a b c : pts) : Prop :=
∃ l ∈ lines, a ∈ l ∧ b ∈ l ∧ c ∈ l

/--Opposite to col -/
def noncol (a b c : pts) : Prop := ¬col a b c

lemma noncol_exist {a b : pts} (hab : a ≠ b) : ∃ c : pts, noncol a b c :=
begin
  by_contra hf, unfold noncol col at hf, push_neg at hf,
  rcases I3 with ⟨x, y, z, hxy, hxz, hyz, hxyz⟩,
  rcases hf x with ⟨l, hl, hal, hbl, hxl⟩,
  rcases hf y with ⟨m, hm, ham, hbm, hym⟩,
  rcases hf z with ⟨n, hn, han, hbn, hzn⟩,
  rw ←two_pt_one_line hl hm hab hal hbl ham hbm at hym,
  rw ←two_pt_one_line hl hn hab hal hbl han hbn at hzn,
  exact hxyz ⟨l, hl, hxl, hym, hzn⟩
end

lemma noncol_neq {a b c : pts} (hf : noncol a b c) : a ≠ b ∧ a ≠ c ∧ b ≠ c :=
begin
  have : ∀ a b : pts, ∃ l ∈ lines, a ∈ l ∧ b ∈ l,
    intros a b, by_cases a = b,
    rw ←h, simp,
    have : ∃ p : pts, a ≠ p,
      by_contra, push_neg at h,
      rcases I3 with ⟨x, y, -, hxy, -, -, -⟩,
      exact hxy ((h x).symm .trans (h y)),
    cases this with b h,
    use (a-ₗb), exact ⟨line_in_lines h, pt_left_in_line a b⟩,
    use (a-ₗb), exact ⟨line_in_lines h, pt_left_in_line a b, pt_right_in_line a b⟩,
  split, intro h,
  rw h at hf,
  rcases this b c with ⟨l, hl, key⟩,
  exact hf ⟨l, hl, key.1, key.1, key.2⟩,
  split, intro h,
  rw h at hf,
  rcases this c b with ⟨l, hl, key⟩,
  exact hf ⟨l, hl, key.1, key.2, key.1⟩,
  intro h, rw h at hf,
  rcases this a c with ⟨l, hl, key⟩,
  exact hf ⟨l, hl, key.1, key.2, key.2⟩
end

lemma col12 {a b c : pts} : col a b c → col b a c :=
by {rintros ⟨l, hl, habc⟩, use l, tauto}

lemma noncol12 {a b c : pts} : noncol a b c → noncol b a c :=
by {unfold noncol, contrapose!, exact col12}

lemma col13 {a b c : pts} : col a b c → col c b a :=
by {rintros ⟨l, hl, habc⟩, use l, tauto}

lemma noncol13 {a b c : pts} : noncol a b c → noncol c b a :=
by {unfold noncol, contrapose!, exact col13}

lemma col23 {a b c : pts} : col a b c → col a c b :=
by {rintros ⟨l, hl, habc⟩, use l, tauto}

lemma noncol23 {a b c : pts} : noncol a b c → noncol a c b :=
by {unfold noncol, contrapose!, exact col23}

lemma col123 {a b c : pts} : col a b c → col b c a :=
λh, col23 (col12 h)

lemma col132 {a b c : pts} : col a b c → col c a b :=
λh, col23 (col13 h)

lemma noncol123 {a b c : pts} : noncol a b c → noncol b c a :=
by {unfold noncol, contrapose!, exact col132}

lemma noncol132 {a b c : pts} : noncol a b c → noncol c a b :=
by {unfold noncol, contrapose!, exact col123}

lemma col_trans {a b c d : pts} (habc : col a b c) (habd : col a b d)
  (hab : a ≠ b) : col a c d :=
begin
  rcases habc with ⟨l, hl, hal, hbl, hcl⟩, rcases habd with ⟨m, hm, ham, hbm, hdm⟩,
  rw two_pt_one_line hm hl hab ham hbm hal hbl at hdm,
  exact ⟨l, hl, hal, hcl, hdm⟩
end

lemma col_noncol {a b c d : pts} (habc : col a b c) (habd : noncol a b d) :
a ≠ c → noncol a c d :=
λhac hacd, habd (col_trans (col23 habc) hacd hac)

lemma col_in12 {a b c : pts} : col a b c → a ≠ b → c ∈ (a-ₗb) :=
begin
  rintros ⟨l, hl, hal, hbl, hcl⟩, intro hab,
  rw two_pt_one_line hl (line_in_lines hab) hab
    hal hbl (pt_left_in_line a b) (pt_right_in_line a b) at hcl,
  exact hcl
end

lemma col_in21 {a b c : pts} : col a b c → b ≠ a → c ∈ (b-ₗa) :=
by {rw line_symm, exact λhabc hba, col_in12 habc hba.symm}

lemma col_in13 {a b c : pts} : col a b c → a ≠ c → b ∈ (a-ₗc) :=
begin
  rintros ⟨l, hl, hal, hbl, hcl⟩, intro hac,
  rw two_pt_one_line hl (line_in_lines hac) hac
    hal hcl (pt_left_in_line a c) (pt_right_in_line a c) at hbl,
  exact hbl
end

lemma col_in31 {a b c : pts} : col a b c → c ≠ a → b ∈ (c-ₗa) :=
by {rw line_symm, exact λhabc hca, col_in13 habc hca.symm}

lemma col_in23 {a b c : pts} : col a b c → b ≠ c → a ∈ (b-ₗc) :=
begin
  rintros ⟨l, hl, hal, hbl, hcl⟩, intro hbc,
  rw two_pt_one_line hl (line_in_lines hbc) hbc
    hbl hcl (pt_left_in_line b c) (pt_right_in_line b c) at hal,
  exact hal
end

lemma col_in32 {a b c : pts} : col a b c → c ≠ b → a ∈ (c-ₗb) :=
by {rw line_symm, exact λhabc hcb, col_in23 habc hcb.symm}

lemma noncol_in12 {a b c : pts} : noncol a b c → c ∉ (a-ₗb) :=
λ habc hc, habc ⟨(a-ₗb), line_in_lines (noncol_neq habc).1,
  pt_left_in_line a b, pt_right_in_line a b, hc⟩

lemma noncol_in21 {a b c : pts} : noncol a b c → c ∉ (b-ₗa) :=
by {rw line_symm, exact noncol_in12}

lemma noncol_in13 {a b c : pts} : noncol a b c → b ∉ (a-ₗc) :=
λ habc hb, habc ⟨(a-ₗc), line_in_lines (noncol_neq habc).2.1,
  pt_left_in_line a c, hb, pt_right_in_line a c⟩

lemma noncol_in31 {a b c : pts} : noncol a b c → b ∉ (c-ₗa) :=
by {rw line_symm, exact noncol_in13}

lemma noncol_in23 {a b c : pts} : noncol a b c → a ∉ (b-ₗc) :=
λ habc ha, habc ⟨(b-ₗc), line_in_lines (noncol_neq habc).2.2, ha,
  pt_left_in_line b c, pt_right_in_line b c⟩

lemma noncol_in32 {a b c : pts} : noncol a b c → a ∉ (c-ₗb) :=
by {rw line_symm, exact noncol_in23}

lemma col_in12' {a b c : pts} : c ∈ (a-ₗb) → col a b c :=
by { intro h, by_contra habc, exact (noncol_in12 habc) h }

lemma col_in21' {a b c : pts} : c ∈ (b-ₗa) → col a b c :=
by { rw line_symm, exact col_in12' }

lemma col_in13' {a b c : pts} : b ∈ (a-ₗc) → col a b c :=
by { intro h, by_contra habc, exact (noncol_in13 habc) h }

lemma col_in31' {a b c : pts} : b ∈ (c-ₗa) → col a b c :=
by { rw line_symm, exact col_in13' }

lemma col_in23' {a b c : pts} : a ∈ (b-ₗc) → col a b c :=
by { intro h, by_contra habc, exact (noncol_in23 habc) h }

lemma col_in32' {a b c : pts} : a ∈ (c-ₗb) → col a b c :=
by { rw line_symm, exact col_in23' }

lemma noncol_in12' {a b c : pts} (hab : a ≠ b) : c ∉ (a-ₗb) → noncol a b c :=
by { contrapose!, intro h, unfold noncol at h, rw not_not at h,
  exact col_in12 h hab }

lemma noncol_in21' {a b c : pts} (hba : b ≠ a) : c ∉ (b-ₗa) → noncol a b c :=
by { rw line_symm, exact noncol_in12' hba.symm }

lemma noncol_in13' {a b c : pts} (hac : a ≠ c) : b ∉ (a-ₗc) → noncol a b c :=
by { contrapose!, intro h, unfold noncol at h, rw not_not at h,
  exact col_in13 h hac }

lemma noncol_in31' {a b c : pts} (hca : c ≠ a) : b ∉ (c-ₗa) → noncol a b c :=
by { rw line_symm, exact noncol_in13' hca.symm }

lemma noncol_in23' {a b c : pts} (hbc : b ≠ c) : a ∉ (b-ₗc) → noncol a b c :=
by { contrapose!, intro h, unfold noncol at h, rw not_not at h,
  exact col_in23 h hbc }

lemma noncol_in32' {a b c : pts} (hcb : c ≠ b) : a ∉ (c-ₗb) → noncol a b c :=
by { rw line_symm, exact noncol_in23' hcb.symm }


variable (p q : Prop)
theorem and_commutative : p ∧ q → q ∧ p :=
  fun hypq : p ∧ q =>
  have hp : p := And.left hypq
  have hq : q := And.right hypq
  show q ∧ p from And.intro hq hp

-- one-line version of and_commutative
example (hpq : p ∧ q) : q ∧ p :=
  And.intro (And.right hpq) (And.left hpq)

-- using canonical inductive type And constructor implicitly
example (hpq : p ∧ q) : q ∧ p :=
  ⟨hpq.right, hpq.left⟩

theorem or_commutative : p \/ q -> q \/ p :=
  fun hypq : p ∨ q =>
  have right : p → q ∨ p := Or.intro_right q
  have left : q → q ∨ p := Or.intro_left p
  show q ∨ p from Or.elim hypq right left

-- one-line version of or_commutative
example (hpq : p ∨ q) : q ∨ p :=
  Or.elim hpq (Or.intro_right q) (Or.intro_left p)


import data.nat.basic
import tactic

open classical
attribute [instance] prop_decidable

theorem exists_unique_le : ∃! n m : ℕ, m ≤ n :=
begin
  unfold exists_unique,
  use 0,
  split,
    use 0,
    split, refl,
    intro y,
    exact nat.le_zero_iff.mp,

    intro y,
    intro hy,
    cases hy with z hy,
    contrapose! hy,
    -- intros hz,
    -- by_cases z=y,
    have ht := nat.exists_eq_succ_of_ne_zero hy,
    cases ht with t ht,
    rw ht,
    intro hz,

    by_cases z=t + 1,

      rw h,
      use t,
      split, linarith, simp only [self_eq_add_right, ne.def, not_false_iff, one_ne_zero],

      use t+1,
      split, refl, simp only [ne.def], contrapose! h, symmetry, assumption,
end


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

! This file was ported from Lean 3 source module data.nat.size
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Pow
import Mathbin.Data.Nat.Bits

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

namespace Nat

/-! ### `shiftl` and `shiftr` -/

#print Nat.shiftl_eq_mul_pow /-
theorem shiftl_eq_mul_pow (m) : ∀ n, shiftl m n = m * 2 ^ n
  | 0 => (Nat.mul_one _).symm
  | k + 1 =>
    show bit0 (shiftl m k) = m * (2 * 2 ^ k) by
      rw [bit0_val, shiftl_eq_mul_pow, mul_left_comm, mul_comm 2]
#align nat.shiftl_eq_mul_pow Nat.shiftl_eq_mul_pow
-/

#print Nat.shiftl'_tt_eq_mul_pow /-
theorem shiftl'_tt_eq_mul_pow (m) : ∀ n, shiftl' true m n + 1 = (m + 1) * 2 ^ n
  | 0 => by simp [shiftl, shiftl', pow_zero, Nat.one_mul]
  | k + 1 => by
    change bit1 (shiftl' tt m k) + 1 = (m + 1) * (2 * 2 ^ k)
    rw [bit1_val]
    change 2 * (shiftl' tt m k + 1) = _
    rw [shiftl'_tt_eq_mul_pow, mul_left_comm, mul_comm 2]
#align nat.shiftl'_tt_eq_mul_pow Nat.shiftl'_tt_eq_mul_pow
-/

#print Nat.one_shiftl /-
theorem one_shiftl (n) : shiftl 1 n = 2 ^ n :=
  (shiftl_eq_mul_pow _ _).trans (Nat.one_mul _)
#align nat.one_shiftl Nat.one_shiftl
-/

#print Nat.zero_shiftl /-
@[simp]
theorem zero_shiftl (n) : shiftl 0 n = 0 :=
  (shiftl_eq_mul_pow _ _).trans (Nat.zero_mul _)
#align nat.zero_shiftl Nat.zero_shiftl
-/

#print Nat.shiftr_eq_div_pow /-
theorem shiftr_eq_div_pow (m) : ∀ n, shiftr m n = m / 2 ^ n
  | 0 => (Nat.div_one _).symm
  | k + 1 =>
    (congr_arg div2 (shiftr_eq_div_pow k)).trans <| by
      rw [div2_val, Nat.div_div_eq_div_mul, mul_comm] <;> rfl
#align nat.shiftr_eq_div_pow Nat.shiftr_eq_div_pow
-/

#print Nat.zero_shiftr /-
@[simp]
theorem zero_shiftr (n) : shiftr 0 n = 0 :=
  (shiftr_eq_div_pow _ _).trans (Nat.zero_div _)
#align nat.zero_shiftr Nat.zero_shiftr
-/

#print Nat.shiftl'_ne_zero_left /-
theorem shiftl'_ne_zero_left (b) {m} (h : m ≠ 0) (n) : shiftl' b m n ≠ 0 := by
  induction n <;> simp [bit_ne_zero, shiftl', *]
#align nat.shiftl'_ne_zero_left Nat.shiftl'_ne_zero_left
-/

#print Nat.shiftl'_tt_ne_zero /-
theorem shiftl'_tt_ne_zero (m) : ∀ {n} (h : n ≠ 0), shiftl' true m n ≠ 0
  | 0, h => absurd rfl h
  | succ n, _ => Nat.bit1_ne_zero _
#align nat.shiftl'_tt_ne_zero Nat.shiftl'_tt_ne_zero
-/

/-! ### `size` -/

#print Nat.size_zero /-
@[simp]
theorem size_zero : size 0 = 0 := by simp [size]
#align nat.size_zero Nat.size_zero
-/

#print Nat.size_bit /-
@[simp]
theorem size_bit {b n} (h : bit b n ≠ 0) : size (bit b n) = succ (size n) :=
  by
  rw [size]
  conv =>
    lhs
    rw [binary_rec]
    simp [h]
  rw [div2_bit]
#align nat.size_bit Nat.size_bit
-/

#print Nat.size_bit0 /-
@[simp]
theorem size_bit0 {n} (h : n ≠ 0) : size (bit0 n) = succ (size n) :=
  @size_bit false n (Nat.bit0_ne_zero h)
#align nat.size_bit0 Nat.size_bit0
-/

#print Nat.size_bit1 /-
@[simp]
theorem size_bit1 (n) : size (bit1 n) = succ (size n) :=
  @size_bit true n (Nat.bit1_ne_zero n)
#align nat.size_bit1 Nat.size_bit1
-/

#print Nat.size_one /-
@[simp]
theorem size_one : size 1 = 1 :=
  show size (bit1 0) = 1 by rw [size_bit1, size_zero]
#align nat.size_one Nat.size_one
-/

#print Nat.size_shiftl' /-
@[simp]
theorem size_shiftl' {b m n} (h : shiftl' b m n ≠ 0) : size (shiftl' b m n) = size m + n :=
  by
  induction' n with n IH <;> simp [shiftl'] at h⊢
  rw [size_bit h, Nat.add_succ]
  by_cases s0 : shiftl' b m n = 0 <;> [skip, rw [IH s0]]
  rw [s0] at h⊢
  cases b; · exact absurd rfl h
  have : shiftl' tt m n + 1 = 1 := congr_arg (· + 1) s0
  rw [shiftl'_tt_eq_mul_pow] at this
  obtain rfl := succ.inj (eq_one_of_dvd_one ⟨_, this.symm⟩)
  rw [one_mul] at this
  obtain rfl : n = 0 :=
    Nat.eq_zero_of_le_zero
      (le_of_not_gt fun hn => ne_of_gt (pow_lt_pow_of_lt_right (by decide) hn) this)
  rfl
#align nat.size_shiftl' Nat.size_shiftl'
-/

#print Nat.size_shiftl /-
@[simp]
theorem size_shiftl {m} (h : m ≠ 0) (n) : size (shiftl m n) = size m + n :=
  size_shiftl' (shiftl'_ne_zero_left _ h _)
#align nat.size_shiftl Nat.size_shiftl
-/

#print Nat.lt_size_self /-
theorem lt_size_self (n : ℕ) : n < 2 ^ size n :=
  by
  rw [← one_shiftl]
  have : ∀ {n}, n = 0 → n < shiftl 1 (size n) := by simp
  apply binary_rec _ _ n
  · apply this rfl
  intro b n IH
  by_cases bit b n = 0
  · apply this h
  rw [size_bit h, shiftl_succ]
  exact bit_lt_bit0 _ IH
#align nat.lt_size_self Nat.lt_size_self
-/

#print Nat.size_le /-
theorem size_le {m n : ℕ} : size m ≤ n ↔ m < 2 ^ n :=
  ⟨fun h => lt_of_lt_of_le (lt_size_self _) (pow_le_pow_of_le_right (by decide) h),
    by
    rw [← one_shiftl]; revert n
    apply binary_rec _ _ m
    · intro n h
      simp
    · intro b m IH n h
      by_cases e : bit b m = 0
      · simp [e]
      rw [size_bit e]
      cases' n with n
      · exact e.elim (Nat.eq_zero_of_le_zero (le_of_lt_succ h))
      · apply succ_le_succ (IH _)
        apply lt_imp_lt_of_le_imp_le (fun h' => bit0_le_bit _ h') h⟩
#align nat.size_le Nat.size_le
-/

#print Nat.lt_size /-
theorem lt_size {m n : ℕ} : m < size n ↔ 2 ^ m ≤ n := by
  rw [← not_lt, Decidable.iff_not_comm, not_lt, size_le]
#align nat.lt_size Nat.lt_size
-/

#print Nat.size_pos /-
theorem size_pos {n : ℕ} : 0 < size n ↔ 0 < n := by rw [lt_size] <;> rfl
#align nat.size_pos Nat.size_pos
-/

#print Nat.size_eq_zero /-
theorem size_eq_zero {n : ℕ} : size n = 0 ↔ n = 0 := by
  have := @size_pos n <;> simp [pos_iff_ne_zero] at this <;> exact Decidable.not_iff_not.1 this
#align nat.size_eq_zero Nat.size_eq_zero
-/

#print Nat.size_pow /-
theorem size_pow {n : ℕ} : size (2 ^ n) = n + 1 :=
  le_antisymm (size_le.2 <| pow_lt_pow_of_lt_right (by decide) (lt_succ_self _))
    (lt_size.2 <| le_rfl)
#align nat.size_pow Nat.size_pow
-/

#print Nat.size_le_size /-
theorem size_le_size {m n : ℕ} (h : m ≤ n) : size m ≤ size n :=
  size_le.2 <| lt_of_le_of_lt h (lt_size_self _)
#align nat.size_le_size Nat.size_le_size
-/

#print Nat.size_eq_bits_len /-
theorem size_eq_bits_len (n : ℕ) : n.bits.length = n.size :=
  by
  induction' n using Nat.binaryRec' with b n h ih; · simp
  rw [size_bit, bits_append_bit _ _ h]
  · simp [ih]
  · simpa [bit_eq_zero_iff]
#align nat.size_eq_bits_len Nat.size_eq_bits_len
-/

end Nat


import tactic

namespace paulo

class group (G : Type) extends has_mul G, has_one G, has_inv G :=
(mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c))
(one_mul : ∀ (a : G), 1 * a = a)
(mul_left_inv : ∀ (a : G), a⁻¹ * a = 1)

variables {G: Type} [group G]

namespace group

def is_abelian (G : Type) [group G] :=
∀ (a b : G), a * b = b * a

structure subgroup (G : Type) [group G] :=
(carrier : set G)
(one_mem' : (1 : G) ∈ carrier)
(mul_mem' {x y} : x ∈ carrier → y ∈ carrier → x * y ∈ carrier)
(inv_mem' {x} : x ∈ carrier → x⁻¹ ∈ carrier)

variables (H : subgroup G)

instance : has_mem G (subgroup G) := ⟨λ m H, m ∈ H.carrier⟩

instance : has_coe (subgroup G) (set G) := ⟨λ H, H.carrier⟩

@[simp] lemma mem_carrier
  {g : G}
  : g ∈ H.carrier ↔ g ∈ H :=
by refl

theorem one_mem :
  (1 : G) ∈ H :=
by apply H.one_mem'

/-- A subgroup is closed under multiplication. -/
theorem mul_mem
  {x y : G}
  : x ∈ H → y ∈ H → x * y ∈ H :=
by apply H.mul_mem'

/-- A subgroup is closed under inverse -/
theorem inv_mem
  {x : G}
  : x ∈ H → x⁻¹ ∈ H :=
by apply H.inv_mem'

@[simp] lemma mem_coe
  {g : G}
  : g ∈ (↑H : set G) ↔ g ∈ H :=
by refl

namespace subgroup

def is_normal_subgroup :=
∀ (g : G), ∀ h, h ∈ H → g*h*g⁻¹ ∈ H

lemma abelian_subgroups_normal
  {G₁ : Type}
  [group G₁]
  (hyp : is_abelian G₁)
  (H₁ : subgroup G₁)
  : is_normal_subgroup H₁ :=
begin
  intros g h h_in,
  rwa [hyp, ← mul_assoc, mul_left_inv, one_mul]
end

end subgroup

end group

end paulo


/-
Copyright (c) 2018 Violeta Hernández Palacios, Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Violeta Hernández Palacios, Mario Carneiro
-/

import set_theory.ordinal.arithmetic
import set_theory.ordinal.exponential

/-!
# Fixed points of normal functions

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

We prove various statements about the fixed points of normal ordinal functions. We state them in
three forms: as statements about type-indexed families of normal functions, as statements about
ordinal-indexed families of normal functions, and as statements about a single normal function. For
the most part, the first case encompasses the others.

Moreover, we prove some lemmas about the fixed points of specific normal functions.

## Main definitions and results

* `nfp_family`, `nfp_bfamily`, `nfp`: the next fixed point of a (family of) normal function(s).
* `fp_family_unbounded`, `fp_bfamily_unbounded`, `fp_unbounded`: the (common) fixed points of a
  (family of) normal function(s) are unbounded in the ordinals.
* `deriv_add_eq_mul_omega_add`: a characterization of the derivative of addition.
* `deriv_mul_eq_opow_omega_mul`: a characterization of the derivative of multiplication.
-/

noncomputable theory

universes u v

open function order

namespace ordinal

/-! ### Fixed points of type-indexed families of ordinals -/

section
variables {ι : Type u} {f : ι → ordinal.{max u v} → ordinal.{max u v}}

/-- The next common fixed point, at least `a`, for a family of normal functions.

This is defined for any family of functions, as the supremum of all values reachable by applying
finitely many functions in the family to `a`.

`ordinal.nfp_family_fp` shows this is a fixed point, `ordinal.le_nfp_family` shows it's at
least `a`, and `ordinal.nfp_family_le_fp` shows this is the least ordinal with these properties. -/
def nfp_family (f : ι → ordinal → ordinal) (a) : ordinal :=
sup (list.foldr f a)

theorem nfp_family_eq_sup (f : ι → ordinal → ordinal) (a) :
  nfp_family f a = sup (list.foldr f a) :=
rfl

theorem foldr_le_nfp_family (f : ι → ordinal → ordinal) (a l) :
  list.foldr f a l ≤ nfp_family f a :=
le_sup _ _

theorem le_nfp_family (f : ι → ordinal → ordinal) (a) : a ≤ nfp_family f a :=
le_sup _ []

theorem lt_nfp_family {a b} : a < nfp_family f b ↔ ∃ l, a < list.foldr f b l :=
lt_sup

theorem nfp_family_le_iff {a b} : nfp_family f a ≤ b ↔ ∀ l, list.foldr f a l ≤ b :=
sup_le_iff

theorem nfp_family_le {a b} : (∀ l, list.foldr f a l ≤ b) → nfp_family f a ≤ b :=
sup_le

theorem nfp_family_monotone (hf : ∀ i, monotone (f i)) : monotone (nfp_family f) :=
λ a b h, sup_le $ λ l, (list.foldr_monotone hf l h).trans (le_sup _ l)

theorem apply_lt_nfp_family (H : ∀ i, is_normal (f i)) {a b} (hb : b < nfp_family f a) (i) :
  f i b < nfp_family f a :=
let ⟨l, hl⟩ := lt_nfp_family.1 hb in lt_sup.2 ⟨i :: l, (H i).strict_mono hl⟩

theorem apply_lt_nfp_family_iff [nonempty ι] (H : ∀ i, is_normal (f i)) {a b} :
  (∀ i, f i b < nfp_family f a) ↔ b < nfp_family f a :=
⟨λ h, lt_nfp_family.2 $ let ⟨l, hl⟩ := lt_sup.1 $ h $ classical.arbitrary ι in
  ⟨l, ((H _).self_le b).trans_lt hl⟩, apply_lt_nfp_family H⟩

theorem nfp_family_le_apply [nonempty ι] (H : ∀ i, is_normal (f i)) {a b} :
  (∃ i, nfp_family f a ≤ f i b) ↔ nfp_family f a ≤ b :=
by { rw ←not_iff_not, push_neg, exact apply_lt_nfp_family_iff H }

theorem nfp_family_le_fp (H : ∀ i, monotone (f i)) {a b} (ab : a ≤ b) (h : ∀ i, f i b ≤ b) :
  nfp_family f a ≤ b :=
sup_le $ λ l, begin
  by_cases hι : is_empty ι,
  { resetI, rwa unique.eq_default l },
  { haveI := not_is_empty_iff.1 hι,
    induction l with i l IH generalizing a, {exact ab},
    exact (H i (IH ab)).trans (h i) }
end

theorem nfp_family_fp {i} (H : is_normal (f i)) (a) : f i (nfp_family f a) = nfp_family f a :=
begin
  unfold nfp_family,
  rw @is_normal.sup _ H _ _ ⟨[]⟩,
  apply le_antisymm;
  refine ordinal.sup_le (λ l, _),
  { exact le_sup _ (i :: l) },
  { exact (H.self_le _).trans (le_sup _ _) }
end

theorem apply_le_nfp_family [hι : nonempty ι] {f : ι → ordinal → ordinal} (H : ∀ i, is_normal (f i))
  {a b} : (∀ i, f i b ≤ nfp_family f a) ↔ b ≤ nfp_family f a :=
begin
  refine ⟨λ h, _, λ h i, _⟩,
  { unfreezingI { cases hι with i },
    exact ((H i).self_le b).trans (h i) },
  rw ←nfp_family_fp (H i),
  exact (H i).monotone h
end

theorem nfp_family_eq_self {f : ι → ordinal → ordinal} {a} (h : ∀ i, f i a = a) :
  nfp_family f a = a :=
le_antisymm (sup_le $ λ l, by rw list.foldr_fixed' h l) $ le_nfp_family f a

/-- A generalization of the fixed point lemma for normal functions: any family of normal functions
    has an unbounded set of common fixed points. -/
-- Todo: This is actually a special case of the fact the intersection of club sets is a club set.
theorem fp_family_unbounded (H : ∀ i, is_normal (f i)) :
  (⋂ i, function.fixed_points (f i)).unbounded (<) :=
λ a, ⟨_, λ s ⟨i, hi⟩, begin
  rw ←hi,
  exact nfp_family_fp (H i) a
end, (le_nfp_family f a).not_lt⟩

/-- The derivative of a family of normal functions is the sequence of their common fixed points.

This is defined for all functions such that `ordinal.deriv_family_zero`,
`ordinal.deriv_family_succ`, and `ordinal.deriv_family_limit` are satisfied. -/
def deriv_family (f : ι → ordinal → ordinal) (o : ordinal) : ordinal :=
limit_rec_on o (nfp_family f 0)
  (λ a IH, nfp_family f (succ IH))
  (λ a l, bsup.{(max u v) u} a)

@[simp] theorem deriv_family_zero (f : ι → ordinal → ordinal) :
  deriv_family f 0 = nfp_family f 0 :=
limit_rec_on_zero _ _ _

@[simp] theorem deriv_family_succ (f : ι → ordinal → ordinal) (o) :
  deriv_family f (succ o) = nfp_family f (succ (deriv_family f o)) :=
limit_rec_on_succ _ _ _ _

theorem deriv_family_limit (f : ι → ordinal → ordinal) {o} : is_limit o →
  deriv_family f o = bsup.{(max u v) u} o (λ a _, deriv_family f a) :=
limit_rec_on_limit _ _ _ _

theorem deriv_family_is_normal (f : ι → ordinal → ordinal) : is_normal (deriv_family f) :=
⟨λ o, by rw [deriv_family_succ, ← succ_le_iff]; apply le_nfp_family,
 λ o l a, by rw [deriv_family_limit _ l, bsup_le_iff]⟩

theorem deriv_family_fp {i} (H : is_normal (f i)) (o : ordinal.{max u v}) :
  f i (deriv_family f o) = deriv_family f o :=
begin
  refine limit_rec_on o _ (λ o IH, _) _,
  { rw [deriv_family_zero], exact nfp_family_fp H 0 },
  { rw [deriv_family_succ], exact nfp_family_fp H _ },
  { intros o l IH,
    rw [deriv_family_limit _ l,
      is_normal.bsup.{(max u v) u (max u v)} H (λ a _, deriv_family f a) l.1],
    refine eq_of_forall_ge_iff (λ c, _),
    simp only [bsup_le_iff, IH] {contextual:=tt} }
end

theorem le_iff_deriv_family (H : ∀ i, is_normal (f i)) {a} :
  (∀ i, f i a ≤ a) ↔ ∃ o, deriv_family f o = a :=
⟨λ ha, begin
  suffices : ∀ o (_ : a ≤ deriv_family f o), ∃ o, deriv_family f o = a,
  from this a ((deriv_family_is_normal _).self_le _),
  refine λ o, limit_rec_on o (λ h₁, ⟨0, le_antisymm _ h₁⟩) (λ o IH h₁, _) (λ o l IH h₁, _),
  { rw deriv_family_zero,
    exact nfp_family_le_fp (λ i, (H i).monotone) (ordinal.zero_le _) ha },
  { cases le_or_lt a (deriv_family f o), {exact IH h},
    refine ⟨succ o, le_antisymm _ h₁⟩,
    rw deriv_family_succ,
    exact nfp_family_le_fp (λ i, (H i).monotone) (succ_le_of_lt h) ha },
  { cases eq_or_lt_of_le h₁, {exact ⟨_, h.symm⟩},
    rw [deriv_family_limit _ l, ← not_le, bsup_le_iff, not_ball] at h,
    exact let ⟨o', h, hl⟩ := h in IH o' h (le_of_not_le hl) }
end, λ ⟨o, e⟩ i, e ▸ (deriv_family_fp (H i) _).le⟩

theorem fp_iff_deriv_family (H : ∀ i, is_normal (f i)) {a} :
  (∀ i, f i a = a) ↔ ∃ o, deriv_family f o = a :=
iff.trans ⟨λ h i, le_of_eq (h i), λ h i, (H i).le_iff_eq.1 (h i)⟩ (le_iff_deriv_family H)

/-- For a family of normal functions, `ordinal.deriv_family` enumerates the common fixed points. -/
theorem deriv_family_eq_enum_ord (H : ∀ i, is_normal (f i)) :
  deriv_family f = enum_ord (⋂ i, function.fixed_points (f i)) :=
begin
  rw ←eq_enum_ord _ (fp_family_unbounded H),
  use (deriv_family_is_normal f).strict_mono,
  rw set.range_eq_iff,
  refine ⟨_, λ a ha, _⟩,
  { rintros a S ⟨i, hi⟩,
    rw ←hi,
    exact deriv_family_fp (H i) a },
  rw set.mem_Inter at ha,
  rwa ←fp_iff_deriv_family H
end

end

/-! ### Fixed points of ordinal-indexed families of ordinals -/

section
variables {o : ordinal.{u}} {f : Π b < o, ordinal.{max u v} → ordinal.{max u v}}

/-- The next common fixed point, at least `a`, for a family of normal functions indexed by ordinals.

This is defined as `ordinal.nfp_family` of the type-indexed family associated to `f`.
-/
def nfp_bfamily (o : ordinal) (f : Π b < o, ordinal → ordinal) : ordinal → ordinal :=
nfp_family (family_of_bfamily o f)

theorem nfp_bfamily_eq_nfp_family {o : ordinal} (f : Π b < o, ordinal → ordinal) :
  nfp_bfamily o f = nfp_family (family_of_bfamily o f) :=
rfl

theorem foldr_le_nfp_bfamily {o : ordinal} (f : Π b < o, ordinal → ordinal) (a l) :
  list.foldr (family_of_bfamily o f) a l ≤ nfp_bfamily o f a :=
le_sup _ _

theorem le_nfp_bfamily {o : ordinal} (f : Π b < o, ordinal → ordinal) (a) :
  a ≤ nfp_bfamily o f a :=
le_sup _ []

theorem lt_nfp_bfamily {a b} :
  a < nfp_bfamily o f b ↔ ∃ l, a < list.foldr (family_of_bfamily o f) b l :=
lt_sup

theorem nfp_bfamily_le_iff {o : ordinal} {f : Π b < o, ordinal → ordinal} {a b} :
  nfp_bfamily o f a ≤ b ↔ ∀ l, list.foldr (family_of_bfamily o f) a l ≤ b :=
sup_le_iff

theorem nfp_bfamily_le {o : ordinal} {f : Π b < o, ordinal → ordinal} {a b} :
  (∀ l, list.foldr (family_of_bfamily o f) a l ≤ b) → nfp_bfamily o f a ≤ b :=
sup_le

theorem nfp_bfamily_monotone (hf : ∀ i hi, monotone (f i hi)) : monotone (nfp_bfamily o f) :=
nfp_family_monotone (λ i, hf _ _)

theorem apply_lt_nfp_bfamily (H : ∀ i hi, is_normal (f i hi)) {a b} (hb : b < nfp_bfamily o f a)
  (i hi) : f i hi b < nfp_bfamily o f a :=
begin
  rw ←family_of_bfamily_enum o f,
  apply apply_lt_nfp_family _ hb,
  exact λ _, H _ _
end

theorem apply_lt_nfp_bfamily_iff (ho : o ≠ 0) (H : ∀ i hi, is_normal (f i hi)) {a b} :
  (∀ i hi, f i hi b < nfp_bfamily o f a) ↔ b < nfp_bfamily o f a :=
⟨λ h, begin
  haveI := out_nonempty_iff_ne_zero.2 ho,
  refine (apply_lt_nfp_family_iff _).1 (λ _, h _ _),
  exact λ _, H _ _,
end, apply_lt_nfp_bfamily H⟩

theorem nfp_bfamily_le_apply (ho : o ≠ 0) (H : ∀ i hi, is_normal (f i hi)) {a b} :
  (∃ i hi, nfp_bfamily o f a ≤ f i hi b) ↔ nfp_bfamily o f a ≤ b :=
by { rw ←not_iff_not, push_neg, convert apply_lt_nfp_bfamily_iff ho H, simp only [not_le] }

theorem nfp_bfamily_le_fp (H : ∀ i hi, monotone (f i hi)) {a b} (ab : a ≤ b)
  (h : ∀ i hi, f i hi b ≤ b) : nfp_bfamily o f a ≤ b :=
nfp_family_le_fp (λ _, H _ _) ab (λ i, h _ _)

theorem nfp_bfamily_fp {i hi} (H : is_normal (f i hi)) (a) :
  f i hi (nfp_bfamily o f a) = nfp_bfamily o f a :=
by { rw ←family_of_bfamily_enum o f, apply nfp_family_fp, rw family_of_bfamily_enum, exact H }

theorem apply_le_nfp_bfamily (ho : o ≠ 0) (H : ∀ i hi, is_normal (f i hi)) {a b} :
  (∀ i hi, f i hi b ≤ nfp_bfamily o f a) ↔ b ≤ nfp_bfamily o f a :=
begin
  refine ⟨λ h, _, λ h i hi, _⟩,
  { have ho' : 0 < o := ordinal.pos_iff_ne_zero.2 ho,
    exact ((H 0 ho').self_le b).trans (h 0 ho') },
  { rw ←nfp_bfamily_fp (H i hi),
    exact (H i hi).monotone h }
end

theorem nfp_bfamily_eq_self {a} (h : ∀ i hi, f i hi a = a) : nfp_bfamily o f a = a :=
nfp_family_eq_self (λ _, h _ _)

/-- A generalization of the fixed point lemma for normal functions: any family of normal functions
    has an unbounded set of common fixed points. -/
theorem fp_bfamily_unbounded (H : ∀ i hi, is_normal (f i hi)) :
  (⋂ i hi, function.fixed_points (f i hi)).unbounded (<) :=
λ a, ⟨_, by { rw set.mem_Inter₂, exact λ i hi, nfp_bfamily_fp (H i hi) _ },
  (le_nfp_bfamily f a).not_lt⟩

/-- The derivative of a family of normal functions is the sequence of their common fixed points.

This is defined as `ordinal.deriv_family` of the type-indexed family associated to `f`. -/
def deriv_bfamily (o : ordinal) (f : Π b < o, ordinal → ordinal) : ordinal → ordinal :=
deriv_family (family_of_bfamily o f)

theorem deriv_bfamily_eq_deriv_family {o : ordinal} (f : Π b < o, ordinal → ordinal) :
  deriv_bfamily o f = deriv_family (family_of_bfamily o f) :=
rfl

theorem deriv_bfamily_is_normal {o : ordinal} (f : Π b < o, ordinal → ordinal) :
  is_normal (deriv_bfamily o f) :=
deriv_family_is_normal _

theorem deriv_bfamily_fp {i hi} (H : is_normal (f i hi)) (a : ordinal) :
  f i hi (deriv_bfamily o f a) = deriv_bfamily o f a :=
by { rw ←family_of_bfamily_enum o f, apply deriv_family_fp, rw family_of_bfamily_enum, exact H }

theorem le_iff_deriv_bfamily (H : ∀ i hi, is_normal (f i hi)) {a} :
  (∀ i hi, f i hi a ≤ a) ↔ ∃ b, deriv_bfamily o f b = a :=
begin
  unfold deriv_bfamily,
  rw ←le_iff_deriv_family,
  { refine ⟨λ h i, h _ _, λ h i hi, _⟩,
    rw ←family_of_bfamily_enum o f,
    apply h },
  { exact λ _, H _ _ }
end

theorem fp_iff_deriv_bfamily (H : ∀ i hi, is_normal (f i hi)) {a} :
  (∀ i hi, f i hi a = a) ↔ ∃ b, deriv_bfamily o f b = a :=
begin
  rw ←le_iff_deriv_bfamily H,
  refine ⟨λ h i hi, le_of_eq (h i hi), λ h i hi, _⟩,
  rw ←(H i hi).le_iff_eq,
  exact h i hi
end

/-- For a family of normal functions, `ordinal.deriv_bfamily` enumerates the common fixed points. -/
theorem deriv_bfamily_eq_enum_ord (H : ∀ i hi, is_normal (f i hi)) :
  deriv_bfamily o f = enum_ord (⋂ i hi, function.fixed_points (f i hi)) :=
begin
  rw ←eq_enum_ord _ (fp_bfamily_unbounded H),
  use (deriv_bfamily_is_normal f).strict_mono,
  rw set.range_eq_iff,
  refine ⟨λ a, set.mem_Inter₂.2 (λ i hi, deriv_bfamily_fp (H i hi) a), λ a ha, _⟩,
  rw set.mem_Inter₂ at ha,
  rwa ←fp_iff_deriv_bfamily H
end

end

/-! ### Fixed points of a single function -/

section
variable {f : ordinal.{u} → ordinal.{u}}

/-- The next fixed point function, the least fixed point of the normal function `f`, at least `a`.

This is defined as `ordinal.nfp_family` applied to a family consisting only of `f`. -/
def nfp (f : ordinal → ordinal) : ordinal → ordinal :=
nfp_family (λ _ : unit, f)

theorem nfp_eq_nfp_family (f : ordinal → ordinal) : nfp f = nfp_family (λ _ : unit, f) :=
rfl

@[simp] theorem sup_iterate_eq_nfp (f : ordinal.{u} → ordinal.{u}) :
  (λ a, sup (λ n : ℕ, f^[n] a)) = nfp f :=
begin
  refine funext (λ a, le_antisymm _ (sup_le (λ l, _))),
  { rw sup_le_iff,
    intro n,
    rw [←list.length_replicate n unit.star, ←list.foldr_const f a],
    apply le_sup },
  { rw list.foldr_const f a l,
    exact le_sup _ _ },
end

theorem iterate_le_nfp (f a n) : f^[n] a ≤ nfp f a :=
by { rw ←sup_iterate_eq_nfp, exact le_sup _ n }

theorem le_nfp (f a) : a ≤ nfp f a :=
iterate_le_nfp f a 0

theorem lt_nfp {a b} : a < nfp f b ↔ ∃ n, a < (f^[n]) b :=
by { rw ←sup_iterate_eq_nfp, exact lt_sup }

theorem nfp_le_iff {a b} : nfp f a ≤ b ↔ ∀ n, (f^[n]) a ≤ b :=
by { rw ←sup_iterate_eq_nfp, exact sup_le_iff }

theorem nfp_le {a b} : (∀ n, (f^[n]) a ≤ b) → nfp f a ≤ b := nfp_le_iff.2

@[simp] theorem nfp_id : nfp id = id :=
funext (λ a, begin
  simp_rw [←sup_iterate_eq_nfp, iterate_id],
  exact sup_const a
end)

theorem nfp_monotone (hf : monotone f) : monotone (nfp f) :=
nfp_family_monotone (λ i, hf)

theorem is_normal.apply_lt_nfp {f} (H : is_normal f) {a b} :
  f b < nfp f a ↔ b < nfp f a :=
begin
  unfold nfp,
  rw ←@apply_lt_nfp_family_iff unit (λ _, f) _ (λ _, H) a b,
  exact ⟨λ h _, h, λ h, h unit.star⟩
end

theorem is_normal.nfp_le_apply {f} (H : is_normal f) {a b} : nfp f a ≤ f b ↔ nfp f a ≤ b :=
le_iff_le_iff_lt_iff_lt.2 H.apply_lt_nfp

theorem nfp_le_fp {f} (H : monotone f) {a b} (ab : a ≤ b) (h : f b ≤ b) : nfp f a ≤ b :=
nfp_family_le_fp (λ _, H) ab (λ _, h)

theorem is_normal.nfp_fp {f} (H : is_normal f) : ∀ a, f (nfp f a) = nfp f a :=
@nfp_family_fp unit (λ _, f) unit.star H

theorem is_normal.apply_le_nfp {f} (H : is_normal f) {a b} :
  f b ≤ nfp f a ↔ b ≤ nfp f a :=
⟨le_trans (H.self_le _), λ h, by simpa only [H.nfp_fp] using H.le_iff.2 h⟩

theorem nfp_eq_self {f : ordinal → ordinal} {a} (h : f a = a) : nfp f a = a :=
nfp_family_eq_self (λ _, h)

/-- The fixed point lemma for normal functions: any normal function has an unbounded set of
fixed points. -/
theorem fp_unbounded (H : is_normal f) : (function.fixed_points f).unbounded (<) :=
by { convert fp_family_unbounded (λ _ : unit, H), exact (set.Inter_const _).symm }

/-- The derivative of a normal function `f` is the sequence of fixed points of `f`.

This is defined as `ordinal.deriv_family` applied to a trivial family consisting only of `f`. -/
def deriv (f : ordinal → ordinal) : ordinal → ordinal :=
deriv_family (λ _ : unit, f)

theorem deriv_eq_deriv_family (f : ordinal → ordinal) : deriv f = deriv_family (λ _ : unit, f) :=
rfl

@[simp] theorem deriv_zero (f) : deriv f 0 = nfp f 0 :=
deriv_family_zero _

@[simp] theorem deriv_succ (f o) : deriv f (succ o) = nfp f (succ (deriv f o)) :=
deriv_family_succ _ _

theorem deriv_limit (f) {o} : is_limit o → deriv f o = bsup.{u 0} o (λ a _, deriv f a) :=
deriv_family_limit _

theorem deriv_is_normal (f) : is_normal (deriv f) :=
deriv_family_is_normal _

theorem deriv_id_of_nfp_id {f : ordinal → ordinal} (h : nfp f = id) : deriv f = id :=
((deriv_is_normal _).eq_iff_zero_and_succ is_normal.refl).2 (by simp [h])

theorem is_normal.deriv_fp {f} (H : is_normal f) : ∀ o, f (deriv f o) = deriv f o :=
@deriv_family_fp unit (λ _, f) unit.star H

theorem is_normal.le_iff_deriv {f} (H : is_normal f) {a} : f a ≤ a ↔ ∃ o, deriv f o = a :=
begin
  unfold deriv,
  rw ←le_iff_deriv_family (λ _ : unit, H),
  exact ⟨λ h _, h, λ h, h unit.star⟩
end

theorem is_normal.fp_iff_deriv {f} (H : is_normal f) {a} : f a = a ↔ ∃ o, deriv f o = a :=
by rw [←H.le_iff_eq, H.le_iff_deriv]

/-- `ordinal.deriv` enumerates the fixed points of a normal function. -/
theorem deriv_eq_enum_ord (H : is_normal f) : deriv f = enum_ord (function.fixed_points f) :=
by { convert deriv_family_eq_enum_ord (λ _ : unit, H), exact (set.Inter_const _).symm }

theorem deriv_eq_id_of_nfp_eq_id {f : ordinal → ordinal} (h : nfp f = id) : deriv f = id :=
(is_normal.eq_iff_zero_and_succ (deriv_is_normal _) is_normal.refl).2 $ by simp [h]

end

/-! ### Fixed points of addition -/

@[simp] theorem nfp_add_zero (a) : nfp ((+) a) 0 = a * omega :=
begin
  simp_rw [←sup_iterate_eq_nfp, ←sup_mul_nat],
  congr, funext,
  induction n with n hn,
  { rw [nat.cast_zero, mul_zero, iterate_zero_apply] },
  { nth_rewrite 1 nat.succ_eq_one_add,
    rw [nat.cast_add, nat.cast_one, mul_one_add, iterate_succ_apply', hn] }
end

theorem nfp_add_eq_mul_omega {a b} (hba : b ≤ a * omega) :
  nfp ((+) a) b = a * omega :=
begin
  apply le_antisymm (nfp_le_fp (add_is_normal a).monotone hba _),
  { rw ←nfp_add_zero,
    exact nfp_monotone (add_is_normal a).monotone (ordinal.zero_le b) },
  { rw [←mul_one_add, one_add_omega] }
end

theorem add_eq_right_iff_mul_omega_le {a b : ordinal} : a + b = b ↔ a * omega ≤ b :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { rw [←nfp_add_zero a, ←deriv_zero],
    cases (add_is_normal a).fp_iff_deriv.1 h with c hc,
    rw ←hc,
    exact (deriv_is_normal _).monotone (ordinal.zero_le _) },
  { have := ordinal.add_sub_cancel_of_le h,
    nth_rewrite 0 ←this,
    rwa [←add_assoc, ←mul_one_add, one_add_omega] }
end

theorem add_le_right_iff_mul_omega_le {a b : ordinal} : a + b ≤ b ↔ a * omega ≤ b :=
by { rw ←add_eq_right_iff_mul_omega_le, exact (add_is_normal a).le_iff_eq }

theorem deriv_add_eq_mul_omega_add (a b : ordinal.{u}) : deriv ((+) a) b = a * omega + b :=
begin
  revert b,
  rw [←funext_iff, is_normal.eq_iff_zero_and_succ (deriv_is_normal _) (add_is_normal _)],
  refine ⟨_, λ a h, _⟩,
  { rw [deriv_zero, add_zero],
    exact nfp_add_zero a },
  { rw [deriv_succ, h, add_succ],
    exact nfp_eq_self (add_eq_right_iff_mul_omega_le.2 ((le_add_right _ _).trans (le_succ _))) }
end

/-! ### Fixed points of multiplication -/

local infixr (name := ordinal.pow) ^ := @pow ordinal ordinal ordinal.has_pow
@[simp] theorem nfp_mul_one {a : ordinal} (ha : 0 < a) : nfp ((*) a) 1 = a ^ omega :=
begin
  rw [←sup_iterate_eq_nfp, ←sup_opow_nat],
  { dsimp, congr, funext,
    induction n with n hn,
    { rw [nat.cast_zero, opow_zero, iterate_zero_apply] },
    nth_rewrite 1 nat.succ_eq_one_add,
    rw [nat.cast_add, nat.cast_one, opow_add, opow_one, iterate_succ_apply', hn] },
  { exact ha }
end

@[simp] theorem nfp_mul_zero (a : ordinal) : nfp ((*) a) 0 = 0 :=
begin
  rw [←ordinal.le_zero, nfp_le_iff],
  intro n,
  induction n with n hn, { refl },
  rwa [iterate_succ_apply, mul_zero]
end

@[simp]

@[simp] theorem deriv_mul_zero : deriv ((*) 0) = id :=
deriv_eq_id_of_nfp_eq_id nfp_zero_mul

theorem nfp_mul_eq_opow_omega {a b : ordinal} (hb : 0 < b) (hba : b ≤ a ^ omega) :
  nfp ((*) a) b = a ^ omega.{u} :=
begin
  cases eq_zero_or_pos a with ha ha,
  { rw [ha, zero_opow omega_ne_zero] at *,
    rw [ordinal.le_zero.1 hba, nfp_zero_mul],
    refl },
  apply le_antisymm,
  { apply nfp_le_fp (mul_is_normal ha).monotone hba,
    rw [←opow_one_add, one_add_omega] },
  rw ←nfp_mul_one ha,
  exact nfp_monotone (mul_is_normal ha).monotone (one_le_iff_pos.2 hb)
end

theorem eq_zero_or_opow_omega_le_of_mul_eq_right {a b : ordinal} (hab : a * b = b) :
  b = 0 ∨ a ^ omega.{u} ≤ b :=
begin
  cases eq_zero_or_pos a with ha ha,
  { rw [ha, zero_opow omega_ne_zero],
    exact or.inr (ordinal.zero_le b) },
  rw or_iff_not_imp_left,
  intro hb,
  change b ≠ 0 at hb,
  rw ←nfp_mul_one ha,
  rw ←one_le_iff_ne_zero at hb,
  exact nfp_le_fp (mul_is_normal ha).monotone hb (le_of_eq hab)
end

theorem mul_eq_right_iff_opow_omega_dvd {a b : ordinal} : a * b = b ↔ a ^ omega ∣ b :=
begin
  cases eq_zero_or_pos a with ha ha,
  { rw [ha, zero_mul, zero_opow omega_ne_zero, zero_dvd_iff],
    exact eq_comm },
  refine ⟨λ hab, _, λ h, _⟩,
  { rw dvd_iff_mod_eq_zero,
    rw [←div_add_mod b (a ^ omega), mul_add, ←mul_assoc, ←opow_one_add, one_add_omega,
      add_left_cancel] at hab,
    cases eq_zero_or_opow_omega_le_of_mul_eq_right hab with hab hab,
    { exact hab },
    refine (not_lt_of_le hab (mod_lt b (opow_ne_zero omega _))).elim,
    rwa ←ordinal.pos_iff_ne_zero },
  cases h with c hc,
  rw [hc, ←mul_assoc, ←opow_one_add, one_add_omega]
end

theorem mul_le_right_iff_opow_omega_dvd {a b : ordinal} (ha : 0 < a) : a * b ≤ b ↔ a ^ omega ∣ b :=
by { rw ←mul_eq_right_iff_opow_omega_dvd, exact (mul_is_normal ha).le_iff_eq }

theorem nfp_mul_opow_omega_add {a c : ordinal} (b) (ha : 0 < a) (hc : 0 < c) (hca : c ≤ a ^ omega) :
  nfp ((*) a) (a ^ omega * b + c) = a ^ omega.{u} * (succ b) :=
begin
  apply le_antisymm,
  { apply nfp_le_fp (mul_is_normal ha).monotone,
    { rw mul_succ,
      apply add_le_add_left hca },
    { rw [←mul_assoc, ←opow_one_add, one_add_omega] } },
  { cases mul_eq_right_iff_opow_omega_dvd.1 ((mul_is_normal ha).nfp_fp (a ^ omega * b + c))
      with d hd,
    rw hd,
    apply mul_le_mul_left',
    have := le_nfp (has_mul.mul a) (a ^ omega * b + c),
    rw hd at this,
    have := (add_lt_add_left hc (a ^ omega * b)).trans_le this,
    rw [add_zero, mul_lt_mul_iff_left (opow_pos omega ha)] at this,
    rwa succ_le_iff }
end

theorem deriv_mul_eq_opow_omega_mul {a : ordinal.{u}} (ha : 0 < a) (b) :
  deriv ((*) a) b = a ^ omega * b :=
begin
  revert b,
  rw [←funext_iff,
    is_normal.eq_iff_zero_and_succ (deriv_is_normal _) (mul_is_normal (opow_pos omega ha))],
  refine ⟨_, λ c h, _⟩,
  { rw [deriv_zero, nfp_mul_zero, mul_zero] },
  { rw [deriv_succ, h],
    exact nfp_mul_opow_omega_add c ha zero_lt_one (one_le_iff_pos.2 (opow_pos _ ha)) },
end

end ordinal


import MyNat.Definition
namespace MyNat
open MyNat
/-!
# Advanced proposition world.

## Level 10: the law of the excluded middle.

We proved earlier that `(P → Q) → (¬ Q → ¬ P)`. The converse,
that `(¬ Q → ¬ P) → (P → Q)` is certainly true, but trying to prove
it using what we've learnt so far is impossible (because it is not provable in
constructive logic). For example, after

```
intro h
intro p
repeat rw [not_iff_imp_false] at h
```

in the below, you are left with
```
P Q : Prop,
h : (Q → false) → P → false
p : P
⊢ Q
```

The tools you have are not sufficient to continue. But you can just prove this, and any other basic
lemmas of this form like `¬ ¬ P → P`, using the [`by_cases` tactic](../Tactics/by_cases.lean.md). Here we start with the usual
`intros` to turn the implication into hypotheses `h : ¬ Q → ¬ P` and `p : P` which leaves with the
goal of `⊢ Q`.  But how can you prove `Q` using these hypotheses?  You can use this tactic:

`by_cases q : Q`

This creates two sub-goals `pos` and `neg` with the first one assuming Q is true - which can easily
satisfy the goal! and the second one assuming Q is false. But how can `h: ¬Q → ¬P`, `p: P`, `q: ¬Q`
prove the goal `⊢ Q` ? Well if you apply `q` to the hypothesis `h` you end up with the conclusion
`¬ P`, but then you have a contradiction in your hypotheses saying `P` and `¬ P` which the
[`contradiction` tactic](../Tactics/contradiction.lean.md) can take care of.

The `contradiction` tactic closes the main goal if its hypotheses
are "trivially contradictory".

## Lemma
If `P` and `Q` are true/false statements, then
`(¬ Q ⟹ ¬ P) ⟹ (P ⟹ Q).`
-/
lemma contrapositive2 (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) := by
  intro h
  intro p
  by_cases q : Q
  exact q
  have np := h q
  contradiction
/-!

OK that's enough logic -- now perhaps it's time to go on to [Advanced Addition World](../AdvancedAdditionWorld.lean.md)!

## Pro tip

In fact the [tactic `tauto!`](../Tactics/tauto.lean.md) just kills this goal (and many other logic goals) immediately.

Each of these can now be proved using `intro`, `apply`, `exact` and `exfalso`.
Remember though that in these simple logic cases, high-powered logic
tactics like `tauto!` will just prove everything.

-/


/-
Copyright (c) 2021 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import analysis.normed_space.ordered
import analysis.asymptotics.asymptotics

/-!
# A collection of specific asymptotic results

This file contains specific lemmas about asymptotics which don't have their place in the general
theory developped in `analysis.asymptotics.asymptotics`.
-/

open filter asymptotics
open_locale topological_space

section normed_field

/-- If `f : 𝕜 → E` is bounded in a punctured neighborhood of `a`, then `f(x) = o((x - a)⁻¹)` as
`x → a`, `x ≠ a`. -/
lemma filter.is_bounded_under.is_o_sub_self_inv {𝕜 E : Type*} [normed_field 𝕜] [has_norm E]
  {a : 𝕜} {f : 𝕜 → E} (h : is_bounded_under (≤) (𝓝[≠] a) (norm ∘ f)) :
  f =o[𝓝[≠] a] (λ x, (x - a)⁻¹) :=
begin
  refine (h.is_O_const (@one_ne_zero ℝ _ _)).trans_is_o (is_o_const_left.2 $ or.inr _),
  simp only [(∘), norm_inv],
  exact (tendsto_norm_sub_self_punctured_nhds a).inv_tendsto_zero
end

end normed_field

section linear_ordered_field

variables {𝕜 : Type*} [linear_ordered_field 𝕜]

lemma pow_div_pow_eventually_eq_at_top {p q : ℕ} :
  (λ x : 𝕜, x^p / x^q) =ᶠ[at_top] (λ x, x^((p : ℤ) -q)) :=
begin
  apply ((eventually_gt_at_top (0 : 𝕜)).mono (λ x hx, _)),
  simp [zpow_sub₀ hx.ne'],
end

lemma pow_div_pow_eventually_eq_at_bot {p q : ℕ} :
  (λ x : 𝕜, x^p / x^q) =ᶠ[at_bot] (λ x, x^((p : ℤ) -q)) :=
begin
  apply ((eventually_lt_at_bot (0 : 𝕜)).mono (λ x hx, _)),
  simp [zpow_sub₀ hx.ne],
end

lemma tendsto_zpow_at_top_at_top {n : ℤ}
  (hn : 0 < n) : tendsto (λ x : 𝕜, x^n) at_top at_top :=
begin
  lift n to ℕ using hn.le,
  simp only [zpow_coe_nat],
  exact tendsto_pow_at_top (nat.succ_le_iff.mpr $ int.coe_nat_pos.mp hn)
end

lemma tendsto_pow_div_pow_at_top_at_top {p q : ℕ}
  (hpq : q < p) : tendsto (λ x : 𝕜, x^p / x^q) at_top at_top :=
begin
  rw tendsto_congr' pow_div_pow_eventually_eq_at_top,
  apply tendsto_zpow_at_top_at_top,
  linarith
end

lemma tendsto_pow_div_pow_at_top_zero [topological_space 𝕜] [order_topology 𝕜] {p q : ℕ}
  (hpq : p < q) : tendsto (λ x : 𝕜, x^p / x^q) at_top (𝓝 0) :=
begin
  rw tendsto_congr' pow_div_pow_eventually_eq_at_top,
  apply tendsto_zpow_at_top_zero,
  linarith
end

end linear_ordered_field

section normed_linear_ordered_field

variables {𝕜 : Type*} [normed_linear_ordered_field 𝕜]

lemma asymptotics.is_o_pow_pow_at_top_of_lt
  [order_topology 𝕜] {p q : ℕ} (hpq : p < q) :
  (λ x : 𝕜, x^p) =o[at_top] (λ x, x^q) :=
begin
  refine (is_o_iff_tendsto' _).mpr (tendsto_pow_div_pow_at_top_zero hpq),
  exact (eventually_gt_at_top 0).mono (λ x hx hxq, (pow_ne_zero q hx.ne' hxq).elim),
end

lemma asymptotics.is_O.trans_tendsto_norm_at_top {α : Type*} {u v : α → 𝕜} {l : filter α}
  (huv : u =O[l] v) (hu : tendsto (λ x, ∥u x∥) l at_top) : tendsto (λ x, ∥v x∥) l at_top :=
begin
  rcases huv.exists_pos with ⟨c, hc, hcuv⟩,
  rw is_O_with at hcuv,
  convert tendsto.at_top_div_const hc (tendsto_at_top_mono' l hcuv hu),
  ext x,
  rw mul_div_cancel_left _ hc.ne.symm,
end

end normed_linear_ordered_field

section real

open_locale big_operators
open finset

lemma asymptotics.is_o.sum_range {α : Type*} [normed_group α]
  {f : ℕ → α} {g : ℕ → ℝ} (h : f =o[at_top] g)
  (hg : 0 ≤ g) (h'g : tendsto (λ n, ∑ i in range n, g i) at_top at_top) :
  (λ n, ∑ i in range n, f i) =o[at_top] (λ n, ∑ i in range n, g i) :=
begin
  have A : ∀ i, ∥g i∥ = g i := λ i, real.norm_of_nonneg (hg i),
  have B : ∀ n, ∥∑ i in range n, g i∥ = ∑ i in range n, g i,
    from λ n, by rwa [real.norm_eq_abs, abs_sum_of_nonneg'],
  apply is_o_iff.2 (λ ε εpos, _),
  obtain ⟨N, hN⟩ : ∃ (N : ℕ), ∀ (b : ℕ), N ≤ b → ∥f b∥ ≤ ε / 2 * g b,
    by simpa only [A, eventually_at_top] using is_o_iff.mp h (half_pos εpos),
  have : (λ (n : ℕ), ∑ i in range N, f i) =o[at_top] (λ (n : ℕ), ∑ i in range n, g i),
  { apply is_o_const_left.2,
    exact or.inr (h'g.congr (λ n, (B n).symm)) },
  filter_upwards [is_o_iff.1 this (half_pos εpos), Ici_mem_at_top N] with n hn Nn,
  calc ∥∑ i in range n, f i∥
  = ∥∑ i in range N, f i + ∑ i in Ico N n, f i∥ :
    by rw sum_range_add_sum_Ico _ Nn
  ... ≤ ∥∑ i in range N, f i∥ + ∥∑ i in Ico N n, f i∥ :
    norm_add_le _ _
  ... ≤ ∥∑ i in range N, f i∥ + ∑ i in Ico N n, (ε / 2) * g i :
    add_le_add le_rfl (norm_sum_le_of_le _ (λ i hi, hN _ (mem_Ico.1 hi).1))
  ... ≤ ∥∑ i in range N, f i∥ + ∑ i in range n, (ε / 2) * g i :
    begin
      refine add_le_add le_rfl _,
      apply sum_le_sum_of_subset_of_nonneg,
      { rw range_eq_Ico,
        exact Ico_subset_Ico (zero_le _) le_rfl },
      { assume i hi hident,
        exact mul_nonneg (half_pos εpos).le (hg i) }
    end
  ... ≤ (ε / 2) * ∥∑ i in range n, g i∥ + (ε / 2) * (∑ i in range n, g i) :
    begin
      rw ← mul_sum,
      exact add_le_add hn (mul_le_mul_of_nonneg_left le_rfl (half_pos εpos).le),
    end
  ... = ε * ∥(∑ i in range n, g i)∥ : by { simp [B], ring }
end

lemma asymptotics.is_o_sum_range_of_tendsto_zero {α : Type*} [normed_group α]
  {f : ℕ → α} (h : tendsto f at_top (𝓝 0)) :
  (λ n, ∑ i in range n, f i) =o[at_top] (λ n, (n : ℝ)) :=
begin
  have := ((is_o_one_iff ℝ).2 h).sum_range (λ i, zero_le_one),
  simp only [sum_const, card_range, nat.smul_one_eq_coe] at this,
  exact this tendsto_coe_nat_at_top_at_top
end

/-- The Cesaro average of a converging sequence converges to the same limit. -/
lemma filter.tendsto.cesaro_smul {E : Type*} [normed_group E] [normed_space ℝ E]
  {u : ℕ → E} {l : E} (h : tendsto u at_top (𝓝 l)) :
  tendsto (λ (n : ℕ), (n ⁻¹ : ℝ) • (∑ i in range n, u i)) at_top (𝓝 l) :=
begin
  rw [← tendsto_sub_nhds_zero_iff, ← is_o_one_iff ℝ],
  have := asymptotics.is_o_sum_range_of_tendsto_zero (tendsto_sub_nhds_zero_iff.2 h),
  apply ((is_O_refl (λ (n : ℕ), (n : ℝ) ⁻¹) at_top).smul_is_o this).congr' _ _,
  { filter_upwards [Ici_mem_at_top 1] with n npos,
    have nposℝ : (0 : ℝ) < n := nat.cast_pos.2 npos,
    simp only [smul_sub, sum_sub_distrib, sum_const, card_range, sub_right_inj],
    rw [nsmul_eq_smul_cast ℝ, smul_smul, inv_mul_cancel nposℝ.ne', one_smul] },
  { filter_upwards [Ici_mem_at_top 1] with n npos,
    have nposℝ : (0 : ℝ) < n := nat.cast_pos.2 npos,
    rw [algebra.id.smul_eq_mul, inv_mul_cancel nposℝ.ne'] }
end

/-- The Cesaro average of a converging sequence converges to the same limit. -/
lemma filter.tendsto.cesaro {u : ℕ → ℝ} {l : ℝ} (h : tendsto u at_top (𝓝 l)) :
  tendsto (λ (n : ℕ), (n ⁻¹ : ℝ) * (∑ i in range n, u i)) at_top (𝓝 l) :=
h.cesaro_smul

end real


namespace mth1001

namespace myreal

section comm_group

class comm_group (R : Type*) :=
(add : R → R → R)
(zero : R)
(neg : R → R)
(add_comm : ∀ a b : R, add a b = add b a)
(add_assoc : ∀ a b c : R, add (add a b) c = add a (add b c))
(add_zero : ∀ a : R, add a zero = a)
(add_inv : ∀ a : R, add a (neg a) = zero)

variables {R : Type*} [comm_group R]

instance : has_add R := ⟨comm_group.add⟩
instance : has_zero R := ⟨comm_group.zero⟩
instance : has_neg R := ⟨comm_group.neg⟩

def sub (x y : R) := x + (-y)

instance : has_sub R := ⟨sub⟩

end comm_group

class myfield (R : Type*) extends comm_group R:=
(mul : R → R → R)
(mul_comm : ∀ a b : R, mul a b = mul b a)
(mul_assoc : ∀ a b c : R, mul (mul a b) c = mul a (mul b c))
(one : R)
(mul_one : ∀ a : R, mul a one = a)
(inv : R → R)
(mul_inv : ∀ a : R, a ≠ 0 → mul a (inv a) = one)
(mul_add : ∀ a b c : R, mul a (b + c) = mul a  b + mul a c)
(zero_ne_one : (0 : R) ≠ (one : R))

variables {R : Type} [myfield R]

instance : has_mul R := ⟨myfield.mul⟩
instance : has_one R := ⟨myfield.one⟩
instance : has_inv R := ⟨myfield.inv⟩

def of_nat : ℕ → R
| 0            := (0 : R)
| (nat.succ x) := (of_nat x) + 1

instance : has_coe ℕ R := ⟨of_nat⟩

lemma coe_nat_succ (n : ℕ) : ((nat.succ n) : R) = (n : R) + (1 : R) := rfl

end myreal

end mth1001


-- Examples of Propositional Validities

open classical

variables p q r : Prop

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
iff.intro
  (assume h : p ∧ (q ∨ r),
    have hp : p, from h.left,
    or.elim (h.right)
    (assume hq : q,
      show (p ∧ q) ∨ (p ∧ r), from or.inl ⟨hp, hq⟩)
    (assume hr : r,
      show (p ∧ q) ∨ (p ∧ r), from or.inr ⟨hp, hr⟩))
  (assume h : p ∧ q ∨ p ∧ r,
      show p ∧ (q ∨ r), from
        or.elim h
        (assume hpq : p ∧ q,
          show p ∧ (q ∨ r), from ⟨hpq.left, or.inl hpq.right⟩)
        (assume hpr : p ∧ r,
          show p ∧ (q ∨ r), from ⟨hpr.left, or.inr hpr.right⟩))

-- an example that requires classical thinking
example : ¬ (p ∧ ¬ q) → (p → q) :=
assume h : ¬ (p ∧ ¬ q),
assume hp : p,
show q, from
  or.elim (em q)
    (assume hq : q, hq)
    (assume hnq : ¬ q, false.elim (h (and.intro hp hnq)))


/-
Copyright (c) 2022 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying, Bhavik Mehta

! This file was ported from Lean 3 source module probability.cond_count
! leanprover-community/mathlib commit 117e93f82b5f959f8193857370109935291f0cc4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Probability.ConditionalProbability

/-!
# Classical probability

The classical formulation of probability states that the probability of an event occurring in a
finite probability space is the ratio of that event to all possible events.
This notion can be expressed with measure theory using
the counting measure. In particular, given the sets `s` and `t`, we define the probability of `t`
occuring in `s` to be `|s|⁻¹ * |s ∩ t|`. With this definition, we recover the the probability over
the entire sample space when `s = set.univ`.

Classical probability is often used in combinatorics and we prove some useful lemmas in this file
for that purpose.

## Main definition

* `probability_theory.cond_count`: given a set `s`, `cond_count s` is the counting measure
  conditioned on `s`. This is a probability measure when `s` is finite and nonempty.

## Notes

The original aim of this file is to provide a measure theoretic method of describing the
probability an element of a set `s` satisfies some predicate `P`. Our current formulation still
allow us to describe this by abusing the definitional equality of sets and predicates by simply
writing `cond_count s P`. We should avoid this however as none of the lemmas are written for
predicates.
-/

noncomputable section

open ProbabilityTheory

open MeasureTheory MeasurableSpace

namespace ProbabilityTheory

variable {Ω : Type _} [MeasurableSpace Ω]

/-- Given a set `s`, `cond_count s` is the counting measure conditioned on `s`. In particular,
`cond_count s t` is the proportion of `s` that is contained in `t`.

This is a probability measure when `s` is finite and nonempty and is given by
`probability_theory.cond_count_is_probability_measure`. -/
def condCount (s : Set Ω) : Measure Ω :=
  Measure.count[|s]
#align probability_theory.cond_count ProbabilityTheory.condCount

@[simp]
theorem condCount_empty_meas : (condCount ∅ : Measure Ω) = 0 := by simp [cond_count]
#align probability_theory.cond_count_empty_meas ProbabilityTheory.condCount_empty_meas

theorem condCount_empty {s : Set Ω} : condCount s ∅ = 0 := by simp
#align probability_theory.cond_count_empty ProbabilityTheory.condCount_empty

theorem finite_of_condCount_ne_zero {s t : Set Ω} (h : condCount s t ≠ 0) : s.Finite :=
  by
  by_contra hs'
  simpa [cond_count, cond, measure.count_apply_infinite hs'] using h
#align probability_theory.finite_of_cond_count_ne_zero ProbabilityTheory.finite_of_condCount_ne_zero

theorem condCount_univ [Fintype Ω] {s : Set Ω} :
    condCount Set.univ s = Measure.count s / Fintype.card Ω :=
  by
  rw [cond_count, cond_apply _ MeasurableSet.univ, ← ENNReal.div_eq_inv_mul, Set.univ_inter]
  congr
  rw [← Finset.coe_univ, measure.count_apply, finset.univ.tsum_subtype' fun _ => (1 : ENNReal)]
  · simp [Finset.card_univ]
  · exact (@Finset.coe_univ Ω _).symm ▸ MeasurableSet.univ
#align probability_theory.cond_count_univ ProbabilityTheory.condCount_univ

variable [MeasurableSingletonClass Ω]

theorem condCountIsProbabilityMeasure {s : Set Ω} (hs : s.Finite) (hs' : s.Nonempty) :
    IsProbabilityMeasure (condCount s) :=
  {
    measure_univ :=
      by
      rw [cond_count, cond_apply _ hs.measurable_set, Set.inter_univ, ENNReal.inv_mul_cancel]
      · exact fun h => hs'.ne_empty <| measure.empty_of_count_eq_zero h
      · exact (measure.count_apply_lt_top.2 hs).Ne }
#align probability_theory.cond_count_is_probability_measure ProbabilityTheory.condCountIsProbabilityMeasure

theorem condCount_singleton (ω : Ω) (t : Set Ω) [Decidable (ω ∈ t)] :
    condCount {ω} t = if ω ∈ t then 1 else 0 :=
  by
  rw [cond_count, cond_apply _ (measurable_set_singleton ω), measure.count_singleton, inv_one,
    one_mul]
  split_ifs
  · rw [(by simpa : ({ω} : Set Ω) ∩ t = {ω}), measure.count_singleton]
  · rw [(by simpa : ({ω} : Set Ω) ∩ t = ∅), measure.count_empty]
#align probability_theory.cond_count_singleton ProbabilityTheory.condCount_singleton

variable {s t u : Set Ω}

theorem condCount_inter_self (hs : s.Finite) : condCount s (s ∩ t) = condCount s t := by
  rw [cond_count, cond_inter_self _ hs.measurable_set]
#align probability_theory.cond_count_inter_self ProbabilityTheory.condCount_inter_self

theorem condCount_self (hs : s.Finite) (hs' : s.Nonempty) : condCount s s = 1 :=
  by
  rw [cond_count, cond_apply _ hs.measurable_set, Set.inter_self, ENNReal.inv_mul_cancel]
  · exact fun h => hs'.ne_empty <| measure.empty_of_count_eq_zero h
  · exact (measure.count_apply_lt_top.2 hs).Ne
#align probability_theory.cond_count_self ProbabilityTheory.condCount_self

theorem condCount_eq_one_of (hs : s.Finite) (hs' : s.Nonempty) (ht : s ⊆ t) : condCount s t = 1 :=
  by
  haveI := cond_count_is_probability_measure hs hs'
  refine' eq_of_le_of_not_lt prob_le_one _
  rw [not_lt, ← cond_count_self hs hs']
  exact measure_mono ht
#align probability_theory.cond_count_eq_one_of ProbabilityTheory.condCount_eq_one_of

theorem pred_true_of_condCount_eq_one (h : condCount s t = 1) : s ⊆ t :=
  by
  have hsf :=
    finite_of_cond_count_ne_zero
      (by
        rw [h]
        exact one_ne_zero)
  rw [cond_count, cond_apply _ hsf.measurable_set, mul_comm] at h
  replace h := ENNReal.eq_inv_of_mul_eq_one_left h
  rw [inv_inv, measure.count_apply_finite _ hsf, measure.count_apply_finite _ (hsf.inter_of_left _),
    Nat.cast_inj] at h
  suffices s ∩ t = s by exact this ▸ fun x hx => hx.2
  rw [← @Set.Finite.toFinset_inj _ _ _ (hsf.inter_of_left _) hsf]
  exact Finset.eq_of_subset_of_card_le (Set.Finite.toFinset_mono <| s.inter_subset_left t) h.ge
#align probability_theory.pred_true_of_cond_count_eq_one ProbabilityTheory.pred_true_of_condCount_eq_one

theorem condCount_eq_zero_iff (hs : s.Finite) : condCount s t = 0 ↔ s ∩ t = ∅ := by
  simp [cond_count, cond_apply _ hs.measurable_set, measure.count_apply_eq_top,
    Set.not_infinite.2 hs, measure.count_apply_finite _ (hs.inter_of_left _)]
#align probability_theory.cond_count_eq_zero_iff ProbabilityTheory.condCount_eq_zero_iff

theorem condCount_of_univ (hs : s.Finite) (hs' : s.Nonempty) : condCount s Set.univ = 1 :=
  condCount_eq_one_of hs hs' s.subset_univ
#align probability_theory.cond_count_of_univ ProbabilityTheory.condCount_of_univ

theorem condCount_inter (hs : s.Finite) :
    condCount s (t ∩ u) = condCount (s ∩ t) u * condCount s t :=
  by
  by_cases hst : s ∩ t = ∅
  ·
    rw [hst, cond_count_empty_meas, measure.coe_zero, Pi.zero_apply, MulZeroClass.zero_mul,
      cond_count_eq_zero_iff hs, ← Set.inter_assoc, hst, Set.empty_inter]
  rw [cond_count, cond_count, cond_apply _ hs.measurable_set, cond_apply _ hs.measurable_set,
    cond_apply _ (hs.inter_of_left _).MeasurableSet, mul_comm _ (measure.count (s ∩ t)), ←
    mul_assoc, mul_comm _ (measure.count (s ∩ t)), ← mul_assoc, ENNReal.mul_inv_cancel, one_mul,
    mul_comm, Set.inter_assoc]
  · rwa [← measure.count_eq_zero_iff] at hst
  · exact (measure.count_apply_lt_top.2 <| hs.inter_of_left _).Ne
#align probability_theory.cond_count_inter ProbabilityTheory.condCount_inter

theorem condCount_inter' (hs : s.Finite) :
    condCount s (t ∩ u) = condCount (s ∩ u) t * condCount s u :=
  by
  rw [← Set.inter_comm]
  exact cond_count_inter hs
#align probability_theory.cond_count_inter' ProbabilityTheory.condCount_inter'

theorem condCount_union (hs : s.Finite) (htu : Disjoint t u) :
    condCount s (t ∪ u) = condCount s t + condCount s u :=
  by
  rw [cond_count, cond_apply _ hs.measurable_set, cond_apply _ hs.measurable_set,
    cond_apply _ hs.measurable_set, Set.inter_union_distrib_left, measure_union, mul_add]
  exacts[htu.mono inf_le_right inf_le_right, (hs.inter_of_left _).MeasurableSet]
#align probability_theory.cond_count_union ProbabilityTheory.condCount_union

theorem condCount_compl (t : Set Ω) (hs : s.Finite) (hs' : s.Nonempty) :
    condCount s t + condCount s (tᶜ) = 1 := by
  rw [← cond_count_union hs disjoint_compl_right, Set.union_compl_self,
    (cond_count_is_probability_measure hs hs').measure_univ]
#align probability_theory.cond_count_compl ProbabilityTheory.condCount_compl

theorem condCount_disjoint_union (hs : s.Finite) (ht : t.Finite) (hst : Disjoint s t) :
    condCount s u * condCount (s ∪ t) s + condCount t u * condCount (s ∪ t) t =
      condCount (s ∪ t) u :=
  by
  rcases s.eq_empty_or_nonempty with (rfl | hs') <;> rcases t.eq_empty_or_nonempty with (rfl | ht')
  · simp
  · simp [cond_count_self ht ht']
  · simp [cond_count_self hs hs']
  rw [cond_count, cond_count, cond_count, cond_apply _ hs.measurable_set,
    cond_apply _ ht.measurable_set, cond_apply _ (hs.union ht).MeasurableSet,
    cond_apply _ (hs.union ht).MeasurableSet, cond_apply _ (hs.union ht).MeasurableSet]
  conv_lhs =>
    rw [Set.union_inter_cancel_left, Set.union_inter_cancel_right,
      mul_comm (measure.count (s ∪ t))⁻¹, mul_comm (measure.count (s ∪ t))⁻¹, ← mul_assoc, ←
      mul_assoc, mul_comm _ (measure.count s), mul_comm _ (measure.count t), ← mul_assoc, ←
      mul_assoc]
  rw [ENNReal.mul_inv_cancel, ENNReal.mul_inv_cancel, one_mul, one_mul, ← add_mul, ← measure_union,
    Set.union_inter_distrib_right, mul_comm]
  exacts[hst.mono inf_le_left inf_le_left, (ht.inter_of_left _).MeasurableSet,
    measure.count_ne_zero ht', (measure.count_apply_lt_top.2 ht).Ne, measure.count_ne_zero hs',
    (measure.count_apply_lt_top.2 hs).Ne]
#align probability_theory.cond_count_disjoint_union ProbabilityTheory.condCount_disjoint_union

/-- A version of the law of total probability for counting probabilites. -/
theorem condCount_add_compl_eq (u t : Set Ω) (hs : s.Finite) :
    condCount (s ∩ u) t * condCount s u + condCount (s ∩ uᶜ) t * condCount s (uᶜ) = condCount s t :=
  by
  conv_rhs =>
    rw [(by simp : s = s ∩ u ∪ s ∩ uᶜ), ←
      cond_count_disjoint_union (hs.inter_of_left _) (hs.inter_of_left _)
        (disjoint_compl_right.mono inf_le_right inf_le_right)]
  simp [cond_count_inter_self hs]
#align probability_theory.cond_count_add_compl_eq ProbabilityTheory.condCount_add_compl_eq

end ProbabilityTheory


import linear_algebra.dual

variables {K V : Type*} [field K] [add_comm_group V] [module K V]

open module

namespace submodule

def map_to_dual_mod (H : submodule K (dual K V)) :
  H →ₗ[K] dual K (V ⧸ H.dual_annihilator_comap) :=
{ to_fun := λ h, submodule.liftq _ (h : dual K V) (λ x hx, begin
    rw mem_dual_annihilator_comap_iff at hx,
    apply hx _ h.2,
  end),
  map_add' := by tidy,
  map_smul' := by tidy }

@[simp]
lemma map_to_dual_mod_apply (H : submodule K (dual K V)) (f : H) (v : V) :
  H.map_to_dual_mod f (H.dual_annihilator_comap.mkq v) = (f : dual K V) v := rfl

lemma map_to_dual_mod_injective (H : submodule K (dual K V)) :
  function.injective H.map_to_dual_mod :=
begin
  intros f g h,
  ext v,
  apply_fun (λ e, e (H.dual_annihilator_comap.mkq v)) at h,
  exact h
end

section finite_dimensional

open finite_dimensional

variables [finite_dimensional K V]

lemma finrank_dual_mod (H : submodule K (dual K V)) :
  finrank K (dual K (V ⧸ H.dual_annihilator_comap)) = finrank K H :=
begin
  let J : subspace K (dual K V) := H,
  rw [subspace.dual_finrank_eq],
  have := H.dual_annihilator_comap.finrank_quotient_add_finrank,
  rw ← J.finrank_add_finrank_dual_annihilator_comap_eq at this,
  exact nat.add_right_cancel this,
end

noncomputable
def equiv_to_dual_mod (H : submodule K (dual K V)) :
  H ≃ₗ[K] dual K (V ⧸ H.dual_annihilator_comap) :=
H.map_to_dual_mod.linear_equiv_of_injective H.map_to_dual_mod_injective H.finrank_dual_mod.symm

@[simp]
lemma equiv_to_dual_mod_apply_apply (H : submodule K (dual K V)) (h : H) (v : V) :
  H.equiv_to_dual_mod h (H.dual_annihilator_comap.mkq v) = (h : dual K V) v := rfl

@[simp]
lemma equiv_to_dual_mod_symm_apply_apply (H : submodule K (dual K V))
  (f : dual K (V ⧸ H.dual_annihilator_comap)) (v : V) :
(H.equiv_to_dual_mod.symm f : dual K V) v = f (H.dual_annihilator_comap.mkq v) :=
begin
  rw ← equiv_to_dual_mod_apply_apply, simp,
end

@[simp]
lemma equiv_to_dual_mod_symm_apply (H : submodule K (dual K V))
  (f : dual K (V ⧸ H.dual_annihilator_comap)) :
  (H.equiv_to_dual_mod.symm f : dual K V) = linear_map.comp f H.dual_annihilator_comap.mkq :=
by { ext, simp }

lemma mem_iff_dual_annihilator_comap (H : submodule K (dual K V))
  (f : dual K V) : f ∈ H ↔ ∀ (a : V) (ha : a ∈ H.dual_annihilator_comap), f a = 0 :=
begin
  split,
  { intros hf a ha, rw mem_dual_annihilator_comap_iff at ha, exact ha _ hf, },
  { intros h,
    let g : dual K (V ⧸ H.dual_annihilator_comap) := H.dual_annihilator_comap.liftq f h,
    let e := H.equiv_to_dual_mod.symm g,
    convert e.2, ext, simp }
end

end finite_dimensional

end submodule


import lib.tactics
import lib.sets
import lib.nat
import lib.lists

namespace problem1

def problem : ℕ :=
  set_sum { n | (3 ∣ n ∨ 5 ∣ n) ∧ n < 1000 }

def sum_to (n : ℕ) := n * (n + 1) / 2

def sum_mult_below (n : ℕ) (m : ℕ) := sum_to ((m - 1) / n) * n

def sum_mult35_below (m : ℕ) :=
  sum_mult_below 3 m
    + sum_mult_below 5 m
    - sum_mult_below 15 m

example : sum_mult35_below 10 = 23 := rfl

def solution := sum_mult35_below 1000

lemma sum_to_suc {n} : sum_to (n + 1) = n + 1 + sum_to n := begin
  delta sum_to,
  have h₁ := by calc
     (n + 1) * (n + 1 + 1) / 2 = (n + 1) * (n + 2) / 2 : by simp
     ... = (n * n + n * 3 + 2) / 2 : by { simp, ring },
  have h₂ := by calc
    n + 1 + n * (n + 1) / 2 = (n + 1) + n * (n + 1) / 2 : by simp
    ... = (n + 1) * (1 + 1) / (1 + 1) + n * (n + 1) / 2 : by rw [←nat_mul_div_eq 1 (n + 1)]
    ... = ((n + 1) * 2 + n * (n + 1)) / 2 : by simp [mul_distrib_of_dvd, dvd_mul, mul_suc_even]
    ... = (n * 2 + 1 * 2 + n * n + n * 1) / 2 : by simp [nat.left_distrib, nat.right_distrib]
    ... = (n * n + n * 3 + 2) / 2 : by { simp, ring },
  rw [h₁, h₂]
end

lemma sum_to_eq_sum_iota {n} : sum_to n = list.sum (list.iota n) := begin
  induction n with n ih,
  { refl },
  { rw [sum_to_suc, ih, iota_succ, sum_cons] }
end

lemma filter_and {T} {p q : T → Prop} [decidable_pred p] [decidable_pred q] {xs : list T} : list.filter (λ x, (p x ∧ q x)) xs = list.filter p (list.filter q xs) := begin
  sorry
end

lemma set_sum_of_sum_mult_below {d k : ℕ} : sum_mult_below d k = set_sum {n | d ∣ n ∧ n < k} := begin
  delta set_sum,
  delta sum_mult_below,
  unfold has_upper_bound.ub,
  rw [sum_to_eq_sum_iota],
  rw [sum_map_of_sum_mul],
  refine congr rfl _,
  generalize h : (k - 1) / d = m,
  induction m,
  { simp, sorry },
  { sorry }
end

theorem proof : problem = solution := begin
  delta problem solution,
  delta sum_mult35_below,
  sorry
end

end problem1


import game.world9.level2 -- hide
namespace mynat -- hide

/-
# Advanced Multiplication World

## Level 3: `mul_eq_zero_iff`

Now you have `eq_zero_or_eq_zero_of_mul_eq_zero` this is pretty straightforward.
-/

/- Theorem
$ab = 0$, if and only if at least one of $a$ or $b$ is equal to zero.
-/
theorem mul_eq_zero_iff (a b : mynat): a * b = 0 ↔ a = 0 ∨ b = 0 :=
begin [nat_num_game]
  split,
    swap,
    intro hab,
    cases hab,
      rw hab,
      rw zero_mul,
      refl,
    rw hab,
    rw mul_zero,
    refl,
  intro h,
  exact eq_zero_or_eq_zero_of_mul_eq_zero a b h,

end

end mynat -- hide


import ..fglib
import ..basic
import .vector
import .square_matrix

namespace FG

/-
  ## Invertible Matrix

  Defined as a subtype of `square_matrix`.
-/
def invertible_matrix (n : ℕ) :=
  { A : square_matrix n // A.is_invertible }
-- Alternative:
  -- {A : square_matrix n // A.det ≠ 0}

namespace invertible_matrix

variables {n : ℕ} (A : invertible_matrix n)

@[ext] theorem ext (A B : invertible_matrix n) :
  A.val = B.val → A = B :=
begin
  intro h,
  cases' A with A,
  cases' B with B,
  simp at *,
  exact h
end

@[simp] def det : ℂ := A.val.det

@[simp] lemma det_ne_zero :
  A.det ≠ 0 :=
A.val.invertible_det_ne_zero A.property

-- /-
--   I used to se `classical.some` to get the inverse matrix.
--   It was actually computable but too complicated to implement here.
--   So were the definitions of `group` and `similarity_transformation` (in `matrix_representation`), etc.
--  -/
-- @[simp] noncomputable def inv (A : invertible_matrix n) :
--   invertible_matrix n :=
-- begin
--   cases' A with A,
--   let B := classical.some property,
--   have hB := classical.some_spec property,
--   have h : ∃A, A * B = 1 := begin
--     use A,
--     have h₁ : B * A = 1 → A * B = 1 := sorry,
--     rw h₁,
--     -- rw square_matrix.inv_assoc B A,
--     exact hB
--   end,
--   use ⟨B, h⟩
-- end

/- Now just use `A.val.inverse (A.det ≠ 0)` -/
@[simp] noncomputable def inv (A : invertible_matrix n) :
  invertible_matrix n :=
⟨ A.val.inverse A.det_ne_zero,
  begin
    let invA := A.val.inverse A.det_ne_zero,
    apply square_matrix.det_ne_zero_invertible,
    have h : A.val.det ≠ 0 := A.det_ne_zero,
    have h₂ := by calc invA.det * A.val.det = (invA * A.val).det
        : (matrix.det_mul invA A.val).symm
      ... = (1 : square_matrix n).det
        : by rw A.val.mul_inverse_left
      ... ≠ 0
        : by simp,
    have h₃ : invA.det ≠ 0 := (ne_zero_and_ne_zero_of_mul h₂).left,
    exact h₃
  end ⟩

@[simp] lemma mul_invertible (A B : invertible_matrix n) :
  (A.val * B.val).is_invertible :=
square_matrix.det_ne_zero_invertible (A.val * B.val) (by calc
  (A.val * B.val).det = A.val.det * B.val.det
    : matrix.det_mul A.val B.val
  ... ≠ (0 : ℂ)
    : mul_ne_zero (det_ne_zero A) (det_ne_zero B))

@[simps] def mul (A B : invertible_matrix n) : invertible_matrix n :=
  ⟨A.val * B.val, mul_invertible A B⟩

@[simps] def one : invertible_matrix n :=
  ⟨1, (1 : square_matrix n).det_ne_zero_invertible
    (ne_zero_of_eq_one square_matrix.det_one)⟩

@[simps] def I : invertible_matrix n := one

@[simp] protected lemma mul_left_inv :
  A.inv.mul A = one :=
begin
  apply ext,
  apply A.val.mul_inverse_left,
  apply A.val.invertible_det_ne_zero,
  exact A.property
end

/-
  This group of `n×n` invertible matrices is called
  **General Linear Group** over the field of complex numbers,
  and is a complex **Lie Group** of complex dimention `n²`.
-/
@[simps] noncomputable instance : group (invertible_matrix n) :=
{ mul := mul,
  one := one,
  mul_assoc := λA B C, begin
    apply ext,
    simp,
    apply square_matrix.ring.mul_assoc
  end,
  one_mul := begin
    intro a,
    apply ext,
    simp [square_matrix.ring.one_mul]
  end,
  mul_one := begin
    intro a,
    apply ext,
    simp
  end,
  inv := inv,
  mul_left_inv := invertible_matrix.mul_left_inv }

@[simp] def mul_vec (v : vec n) :
  vec n :=
A.val.mul_vec v

/- `invertible_matrix` is not a `ring`, which means it is not a `module` over `vec n`. -/

@[simp] def to_linear_operator :
  linear_operator ℂ (vec n) :=
{ to_fun := λv, A.mul_vec v,
  map_add' := begin
    intros v w,
    apply vec.ext,
    intro i,
    simp [ matrix.mul_vec,
      matrix.dot_product, matrix.dot_product_add,
      mul_add, finset.sum_add_distrib ],
  end,
  map_smul' := begin
    intros a v,
    have h := (matrix.mul_vec_lin A.val).map_smul' a v,
    simp at h,
    simp [mul_vec],
    exact h,
  end }

@[simps] def conj_transpose : invertible_matrix n :=
⟨A.val.conj_transpose, begin
  apply square_matrix.det_ne_zero_invertible,
  rw square_matrix.conj_transpose_det,
  simp,
  apply square_matrix.invertible_det_ne_zero,
  exact A.property
end⟩

@[simp] def is_unitary : Prop :=
  A.val.is_unitary

end invertible_matrix

end FG


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

! This file was ported from Lean 3 source module linear_algebra.matrix.adjugate
! leanprover-community/mathlib commit 0bd2ea37bcba5769e14866170f251c9bc64e35d7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Regular.Basic
import Mathbin.LinearAlgebra.Matrix.MvPolynomial
import Mathbin.LinearAlgebra.Matrix.Polynomial
import Mathbin.RingTheory.Polynomial.Basic

/-!
# Cramer's rule and adjugate matrices

The adjugate matrix is the transpose of the cofactor matrix.
It is calculated with Cramer's rule, which we introduce first.
The vectors returned by Cramer's rule are given by the linear map `cramer`,
which sends a matrix `A` and vector `b` to the vector consisting of the
determinant of replacing the `i`th column of `A` with `b` at index `i`
(written as `(A.update_column i b).det`).
Using Cramer's rule, we can compute for each matrix `A` the matrix `adjugate A`.
The entries of the adjugate are the minors of `A`.
Instead of defining a minor by deleting row `i` and column `j` of `A`, we
replace the `i`th row of `A` with the `j`th basis vector; the resulting matrix
has the same determinant but more importantly equals Cramer's rule applied
to `A` and the `j`th basis vector, simplifying the subsequent proofs.
We prove the adjugate behaves like `det A • A⁻¹`.

## Main definitions

 * `matrix.cramer A b`: the vector output by Cramer's rule on `A` and `b`.
 * `matrix.adjugate A`: the adjugate (or classical adjoint) of the matrix `A`.

## References

  * https://en.wikipedia.org/wiki/Cramer's_rule#Finding_inverse_matrix

## Tags

cramer, cramer's rule, adjugate
-/

namespace Matrix

universe u v

variable {n : Type u} [DecidableEq n] [Fintype n] {α : Type v} [CommRing α]

open Matrix BigOperators Polynomial

open Equiv Equiv.Perm Finset

section Cramer

/-!
  ### `cramer` section

  Introduce the linear map `cramer` with values defined by `cramer_map`.
  After defining `cramer_map` and showing it is linear,
  we will restrict our proofs to using `cramer`.
-/

variable (A : Matrix n n α) (b : n → α)

/-- `cramer_map A b i` is the determinant of the matrix `A` with column `i` replaced with `b`,
  and thus `cramer_map A b` is the vector output by Cramer's rule on `A` and `b`.

  If `A ⬝ x = b` has a unique solution in `x`, `cramer_map A` sends the vector `b` to `A.det • x`.
  Otherwise, the outcome of `cramer_map` is well-defined but not necessarily useful.
-/
def cramerMap (i : n) : α :=
  (A.updateColumn i b).det
#align matrix.cramer_map Matrix.cramerMap

theorem cramerMap_is_linear (i : n) : IsLinearMap α fun b => cramerMap A b i :=
  { map_add := det_updateColumn_add _ _
    map_smul := det_updateColumn_smul _ _ }
#align matrix.cramer_map_is_linear Matrix.cramerMap_is_linear

theorem cramer_is_linear : IsLinearMap α (cramerMap A) :=
  by
  constructor <;> intros <;> ext i
  · apply (cramer_map_is_linear A i).1
  · apply (cramer_map_is_linear A i).2
#align matrix.cramer_is_linear Matrix.cramer_is_linear

/-- `cramer A b i` is the determinant of the matrix `A` with column `i` replaced with `b`,
  and thus `cramer A b` is the vector output by Cramer's rule on `A` and `b`.

  If `A ⬝ x = b` has a unique solution in `x`, `cramer A` sends the vector `b` to `A.det • x`.
  Otherwise, the outcome of `cramer` is well-defined but not necessarily useful.
 -/
def cramer (A : Matrix n n α) : (n → α) →ₗ[α] n → α :=
  IsLinearMap.mk' (cramerMap A) (cramer_is_linear A)
#align matrix.cramer Matrix.cramer

theorem cramer_apply (i : n) : cramer A b i = (A.updateColumn i b).det :=
  rfl
#align matrix.cramer_apply Matrix.cramer_apply

theorem cramer_transpose_apply (i : n) : cramer Aᵀ b i = (A.updateRow i b).det := by
  rw [cramer_apply, update_column_transpose, det_transpose]
#align matrix.cramer_transpose_apply Matrix.cramer_transpose_apply

theorem cramer_transpose_row_self (i : n) : Aᵀ.cramer (A i) = Pi.single i A.det :=
  by
  ext j
  rw [cramer_apply, Pi.single_apply]
  split_ifs with h
  · -- i = j: this entry should be `A.det`
    subst h
    simp only [update_column_transpose, det_transpose, update_row, Function.update_eq_self]
  · -- i ≠ j: this entry should be 0
    rw [update_column_transpose, det_transpose]
    apply det_zero_of_row_eq h
    rw [update_row_self, update_row_ne (Ne.symm h)]
#align matrix.cramer_transpose_row_self Matrix.cramer_transpose_row_self

theorem cramer_row_self (i : n) (h : ∀ j, b j = A j i) : A.cramer b = Pi.single i A.det :=
  by
  rw [← transpose_transpose A, det_transpose]
  convert cramer_transpose_row_self Aᵀ i
  exact funext h
#align matrix.cramer_row_self Matrix.cramer_row_self

@[simp]
theorem cramer_one : cramer (1 : Matrix n n α) = 1 :=
  by
  ext (i j)
  convert congr_fun (cramer_row_self (1 : Matrix n n α) (Pi.single i 1) i _) j
  · simp
  · intro j
    rw [Matrix.one_eq_pi_single, Pi.single_comm]
#align matrix.cramer_one Matrix.cramer_one

theorem cramer_smul (r : α) (A : Matrix n n α) :
    cramer (r • A) = r ^ (Fintype.card n - 1) • cramer A :=
  LinearMap.ext fun b => funext fun _ => det_updateColumn_smul' _ _ _ _
#align matrix.cramer_smul Matrix.cramer_smul

@[simp]
theorem cramer_subsingleton_apply [Subsingleton n] (A : Matrix n n α) (b : n → α) (i : n) :
    cramer A b i = b i := by rw [cramer_apply, det_eq_elem_of_subsingleton _ i, update_column_self]
#align matrix.cramer_subsingleton_apply Matrix.cramer_subsingleton_apply

theorem cramer_zero [Nontrivial n] : cramer (0 : Matrix n n α) = 0 :=
  by
  ext (i j)
  obtain ⟨j', hj'⟩ : ∃ j', j' ≠ j := exists_ne j
  apply det_eq_zero_of_column_eq_zero j'
  intro j''
  simp [update_column_ne hj']
#align matrix.cramer_zero Matrix.cramer_zero

/-- Use linearity of `cramer` to take it out of a summation. -/
theorem sum_cramer {β} (s : Finset β) (f : β → n → α) :
    (∑ x in s, cramer A (f x)) = cramer A (∑ x in s, f x) :=
  (LinearMap.map_sum (cramer A)).symm
#align matrix.sum_cramer Matrix.sum_cramer

/-- Use linearity of `cramer` and vector evaluation to take `cramer A _ i` out of a summation. -/
theorem sum_cramer_apply {β} (s : Finset β) (f : n → β → α) (i : n) :
    (∑ x in s, cramer A (fun j => f j x) i) = cramer A (fun j : n => ∑ x in s, f j x) i :=
  calc
    (∑ x in s, cramer A (fun j => f j x) i) = (∑ x in s, cramer A fun j => f j x) i :=
      (Finset.sum_apply i s _).symm
    _ = cramer A (fun j : n => ∑ x in s, f j x) i :=
      by
      rw [sum_cramer, cramer_apply]
      congr with j
      apply Finset.sum_apply

#align matrix.sum_cramer_apply Matrix.sum_cramer_apply

end Cramer

section Adjugate

/-!
### `adjugate` section

Define the `adjugate` matrix and a few equations.
These will hold for any matrix over a commutative ring.
-/

/-- The adjugate matrix is the transpose of the cofactor matrix.

  Typically, the cofactor matrix is defined by taking minors,
  i.e. the determinant of the matrix with a row and column removed.
  However, the proof of `mul_adjugate` becomes a lot easier if we use the
  matrix replacing a column with a basis vector, since it allows us to use
  facts about the `cramer` map.
-/
def adjugate (A : Matrix n n α) : Matrix n n α := fun i => cramer Aᵀ (Pi.single i 1)
#align matrix.adjugate Matrix.adjugate

theorem adjugate_def (A : Matrix n n α) : adjugate A = fun i => cramer Aᵀ (Pi.single i 1) :=
  rfl
#align matrix.adjugate_def Matrix.adjugate_def

theorem adjugate_apply (A : Matrix n n α) (i j : n) :
    adjugate A i j = (A.updateRow j (Pi.single i 1)).det :=
  by
  rw [adjugate_def]
  simp only
  rw [cramer_apply, update_column_transpose, det_transpose]
#align matrix.adjugate_apply Matrix.adjugate_apply

theorem adjugate_transpose (A : Matrix n n α) : (adjugate A)ᵀ = adjugate Aᵀ :=
  by
  ext (i j)
  rw [transpose_apply, adjugate_apply, adjugate_apply, update_row_transpose, det_transpose]
  rw [det_apply', det_apply']
  apply Finset.sum_congr rfl
  intro σ _
  congr 1
  by_cases i = σ j
  · -- Everything except `(i , j)` (= `(σ j , j)`) is given by A, and the rest is a single `1`.
      congr <;> ext j'
    subst h
    have : σ j' = σ j ↔ j' = j := σ.injective.eq_iff
    rw [update_row_apply, update_column_apply]
    simp_rw [this]
    rw [← dite_eq_ite, ← dite_eq_ite]
    congr 1 with rfl
    rw [Pi.single_eq_same, Pi.single_eq_same]
  · -- Otherwise, we need to show that there is a `0` somewhere in the product.
    have : (∏ j' : n, update_column A j (Pi.single i 1) (σ j') j') = 0 :=
      by
      apply prod_eq_zero (mem_univ j)
      rw [update_column_self, Pi.single_eq_of_ne' h]
    rw [this]
    apply prod_eq_zero (mem_univ (σ⁻¹ i))
    erw [apply_symm_apply σ i, update_row_self]
    apply Pi.single_eq_of_ne
    intro h'
    exact h ((symm_apply_eq σ).mp h')
#align matrix.adjugate_transpose Matrix.adjugate_transpose

/-- Since the map `b ↦ cramer A b` is linear in `b`, it must be multiplication by some matrix. This
matrix is `A.adjugate`. -/
theorem cramer_eq_adjugate_mulVec (A : Matrix n n α) (b : n → α) :
    cramer A b = A.adjugate.mulVec b :=
  by
  nth_rw 2 [← A.transpose_transpose]
  rw [← adjugate_transpose, adjugate_def]
  have : b = ∑ i, b i • Pi.single i 1 :=
    by
    refine' (pi_eq_sum_univ b).trans _
    congr with j
    simp [Pi.single_apply, eq_comm]
  nth_rw 1 [this]
  ext k
  simp [mul_vec, dot_product, mul_comm]
#align matrix.cramer_eq_adjugate_mul_vec Matrix.cramer_eq_adjugate_mulVec

theorem mul_adjugate_apply (A : Matrix n n α) (i j k) :
    A i k * adjugate A k j = cramer Aᵀ (Pi.single k (A i k)) j := by
  erw [← smul_eq_mul, ← Pi.smul_apply, ← LinearMap.map_smul, ← Pi.single_smul', smul_eq_mul,
    mul_one]
#align matrix.mul_adjugate_apply Matrix.mul_adjugate_apply

theorem mul_adjugate (A : Matrix n n α) : A ⬝ adjugate A = A.det • 1 :=
  by
  ext (i j)
  rw [mul_apply, Pi.smul_apply, Pi.smul_apply, one_apply, smul_eq_mul, mul_boole]
  simp [mul_adjugate_apply, sum_cramer_apply, cramer_transpose_row_self, Pi.single_apply, eq_comm]
#align matrix.mul_adjugate Matrix.mul_adjugate

theorem adjugate_mul (A : Matrix n n α) : adjugate A ⬝ A = A.det • 1 :=
  calc
    adjugate A ⬝ A = (Aᵀ ⬝ adjugate Aᵀ)ᵀ := by
      rw [← adjugate_transpose, ← transpose_mul, transpose_transpose]
    _ = A.det • 1 := by rw [mul_adjugate Aᵀ, det_transpose, transpose_smul, transpose_one]

#align matrix.adjugate_mul Matrix.adjugate_mul

theorem adjugate_smul (r : α) (A : Matrix n n α) :
    adjugate (r • A) = r ^ (Fintype.card n - 1) • adjugate A :=
  by
  rw [adjugate, adjugate, transpose_smul, cramer_smul]
  rfl
#align matrix.adjugate_smul Matrix.adjugate_smul

/-- A stronger form of **Cramer's rule** that allows us to solve some instances of `A ⬝ x = b` even
if the determinant is not a unit. A sufficient (but still not necessary) condition is that `A.det`
divides `b`. -/
@[simp]
theorem mulVec_cramer (A : Matrix n n α) (b : n → α) : A.mulVec (cramer A b) = A.det • b := by
  rw [cramer_eq_adjugate_mul_vec, mul_vec_mul_vec, mul_adjugate, smul_mul_vec_assoc, one_mul_vec]
#align matrix.mul_vec_cramer Matrix.mulVec_cramer

theorem adjugate_subsingleton [Subsingleton n] (A : Matrix n n α) : adjugate A = 1 :=
  by
  ext (i j)
  simp [Subsingleton.elim i j, adjugate_apply, det_eq_elem_of_subsingleton _ i]
#align matrix.adjugate_subsingleton Matrix.adjugate_subsingleton

theorem adjugate_eq_one_of_card_eq_one {A : Matrix n n α} (h : Fintype.card n = 1) :
    adjugate A = 1 :=
  haveI : Subsingleton n := fintype.card_le_one_iff_subsingleton.mp h.le
  adjugate_subsingleton _
#align matrix.adjugate_eq_one_of_card_eq_one Matrix.adjugate_eq_one_of_card_eq_one

@[simp]
theorem adjugate_zero [Nontrivial n] : adjugate (0 : Matrix n n α) = 0 :=
  by
  ext (i j)
  obtain ⟨j', hj'⟩ : ∃ j', j' ≠ j := exists_ne j
  apply det_eq_zero_of_column_eq_zero j'
  intro j''
  simp [update_column_ne hj']
#align matrix.adjugate_zero Matrix.adjugate_zero

@[simp]
theorem adjugate_one : adjugate (1 : Matrix n n α) = 1 :=
  by
  ext
  simp [adjugate_def, Matrix.one_apply, Pi.single_apply, eq_comm]
#align matrix.adjugate_one Matrix.adjugate_one

@[simp]
theorem adjugate_diagonal (v : n → α) :
    adjugate (diagonal v) = diagonal fun i => ∏ j in Finset.univ.eraseₓ i, v j :=
  by
  ext
  simp only [adjugate_def, cramer_apply, diagonal_transpose]
  obtain rfl | hij := eq_or_ne i j
  ·
    rw [diagonal_apply_eq, diagonal_update_column_single, det_diagonal,
      prod_update_of_mem (Finset.mem_univ _), sdiff_singleton_eq_erase, one_mul]
  · rw [diagonal_apply_ne _ hij]
    refine' det_eq_zero_of_row_eq_zero j fun k => _
    obtain rfl | hjk := eq_or_ne k j
    · rw [update_column_self, Pi.single_eq_of_ne' hij]
    · rw [update_column_ne hjk, diagonal_apply_ne' _ hjk]
#align matrix.adjugate_diagonal Matrix.adjugate_diagonal

theorem RingHom.map_adjugate {R S : Type _} [CommRing R] [CommRing S] (f : R →+* S)
    (M : Matrix n n R) : f.mapMatrix M.adjugate = Matrix.adjugate (f.mapMatrix M) :=
  by
  ext (i k)
  have : Pi.single i (1 : S) = f ∘ Pi.single i 1 :=
    by
    rw [← f.map_one]
    exact Pi.single_op (fun i => f) (fun i => f.map_zero) i (1 : R)
  rw [adjugate_apply, RingHom.mapMatrix_apply, map_apply, RingHom.mapMatrix_apply, this, ←
    map_update_row, ← RingHom.mapMatrix_apply, ← RingHom.map_det, ← adjugate_apply]
#align ring_hom.map_adjugate RingHom.map_adjugate

theorem AlgHom.map_adjugate {R A B : Type _} [CommSemiring R] [CommRing A] [CommRing B]
    [Algebra R A] [Algebra R B] (f : A →ₐ[R] B) (M : Matrix n n A) :
    f.mapMatrix M.adjugate = Matrix.adjugate (f.mapMatrix M) :=
  f.toRingHom.map_adjugate _
#align alg_hom.map_adjugate AlgHom.map_adjugate

theorem det_adjugate (A : Matrix n n α) : (adjugate A).det = A.det ^ (Fintype.card n - 1) :=
  by
  -- get rid of the `- 1`
  cases' (Fintype.card n).eq_zero_or_pos with h_card h_card
  · haveI : IsEmpty n := fintype.card_eq_zero_iff.mp h_card
    rw [h_card, Nat.zero_sub, pow_zero, adjugate_subsingleton, det_one]
  replace h_card := tsub_add_cancel_of_le h_card.nat_succ_le
  -- express `A` as an evaluation of a polynomial in n^2 variables, and solve in the polynomial ring
  -- where `A'.det` is non-zero.
  let A' := mv_polynomial_X n n ℤ
  suffices A'.adjugate.det = A'.det ^ (Fintype.card n - 1) by
    rw [← mv_polynomial_X_map_matrix_aeval ℤ A, ← AlgHom.map_adjugate, ← AlgHom.map_det, ←
      AlgHom.map_det, ← AlgHom.map_pow, this]
  apply mul_left_cancel₀ (show A'.det ≠ 0 from det_mv_polynomial_X_ne_zero n ℤ)
  calc
    A'.det * A'.adjugate.det = (A' ⬝ adjugate A').det := (det_mul _ _).symm
    _ = A'.det ^ Fintype.card n := by rw [mul_adjugate, det_smul, det_one, mul_one]
    _ = A'.det * A'.det ^ (Fintype.card n - 1) := by rw [← pow_succ, h_card]

#align matrix.det_adjugate Matrix.det_adjugate

@[simp]
theorem adjugate_fin_zero (A : Matrix (Fin 0) (Fin 0) α) : adjugate A = 0 :=
  Subsingleton.elim _ _
#align matrix.adjugate_fin_zero Matrix.adjugate_fin_zero

@[simp]
theorem adjugate_fin_one (A : Matrix (Fin 1) (Fin 1) α) : adjugate A = 1 :=
  adjugate_subsingleton A
#align matrix.adjugate_fin_one Matrix.adjugate_fin_one

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
theorem adjugate_fin_two (A : Matrix (Fin 2) (Fin 2) α) :
    adjugate A =
      «expr!![ »
        "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation" :=
  by
  ext (i j)
  rw [adjugate_apply, det_fin_two]
  fin_cases i <;> fin_cases j <;>
    simp only [one_mul, Fin.one_eq_zero_iff, Pi.single_eq_same, MulZeroClass.mul_zero, sub_zero,
      Pi.single_eq_of_ne, Ne.def, not_false_iff, update_row_self, update_row_ne, cons_val_zero,
      of_apply, Nat.succ_succ_ne_one, Pi.single_eq_of_ne, update_row_self, Pi.single_eq_of_ne,
      Ne.def, Fin.zero_eq_one_iff, Nat.succ_succ_ne_one, not_false_iff, update_row_ne,
      Fin.one_eq_zero_iff, MulZeroClass.zero_mul, Pi.single_eq_same, one_mul, zero_sub, of_apply,
      cons_val', cons_val_fin_one, cons_val_one, head_fin_const, neg_inj, eq_self_iff_true,
      cons_val_zero, head_cons, mul_one]
#align matrix.adjugate_fin_two Matrix.adjugate_fin_two

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
@[simp]
theorem adjugate_fin_two_of (a b c d : α) :
    adjugate
        («expr!![ »
          "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation") =
      «expr!![ »
        "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation" :=
  adjugate_fin_two _
#align matrix.adjugate_fin_two_of Matrix.adjugate_fin_two_of

theorem adjugate_conjTranspose [StarRing α] (A : Matrix n n α) : A.adjugateᴴ = adjugate Aᴴ :=
  by
  dsimp only [conj_transpose]
  have : Aᵀ.adjugate.map star = adjugate (Aᵀ.map star) := (starRingEnd α).map_adjugate Aᵀ
  rw [A.adjugate_transpose, this]
#align matrix.adjugate_conj_transpose Matrix.adjugate_conjTranspose

theorem isRegular_of_isLeftRegular_det {A : Matrix n n α} (hA : IsLeftRegular A.det) :
    IsRegular A := by
  constructor
  · intro B C h
    refine' hA.matrix _
    rw [← Matrix.one_mul B, ← Matrix.one_mul C, ← Matrix.smul_mul, ← Matrix.smul_mul, ←
      adjugate_mul, Matrix.mul_assoc, Matrix.mul_assoc, ← mul_eq_mul A, h, mul_eq_mul]
  · intro B C h
    simp only [mul_eq_mul] at h
    refine' hA.matrix _
    rw [← Matrix.mul_one B, ← Matrix.mul_one C, ← Matrix.mul_smul, ← Matrix.mul_smul, ←
      mul_adjugate, ← Matrix.mul_assoc, ← Matrix.mul_assoc, h]
#align matrix.is_regular_of_is_left_regular_det Matrix.isRegular_of_isLeftRegular_det

theorem adjugate_mul_distrib_aux (A B : Matrix n n α) (hA : IsLeftRegular A.det)
    (hB : IsLeftRegular B.det) : adjugate (A ⬝ B) = adjugate B ⬝ adjugate A :=
  by
  have hAB : IsLeftRegular (A ⬝ B).det := by
    rw [det_mul]
    exact hA.mul hB
  refine' (is_regular_of_is_left_regular_det hAB).left _
  rw [mul_eq_mul, mul_adjugate, mul_eq_mul, Matrix.mul_assoc, ← Matrix.mul_assoc B, mul_adjugate,
    smul_mul, Matrix.one_mul, mul_smul, mul_adjugate, smul_smul, mul_comm, ← det_mul]
#align matrix.adjugate_mul_distrib_aux Matrix.adjugate_mul_distrib_aux

/-- Proof follows from "The trace Cayley-Hamilton theorem" by Darij Grinberg, Section 5.3
-/
theorem adjugate_mul_distrib (A B : Matrix n n α) : adjugate (A ⬝ B) = adjugate B ⬝ adjugate A :=
  by
  let g : Matrix n n α → Matrix n n α[X] := fun M => M.map Polynomial.C + (Polynomial.X : α[X]) • 1
  let f' : Matrix n n α[X] →+* Matrix n n α := (Polynomial.evalRingHom 0).mapMatrix
  have f'_inv : ∀ M, f' (g M) = M := by
    intro
    ext
    simp [f', g]
  have f'_adj : ∀ M : Matrix n n α, f' (adjugate (g M)) = adjugate M :=
    by
    intro
    rw [RingHom.map_adjugate, f'_inv]
  have f'_g_mul : ∀ M N : Matrix n n α, f' (g M ⬝ g N) = M ⬝ N :=
    by
    intros
    rw [← mul_eq_mul, RingHom.map_mul, f'_inv, f'_inv, mul_eq_mul]
  have hu : ∀ M : Matrix n n α, IsRegular (g M).det :=
    by
    intro M
    refine' Polynomial.Monic.isRegular _
    simp only [g, Polynomial.Monic.def, ← Polynomial.leadingCoeff_det_x_one_add_c M, add_comm]
  rw [← f'_adj, ← f'_adj, ← f'_adj, ← mul_eq_mul (f' (adjugate (g B))), ← f'.map_mul, mul_eq_mul, ←
    adjugate_mul_distrib_aux _ _ (hu A).left (hu B).left, RingHom.map_adjugate,
    RingHom.map_adjugate, f'_inv, f'_g_mul]
#align matrix.adjugate_mul_distrib Matrix.adjugate_mul_distrib

@[simp]
theorem adjugate_pow (A : Matrix n n α) (k : ℕ) : adjugate (A ^ k) = adjugate A ^ k :=
  by
  induction' k with k IH
  · simp
  · rw [pow_succ', mul_eq_mul, adjugate_mul_distrib, IH, ← mul_eq_mul, pow_succ]
#align matrix.adjugate_pow Matrix.adjugate_pow

theorem det_smul_adjugate_adjugate (A : Matrix n n α) :
    det A • adjugate (adjugate A) = det A ^ (Fintype.card n - 1) • A :=
  by
  have : A ⬝ (A.adjugate ⬝ A.adjugate.adjugate) = A ⬝ (A.det ^ (Fintype.card n - 1) • 1) := by
    rw [← adjugate_mul_distrib, adjugate_mul, adjugate_smul, adjugate_one]
  rwa [← Matrix.mul_assoc, mul_adjugate, Matrix.mul_smul, Matrix.mul_one, Matrix.smul_mul,
    Matrix.one_mul] at this
#align matrix.det_smul_adjugate_adjugate Matrix.det_smul_adjugate_adjugate

/-- Note that this is not true for `fintype.card n = 1` since `1 - 2 = 0` and not `-1`. -/
theorem adjugate_adjugate (A : Matrix n n α) (h : Fintype.card n ≠ 1) :
    adjugate (adjugate A) = det A ^ (Fintype.card n - 2) • A :=
  by
  -- get rid of the `- 2`
  cases' h_card : Fintype.card n with n'
  · haveI : IsEmpty n := fintype.card_eq_zero_iff.mp h_card
    apply Subsingleton.elim
  cases n'
  · exact (h h_card).elim
  rw [← h_card]
  -- express `A` as an evaluation of a polynomial in n^2 variables, and solve in the polynomial ring
  -- where `A'.det` is non-zero.
  let A' := mv_polynomial_X n n ℤ
  suffices adjugate (adjugate A') = det A' ^ (Fintype.card n - 2) • A' by
    rw [← mv_polynomial_X_map_matrix_aeval ℤ A, ← AlgHom.map_adjugate, ← AlgHom.map_adjugate, this,
      ← AlgHom.map_det, ← AlgHom.map_pow, AlgHom.mapMatrix_apply, AlgHom.mapMatrix_apply,
      Matrix.map_smul' _ _ _ (_root_.map_mul _)]
  have h_card' : Fintype.card n - 2 + 1 = Fintype.card n - 1 := by simp [h_card]
  have is_reg : IsSMulRegular (MvPolynomial (n × n) ℤ) (det A') := fun x y =>
    mul_left_cancel₀ (det_mv_polynomial_X_ne_zero n ℤ)
  apply is_reg.matrix
  rw [smul_smul, ← pow_succ, h_card', det_smul_adjugate_adjugate]
#align matrix.adjugate_adjugate Matrix.adjugate_adjugate

/-- A weaker version of `matrix.adjugate_adjugate` that uses `nontrivial`. -/
theorem adjugate_adjugate' (A : Matrix n n α) [Nontrivial n] :
    adjugate (adjugate A) = det A ^ (Fintype.card n - 2) • A :=
  adjugate_adjugate _ <| Fintype.one_lt_card.ne'
#align matrix.adjugate_adjugate' Matrix.adjugate_adjugate'

end Adjugate

end Matrix


/-
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
import data.zmod.basic

/-

# Prove that 19 ∣ 2^(2^(6k+2)) + 3 for k = 0,1,2,...

This is the fifth question in Sierpinski's book "250 elementary problems
in number theory".

thoughts

if a(k)=2^(2^(6k+2))
then a(k+1)=2^(2^6*2^(6k+2))=a(k)^64

Note that 16^64 is 16 mod 19 according to a brute force calculation
and so all of the a(k) are 16 mod 19 and we're done

-/

lemma sixteen_pow_sixtyfour_mod_nineteen : (16 : zmod 19)^64 = 16 :=
begin
  refl, -- :-)
end

example (k : ℕ) : 19 ∣ 2^(2^(6*k+2))+3 :=
begin
  sorry,
end


theorem le_total (a b : mynat) : a ≤ b ∨ b ≤ a :=
begin
induction a with k Pk,
left,
exact zero_le b,

cases Pk,
cases Pk with c hc,
cases c,
rw add_zero at hc,
right,
rw hc,
use 1,
refl,

left,
rw hc,
repeat { rw ← add_one_eq_succ },
rw add_comm c 1,
rw ← add_assoc k 1 c,
use c,
refl,

right,
rw add_one_eq_succ,
exact (le_succ b k) Pk,

end