/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro

Ordinal notations (constructive ordinal arithmetic for ordinals < ε₀).
-/
import set_theory.ordinal data.pnat
open ordinal

local notation `ω` := omega.{0}

/-- Recursive definition of an ordinal notation. `zero` denotes the
  ordinal 0, and `oadd e n a` is intended to refer to `ω^e * n + a`.
  For this to be valid Cantor normal form, we must have the exponents
  decrease to the right, but we can't state this condition until we've
  defined `repr`, so it is a separate definition `NF`. -/
@[derive decidable_eq]
inductive onote : Type
| zero : onote
| oadd : onote → ℕ+ → onote → onote

namespace onote

/-- Notation for 0 -/
instance : has_zero onote := ⟨zero⟩
@[simp] theorem zero_def : zero = 0 := rfl

/-- Notation for 1 -/
instance : has_one onote := ⟨oadd 0 1 0⟩

/-- Notation for ω -/
def omega : onote := oadd 1 1 0

/-- The ordinal denoted by a notation -/
@[simp] noncomputable def repr : onote → ordinal.{0}
| 0 := 0
| (oadd e n a) := ω ^ repr e * n + repr a

def to_string_aux1 (e : onote) (n : ℕ) (s : string) : string :=
if e = 0 then _root_.to_string n else
(if e = 1 then "ω" else "ω^(" ++ s ++ ")") ++
if n = 1 then "" else "*" ++ _root_.to_string n

/-- Print an ordinal notation -/
def to_string : onote → string
| zero := "0"
| (oadd e n 0) := to_string_aux1 e n (to_string e)
| (oadd e n a) := to_string_aux1 e n (to_string e) ++ " + " ++ to_string a

/-- Print an ordinal notation -/
def repr' : onote → string
| zero := "0"
| (oadd e n a) := "(oadd " ++ repr' e ++ " " ++ _root_.to_string (n:ℕ) ++ " " ++ repr' a ++ ")"

instance : has_to_string onote := ⟨to_string⟩
instance : has_repr onote := ⟨repr'⟩

instance : preorder onote :=
{ le       := λ x y, repr x ≤ repr y,
  lt       := λ x y, repr x < repr y,
  le_refl  := λ a, @le_refl ordinal _ _,
  le_trans := λ a b c, @le_trans ordinal _ _ _ _,
  lt_iff_le_not_le := λ a b, @lt_iff_le_not_le ordinal _ _ _ }

theorem lt_def {x y : onote} : x < y ↔ repr x < repr y := iff.rfl
theorem le_def {x y : onote} : x ≤ y ↔ repr x ≤ repr y := iff.rfl

/-- Convert a `nat` into an ordinal -/
@[simp] def of_nat : ℕ → onote
| 0            := 0
| (nat.succ n) := oadd 0 n.succ_pnat 0

@[simp] theorem of_nat_one : of_nat 1 = 1 := rfl

@[simp] theorem repr_of_nat (n : ℕ) : repr (of_nat n) = n :=
by cases n; simp

@[simp] theorem repr_one : repr 1 = 1 :=
by simpa using repr_of_nat 1

theorem omega_le_oadd (e n a) : ω ^ repr e ≤ repr (oadd e n a) :=
begin
  unfold repr,
  refine le_trans _ (le_add_right _ _),
  simpa using (mul_le_mul_iff_left $ power_pos (repr e) omega_pos).2 (nat_cast_le.2 n.2)
end

theorem oadd_pos (e n a) : 0 < oadd e n a :=
@lt_of_lt_of_le _ _ _ _ _ (power_pos _ omega_pos)
  (omega_le_oadd _ _ _)

/-- Compare ordinal notations -/
def cmp : onote → onote → ordering
| 0 0 := ordering.eq
| _ 0 := ordering.gt
| 0 _ := ordering.lt
| o₁@(oadd e₁ n₁ a₁) o₂@(oadd e₂ n₂ a₂) :=
  (cmp e₁ e₂).or_else $ (_root_.cmp (n₁:ℕ) n₂).or_else (cmp a₁ a₂)

theorem eq_of_cmp_eq : ∀ {o₁ o₂}, cmp o₁ o₂ = ordering.eq → o₁ = o₂
| 0            0 h := rfl
| (oadd e n a) 0 h := by injection h
| 0 (oadd e n a) h := by injection h
| o₁@(oadd e₁ n₁ a₁) o₂@(oadd e₂ n₂ a₂) h := begin
  revert h, simp [cmp],
  cases h₁ : cmp e₁ e₂; intro h; try {cases h},
  have := eq_of_cmp_eq h₁, subst e₂,
  revert h, cases h₂ : _root_.cmp (n₁:ℕ) n₂; intro h; try {cases h},
  have := eq_of_cmp_eq h, subst a₂,
  rw [_root_.cmp, cmp_using_eq_eq] at h₂,
  have := subtype.eq (eq_of_incomp h₂), subst n₂, simp
end

theorem zero_lt_one : (0 : onote) < 1 :=
by rw [lt_def, repr, repr_one]; exact zero_lt_one

/-- `NF_below o b` says that `o` is a normal form ordinal notation
  satisfying `repr o < ω ^ b`. -/
inductive NF_below : onote → ordinal.{0} → Prop
| zero {b} : NF_below 0 b
| oadd' {e n a eb b} : NF_below e eb →
  NF_below a (repr e) → repr e < b → NF_below (oadd e n a) b

/-- A normal form ordinal notation has the form

     ω ^ a₁ * n₁ + ω ^ a₂ * n₂ + ... ω ^ aₖ * nₖ
  where `a₁ > a₂ > ... > aₖ` and all the `aᵢ` are
  also in normal form.

  We will essentially only be interested in normal form
  ordinal notations, but to avoid complicating the algorithms
  we define everything over general ordinal notations and
  only prove correctness with normal form as an invariant. -/
@[class] def NF (o : onote) := Exists (NF_below o)

instance NF.zero : NF 0 := ⟨0, NF_below.zero⟩

theorem NF_below.oadd {e n a b} : NF e →
  NF_below a (repr e) → repr e < b → NF_below (oadd e n a) b
| ⟨eb, h⟩ := NF_below.oadd' h

theorem NF_below.fst {e n a b} (h : NF_below (oadd e n a) b) : NF e :=
by cases h with _ _ _ _ eb _ h₁ h₂ h₃; exact ⟨_, h₁⟩

theorem NF.fst {e n a} : NF (oadd e n a) → NF e
| ⟨b, h⟩ := h.fst

theorem NF_below.snd {e n a b} (h : NF_below (oadd e n a) b) : NF_below a (repr e) :=
by cases h with _ _ _ _ eb _ h₁ h₂ h₃; exact h₂

theorem NF.snd' {e n a} : NF (oadd e n a) → NF_below a (repr e)
| ⟨b, h⟩ := h.snd

theorem NF.snd {e n a} (h : NF (oadd e n a)) : NF a :=
⟨_, h.snd'⟩

theorem NF.oadd {e a} (h₁ : NF e) (n)
  (h₂ : NF_below a (repr e)) : NF (oadd e n a) :=
⟨_, NF_below.oadd h₁ h₂ (ordinal.lt_succ_self _)⟩

instance NF.oadd_zero (e n) [h : NF e] : NF (oadd e n 0) :=
h.oadd _ NF_below.zero

theorem NF_below.lt {e n a b} (h : NF_below (oadd e n a) b) : repr e < b :=
by cases h with _ _ _ _ eb _ h₁ h₂ h₃; exact h₃

theorem NF_below_zero : ∀ {o}, NF_below o 0 ↔ o = 0
| 0            := ⟨λ _, rfl, λ _, NF_below.zero⟩
| (oadd e n a) := ⟨λ h, (not_le_of_lt h.lt).elim (zero_le _),
                   λ e, e.symm ▸ NF_below.zero⟩

theorem NF.zero_of_zero {e n a} (h : NF (oadd e n a)) (e0 : e = 0) : a = 0 :=
by simpa [e0, NF_below_zero] using h.snd'

theorem NF_below.repr_lt {o b} (h : NF_below o b) : repr o < ω ^ b :=
begin
  induction h with _ e n a eb b h₁ h₂ h₃ _ IH,
  { exact power_pos _ omega_pos },
  { rw repr,
    refine lt_of_lt_of_le ((ordinal.add_lt_add_iff_left _).2 IH) _,
    rw ← mul_succ,
    refine le_trans (mul_le_mul_left _ $ ordinal.succ_le.2 $ nat_lt_omega _) _,
    rw ← power_succ,
    exact power_le_power_right omega_pos (ordinal.succ_le.2 h₃) }
end

theorem NF_below.mono {o b₁ b₂} (bb : b₁ ≤ b₂) (h : NF_below o b₁) : NF_below o b₂ :=
begin
  induction h with _ e n a eb b h₁ h₂ h₃ _ IH; constructor,
  exacts [h₁, h₂, lt_of_lt_of_le h₃ bb]
end

theorem NF.below_of_lt {e n a b} (H : repr e < b) : NF (oadd e n a) → NF_below (oadd e n a) b
| ⟨b', h⟩ := by cases h with _ _ _ _ eb _ h₁ h₂ h₃;
  exact NF_below.oadd' h₁ h₂ H

theorem NF.below_of_lt' : ∀ {o b}, repr o < ω ^ b → NF o → NF_below o b
| 0            b H _ := NF_below.zero
| (oadd e n a) b H h := h.below_of_lt $ (power_lt_power_iff_right one_lt_omega).1 $
    (lt_of_le_of_lt (omega_le_oadd _ _ _) H)

theorem NF_below_of_nat : ∀ n, NF_below (of_nat n) 1
| 0            := NF_below.zero
| (nat.succ n) := NF_below.oadd NF.zero NF_below.zero ordinal.zero_lt_one

instance NF_of_nat (n) : NF (of_nat n) := ⟨_, NF_below_of_nat n⟩

instance NF_one : NF 1 := by rw ← of_nat_one; apply_instance

theorem oadd_lt_oadd_1 {e₁ n₁ o₁ e₂ n₂ o₂}
  (h₁ : NF (oadd e₁ n₁ o₁)) (h₂ : NF (oadd e₂ n₂ o₂))
  (h : e₁ < e₂) : oadd e₁ n₁ o₁ < oadd e₂ n₂ o₂ :=
@lt_of_lt_of_le _ _ _ _ _ ((h₁.below_of_lt h).repr_lt) (omega_le_oadd _ _ _)

theorem oadd_lt_oadd_2 {e n₁ o₁ n₂ o₂}
  (h₁ : NF (oadd e n₁ o₁)) (h₂ : NF (oadd e n₂ o₂))
  (h : (n₁:ℕ) < n₂) : oadd e n₁ o₁ < oadd e n₂ o₂ :=
begin
  simp [lt_def],
  refine lt_of_lt_of_le ((ordinal.add_lt_add_iff_left _).2 h₁.snd'.repr_lt)
    (le_trans _ (le_add_right _ _)),
  rwa [← mul_succ, mul_le_mul_iff_left (power_pos _ omega_pos),
       ordinal.succ_le, nat_cast_lt]
end

theorem oadd_lt_oadd_3 {e n a₁ a₂}
  (h₁ : NF (oadd e n a₁)) (h₂ : NF (oadd e n a₂))
  (h : a₁ < a₂) : oadd e n a₁ < oadd e n a₂ :=
begin
  rw lt_def, unfold repr,
  exact (ordinal.add_lt_add_iff_left _).2 h
end

theorem cmp_compares : ∀ (a b : onote) [NF a] [NF b], (cmp a b).compares a b
| 0 0 h₁ h₂ := rfl
| (oadd e n a) 0 h₁ h₂ := oadd_pos _ _ _
| 0 (oadd e n a) h₁ h₂ := oadd_pos _ _ _
| o₁@(oadd e₁ n₁ a₁) o₂@(oadd e₂ n₂ a₂) h₁ h₂ := begin
    rw cmp,
    have IHe := @cmp_compares _ _ h₁.fst h₂.fst,
    cases cmp e₁ e₂,
    case ordering.lt { exact oadd_lt_oadd_1 h₁ h₂ IHe },
    case ordering.gt { exact oadd_lt_oadd_1 h₂ h₁ IHe },
    change e₁ = e₂ at IHe, subst IHe,
    unfold _root_.cmp, cases nh : cmp_using (<) (n₁:ℕ) n₂,
    case ordering.lt {
      rw cmp_using_eq_lt at nh, exact oadd_lt_oadd_2 h₁ h₂ nh },
    case ordering.gt {
      rw cmp_using_eq_gt at nh, exact oadd_lt_oadd_2 h₂ h₁ nh },
    rw cmp_using_eq_eq at nh,
    have := subtype.eq (eq_of_incomp nh), subst n₂,
    have IHa := @cmp_compares _ _ h₁.snd h₂.snd,
    cases cmp a₁ a₂,
    case ordering.lt { exact oadd_lt_oadd_3 h₁ h₂ IHa },
    case ordering.gt { exact oadd_lt_oadd_3 h₂ h₁ IHa },
    change a₁ = a₂ at IHa, subst IHa, exact rfl
  end

theorem repr_inj {a b} [NF a] [NF b] : repr a = repr b ↔ a = b :=
⟨match cmp a b, cmp_compares a b with
 | ordering.lt, (h : repr a < repr b), e := (ne_of_lt h e).elim
 | ordering.gt, (h : repr a > repr b), e := (ne_of_gt h e).elim
 | ordering.eq, h, e := h
 end, congr_arg _⟩

theorem NF.of_dvd_omega_power {b e n a} (h : NF (oadd e n a)) (d : ω ^ b ∣ repr (oadd e n a)) :
  b ≤ repr e ∧ ω ^ b ∣ repr a :=
begin
  have := mt repr_inj.1 (λ h, by injection h : oadd e n a ≠ 0),
  have L := le_of_not_lt (λ l, not_le_of_lt (h.below_of_lt l).repr_lt (le_of_dvd this d)),
  simp at d,
  exact ⟨L, (dvd_add_iff $ dvd_mul_of_dvd _ $ power_dvd_power _ L).1 d⟩
end

theorem NF.of_dvd_omega {e n a} (h : NF (oadd e n a)) :
   ω ∣ repr (oadd e n a) → repr e ≠ 0 ∧ ω ∣ repr a :=
by rw [← power_one ω, ← one_le_iff_ne_zero]; exact h.of_dvd_omega_power

/-- `top_below b o` asserts that the largest exponent in `o`, if
  it exists, is less than `b`. This is an auxiliary definition
  for decidability of `NF`. -/
def top_below (b) : onote → Prop
| 0            := true
| (oadd e n a) := cmp e b = ordering.lt

instance decidable_top_below : decidable_rel top_below :=
by intros b o; cases o; delta top_below; apply_instance

theorem NF_below_iff_top_below {b} [NF b] : ∀ {o},
  NF_below o (repr b) ↔ NF o ∧ top_below b o
| 0            := ⟨λ h, ⟨⟨_, h⟩, trivial⟩, λ _, NF_below.zero⟩
| (oadd e n a) :=
  ⟨λ h, ⟨⟨_, h⟩, (@cmp_compares _ b h.fst _).eq_lt.2 h.lt⟩,
   λ ⟨h₁, h₂⟩, h₁.below_of_lt $ (@cmp_compares _ b h₁.fst _).eq_lt.1 h₂⟩

instance decidable_NF : decidable_pred NF
| 0            := is_true NF.zero
| (oadd e n a) := begin
  have := decidable_NF e,
  have := decidable_NF a, resetI,
  apply decidable_of_iff (NF e ∧ NF a ∧ top_below e a),
  abstract {
    rw ← and_congr_right (λ h, @NF_below_iff_top_below _ h _),
    exact ⟨λ ⟨h₁, h₂⟩, NF.oadd h₁ n h₂, λ h, ⟨h.fst, h.snd'⟩⟩ },
end

/-- Addition of ordinal notations (correct only for normal input) -/
def add : onote → onote → onote
| 0            o := o
| (oadd e n a) o := match add a o with
  | 0 := oadd e n 0
  | o'@(oadd e' n' a') := match cmp e e' with
    | ordering.lt := o'
    | ordering.eq := oadd e (n + n') a'
    | ordering.gt := oadd e n o'
    end
  end

instance : has_add onote := ⟨add⟩

@[simp] theorem zero_add (o : onote) : 0 + o = o := rfl
theorem oadd_add (e n a o) : oadd e n a + o = add._match_1 e n (a + o) := rfl

/-- Subtraction of ordinal notations (correct only for normal input) -/
def sub : onote → onote → onote
| 0 o := 0
| o 0 := o
| o₁@(oadd e₁ n₁ a₁) (oadd e₂ n₂ a₂) := match cmp e₁ e₂ with
  | ordering.lt := 0
  | ordering.gt := o₁
  | ordering.eq := match (n₁:ℕ) - n₂ with
    | 0            := if n₁ = n₂ then sub a₁ a₂ else 0
    | (nat.succ k) := oadd e₁ k.succ_pnat a₁
  end
end

instance : has_sub onote := ⟨sub⟩

theorem add_NF_below {b} : ∀ {o₁ o₂}, NF_below o₁ b → NF_below o₂ b → NF_below (o₁ + o₂) b
| 0            o h₁ h₂ := h₂
| (oadd e n a) o h₁ h₂ := begin
  have h' := add_NF_below (h₁.snd.mono $ le_of_lt h₁.lt) h₂,
  simp [oadd_add], cases a + o with e' n' a',
  { exact NF_below.oadd h₁.fst NF_below.zero h₁.lt },
  simp [add], have := @cmp_compares _ _ h₁.fst h'.fst,
  cases cmp e e'; simp [add],
  { exact h' },
  { simp at this, subst e',
    exact NF_below.oadd h'.fst h'.snd h'.lt },
  { exact NF_below.oadd h₁.fst (NF.below_of_lt this ⟨_, h'⟩) h₁.lt }
end

instance add_NF (o₁ o₂) : ∀ [NF o₁] [NF o₂], NF (o₁ + o₂)
| ⟨b₁, h₁⟩ ⟨b₂, h₂⟩ := (b₁.le_total b₂).elim
  (λ h, ⟨b₂, add_NF_below (h₁.mono h) h₂⟩)
  (λ h, ⟨b₁, add_NF_below h₁ (h₂.mono h)⟩)

@[simp] theorem repr_add : ∀ o₁ o₂ [NF o₁] [NF o₂], repr (o₁ + o₂) = repr o₁ + repr o₂
| 0            o h₁ h₂ := by simp
| (oadd e n a) o h₁ h₂ := begin
  haveI := h₁.snd, have h' := repr_add a o,
  conv at h' in (_+o) {simp [(+)]},
  have nf := onote.add_NF a o,
  conv at nf in (_+o) {simp [(+)]},
  conv in (_+o) {simp [(+), add]},
  cases add a o with e' n' a'; simp [add, h'.symm],
  have := h₁.fst, have := nf.fst, have ee := cmp_compares e e',
  cases cmp e e'; simp [add],
  { rw [← add_assoc, @add_absorp _ (repr e') (ω ^ repr e' * (n':ℕ))],
    { have := (h₁.below_of_lt ee).repr_lt, unfold repr at this,
      exact lt_of_le_of_lt (le_add_right _ _) this },
    { simpa using (mul_le_mul_iff_left $
        power_pos (repr e') omega_pos).2 (nat_cast_le.2 n'.pos) } },
  { change e = e' at ee, subst e',
    rw [← add_assoc, ← ordinal.mul_add, ← nat.cast_add] }
end

theorem sub_NF_below : ∀ {o₁ o₂ b}, NF_below o₁ b → NF o₂ → NF_below (o₁ - o₂) b
| 0            o b h₁ h₂ := by cases o; exact NF_below.zero
| (oadd e n a) 0 b h₁ h₂ := h₁
| (oadd e₁ n₁ a₁) (oadd e₂ n₂ a₂) b h₁ h₂ := begin
  have h' := sub_NF_below h₁.snd h₂.snd,
  simp [has_sub.sub, sub] at h' ⊢,
  have := @cmp_compares _ _ h₁.fst h₂.fst,
  cases cmp e₁ e₂; simp [sub],
  { apply NF_below.zero },
  { simp at this, subst e₂,
    cases mn : (n₁:ℕ) - n₂; simp [sub],
    { by_cases en : n₁ = n₂; simp [en],
      { exact h'.mono (le_of_lt h₁.lt) },
      { exact NF_below.zero } },
    { exact NF_below.oadd h₁.fst h₁.snd h₁.lt } },
  { exact h₁ }
end

instance sub_NF (o₁ o₂) : ∀ [NF o₁] [NF o₂], NF (o₁ - o₂)
| ⟨b₁, h₁⟩ h₂ := ⟨b₁, sub_NF_below h₁ h₂⟩

@[simp] theorem repr_sub : ∀ o₁ o₂ [NF o₁] [NF o₂], repr (o₁ - o₂) = repr o₁ - repr o₂
| 0            o h₁ h₂ := by cases o; exact (ordinal.zero_sub _).symm
| (oadd e n a) 0 h₁ h₂ := (ordinal.sub_zero _).symm
| (oadd e₁ n₁ a₁) (oadd e₂ n₂ a₂) h₁ h₂ := begin
  haveI := h₁.snd, haveI := h₂.snd, have h' := repr_sub a₁ a₂,
  conv at h' in (a₁-a₂) {simp [has_sub.sub]},
  have nf := onote.sub_NF a₁ a₂,
  conv at nf in (a₁-a₂) {simp [has_sub.sub]},
  conv in (_-oadd _ _ _) {simp [has_sub.sub, sub]},
  have ee := @cmp_compares _ _ h₁.fst h₂.fst,
  cases cmp e₁ e₂,
  { rw [sub_eq_zero_iff_le.2], {refl},
    exact le_of_lt (oadd_lt_oadd_1 h₁ h₂ ee) },
  { change e₁ = e₂ at ee, subst e₂, unfold sub._match_1,
    cases mn : (n₁:ℕ) - n₂; dsimp only [sub._match_2],
    { by_cases en : n₁ = n₂,
      { simp [en], rwa [add_sub_add_cancel] },
      { simp [en, -repr],
        exact (sub_eq_zero_iff_le.2 $ le_of_lt $ oadd_lt_oadd_2 h₁ h₂ $
          lt_of_le_of_ne (nat.sub_eq_zero_iff_le.1 mn) (mt pnat.eq en)).symm } },
    { simp [nat.succ_pnat, -nat.cast_succ],
      rw [(nat.sub_eq_iff_eq_add $ le_of_lt $ nat.lt_of_sub_eq_succ mn).1 mn,
          add_comm, nat.cast_add, ordinal.mul_add, add_assoc, add_sub_add_cancel],
      refine (ordinal.sub_eq_of_add_eq $ add_absorp h₂.snd'.repr_lt $
        le_trans _ (le_add_right _ _)).symm,
      simpa using mul_le_mul_left _ (nat_cast_le.2 $ nat.succ_pos _) } },
  { exact (ordinal.sub_eq_of_add_eq $ add_absorp (h₂.below_of_lt ee).repr_lt $
      omega_le_oadd _ _ _).symm }
end

/-- Multiplication of ordinal notations (correct only for normal input) -/
def mul : onote → onote → onote
| 0 _ := 0
| _ 0 := 0
| o₁@(oadd e₁ n₁ a₁) (oadd e₂ n₂ a₂) :=
  if e₂ = 0 then oadd e₁ (n₁ * n₂) a₁ else
  oadd (e₁ + e₂) n₂ (mul o₁ a₂)

instance : has_mul onote := ⟨mul⟩

@[simp] theorem zero_mul (o : onote) : 0 * o = 0 := by cases o; refl
@[simp] theorem mul_zero (o : onote) : o * 0 = 0 := by cases o; refl

theorem oadd_mul (e₁ n₁ a₁ e₂ n₂ a₂) : oadd e₁ n₁ a₁ * oadd e₂ n₂ a₂ =
  if e₂ = 0 then oadd e₁ (n₁ * n₂) a₁ else
  oadd (e₁ + e₂) n₂ (oadd e₁ n₁ a₁ * a₂) := rfl

theorem oadd_mul_NF_below {e₁ n₁ a₁ b₁} (h₁ : NF_below (oadd e₁ n₁ a₁) b₁) :
  ∀ {o₂ b₂}, NF_below o₂ b₂ → NF_below (oadd e₁ n₁ a₁ * o₂) (repr e₁ + b₂)
| 0 b₂ h₂ := NF_below.zero
| (oadd e₂ n₂ a₂) b₂ h₂ := begin
  have IH := oadd_mul_NF_below h₂.snd,
  by_cases e0 : e₂ = 0; simp [e0, oadd_mul],
  { apply NF_below.oadd h₁.fst h₁.snd,
    simpa using (add_lt_add_iff_left (repr e₁)).2
      (lt_of_le_of_lt (ordinal.zero_le _) h₂.lt) },
  { haveI := h₁.fst, haveI := h₂.fst,
    apply NF_below.oadd, apply_instance,
    { rwa repr_add },
    { rw [repr_add, ordinal.add_lt_add_iff_left], exact h₂.lt } }
end

instance mul_NF : ∀ o₁ o₂ [NF o₁] [NF o₂], NF (o₁ * o₂)
| 0 o h₁ h₂ := by cases o; exact NF.zero
| (oadd e n a) o ⟨b₁, hb₁⟩ ⟨b₂, hb₂⟩ :=
  ⟨_, oadd_mul_NF_below hb₁ hb₂⟩

@[simp] theorem repr_mul : ∀ o₁ o₂ [NF o₁] [NF o₂], repr (o₁ * o₂) = repr o₁ * repr o₂
| 0               o               h₁ h₂ := by cases o; exact (ordinal.zero_mul _).symm
| (oadd e₁ n₁ a₁) 0               h₁ h₂ := (ordinal.mul_zero _).symm
| (oadd e₁ n₁ a₁) (oadd e₂ n₂ a₂) h₁ h₂ := begin
  have IH : repr (mul _ _) = _ := @repr_mul _ _ h₁ h₂.snd,
  conv {to_lhs, simp [(*)]},
  have ao : repr a₁ + ω ^ repr e₁ * (n₁:ℕ) = ω ^ repr e₁ * (n₁:ℕ),
  { apply add_absorp h₁.snd'.repr_lt,
    simpa using (mul_le_mul_iff_left $ power_pos _ omega_pos).2
      (nat_cast_le.2 n₁.2) },
  by_cases e0 : e₂ = 0; simp [e0, mul],
  { cases nat.exists_eq_succ_of_ne_zero n₂.ne_zero with x xe,
    simp [h₂.zero_of_zero e0, xe, -nat.cast_succ],
    rw [← nat_cast_succ x, add_mul_succ _ ao, mul_assoc] },
  { haveI := h₁.fst, haveI := h₂.fst,
    simp [IH, repr_add, power_add, ordinal.mul_add],
    rw ← mul_assoc, congr' 2,
    have := mt repr_inj.1 e0,
    rw [add_mul_limit ao (power_is_limit_left omega_is_limit this),
        mul_assoc, mul_omega_dvd (nat_cast_pos.2 n₁.pos) (nat_lt_omega _)],
    simpa using power_dvd_power ω (one_le_iff_ne_zero.2 this) },
end

/-- Calculate division and remainder of `o` mod ω.
  `split' o = (a, n)` means `o = ω * a + n`. -/
def split' : onote → onote × ℕ
| 0            := (0, 0)
| (oadd e n a) := if e = 0 then (0, n) else
  let (a', m) := split' a in (oadd (e - 1) n a', m)

/-- Calculate division and remainder of `o` mod ω.
  `split o = (a, n)` means `o = a + n`, where `ω ∣ a`. -/
def split : onote → onote × ℕ
| 0            := (0, 0)
| (oadd e n a) := if e = 0 then (0, n) else
  let (a', m) := split a in (oadd e n a', m)

/-- `scale x o` is the ordinal notation for `ω ^ x * o`. -/
def scale (x : onote) : onote → onote
| 0            := 0
| (oadd e n a) := oadd (x + e) n (scale a)

/-- `mul_nat o n` is the ordinal notation for `o * n`. -/
def mul_nat : onote → ℕ → onote
| 0            m := 0
| _            0 := 0
| (oadd e n a) (m+1) := oadd e (n * m.succ_pnat) a

def power_aux (e a0 a : onote) : ℕ → ℕ → onote
| _     0     := 0
| 0     (m+1) := oadd e m.succ_pnat 0
| (k+1) m     := scale (e + mul_nat a0 k) a + power_aux k m

/-- `power o₁ o₂` calculates the ordinal notation for
  the ordinal exponential `o₁ ^ o₂`. -/
def power (o₁ o₂ : onote) : onote :=
match split o₁ with
| (0, 0) := if o₂ = 0 then 1 else 0
| (0, 1) := 1
| (0, m+1) := let (b', k) := split' o₂ in
  oadd b' (@has_pow.pow ℕ+ _ _ m.succ_pnat k) 0
| (a@(oadd a0 _ _), m) := match split o₂ with
  | (b, 0) := oadd (a0 * b) 1 0
  | (b, k+1) := let eb := a0*b in
    scale (eb + mul_nat a0 k) a + power_aux eb a0 (mul_nat a m) k m
  end
end

instance : has_pow onote onote := ⟨power⟩

theorem power_def (o₁ o₂ : onote) : o₁ ^ o₂ = power._match_1 o₂ (split o₁) := rfl

theorem split_eq_scale_split' : ∀ {o o' m} [NF o], split' o = (o', m) → split o = (scale 1 o', m)
| 0            o' m h p := by injection p; substs o' m; refl
| (oadd e n a) o' m h p := begin
  by_cases e0 : e = 0; simp [e0, split, split'] at p ⊢,
  { rcases p with ⟨rfl, rfl⟩, exact ⟨rfl, rfl⟩ },
  { revert p, cases h' : split' a with a' m',
    haveI := h.fst, haveI := h.snd,
    simp [split_eq_scale_split' h', split, split'],
    have : 1 + (e - 1) = e,
    { refine repr_inj.1 _, simp,
      have := mt repr_inj.1 e0,
      exact add_sub_cancel_of_le (one_le_iff_ne_zero.2 this) },
    intros, substs o' m, simp [scale, this] }
end

theorem NF_repr_split' : ∀ {o o' m} [NF o], split' o = (o', m) → NF o' ∧ repr o = ω * repr o' + m
| 0            o' m h p := by injection p; substs o' m; simp [NF.zero]
| (oadd e n a) o' m h p := begin
  by_cases e0 : e = 0; simp [e0, split, split'] at p ⊢,
  { rcases p with ⟨rfl, rfl⟩,
    simp [h.zero_of_zero e0, NF.zero] },
  { revert p, cases h' : split' a with a' m',
    haveI := h.fst, haveI := h.snd,
    cases NF_repr_split' h' with IH₁ IH₂,
    simp [IH₂, split'],
    intros, substs o' m,
    have : ω ^ repr e = ω ^ (1 : ordinal.{0}) * ω ^ (repr e - 1),
    { have := mt repr_inj.1 e0,
      rw [← power_add, add_sub_cancel_of_le (one_le_iff_ne_zero.2 this)] },
    refine ⟨NF.oadd (by apply_instance) _ _, _⟩,
    { simp at this ⊢,
      refine IH₁.below_of_lt' ((mul_lt_mul_iff_left omega_pos).1 $
        lt_of_le_of_lt (le_add_right _ m') _),
      rw [← this, ← IH₂], exact h.snd'.repr_lt },
    { rw this, simp [ordinal.mul_add, mul_assoc] } }
end

theorem scale_eq_mul (x) [NF x] : ∀ o [NF o], scale x o = oadd x 1 0 * o
| 0            h := rfl
| (oadd e n a) h := begin
  simp [(*)], simp [mul, scale],
  haveI := h.snd,
  by_cases e0 : e = 0,
  { rw scale_eq_mul, simp [e0, h.zero_of_zero, show x + 0 = x, from repr_inj.1 (by simp)] },
  { simp [e0, scale_eq_mul, (*)] }
end

instance NF_scale (x) [NF x] (o) [NF o] : NF (scale x o) :=
by rw scale_eq_mul; apply_instance

@[simp] theorem repr_scale (x) [NF x] (o) [NF o] : repr (scale x o) = ω ^ repr x * repr o :=
by simp [scale_eq_mul]

theorem NF_repr_split {o o' m} [NF o] (h : split o = (o', m)) : NF o' ∧ repr o = repr o' + m :=
begin
  cases e : split' o with a n,
  cases NF_repr_split' e with s₁ s₂, resetI,
  rw split_eq_scale_split' e at h,
  injection h, substs o' n,
  simp [repr_scale, s₂.symm],
  apply_instance
end

theorem split_dvd {o o' m} [NF o] (h : split o = (o', m)) : ω ∣ repr o' :=
begin
  cases e : split' o with a n,
  rw split_eq_scale_split' e at h,
  injection h, subst o',
  cases NF_repr_split' e, resetI, simp [dvd_mul]
end

theorem split_add_lt {o e n a m} [NF o] (h : split o = (oadd e n a, m)) : repr a + m < ω ^ repr e :=
begin
  cases NF_repr_split h with h₁ h₂,
  cases h₁.of_dvd_omega (split_dvd h) with e0 d,
  have := h₁.fst, have := h₁.snd,
  refine add_lt_omega_power h₁.snd'.repr_lt (lt_of_lt_of_le (nat_lt_omega _) _),
  simpa using power_le_power_right omega_pos (one_le_iff_ne_zero.2 e0),
end

@[simp] theorem mul_nat_eq_mul (n o) : mul_nat o n = o * of_nat n :=
by cases o; cases n; refl

instance NF_mul_nat (o) [NF o] (n) : NF (mul_nat o n) :=
by simp; apply_instance

instance NF_power_aux (e a0 a) [NF e] [NF a0] [NF a] : ∀ k m, NF (power_aux e a0 a k m)
| k     0     := by cases k; exact NF.zero
| 0     (m+1) := NF.oadd_zero _ _
| (k+1) (m+1) := by haveI := NF_power_aux k;
  simp [power_aux, nat.succ_ne_zero]; apply_instance

instance NF_power (o₁ o₂) [NF o₁] [NF o₂] : NF (o₁ ^ o₂) :=
begin
  cases e₁ : split o₁ with a m,
  have na := (NF_repr_split e₁).1,
  cases e₂ : split' o₂ with b' k,
  haveI := (NF_repr_split' e₂).1,
  cases a with a0 n a',
  { cases m with m,
    { by_cases o₂ = 0; simp [pow, power, e₁, h]; apply_instance },
    { by_cases m = 0; simp [pow, power, e₁, e₂, h]; apply_instance } },
  { simp [pow, power, e₁, e₂, split_eq_scale_split' e₂],
    have := na.fst,
    cases k with k; simp [succ_eq_add_one, power]; apply_instance }
end

theorem scale_power_aux (e a0 a : onote) [NF e] [NF a0] [NF a] :
  ∀ k m, repr (power_aux e a0 a k m) = ω ^ repr e * repr (power_aux 0 a0 a k m)
| 0     m := by cases m; simp [power_aux]
| (k+1) m := by by_cases m = 0; simp [h, power_aux,
  ordinal.mul_add, power_add, mul_assoc, scale_power_aux]

theorem repr_power_aux₁ {e a} [Ne : NF e] [Na : NF a] {a' : ordinal}
  (e0 : repr e ≠ 0) (h : a' < ω ^ repr e) (aa : repr a = a') (n : ℕ+) :
  (ω ^ repr e * (n:ℕ) + a') ^ ω = (ω ^ repr e) ^ ω :=
begin
  subst aa,
  have No := Ne.oadd n (Na.below_of_lt' h),
  have := omega_le_oadd e n a, unfold repr at this,
  refine le_antisymm _ (power_le_power_left _ this),
  apply (power_le_of_limit
    (ne_of_gt $ lt_of_lt_of_le (power_pos _ omega_pos) this) omega_is_limit).2,
  intros b l,
  have := (No.below_of_lt (lt_succ_self _)).repr_lt, unfold repr at this,
  apply le_trans (power_le_power_left b $ le_of_lt this),
  rw [← power_mul, ← power_mul],
  apply power_le_power_right omega_pos,
  cases le_or_lt ω (repr e) with h h,
  { apply le_trans (mul_le_mul_left _ $ le_of_lt $ lt_succ_self _),
    rw [succ, add_mul_succ _ (one_add_of_omega_le h), ← succ,
        succ_le, mul_lt_mul_iff_left (pos_iff_ne_zero.2 e0)],
    exact omega_is_limit.2 _ l },
  { refine le_trans (le_of_lt $ mul_lt_omega (omega_is_limit.2 _ h) l) _,
    simpa using mul_le_mul_right ω (one_le_iff_ne_zero.2 e0) }
end

section
local infixr ^ := @pow ordinal.{0} ordinal ordinal.has_pow

theorem repr_power_aux₂ {a0 a'} [N0 : NF a0] [Na' : NF a'] (m : ℕ)
  (d : ω ∣ repr a')
  (e0 : repr a0 ≠ 0) (h : repr a' + m < ω ^ repr a0) (n : ℕ+) (k : ℕ) :
  let R := repr (power_aux 0 a0 (oadd a0 n a' * of_nat m) k m) in
  (k ≠ 0 → R < (ω ^ repr a0) ^ succ k) ∧
  (ω ^ repr a0) ^ k * (ω ^ repr a0 * (n:ℕ) + repr a') + R =
    (ω ^ repr a0 * (n:ℕ) + repr a' + m) ^ succ k :=
begin
  intro,
  haveI No : NF (oadd a0 n a') :=
    N0.oadd n (Na'.below_of_lt' $ lt_of_le_of_lt (le_add_right _ _) h),
  induction k with k IH, {cases m; simp [power_aux, R]},
  rename R R', let R := repr (power_aux 0 a0 (oadd a0 n a' * of_nat m) k m),
  let ω0 := ω ^ repr a0, let α' := ω0 * n + repr a',
  change (k ≠ 0 → R < ω0 ^ succ k) ∧ ω0 ^ k * α' + R = (α' + m) ^ succ k at IH,
  have RR : R' = ω0 ^ k * (α' * m) + R,
  { by_cases m = 0; simp [h, R', power_aux, R, power_mul],
    { cases k; simp [power_aux] }, { refl } },
  have α0 : 0 < α', {simpa [α', lt_def, repr] using oadd_pos a0 n a'},
  have ω00 : 0 < ω0 ^ k := power_pos _ (power_pos _ omega_pos),
  have Rl : R < ω ^ (repr a0 * succ ↑k),
  { by_cases k0 : k = 0,
    { simp [k0],
      refine lt_of_lt_of_le _ (power_le_power_right omega_pos (one_le_iff_ne_zero.2 e0)),
      cases m with m; simp [k0, R, power_aux, omega_pos],
      rw [← nat.cast_succ], apply nat_lt_omega },
    { rw power_mul, exact IH.1 k0 } },
  refine ⟨λ_, _, _⟩,
  { rw [RR, ← power_mul _ _ (succ k.succ)],
    have e0 := pos_iff_ne_zero.2 e0,
    have rr0 := lt_of_lt_of_le e0 (le_add_left _ _),
    apply add_lt_omega_power,
    { simp [power_mul, ω0, power_add],
      rw [mul_lt_mul_iff_left ω00, ← ordinal.power_add],
      have := (No.below_of_lt _).repr_lt, unfold repr at this,
      refine mul_lt_omega_power rr0 this (nat_lt_omega _),
      simpa using (add_lt_add_iff_left (repr a0)).2 e0 },
    { refine lt_of_lt_of_le Rl (power_le_power_right omega_pos $
        mul_le_mul_left _ $ succ_le_succ.2 $ nat_cast_le.2 $ le_of_lt k.lt_succ_self) } },
  refine calc
        ω0 ^ k.succ * α' + R'
      = ω0 ^ succ k * α' + (ω0 ^ k * α' * m + R) : by rw [nat_cast_succ, RR, ← mul_assoc]
  ... = (ω0 ^ k * α' + R) * α' + (ω0 ^ k * α' + R) * m : _
  ... = (α' + m) ^ succ k.succ : by rw [← ordinal.mul_add, ← nat_cast_succ, power_succ, IH.2],
  congr' 1,
  { have αd : ω ∣ α' := dvd_add (dvd_mul_of_dvd _
      (by simpa using power_dvd_power ω (one_le_iff_ne_zero.2 e0))) d,
    rw [ordinal.mul_add (ω0 ^ k), add_assoc, ← mul_assoc, ← power_succ,
        add_mul_limit _ (is_limit_iff_omega_dvd.2 ⟨ne_of_gt α0, αd⟩), mul_assoc,
        @mul_omega_dvd n (nat_cast_pos.2 n.pos) (nat_lt_omega _) _ αd],
    apply @add_absorp _ (repr a0 * succ k),
    { refine add_lt_omega_power _ Rl,
      rw [power_mul, power_succ, mul_lt_mul_iff_left ω00],
      exact No.snd'.repr_lt },
    { have := mul_le_mul_left (ω0 ^ succ k) (one_le_iff_pos.2 $ nat_cast_pos.2 n.pos),
      rw power_mul, simpa [-power_succ] } },
  { cases m,
    { have : R = 0, {cases k; simp [R, power_aux]}, simp [this] },
    { rw [← nat_cast_succ, add_mul_succ],
      apply add_absorp Rl,
      rw [power_mul, power_succ],
      apply ordinal.mul_le_mul_left,
      simpa [α', repr] using omega_le_oadd a0 n a' } }
end

end

theorem repr_power (o₁ o₂) [NF o₁] [NF o₂] : repr (o₁ ^ o₂) = repr o₁ ^ repr o₂ :=
begin
  cases e₁ : split o₁ with a m,
  cases NF_repr_split e₁ with N₁ r₁,
  cases a with a0 n a',
  { cases m with m,
    { by_cases o₂ = 0; simp [power_def, power, e₁, h, r₁],
      have := mt repr_inj.1 h, rw zero_power this },
    { cases e₂ : split' o₂ with b' k,
      cases NF_repr_split' e₂ with _ r₂,
      by_cases m = 0; simp [power_def, power, e₁, h, r₁, e₂, r₂, -nat.cast_succ],
      rw [power_add, power_mul, power_omega _ (nat_lt_omega _)],
      simpa using nat_cast_lt.2 (nat.succ_lt_succ $ nat.pos_iff_ne_zero.2 h) } },
  { haveI := N₁.fst, haveI := N₁.snd,
    cases N₁.of_dvd_omega (split_dvd e₁) with a00 ad,
    have al := split_add_lt e₁,
    have aa : repr (a' + of_nat m) = repr a' + m, {simp},
    cases e₂ : split' o₂ with b' k,
    cases NF_repr_split' e₂ with _ r₂,
    simp [power_def, power, e₁, r₁, split_eq_scale_split' e₂],
    cases k with k,
    { simp [power, r₂, power_mul, repr_power_aux₁ a00 al aa] },
    { simp [succ_eq_add_one, power, r₂, power_add, power_mul, mul_assoc],
      rw [repr_power_aux₁ a00 al aa, scale_power_aux], simp [power_mul],
      rw [← ordinal.mul_add, ← add_assoc (ω ^ repr a0 * (n:ℕ))], congr' 1,
      rw [← power_succ],
      exact (repr_power_aux₂ _ ad a00 al _ _).2 } }
end

end onote

/-- The type of normal ordinal notations. (It would have been
  nicer to define this right in the inductive type, but `NF o`
  requires `repr` which requires `onote`, so all these things
  would have to be defined at once, which messes up the VM
  representation.) -/
def nonote := {o : onote // o.NF}

instance : decidable_eq nonote := by unfold nonote; apply_instance

namespace nonote
open onote

instance NF (o : nonote) : NF o.1 := o.2

/-- Construct a `nonote` from an ordinal notation
  (and infer normality) -/
def mk (o : onote) [h : NF o] : nonote := ⟨o, h⟩

/-- The ordinal represented by an ordinal notation.
  (This function is noncomputable because ordinal
  arithmetic is noncomputable. In computational applications
  `nonote` can be used exclusively without reference
  to `ordinal`, but this function allows for correctness
  results to be stated.) -/
noncomputable def repr (o : nonote) : ordinal := o.1.repr

instance : has_to_string nonote := ⟨λ x, x.1.to_string⟩
instance : has_repr nonote := ⟨λ x, x.1.repr'⟩

instance : preorder nonote :=
{ le       := λ x y, repr x ≤ repr y,
  lt       := λ x y, repr x < repr y,
  le_refl  := λ a, @le_refl ordinal _ _,
  le_trans := λ a b c, @le_trans ordinal _ _ _ _,
  lt_iff_le_not_le := λ a b, @lt_iff_le_not_le ordinal _ _ _ }

instance : has_zero nonote := ⟨⟨0, NF.zero⟩⟩

/-- Convert a natural number to an ordinal notation -/
def of_nat (n : ℕ) : nonote := ⟨of_nat n, _, NF_below_of_nat _⟩

/-- Compare ordinal notations -/
def cmp (a b : nonote) : ordering :=
cmp a.1 b.1

theorem cmp_compares : ∀ a b : nonote, (cmp a b).compares a b
| ⟨a, ha⟩ ⟨b, hb⟩ := begin
  resetI,
  dsimp [cmp], have := onote.cmp_compares a b,
  cases onote.cmp a b; try {exact this},
  exact subtype.mk_eq_mk.2 this
end

instance : linear_order nonote :=
{ le_antisymm := λ a b, match cmp a b, cmp_compares a b with
    | ordering.lt, h, h₁, h₂ := (not_lt_of_le h₂).elim h
    | ordering.eq, h, h₁, h₂ := h
    | ordering.gt, h, h₁, h₂ := (not_lt_of_le h₁).elim h
    end,
  le_total := λ a b, match cmp a b, cmp_compares a b with
    | ordering.lt, h := or.inl (le_of_lt h)
    | ordering.eq, h := or.inl (le_of_eq h)
    | ordering.gt, h := or.inr (le_of_lt h)
    end,
  ..nonote.preorder }

instance decidable_lt : @decidable_rel nonote (<)
| a b := decidable_of_iff _ (cmp_compares a b).eq_lt

instance : decidable_linear_order nonote :=
{ decidable_le := λ a b, decidable_of_iff _ not_lt,
  decidable_lt := nonote.decidable_lt,
  ..nonote.linear_order }

/-- Asserts that `repr a < ω ^ repr b`. Used in `nonote.rec_on` -/
def below (a b : nonote) : Prop := NF_below a.1 (repr b)

/-- The `oadd` pseudo-constructor for `nonote` -/
def oadd (e : nonote) (n : ℕ+) (a : nonote) (h : below a e) : nonote := ⟨_, NF.oadd e.2 n h⟩

/-- This is a recursor-like theorem for `nonote` suggesting an
  inductive definition, which can't actually be defined this
  way due to conflicting dependencies. -/
@[elab_as_eliminator] def rec_on {C : nonote → Sort*} (o : nonote)
  (H0 : C 0)
  (H1 : ∀ e n a h, C e → C a → C (oadd e n a h)) : C o :=
begin
  cases o with o h, induction o with e n a IHe IHa,
  { exact H0 },
  { exact H1 ⟨e, h.fst⟩ n ⟨a, h.snd⟩ h.snd' (IHe _) (IHa _) }
end

/-- Addition of ordinal notations -/
instance : has_add nonote := ⟨λ x y, mk (x.1 + y.1)⟩

theorem repr_add (a b) : repr (a + b) = repr a + repr b :=
onote.repr_add a.1 b.1

/-- Subtraction of ordinal notations -/
instance : has_sub nonote := ⟨λ x y, mk (x.1 - y.1)⟩

theorem repr_sub (a b) : repr (a - b) = repr a - repr b :=
onote.repr_sub a.1 b.1

/-- Multiplication of ordinal notations -/
instance : has_mul nonote := ⟨λ x y, mk (x.1 * y.1)⟩

theorem repr_mul (a b) : repr (a * b) = repr a * repr b :=
onote.repr_mul a.1 b.1

/-- Exponentiation of ordinal notations -/
def power (x y : nonote) := mk (x.1.power y.1)

theorem repr_power (a b) : repr (power a b) = (repr a).power (repr b) :=
onote.repr_power a.1 b.1

end nonote


/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Scott Morrison, Simon Hudon

Definition and basic properties of endomorphisms and automorphisms of an object in a category.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.groupoid
import Mathlib.data.equiv.mul_add
import Mathlib.PostPort

universes v u u' v'

namespace Mathlib

namespace category_theory

/-- Endomorphisms of an object in a category. Arguments order in multiplication agrees with
`function.comp`, not with `category.comp`. -/
def End {C : Type u} [category_struct C] (X : C) := X ⟶ X

namespace End

protected instance has_one {C : Type u} [category_struct C] (X : C) : HasOne (End X) := { one := 𝟙 }

protected instance inhabited {C : Type u} [category_struct C] (X : C) : Inhabited (End X) :=
  { default := 𝟙 }

/-- Multiplication of endomorphisms agrees with `function.comp`, not `category_struct.comp`. -/
protected instance has_mul {C : Type u} [category_struct C] (X : C) : Mul (End X) :=
  { mul := fun (x y : End X) => y ≫ x }

@[simp] theorem one_def {C : Type u} [category_struct C] {X : C} : 1 = 𝟙 := rfl

@[simp] theorem mul_def {C : Type u} [category_struct C] {X : C} (xs : End X) (ys : End X) :
    xs * ys = ys ≫ xs :=
  rfl

/-- Endomorphisms of an object form a monoid -/
protected instance monoid {C : Type u} [category C] {X : C} : monoid (End X) :=
  monoid.mk Mul.mul sorry 1 category.comp_id category.id_comp

/-- In a groupoid, endomorphisms form a group -/
protected instance group {C : Type u} [groupoid C] (X : C) : group (End X) :=
  group.mk monoid.mul sorry monoid.one sorry sorry groupoid.inv
    (div_inv_monoid.div._default monoid.mul sorry monoid.one sorry sorry groupoid.inv)
    groupoid.comp_inv

end End

/--
Automorphisms of an object in a category.

The order of arguments in multiplication agrees with
`function.comp`, not with `category.comp`.
-/
def Aut {C : Type u} [category C] (X : C) := X ≅ X

namespace Aut

protected instance inhabited {C : Type u} [category C] (X : C) : Inhabited (Aut X) :=
  { default := iso.refl X }

protected instance group {C : Type u} [category C] (X : C) : group (Aut X) :=
  group.mk (flip iso.trans) sorry (iso.refl X) sorry sorry iso.symm
    (div_inv_monoid.div._default (flip iso.trans) sorry (iso.refl X) sorry sorry iso.symm) sorry

/--
Units in the monoid of endomorphisms of an object
are (multiplicatively) equivalent to automorphisms of that object.
-/
def units_End_equiv_Aut {C : Type u} [category C] (X : C) : units (End X) ≃* Aut X :=
  mul_equiv.mk (fun (f : units (End X)) => iso.mk (units.val f) (units.inv f))
    (fun (f : Aut X) => units.mk (iso.hom f) (iso.inv f) (iso.inv_hom_id' f) (iso.hom_inv_id' f))
    sorry sorry sorry

end Aut

namespace functor

/-- `f.map` as a monoid hom between endomorphism monoids. -/
def map_End {C : Type u} [category C] (X : C) {D : Type u'} [category D] (f : C ⥤ D) :
    End X →* End (obj f X) :=
  monoid_hom.mk (map f) (map_id f X) sorry

/-- `f.map_iso` as a group hom between automorphism groups. -/
def map_Aut {C : Type u} [category C] (X : C) {D : Type u'} [category D] (f : C ⥤ D) :
    Aut X →* Aut (obj f X) :=
  monoid_hom.mk (map_iso f) (map_iso_refl f X) sorry

end Mathlib


import data.nat.prime
import tactic.norm_num
import data.nat.gcd
open nat

definition is_prime : nat → Prop
| zero := false
| (succ zero) := false
| (succ(succ x)) := ¬∃b c:nat,2≤b ∧ 2≤c ∧ b*c=succ(succ x)
definition product : list nat → nat
| list.nil := 1
| (n::L) :=  n * product L

theorem product_append: ∀L M:list nat,product L*product M=product (L ++ M):=begin
    assume L,
    induction L with h L1 HiL,
        unfold product append list.append,
        assume M, rw one_mul,

        assume M1,
        have H2:product L1 * product (h::M1) = product (L1 ++ (h::M1)):=HiL (h::M1),
        clear HiL,revert H2,
        unfold product append list.append,
        rw[←mul_assoc, mul_comm (product L1) h],
        assume H,rw H,clear H,
        induction L1 with h1 L2 HiL1,
            unfold list.append product,

            unfold list.append product,
            rw [HiL1,←mul_assoc,←mul_assoc, mul_comm h h1],
end

theorem prime_eq :∀ p, is_prime p ↔ prime p:=begin
    intro, cases p with p,
    unfold is_prime prime,norm_num,
    cases p with p,
    unfold is_prime prime,norm_num,exact dec_trivial,
    unfold prime is_prime,
    apply iff.intro,
    assume H,apply and.intro,
    exact dec_trivial,
    assume p1 H3,
    have H4:=exists_eq_mul_right_of_dvd H3,
    apply exists.elim H4, assume c Hc,
    cases c with c,
    exfalso,revert Hc,exact dec_trivial,
    cases c with c,
    revert Hc,norm_num,rw eq_comm,cc,
    cases classical.em(p1=1),left,assumption,
    have H5:∃ (b c : ℕ), 2 ≤ b ∧ 2 ≤ c ∧ b * c = succ (succ p):=begin
        existsi (succ(succ c)),existsi p1,
        have H6:2 ≤ succ (succ c)↔true:=dec_trivial,
        rw H6,simp,rw Hc,simp,
        cases p1 with p1,
        revert Hc,norm_num,exact succ_ne_zero (succ p),
        cases p1 with p1,
        revert a,norm_num,exact dec_trivial,
    end,exfalso,exact H H5,
    assume Hp Hexists,
    apply exists.elim Hexists,assume b Hb,
    apply exists.elim Hb,assume c Hbc,clear Hb Hexists,
    apply and.elim Hbc,assume Hb Hc1,clear Hbc,
    apply and.elim Hc1, assume Hc Hbc,clear Hc1,apply and.elim Hp,clear Hp,
    assume H1 Hp,
    have H3:=Hp c,
    have H4:= dvd_of_mul_left_eq b Hbc,
    have H5:= H3 H4,
    have H6:c=1↔false:=begin
        apply iff.intro,
        assume Ht,revert Hc,rw Ht,norm_num,
    end,revert H5,rw H6,simp,
    assume Hc,rw Hc at Hbc,
    cases b with b,revert Hb,exact dec_trivial,
    cases b with b,revert Hb,exact dec_trivial,
    revert Hbc,simp,rw mul_succ,norm_num,rw[mul_comm,mul_succ],assume Hbc,
    have H7:succ (succ p) + (succ (succ p) * b + succ (succ p)) = succ (succ p)+0:=begin rw Hbc, end,
    have H8:(succ (succ p) * b + succ (succ p))=0:=add_left_cancel H7,
    revert H8,rw[add_comm,succ_add],apply succ_ne_zero,
end

theorem prime_product: ∀x:ℕ,1≤x→∃L:list ℕ,(∀p:ℕ,p ∈ L→prime p)∧product L=x:=begin
    have Hstrong:∀ x y:ℕ,x≤y→1≤x→∃L:list ℕ,(∀p:ℕ,p ∈ L→prime p)∧product L=x:=begin
        assume x y, revert x,
        induction y with y Hiy,
            assume x Hxy Hx1,
            have Hx:=eq_zero_of_le_zero Hxy,revert Hx1,rw Hx,norm_num,
            assume x Hxy H1x,
            cases x with x,revert H1x,norm_num,
            cases x with x,
            existsi list.nil,
            unfold list.mem product,simp,
            cases classical.em(prime (succ(succ x))) with Hx Hx1,
                existsi ([succ(succ x)]),
                unfold list.mem product,simp,assumption,

                rw ←prime_eq at Hx1,unfold is_prime at Hx1,
                have A:∃ (b c : ℕ), 2 ≤ b ∧ 2 ≤ c ∧ b * c = succ (succ x):=begin
                    revert Hx1,cc,
                end,clear Hx1,
                apply exists.elim A, assume b Hb,clear A,
                apply exists.elim Hb, assume c Hbc1,clear Hb,
                have Hb:=and.elim_left Hbc1,
                have Hc:=and.elim_left(and.elim_right Hbc1),
                have Hbc:=and.elim_right(and.elim_right Hbc1),clear Hbc1,
                have Hbx:b<succ(succ x),{rw[←Hbc,mul_comm,lt_mul_iff_one_lt_left],exact lt_of_succ_le Hc,cases b,revert Hb,norm_num,exact dec_trivial},
                have Hcx:c<succ(succ x),{rw[←Hbc,lt_mul_iff_one_lt_left],exact lt_of_succ_le Hb,cases c,revert Hc,norm_num,exact dec_trivial},
                have Hxy1:succ x≤y:=by rwa ←succ_le_succ_iff,clear Hxy,
                have Hbx1:b≤succ x:=begin rw ←succ_le_succ_iff,apply succ_le_of_lt,assumption end,
                have Hcx1:c≤succ x:=begin rw ←succ_le_succ_iff,apply succ_le_of_lt,assumption end,
                have Hby:=le_trans Hbx1 Hxy1,
                have Hcy:=le_trans Hcx1 Hxy1,
                have H12:1≤2:=dec_trivial,
                have H1b:=le_trans H12 Hb,
                have H1c:=le_trans H12 Hc,
                clear H12 Hcx1 Hbx1 Hxy1 Hcx Hbx Hb Hc H1x,
                apply exists.elim (Hiy b Hby H1b),assume Lb HLb,
                apply exists.elim (Hiy c Hcy H1c),assume Lc HLc,clear Hiy H1b H1c Hby Hcy,
                have HLb1:=and.elim_left HLb,have HLb2:=and.elim_right HLb,clear HLb,
                have HLc1:=and.elim_left HLc,have HLc2:=and.elim_right HLc,clear HLc,
                existsi(Lb ++ Lc),
                apply and.intro,rw[←Hbc,←HLb2,←HLc2,eq_comm],
                exact product_append Lb Lc,
                norm_num,
                assume p H,
                cases H with A A,
                exact HLb1 p A,
                exact HLc1 p A,
    end,
    assume x,
    exact Hstrong x x (le_refl x),
end
def euclid_r: int→int→nat→int
| a b 0     := b
| a b 1     := a%b
| a b (n+2) := euclid_r a b n % euclid_r a b (succ n)
def euclid_q: int→int→nat→int
| a b 0     := 0
| a b 1     := -(a/b)
| a b (n+2) := euclid_r a b n / euclid_r a b (succ n)
def euclid_x: int→int→nat→int
| a b 0     := 0
| a b 1     := 1
| a b (n+2) := euclid_x a b n - euclid_q a b (succ (succ n)) * euclid_x a b (succ n)
def euclid_y: int→int→nat→int
| a b 0     := 1
| a b 1     := euclid_q a b 1
| a b (n+2) := euclid_y a b n - euclid_q a b (succ (succ n)) * euclid_y a b (succ n)
open int
theorem pos_mod:∀ a b:int,a%b≥ 0:=sorry

theorem int_mod_lt: ∀ b c:int, c≠ 0→ b%c<abs(c):=int.mod_lt
theorem decreasing_r: ∀ (b c:int) (n:ℕ),abs(euclid_r b c (n+1))<abs(euclid_r b c n) ∨ ∃m,m≤n+1∧euclid_r b c m = 0 :=begin
    assume b c n,
    induction n with n1 Hin,
        unfold euclid_r,
        cases classical.em(c=0) with A A,
        right,existsi 0,unfold euclid_r,
        rw A,simp,exact dec_trivial,left,

        rw abs_of_nonneg (pos_mod b c),

        exact int_mod_lt b c A,
        unfold euclid_r,rw ←add_one,
        cases classical.em (∃ (m : ℕ), m ≤ n1 + 1 ∧ euclid_r b c m = 0) with A A,
        right,apply exists.elim A,assume m Hm,existsi m,
        apply and.intro,
        exact le_trans (and.elim_left Hm) (le_add_right (n1+1) 1),
        exact and.elim_right Hm,
        cases classical.em(euclid_r b c (n1 + 1)=0) with A A,
        right, existsi n1+1,apply and.intro,norm_num,
        assumption,left,
        rw abs_of_nonneg (pos_mod(euclid_r b c n1)(euclid_r b c (n1 + 1))),
        apply int_mod_lt,exact A,
end
--use size_of not abs
theorem gcd_exists:∀ b c :int, ∃ n:nat, euclid_r b c (succ n) = 0:=begin
    assume b c ,
    have H:∀ n:nat,(∀ m:nat,m≤n→¬euclid_r b c m = 0)→abs (euclid_r b c n)≤abs c-n:=begin
        assume n Hn,
        induction n with n1 Hin,
        unfold euclid_r,norm_num,
        have Hn1:∀ (m : ℕ), m ≤ n1 → ¬euclid_r b c m = 0:=begin
            assume m Hm,
            have H:=le_trans Hm (le_succ n1),
            exact Hn m H,
        end,
        have Hin1:=Hin Hn1,clear Hin,
        have H1:=decreasing_r b c n1,
        have H3:∀ (m : ℕ),¬( m ≤succ n1 ∧ euclid_r b c m = 0):=begin
            assume m,rw not_and,exact Hn m,
        end,
        have H2:¬∃ (m : ℕ), m ≤ succ n1 ∧ euclid_r b c m = 0:=not_exists_of_forall_not H3,
        have H4:(∃ (m : ℕ), m ≤ succ n1 ∧ euclid_r b c m = 0)↔false:=begin
            apply iff.intro,exact H2,trivial,
        end,rw H4 at H1,simp at H1,clear H4 H2 H3,
        have H2:= lt_of_lt_of_le H1 Hin1,
        have H3:= add_one_le_of_lt H2,
        have H4:abs c - ↑n1=(abs c -↑n1-1)+1:=begin rw sub_add_cancel, end,
        rw H4 at H3,
        have H5:=le_of_add_le_add_right H3,revert H5,norm_num,
    end,
    cases classical.em (∃m:nat,↑m≤abs c ∧ euclid_r b c m = 0) with A A,
    have H1

end
open nat
theorem quotients :∀(c b:int) n:nat, euclid_r c b n -euclid_q c b (succ(succ n)) * euclid_r c b (succ n) = euclid_r c b (succ (succ n)):=begin
    assume c b n,
    unfold euclid_q euclid_r,
    rw int.mod_def,norm_num,
end
theorem almost_bezout: ∀ (c b:int) n:nat, euclid_x c b n * c + euclid_y c b n * b = euclid_r c b n:=begin
    -- semi strong induction, need previous two cases
    have Hi:∀(c b:int) n:nat,euclid_x c b n * c + euclid_y c b n * b = euclid_r c b n ∧ euclid_x c b (succ n) * c + euclid_y c b (succ n) * b = euclid_r c b (succ n):=begin
        assume  c b n,
        induction n with n1 Hin2,
        apply and.intro,
        unfold euclid_x euclid_y euclid_r,simp,
        unfold euclid_x euclid_y euclid_r euclid_q,rw int.mod_def,simp,

        have Hin:=and.elim_left Hin2,
        have Hin1:=and.elim_right Hin2,clear Hin2,
        apply and.intro,assumption,

        unfold euclid_x euclid_y,

        rw ←quotients c b n1,
        have H1:(euclid_x c b n1 - euclid_q c b (succ (succ n1)) * euclid_x c b (succ n1)) * c=euclid_x c b n1 *c - euclid_q c b (succ (succ n1)) * euclid_x c b (succ n1)*c:=begin norm_num,rw mul_add,norm_num,end,
        have H2:(euclid_y c b n1 - euclid_q c b (succ (succ n1)) * euclid_y c b (succ n1)) * b=euclid_y c b n1 *b - euclid_q c b (succ (succ n1)) * euclid_y c b (succ n1)*b:=begin norm_num,rw mul_add,norm_num,end,
        rw [H1,H2],clear H1 H2,
        have H1:=calc euclid_x c b n1 * c - euclid_q c b (succ (succ n1)) * euclid_x c b (succ n1) * c +
      (euclid_y c b n1 * b - euclid_q c b (succ (succ n1)) * euclid_y c b (succ n1) * b)=euclid_x c b n1 * c - euclid_q c b (succ (succ n1)) * euclid_x c b (succ n1) * c +
      euclid_y c b n1 * b - euclid_q c b (succ (succ n1)) * euclid_y c b (succ n1) * b:by norm_num
      ...=euclid_x c b n1 * c + euclid_y c b n1 * b - euclid_q c b (succ (succ n1)) * euclid_y c b (succ n1) * b-euclid_q c b (succ (succ n1)) * euclid_x c b (succ n1)*c:by norm_num
      ...=euclid_r c b n1 -euclid_q c b (succ (succ n1)) * euclid_y c b (succ n1) * b-euclid_q c b (succ (succ n1)) * euclid_x c b (succ n1)*c:by rw ←Hin
      ...=euclid_r c b n1 + (-euclid_q c b (succ (succ n1)) * (euclid_y c b (succ n1) * b) + -euclid_q c b (succ (succ n1)) * (euclid_x c b (succ n1)*c)):by norm_num,
      rw H1,
      have H2:=mul_add (-euclid_q c b (succ (succ n1))) (euclid_y c b (succ n1) * b) (euclid_x c b (succ n1)*c),rw  ←H2,
      rw ←Hin1,norm_num,
    end,
    assume c b n,
    exact and.elim_left (Hi c b n),
end

theorem int_dvd_mod_iff: ∀ (b c d:int), b ∣ d → (b ∣ (c % d) ↔ b ∣ c) :=begin
    assume b c d Hbd,
    apply iff.intro,
    rw int.mod_def,
    have H1:c=c-(d * (c / d))+(d * (c / d)):=by norm_num,
    intros,rw H1,
    exact dvd_add a (dvd_mul_of_dvd_left Hbd (c/d)),
    assume H1,
    rw int.mod_def,
    exact dvd_sub H1 (dvd_mul_of_dvd_left Hbd (c/d)),
end
theorem cd_dvd_r:∀ (b c x:int), x ∣ b → x∣c→∀ n:nat, x∣euclid_r b c n:=begin
    assume b c x Hb Hc n,
    have Hi:x ∣ euclid_r b c n∧x ∣ euclid_r b c (succ n):=begin
        induction n with n1 Hin,
        unfold euclid_r,apply and.intro,
        assumption,
        exact iff.elim_right (int_dvd_mod_iff x b c Hc) Hb,

        unfold euclid_r,

        exact and.intro (and.elim_right Hin) (iff.elim_right (int_dvd_mod_iff x (euclid_r b c n1) (euclid_r b c (succ n1)) (and.elim_right Hin)) (and.elim_left Hin)),
    end,
    exact and.elim_left Hi,
end
def gcd1: int→int→int→Prop
| a b n:= n∣a ∧ n ∣ b ∧ (∀ e : int,e∣a→ e∣b → e∣n)
theorem gcd_euclid: ∀ (b c:int) (n:nat), euclid_r b c (n+1)=0→gcd1 b c (euclid_r b c n):=begin
    have quotients_mod: ∀ (b c:int) (n:nat), euclid_r b c n= euclid_q b c (succ (succ n)) * euclid_r b c(succ n) +euclid_r b c (succ (succ n)):=begin
        assume b c n,
        rw ←quotients,norm_num,
    end,
    have Hi:∀ (b c:int) (n:nat), euclid_r b c (succ(succ n))=0→(∀ k:nat,k≤n→euclid_r b c (succ n) ∣ euclid_r b c (n-k)∧euclid_r b c (succ n) ∣ euclid_r b c (succ(n-k))):=begin
        assume b c n H,
        unfold euclid_r at H,
        have H2:=int.dvd_of_mod_eq_zero H,
        assume k Hkn,
        induction k with k1 Hik,
        simp,assumption,
        have Hik3:=Hik ( le_trans (le_succ k1) Hkn),clear Hik,
        have Hik1:= and.elim_left Hik3,
        have Hik2:=and.elim_right Hik3,clear Hik3,
        have Hsucc:(nat.succ (n - succ k1))=n-k1:=sorry,
        apply and.intro,
        rw quotients_mod b c (n- succ k1),
        rw Hsucc,
        exact dvd_add (dvd_mul_of_dvd_right Hik1 (euclid_q b c (succ (n - k1)))) Hik2,
        rw Hsucc,assumption,
    end,
    assume b c n Hn,
    have H1:euclid_r b c n ∣ c:=begin
        cases n with n1,
        unfold euclid_r,exact dvd_refl c,rw add_one at Hn,
        have Hi1:= Hi b c n1 Hn n1 (le_refl n1),
        have H1:n1-n1=0:=nat.sub_self n1,
        rw H1 at Hi1,
        unfold euclid_r at Hi1,
        exact and.elim_left Hi1,
    end,
    have H2:euclid_r b c n ∣ (b%c):=begin
        cases n with n1,
        unfold euclid_r,unfold euclid_r at Hn,rw Hn,
        exact dvd_zero c,
        cases n1 with n2,
        unfold euclid_r,exact dvd_refl (b%c),
        have Hi1:= Hi b c (succ n2) Hn n2,
        have H1:nat.succ n2-n2=1:=begin rw ←zero_add 1,have H2:=nat.sub_self n2,rw[←H2,add_one],exact succ_sub (le_refl n2), end,
        rw H1 at Hi1,
        have H3: euclid_r b c 1 =b%c:=by unfold euclid_r,
        rw ←H3,exact and.elim_left (Hi1 (le_succ n2)),
    end,

    unfold gcd1,
    apply and.intro,
    exact iff.elim_left (int_dvd_mod_iff (euclid_r b c n) b c H1) H2,
    apply and.intro,assumption,
    assume x Hb Hc,
    exact cd_dvd_r b c x Hb Hc n,
end

theorem bezout: ∀ b c d:int, gcd1 b c d→ ∃ x y:ℤ, x *b + y*c = d:=begin
    assume b c n Hn,
    apply exists.elim (gcd_exists b c),
    existsi euclid_x b c n,
    existsi euclid_y b c n,
    existsi euclid_r b c n,
    rw ←add_one at Hn,
    apply and.intro,
    exact almost_bezout b c n,
    exact gcd_euclid b c n Hn,
end
def int_prime : int→Prop
| p := abs p ≠ 1 ∧ ∀ x:int, x∣p → abs x=1 ∨ abs x = p
open int
#eval int.sizeof (0:int)
theorem gcdprime:∀ p x:int, int_prime p → ∀ d, gcd1 x p d → d=1 ∨ d=p:=sorry
theorem euclids_lemma: ∀b c p:int, int_prime p→p ∣ (b*c) → p ∣ b ∨ p ∣ c:=sorry
def product_int :list int → int
| list.nil := 1
| (p::L)   := p* product_int L
theorem int_prime_product: ∀ x:int,∃ L:list int,(∀ p:int,p ∈ L → int_prime p)∧product_int L = x:=sorry
def count: int → (list int) → nat
| n [] :=0
| n (a::l):= if abs a=abs n then (succ (count n l)) else (count n l)
theorem product_dvd: ∀ (p:int) (L:list int),p ∈ L→ p ∣ product_int L:=sorry
theorem unique_prime_factorization: ∀ (x :int) (A : list int),((∀ p:int,p ∈ A → int_prime p)∧product_int A = x)→(∀ B:list int,((∀ p:int,p ∈ B → int_prime p)∧product_int B = x)→ ∀ p:int,count p A = count p B):=begin
    assume x A HA,revert x,

    induction A with pA A1 HiA,
    norm_num,unfold product_int count,assume B HB,
    admit,

    assume x1 HA1,
    have H2:∀ p,p ∈ pA :: A1↔p=pA∨p∈A1:=begin
        norm_num,
    end,
    have H1:(∀ (p : ℤ), p ∈ A1 → int_prime p):=begin
        assume p H1,
        have H:=and.elim_left HA1 p,rw (H2 p) at H,
        exact H (or.intro_right (p=pA) H1),
    end,
    have HiA3:=HiA (product_int A1) (and.intro H1 (by trivial)),clear HiA,
    assume B HB,
    cases B with pB B1,
    unfold product_int at HB,
    have Hx1:=and.elim_right HB,clear HB,
    have HA2:=and.elim_right HA1,exfalso,revert HA2,
    rw ←Hx1,unfold product_int,admit,

    have H2B:∀ p,p ∈ pB :: B1↔p=pB∨p∈B1:=begin
        norm_num,
    end,
    have H1B:(∀ (p : ℤ), p ∈ B1 → int_prime p):=begin
        assume p H1,
        have H:=and.elim_left HB p,rw (H2B p) at H,
        exact H (or.intro_right (p=pB) H1),
    end,
    cases classical.em (pA∣pB) with A A,
    have H1:abs(pA)=abs(pB):=sorry,
    unfold count,admit,

end
open nat
def nat_count: nat → (list nat) → nat
| n [] :=0
| n (a::l):= if a=n then (succ (nat_count n l)) else (nat_count n l)
theorem  unique_prime_factorization_nat: ∀ A B:list nat,product A=product B→(∀p:nat, p∈A→prime p)→(∀ p:nat,p∈ B→ prime p)→∀ p:nat,nat_count p A=nat_count p B:=begin
    assume A,
    induction A with pA A1 Hi,
    admit,

    assume B,
    cases B with pB B1,
    admit,

    cases classical.em(pA ∣ pB) with A B,
    have H1:pB = pA:=sorry,
    unfold product,
    have H2:product A1=product B1:=sorry,
    assume H3 H4 H5,
    have H6:(∀ (p : ℕ), p ∈ A1 → prime p):=sorry,
    have H7:(∀ (p : ℕ), p ∈ B1 → prime p):=sorry,
    have Hi2:=Hi B1 H2 H6 H7,rw H1,
    unfold nat_count,admit,

    unfold product,
    have H6:(∀ (p : ℕ), p ∈ A1 → prime p):=sorry,
    have H7:(∀ (p : ℕ), p ∈ B1 → prime p):=sorry,
    have H8:pA ∣ product B1:=sorry,
    have H9:pA ∈ B1:=sorry,
    have H10:∃ B2, pA :: B2 = pB :: B1:=sorry,intros,
    apply exists.elim H10,clear H10,
    assume B2 HB2,
    have H2:product A1=product B2:=sorry,
    have H3:∀p,p∈ B2→prime p:=sorry,
    have Hi2:= Hi B2 H2 H6 H3,
    rw ←HB2,unfold nat_count,
    cases classical.em (pA=p),
    rw a_3,norm_num,rw Hi2 p,
    have H2:pA=p↔false:=sorry,admit,

end


#exit -- remove this to make the code run

import analysis.real
-- real numbers live in here in Lean 3.3.0 mathlib
-- NB you need mathlib installed to get this working.
-- of_rat is the injection from the rationals to the reals.

def A : set ℝ := { x | x^2 < 3}
def B : set ℝ := {x | (∃ y : ℤ, x = of_rat y) ∧ x^2 < 3}
def C : set ℝ := {x | x^3 < 3}

theorem part_a : of_rat (1/2) ∈ A ∩ B := sorry
theorem part_b : of_rat (1/2) ∈ A ∪ B := sorry
theorem part_c : A ⊆ C := sorry
theorem part_d : B ⊆ C := sorry
theorem part_e : C ⊆ A ∪ B := sorry
theorem part_f : (A ∩ B) ∪ C = (A ∪ B) ∩ C := sorry


import algebra.category.Ring
import category_theory.yoneda
import data.polynomial.algebra_map

open category_theory
open opposite
open polynomial

noncomputable theory

/-!
We show that the forgetful functor `CommRing ⥤ Type` is (co)representable.

There are a sequence of hints available in
`hints/category_theory/hintX.lean`, for `X = 1,2,3,4`.
-/

-- Because we'll be working with `polynomial ℤ`, which is in `Type 0`,
-- we just restrict to that universe for this exercise.
notation `CommRing` := CommRing.{0}

/-!
One bonus hint before we start, showing you how to obtain the
ring homomorphism from `ℤ` into any commutative ring.
-/
example (R : CommRing) : ℤ →+* R :=
by library_search

/-!
Also useful may be the functions
-/
#print polynomial.eval₂
#print polynomial.eval₂_ring_hom

/-!
The actual exercise!
-/
def CommRing_forget_representable : Σ (R : CommRing), (forget CommRing) ≅ coyoneda.obj (op R) :=
-- sorry
⟨CommRing.of (polynomial ℤ),
 { hom :=
   { app := λ R r, polynomial.eval₂_ring_hom (algebra_map ℤ R) r, },
   inv :=
   { app := λ R f, by { dsimp at f, exact f X, }, }, }⟩
-- sorry

/-!
There are some further hints in
`hints/category_theory/exercise4/`
-/

/-
If you get an error message
```
synthesized type class instance is not definitionally equal to expression inferred by typing rules
```
while solving this exercise, see hint4.lean.
-/


import game.order.level08
import game.order.level02
open real

namespace xena -- hide

lemma abs_fix_iff_nonneg (a : ℝ) : 0 ≤ a ↔ |a| = a :=
begin
  split,
  exact abs_of_nonneg,
  intro h,
  rcases lt_trichotomy a 0 with han | haz | hap,
  swap,
  rw haz,
  rw abs at h,
  rw max_eq_right at h,
  by_contradiction,
  push_neg at a_1,
  have g : a = 0,
  linarith,
  linarith,
  linarith,
  linarith,
end

lemma abs_prod_eq_prod_iff_prod_nonneg (a b : ℝ) : 0 ≤ a * b ↔ abs a * abs b = a * b  :=
begin
  have g2 : |a * b| = |a| * |b|,
  exact abs_mul _ _,
  rw ← g2,
  exact abs_fix_iff_nonneg (a * b),
end

end xena -- hide


universes u
def id' {α : Sort u} (a : α) : α := a

def Set (X : Type) := X → Prop

namespace Set

def mem {X : Type} (x : X) (s : Set X) := s x

infix:50 " ∈ " => mem

theorem ext {X : Type} (s₁ s₂ : Set X) (h : ∀ x : X, x ∈ s₁ ↔ x ∈ s₂) : s₁ = s₂ :=
by
  funext x
  exact propext <| h x

@[inline]
def asSubtype {X : Type} (Y : Set X) := Subtype (λ x => x ∈ Y)

instance {X : Type} : CoeSort (Set X) Type where
  coe Y := Subtype (λ x => x ∈ Y)

def img {X Y : Type} (f : X → Y) (P : Set X) : Set Y :=
  λ y => ∃ x, x ∈ P ∧ y = f x

def imgComp {X Y Z : Type} {f : X → Y} {g : Y → Z} {P : Set X} :
  img g (img f P) = img (g ∘ f) P :=
by
  funext z
  apply propext
  simp [img, Function.comp]
  exact ⟨ λ h => match h with
    | ⟨ y, ⟨ ⟨ x, ⟨ xIn, xImg ⟩ ⟩, yImg ⟩ ⟩ =>
      ⟨ x, ⟨ xIn, xImg ▸ yImg ▸ rfl ⟩ ⟩,
    λ h => match h with
    | ⟨ x, ⟨ xIn, xImg ⟩ ⟩ =>
      ⟨ (f x), ⟨ ⟨ x, ⟨ xIn, rfl ⟩ ⟩, xImg ⟩ ⟩ ⟩

def imgCongrFun {X Y : Type} {f g : X → Y} {P : Set X} (h : f = g) :
  img f P = img g P := by rw [h]

end Set


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

/-!
# Galois connections, insertions and coinsertions

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

Galois connections are order theoretic adjoints, i.e. a pair of functions `u` and `l`,
such that `∀ a b, l a ≤ b ↔ a ≤ u b`.

## Main definitions

* `galois_connection`: A Galois connection is a pair of functions `l` and `u` satisfying
  `l a ≤ b ↔ a ≤ u b`. They are special cases of adjoint functors in category theory,
  but do not depend on the category theory library in mathlib.
* `galois_insertion`: A Galois insertion is a Galois connection where `l ∘ u = id`
* `galois_coinsertion`: A Galois coinsertion is a Galois connection where `u ∘ l = id`

## Implementation details

Galois insertions can be used to lift order structures from one type to another.
For example if `α` is a complete lattice, and `l : α → β`, and `u : β → α` form a Galois insertion,
then `β` is also a complete lattice. `l` is the lower adjoint and `u` is the upper adjoint.

An example of a Galois insertion is in group theory. If `G` is a group, then there is a Galois
insertion between the set of subsets of `G`, `set G`, and the set of subgroups of `G`,
`subgroup G`. The lower adjoint is `subgroup.closure`, taking the `subgroup` generated by a `set`,
and the upper adjoint is the coercion from `subgroup G` to `set G`, taking the underlying set
of a subgroup.

Naively lifting a lattice structure along this Galois insertion would mean that the definition
of `inf` on subgroups would be `subgroup.closure (↑S ∩ ↑T)`. This is an undesirable definition
because the intersection of subgroups is already a subgroup, so there is no need to take the
closure. For this reason a `choice` function is added as a field to the `galois_insertion`
structure. It has type `Π S : set G, ↑(closure S) ≤ S → subgroup G`. When `↑(closure S) ≤ S`, then
`S` is already a subgroup, so this function can be defined using `subgroup.mk` and not `closure`.
This means the infimum of subgroups will be defined to be the intersection of sets, paired
with a proof that intersection of subgroups is a subgroup, rather than the closure of the
intersection.
-/

open function order_dual set

universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x} {κ : ι → Sort*} {a a₁ a₂ : α}
  {b b₁ b₂ : β}

/-- A Galois connection is a pair of functions `l` and `u` satisfying
  `l a ≤ b ↔ a ≤ u b`. They are special cases of adjoint functors in category theory,
    but do not depend on the category theory library in mathlib. -/
def galois_connection [preorder α] [preorder β] (l : α → β) (u : β → α) := ∀ a b, l a ≤ b ↔ a ≤ u b

/-- Makes a Galois connection from an order-preserving bijection. -/
theorem order_iso.to_galois_connection [preorder α] [preorder β] (oi : α ≃o β) :
  galois_connection oi oi.symm :=
λ b g, oi.rel_symm_apply.symm

namespace galois_connection

section
variables [preorder α] [preorder β] {l : α → β} {u : β → α} (gc : galois_connection l u)

lemma monotone_intro (hu : monotone u) (hl : monotone l)
  (hul : ∀ a, a ≤ u (l a)) (hlu : ∀ a, l (u a) ≤ a) : galois_connection l u :=
λ a b, ⟨λ h, (hul _).trans (hu h), λ h, (hl h).trans (hlu _)⟩

include gc

protected lemma dual {l : α → β} {u : β → α} (gc : galois_connection l u) :
  galois_connection (order_dual.to_dual ∘ u ∘ order_dual.of_dual)
    (order_dual.to_dual ∘ l ∘ order_dual.of_dual) :=
λ a b, (gc b a).symm

lemma le_iff_le {a : α} {b : β} : l a ≤ b ↔ a ≤ u b :=
gc _ _

lemma l_le {a : α} {b : β} : a ≤ u b → l a ≤ b :=
(gc _ _).mpr

lemma le_u {a : α} {b : β} : l a ≤ b → a ≤ u b :=
(gc _ _).mp

lemma le_u_l (a) : a ≤ u (l a) :=
gc.le_u $ le_rfl

lemma l_u_le (a) : l (u a) ≤ a :=
gc.l_le $ le_rfl

lemma monotone_u : monotone u :=
λ a b H, gc.le_u ((gc.l_u_le a).trans H)

lemma monotone_l : monotone l :=
gc.dual.monotone_u.dual

lemma upper_bounds_l_image (s : set α) : upper_bounds (l '' s) = u ⁻¹' upper_bounds s :=
set.ext $ λ b, by simp [upper_bounds, gc _ _]

lemma lower_bounds_u_image (s : set β) : lower_bounds (u '' s) = l ⁻¹' lower_bounds s :=
gc.dual.upper_bounds_l_image s

lemma bdd_above_l_image {s : set α} : bdd_above (l '' s) ↔ bdd_above s :=
⟨λ ⟨x, hx⟩, ⟨u x, by rwa [gc.upper_bounds_l_image] at hx⟩, gc.monotone_l.map_bdd_above⟩

lemma bdd_below_u_image {s : set β} : bdd_below (u '' s) ↔ bdd_below s :=
gc.dual.bdd_above_l_image

lemma is_lub_l_image {s : set α} {a : α} (h : is_lub s a) : is_lub (l '' s) (l a) :=
⟨gc.monotone_l.mem_upper_bounds_image h.left,
  λ b hb, gc.l_le $ h.right $ by rwa [gc.upper_bounds_l_image] at hb⟩

lemma is_glb_u_image {s : set β} {b : β} (h : is_glb s b) : is_glb (u '' s) (u b) :=
gc.dual.is_lub_l_image h

lemma is_least_l {a : α} : is_least {b | a ≤ u b} (l a) :=
⟨gc.le_u_l _, λ b hb, gc.l_le hb⟩

lemma is_greatest_u {b : β} : is_greatest {a | l a ≤ b} (u b) :=
gc.dual.is_least_l

lemma is_glb_l {a : α} : is_glb {b | a ≤ u b} (l a) := gc.is_least_l.is_glb

lemma is_lub_u {b : β} : is_lub { a | l a ≤ b } (u b) := gc.is_greatest_u.is_lub

/-- If `(l, u)` is a Galois connection, then the relation `x ≤ u (l y)` is a transitive relation.
If `l` is a closure operator (`submodule.span`, `subgroup.closure`, ...) and `u` is the coercion to
`set`, this reads as "if `U` is in the closure of `V` and `V` is in the closure of `W` then `U` is
in the closure of `W`". -/
lemma le_u_l_trans {x y z : α} (hxy : x ≤ u (l y)) (hyz : y ≤ u (l z)) :
  x ≤ u (l z) :=
hxy.trans (gc.monotone_u $ gc.l_le hyz)

lemma l_u_le_trans {x y z : β} (hxy : l (u x) ≤ y) (hyz : l (u y) ≤ z) :
  l (u x) ≤ z :=
(gc.monotone_l $ gc.le_u hxy).trans hyz

end

section partial_order
variables [partial_order α] [preorder β] {l : α → β} {u : β → α} (gc : galois_connection l u)
include gc

lemma u_l_u_eq_u (b : β) : u (l (u b)) = u b :=
(gc.monotone_u (gc.l_u_le _)).antisymm (gc.le_u_l _)

lemma u_l_u_eq_u' : u ∘ l ∘ u = u := funext gc.u_l_u_eq_u

lemma u_unique {l' : α → β} {u' : β → α} (gc' : galois_connection l' u')
  (hl : ∀ a, l a = l' a) {b : β} : u b = u' b :=
le_antisymm (gc'.le_u $ hl (u b) ▸ gc.l_u_le _)
  (gc.le_u $ (hl (u' b)).symm ▸ gc'.l_u_le _)

/-- If there exists a `b` such that `a = u a`, then `b = l a` is one such element. -/
lemma exists_eq_u (a : α) : (∃ b : β, a = u b) ↔ a = u (l a) :=
⟨λ ⟨S, hS⟩, hS.symm ▸ (gc.u_l_u_eq_u _).symm, λ HI, ⟨_, HI⟩ ⟩

lemma u_eq {z : α} {y : β} :
  u y = z ↔ ∀ x, x ≤ z ↔ l x ≤ y :=
begin
  split,
  { rintros rfl x,
    exact (gc x y).symm },
  { intros H,
    exact ((H $ u y).mpr (gc.l_u_le y)).antisymm ((gc _ _).mp $ (H z).mp le_rfl) }
end

end partial_order

section partial_order
variables [preorder α] [partial_order β] {l : α → β} {u : β → α} (gc : galois_connection l u)
include gc

lemma l_u_l_eq_l (a : α) : l (u (l a)) = l a :=
(gc.l_u_le _).antisymm (gc.monotone_l (gc.le_u_l _))

lemma l_u_l_eq_l' : l ∘ u ∘ l = l := funext gc.l_u_l_eq_l

lemma l_unique {l' : α → β} {u' : β → α} (gc' : galois_connection l' u')
  (hu : ∀ b, u b = u' b) {a : α} : l a = l' a :=
le_antisymm (gc.l_le $ (hu (l' a)).symm ▸ gc'.le_u_l _)
  (gc'.l_le $ hu (l a) ▸ gc.le_u_l _)

/-- If there exists an `a` such that `b = l a`, then `a = u b` is one such element. -/
lemma exists_eq_l (b : β) : (∃ a : α, b = l a) ↔ b = l (u b) :=
⟨λ ⟨S, hS⟩, hS.symm ▸ (gc.l_u_l_eq_l _).symm, λ HI, ⟨_, HI⟩ ⟩

lemma l_eq  {x : α} {z : β} :
  l x = z ↔ ∀ y, z ≤ y ↔ x ≤ u y :=
begin
  split,
  { rintros rfl y,
    exact gc x y },
  { intros H,
    exact ((gc _ _).mpr $ (H z).mp le_rfl).antisymm ((H $ l x).mpr (gc.le_u_l x)) }
end

end partial_order

section order_top
variables [partial_order α] [preorder β] [order_top α]

lemma u_eq_top {l : α → β} {u : β → α} (gc : galois_connection l u) {x} : u x = ⊤ ↔ l ⊤ ≤ x :=
top_le_iff.symm.trans gc.le_iff_le.symm

lemma u_top [order_top β] {l : α → β} {u : β → α} (gc : galois_connection l u) : u ⊤ = ⊤ :=
gc.u_eq_top.2 le_top

end order_top

section order_bot
variables [preorder α] [partial_order β] [order_bot β]

lemma l_eq_bot {l : α → β} {u : β → α} (gc : galois_connection l u) {x} : l x = ⊥ ↔ x ≤ u ⊥ :=
gc.dual.u_eq_top

lemma l_bot [order_bot α] {l : α → β} {u : β → α} (gc : galois_connection l u) : l ⊥ = ⊥ :=
gc.dual.u_top

end order_bot

section semilattice_sup
variables [semilattice_sup α] [semilattice_sup β] {l : α → β} {u : β → α}
  (gc : galois_connection l u)
include gc

lemma l_sup : l (a₁ ⊔ a₂) = l a₁ ⊔ l a₂ :=
(gc.is_lub_l_image is_lub_pair).unique $ by simp only [image_pair, is_lub_pair]

end semilattice_sup

section semilattice_inf
variables [semilattice_inf α] [semilattice_inf β] {l : α → β} {u : β → α}
  (gc : galois_connection l u)
include gc

lemma u_inf : u (b₁ ⊓ b₂) = u b₁ ⊓ u b₂ := gc.dual.l_sup

end semilattice_inf

section complete_lattice
variables [complete_lattice α] [complete_lattice β] {l : α → β} {u : β → α}
  (gc : galois_connection l u)
include gc

lemma l_supr {f : ι → α} : l (supr f) = ⨆ i, l (f i) :=
eq.symm $ is_lub.supr_eq $ show is_lub (range (l ∘ f)) (l (supr f)),
  by rw [range_comp, ← Sup_range]; exact gc.is_lub_l_image (is_lub_Sup _)

lemma l_supr₂ {f : Π i, κ i → α} : l (⨆ i j, f i j) = ⨆ i j, l (f i j) := by simp_rw gc.l_supr

lemma u_infi {f : ι → β} : u (infi f) = ⨅ i, u (f i) := gc.dual.l_supr
lemma u_infi₂ {f : Π i, κ i → β} : u (⨅ i j, f i j) = ⨅ i j, u (f i j) := gc.dual.l_supr₂

lemma l_Sup {s : set α} : l (Sup s) = ⨆ a ∈ s, l a := by simp only [Sup_eq_supr, gc.l_supr]
lemma u_Inf {s : set β} : u (Inf s) = ⨅ a ∈ s, u a := gc.dual.l_Sup

end complete_lattice

section linear_order
variables [linear_order α] [linear_order β] {l : α → β} {u : β → α}
  (gc : galois_connection l u)

lemma lt_iff_lt {a : α} {b : β} : b < l a ↔ u b < a := lt_iff_lt_of_le_iff_le (gc a b)

end linear_order

/- Constructing Galois connections -/
section constructions

protected lemma id [pα : preorder α] : @galois_connection α α pα pα id id :=
λ a b, iff.intro (λ x, x) (λ x, x)

protected lemma compose [preorder α] [preorder β] [preorder γ]
  {l1 : α → β} {u1 : β → α} {l2 : β → γ} {u2 : γ → β}
  (gc1 : galois_connection l1 u1) (gc2 : galois_connection l2 u2) :
  galois_connection (l2 ∘ l1) (u1 ∘ u2) :=
by intros a b; rw [gc2, gc1]

protected lemma dfun {ι : Type u} {α : ι → Type v} {β : ι → Type w}
  [∀ i, preorder (α i)] [∀ i, preorder (β i)]
  (l : Πi, α i → β i) (u : Πi, β i → α i) (gc : ∀ i, galois_connection (l i) (u i)) :
  galois_connection (λ (a : Π i, α i) i, l i (a i)) (λ b i, u i (b i)) :=
λ a b, forall_congr $ λ i, gc i (a i) (b i)

end constructions

lemma l_comm_of_u_comm
  {X : Type*} [preorder X] {Y : Type*} [preorder Y]
  {Z : Type*} [preorder Z] {W : Type*} [partial_order W]
  {lYX : X → Y} {uXY : Y → X} (hXY : galois_connection lYX uXY)
  {lWZ : Z → W} {uZW : W → Z} (hZW : galois_connection lWZ uZW)
  {lWY : Y → W} {uYW : W → Y} (hWY : galois_connection lWY uYW)
  {lZX : X → Z} {uXZ : Z → X} (hXZ : galois_connection lZX uXZ)
  (h : ∀ w, uXZ (uZW w) = uXY (uYW w)) {x : X} : lWZ (lZX x) = lWY (lYX x) :=
(hXZ.compose hZW).l_unique (hXY.compose hWY) h

lemma u_comm_of_l_comm
  {X : Type*} [partial_order X] {Y : Type*} [preorder Y]
  {Z : Type*} [preorder Z] {W : Type*} [preorder W]
  {lYX : X → Y} {uXY : Y → X} (hXY : galois_connection lYX uXY)
  {lWZ : Z → W} {uZW : W → Z} (hZW : galois_connection lWZ uZW)
  {lWY : Y → W} {uYW : W → Y} (hWY : galois_connection lWY uYW)
  {lZX : X → Z} {uXZ : Z → X} (hXZ : galois_connection lZX uXZ)
  (h : ∀ x, lWZ (lZX x) = lWY (lYX x)) {w : W} : uXZ (uZW w) = uXY (uYW w) :=
(hXZ.compose hZW).u_unique (hXY.compose hWY) h

lemma l_comm_iff_u_comm
  {X : Type*} [partial_order X] {Y : Type*} [preorder Y]
  {Z : Type*} [preorder Z] {W : Type*} [partial_order W]
  {lYX : X → Y} {uXY : Y → X} (hXY : galois_connection lYX uXY)
  {lWZ : Z → W} {uZW : W → Z} (hZW : galois_connection lWZ uZW)
  {lWY : Y → W} {uYW : W → Y} (hWY : galois_connection lWY uYW)
  {lZX : X → Z} {uXZ : Z → X} (hXZ : galois_connection lZX uXZ) :
  (∀ w : W, uXZ (uZW w) = uXY (uYW w)) ↔ ∀ x : X, lWZ (lZX x) = lWY (lYX x) :=
⟨hXY.l_comm_of_u_comm hZW hWY hXZ, hXY.u_comm_of_l_comm hZW hWY hXZ⟩

end galois_connection

section
variables [complete_lattice α] [complete_lattice β] [complete_lattice γ] {f : α → β → γ} {s : set α}
  {t : set β} {l u : α → β → γ} {l₁ u₁ : β → γ → α} {l₂ u₂ : α → γ → β}

lemma Sup_image2_eq_Sup_Sup (h₁ : ∀ b, galois_connection (swap l b) (u₁ b))
  (h₂ : ∀ a, galois_connection (l a) (u₂ a)) :
  Sup (image2 l s t) = l (Sup s) (Sup t) :=
by simp_rw [Sup_image2, ←(h₂ _).l_Sup, ←(h₁ _).l_Sup]

lemma Sup_image2_eq_Sup_Inf (h₁ : ∀ b, galois_connection (swap l b) (u₁ b))
  (h₂ : ∀ a, galois_connection (l a ∘ of_dual) (to_dual ∘ u₂ a)) :
  Sup (image2 l s t) = l (Sup s) (Inf t) :=
@Sup_image2_eq_Sup_Sup _ βᵒᵈ _ _ _ _ _ _ _ _ _ h₁ h₂

lemma Sup_image2_eq_Inf_Sup (h₁ : ∀ b, galois_connection (swap l b ∘ of_dual) (to_dual ∘ u₁ b))
  (h₂ : ∀ a, galois_connection (l a) (u₂ a)) :
  Sup (image2 l s t) = l (Inf s) (Sup t) :=
@Sup_image2_eq_Sup_Sup αᵒᵈ _ _ _ _ _ _ _ _ _ _ h₁ h₂

lemma Sup_image2_eq_Inf_Inf (h₁ : ∀ b, galois_connection (swap l b ∘ of_dual) (to_dual ∘ u₁ b))
  (h₂ : ∀ a, galois_connection (l a ∘ of_dual) (to_dual ∘ u₂ a)) :
  Sup (image2 l s t) = l (Inf s) (Inf t) :=
@Sup_image2_eq_Sup_Sup αᵒᵈ βᵒᵈ _ _ _ _ _ _ _ _ _ h₁ h₂

lemma Inf_image2_eq_Inf_Inf (h₁ : ∀ b, galois_connection (l₁ b) (swap u b))
  (h₂ : ∀ a, galois_connection (l₂ a) (u a)) :
  Inf (image2 u s t) = u (Inf s) (Inf t) :=
by simp_rw [Inf_image2, ←(h₂ _).u_Inf, ←(h₁ _).u_Inf]

lemma Inf_image2_eq_Inf_Sup (h₁ : ∀ b, galois_connection (l₁ b) (swap u b))
  (h₂ : ∀ a, galois_connection (to_dual ∘ l₂ a) (u a ∘ of_dual)) :
  Inf (image2 u s t) = u (Inf s) (Sup t) :=
@Inf_image2_eq_Inf_Inf _ βᵒᵈ _ _ _ _ _ _ _ _ _ h₁ h₂

lemma Inf_image2_eq_Sup_Inf (h₁ : ∀ b, galois_connection (to_dual ∘ l₁ b) (swap u b ∘ of_dual))
  (h₂ : ∀ a, galois_connection (l₂ a) (u a)) :
  Inf (image2 u s t) = u (Sup s) (Inf t) :=
@Inf_image2_eq_Inf_Inf αᵒᵈ _ _ _ _ _ _ _ _ _ _ h₁ h₂

lemma Inf_image2_eq_Sup_Sup (h₁ : ∀ b, galois_connection (to_dual ∘ l₁ b) (swap u b ∘ of_dual))
  (h₂ : ∀ a, galois_connection (to_dual ∘ l₂ a) (u a ∘ of_dual)) :
  Inf (image2 u s t) = u (Sup s) (Sup t) :=
@Inf_image2_eq_Inf_Inf αᵒᵈ βᵒᵈ _ _ _ _ _ _ _ _ _ h₁ h₂

end

namespace order_iso

variables [preorder α] [preorder β]

@[simp] lemma bdd_above_image (e : α ≃o β) {s : set α} : bdd_above (e '' s) ↔ bdd_above s :=
e.to_galois_connection.bdd_above_l_image

@[simp] lemma bdd_below_image (e : α ≃o β) {s : set α} : bdd_below (e '' s) ↔ bdd_below s :=
e.dual.bdd_above_image

@[simp] lemma bdd_above_preimage (e : α ≃o β) {s : set β} : bdd_above (e ⁻¹' s) ↔ bdd_above s :=
by rw [← e.bdd_above_image, e.image_preimage]

@[simp] lemma bdd_below_preimage (e : α ≃o β) {s : set β} : bdd_below (e ⁻¹' s) ↔ bdd_below s :=
by rw [← e.bdd_below_image, e.image_preimage]

end order_iso

namespace nat

lemma galois_connection_mul_div {k : ℕ} (h : 0 < k) : galois_connection (λ n, n * k) (λ n, n / k) :=
λ x y, (le_div_iff_mul_le h).symm

end nat

/-- A Galois insertion is a Galois connection where `l ∘ u = id`. It also contains a constructive
choice function, to give better definitional equalities when lifting order structures. Dual
to `galois_coinsertion` -/
@[nolint has_nonempty_instance]
structure galois_insertion {α β : Type*} [preorder α] [preorder β] (l : α → β) (u : β → α) :=
(choice : Πx : α, u (l x) ≤ x → β)
(gc : galois_connection l u)
(le_l_u : ∀ x, x ≤ l (u x))
(choice_eq : ∀ a h, choice a h = l a)

/-- A constructor for a Galois insertion with the trivial `choice` function. -/
def galois_insertion.monotone_intro {α β : Type*} [preorder α] [preorder β] {l : α → β} {u : β → α}
  (hu : monotone u) (hl : monotone l) (hul : ∀ a, a ≤ u (l a)) (hlu : ∀ b, l (u b) = b) :
  galois_insertion l u :=
{ choice := λ x _, l x,
  gc := galois_connection.monotone_intro hu hl hul (λ b, le_of_eq (hlu b)),
  le_l_u := λ b, le_of_eq $ (hlu b).symm,
  choice_eq := λ _ _, rfl }

/-- Makes a Galois insertion from an order-preserving bijection. -/
protected def order_iso.to_galois_insertion [preorder α] [preorder β] (oi : α ≃o β) :
  galois_insertion oi oi.symm :=
{ choice := λ b h, oi b,
  gc := oi.to_galois_connection,
  le_l_u := λ g, le_of_eq (oi.right_inv g).symm,
  choice_eq := λ b h, rfl }

/-- Make a `galois_insertion l u` from a `galois_connection l u` such that `∀ b, b ≤ l (u b)` -/
def galois_connection.to_galois_insertion {α β : Type*} [preorder α] [preorder β]
  {l : α → β} {u : β → α} (gc : galois_connection l u) (h : ∀ b, b ≤ l (u b)) :
  galois_insertion l u :=
{ choice := λ x _, l x,
  gc := gc,
  le_l_u := h,
  choice_eq := λ _ _, rfl }

/-- Lift the bottom along a Galois connection -/
def galois_connection.lift_order_bot {α β : Type*} [preorder α] [order_bot α] [partial_order β]
  {l : α → β} {u : β → α} (gc : galois_connection l u) :
  order_bot β :=
{ bot    := l ⊥,
  bot_le := λ b, gc.l_le $ bot_le }

namespace galois_insertion

variables {l : α → β} {u : β → α}

lemma l_u_eq [preorder α] [partial_order β] (gi : galois_insertion l u) (b : β) :
  l (u b) = b :=
(gi.gc.l_u_le _).antisymm (gi.le_l_u _)

lemma left_inverse_l_u [preorder α] [partial_order β] (gi : galois_insertion l u) :
  left_inverse l u :=
gi.l_u_eq

lemma l_surjective [preorder α] [partial_order β] (gi : galois_insertion l u) :
  surjective l :=
gi.left_inverse_l_u.surjective

lemma u_injective [preorder α] [partial_order β] (gi : galois_insertion l u) :
  injective u :=
gi.left_inverse_l_u.injective

lemma l_sup_u [semilattice_sup α] [semilattice_sup β] (gi : galois_insertion l u) (a b : β) :
  l (u a ⊔ u b) = a ⊔ b :=
calc l (u a ⊔ u b) = l (u a) ⊔ l (u b) : gi.gc.l_sup
               ... = a ⊔ b : by simp only [gi.l_u_eq]

lemma l_supr_u [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  {ι : Sort x} (f : ι → β) :
  l (⨆ i, u (f i)) = ⨆ i, (f i) :=
calc l (⨆ (i : ι), u (f i)) = ⨆ (i : ι), l (u (f i)) : gi.gc.l_supr
                        ... = ⨆ (i : ι), f i : congr_arg _ $ funext $ λ i, gi.l_u_eq (f i)

lemma l_bsupr_u [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  {ι : Sort x} {p : ι → Prop} (f : Π i (hi : p i), β) :
  l (⨆ i hi, u (f i hi)) = ⨆ i hi, f i hi :=
by simp only [supr_subtype', gi.l_supr_u]

lemma l_Sup_u_image [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  (s : set β) : l (Sup (u '' s)) = Sup s :=
by rw [Sup_image, gi.l_bsupr_u, Sup_eq_supr]

lemma l_inf_u [semilattice_inf α] [semilattice_inf β] (gi : galois_insertion l u) (a b : β) :
  l (u a ⊓ u b) = a ⊓ b :=
calc l (u a ⊓ u b) = l (u (a ⊓ b)) : congr_arg l gi.gc.u_inf.symm
               ... = a ⊓ b : by simp only [gi.l_u_eq]

lemma l_infi_u [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  {ι : Sort x} (f : ι → β) :
  l (⨅ i, u (f i)) = ⨅ i, f i :=
calc l (⨅ (i : ι), u (f i)) = l (u (⨅ (i : ι), (f i))) : congr_arg l gi.gc.u_infi.symm
                        ... = ⨅ (i : ι), f i : gi.l_u_eq _

lemma l_binfi_u [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  {ι : Sort x} {p : ι → Prop} (f : Π i (hi : p i), β) :
  l (⨅ i hi, u (f i hi)) = ⨅ i hi, f i hi :=
by simp only [infi_subtype', gi.l_infi_u]

lemma l_Inf_u_image [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  (s : set β) : l (Inf (u '' s)) = Inf s :=
by rw [Inf_image, gi.l_binfi_u, Inf_eq_infi]

lemma l_infi_of_ul_eq_self [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  {ι : Sort x} (f : ι → α) (hf : ∀ i, u (l (f i)) = f i) :
  l (⨅ i, f i) = ⨅ i, l (f i) :=
calc l (⨅ i, (f i)) =  l ⨅ (i : ι), (u (l (f i))) : by simp [hf]
                ... = ⨅ i, l (f i) : gi.l_infi_u _

lemma l_binfi_of_ul_eq_self [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  {ι : Sort x} {p : ι → Prop} (f : Π i (hi : p i), α) (hf : ∀ i hi, u (l (f i hi)) = f i hi) :
  l (⨅ i hi, f i hi) = ⨅ i hi, l (f i hi) :=
by { rw [infi_subtype', infi_subtype'], exact gi.l_infi_of_ul_eq_self _ (λ _, hf _ _) }

lemma u_le_u_iff [preorder α] [preorder β] (gi : galois_insertion l u) {a b} :
  u a ≤ u b ↔ a ≤ b :=
⟨λ h, (gi.le_l_u _).trans (gi.gc.l_le h),
    λ h, gi.gc.monotone_u h⟩

lemma strict_mono_u [preorder α] [preorder β] (gi : galois_insertion l u) : strict_mono u :=
strict_mono_of_le_iff_le $ λ _ _, gi.u_le_u_iff.symm

lemma is_lub_of_u_image [preorder α] [preorder β] (gi : galois_insertion l u) {s : set β} {a : α}
  (hs : is_lub (u '' s) a) : is_lub s (l a) :=
⟨λ x hx, (gi.le_l_u x).trans $ gi.gc.monotone_l $ hs.1 $ mem_image_of_mem _ hx,
  λ x hx, gi.gc.l_le $ hs.2 $ gi.gc.monotone_u.mem_upper_bounds_image hx⟩

lemma is_glb_of_u_image [preorder α] [preorder β] (gi : galois_insertion l u) {s : set β} {a : α}
  (hs : is_glb (u '' s) a) : is_glb s (l a) :=
⟨λ x hx, gi.gc.l_le $ hs.1 $ mem_image_of_mem _ hx,
  λ x hx, (gi.le_l_u x).trans $ gi.gc.monotone_l $ hs.2 $
    gi.gc.monotone_u.mem_lower_bounds_image hx⟩

section lift

variables [partial_order β]

/-- Lift the suprema along a Galois insertion -/
@[reducible] -- See note [reducible non instances]
def lift_semilattice_sup [semilattice_sup α] (gi : galois_insertion l u) : semilattice_sup β :=
{ sup := λ a b, l (u a ⊔ u b),
  le_sup_left  := λ a b, (gi.le_l_u a).trans $ gi.gc.monotone_l $ le_sup_left,
  le_sup_right := λ a b, (gi.le_l_u b).trans $ gi.gc.monotone_l $ le_sup_right,
  sup_le       := λ a b c hac hbc,
    gi.gc.l_le $ sup_le (gi.gc.monotone_u hac) (gi.gc.monotone_u hbc),
  .. ‹partial_order β› }

/-- Lift the infima along a Galois insertion -/
@[reducible] -- See note [reducible non instances]
def lift_semilattice_inf [semilattice_inf α] (gi : galois_insertion l u) : semilattice_inf β :=
{ inf := λ a b, gi.choice (u a ⊓ u b) $
    (le_inf (gi.gc.monotone_u $ gi.gc.l_le $ inf_le_left)
      (gi.gc.monotone_u $ gi.gc.l_le $ inf_le_right)),
  inf_le_left  := by simp only [gi.choice_eq]; exact λ a b, gi.gc.l_le inf_le_left,
  inf_le_right := by simp only [gi.choice_eq]; exact λ a b, gi.gc.l_le inf_le_right,
  le_inf       := by simp only [gi.choice_eq]; exact λ a b c hac hbc,
    (gi.le_l_u a).trans $ gi.gc.monotone_l $ le_inf (gi.gc.monotone_u hac) (gi.gc.monotone_u hbc),
  .. ‹partial_order β› }

/-- Lift the suprema and infima along a Galois insertion -/
@[reducible] -- See note [reducible non instances]
def lift_lattice [lattice α] (gi : galois_insertion l u) : lattice β :=
{ .. gi.lift_semilattice_sup, .. gi.lift_semilattice_inf }

/-- Lift the top along a Galois insertion -/
@[reducible] -- See note [reducible non instances]
def lift_order_top [preorder α] [order_top α] (gi : galois_insertion l u) : order_top β :=
{ top    := gi.choice ⊤ $ le_top,
  le_top := by simp only [gi.choice_eq]; exact λ b, (gi.le_l_u b).trans (gi.gc.monotone_l le_top) }

/-- Lift the top, bottom, suprema, and infima along a Galois insertion -/
@[reducible] -- See note [reducible non instances]
def lift_bounded_order [preorder α] [bounded_order α]
  (gi : galois_insertion l u) : bounded_order β :=
{ .. gi.lift_order_top, .. gi.gc.lift_order_bot }

/-- Lift all suprema and infima along a Galois insertion -/
@[reducible] -- See note [reducible non instances]
def lift_complete_lattice [complete_lattice α] (gi : galois_insertion l u) : complete_lattice β :=
{ Sup := λ s, l (Sup (u '' s)),
  Sup_le := λ s, (gi.is_lub_of_u_image (is_lub_Sup _)).2,
  le_Sup := λ s, (gi.is_lub_of_u_image (is_lub_Sup _)).1,
  Inf := λ s, gi.choice (Inf (u '' s)) $ (is_glb_Inf _).2 $ gi.gc.monotone_u.mem_lower_bounds_image
    (gi.is_glb_of_u_image $ is_glb_Inf _).1,
  Inf_le := λ s, by { rw gi.choice_eq, exact (gi.is_glb_of_u_image (is_glb_Inf _)).1 },
  le_Inf := λ s, by { rw gi.choice_eq, exact (gi.is_glb_of_u_image (is_glb_Inf _)).2 },
  .. gi.lift_bounded_order,
  .. gi.lift_lattice }

end lift

end galois_insertion

/-- A Galois coinsertion is a Galois connection where `u ∘ l = id`. It also contains a constructive
choice function, to give better definitional equalities when lifting order structures. Dual to
`galois_insertion` -/
@[nolint has_nonempty_instance]
structure galois_coinsertion [preorder α] [preorder β] (l : α → β) (u : β → α) :=
(choice : Πx : β, x ≤ l (u x) → α)
(gc : galois_connection l u)
(u_l_le : ∀ x, u (l x) ≤ x)
(choice_eq : ∀ a h, choice a h = u a)

/-- Make a `galois_insertion` between `αᵒᵈ` and `βᵒᵈ` from a `galois_coinsertion` between `α` and
`β`. -/
def galois_coinsertion.dual [preorder α] [preorder β] {l : α → β} {u : β → α} :
  galois_coinsertion l u → galois_insertion (to_dual ∘ u ∘ of_dual) (to_dual ∘ l ∘ of_dual) :=
λ x, ⟨x.1, x.2.dual, x.3, x.4⟩

/-- Make a `galois_coinsertion` between `αᵒᵈ` and `βᵒᵈ` from a `galois_insertion` between `α` and
`β`. -/
def galois_insertion.dual [preorder α] [preorder β] {l : α → β} {u : β → α} :
  galois_insertion l u → galois_coinsertion (to_dual ∘ u ∘ of_dual) (to_dual ∘ l ∘ of_dual) :=
λ x, ⟨x.1, x.2.dual, x.3, x.4⟩

/-- Make a `galois_insertion` between `α` and `β` from a `galois_coinsertion` between `αᵒᵈ` and
`βᵒᵈ`. -/
def galois_coinsertion.of_dual [preorder α] [preorder β] {l : αᵒᵈ → βᵒᵈ} {u : βᵒᵈ → αᵒᵈ} :
  galois_coinsertion l u → galois_insertion (of_dual ∘ u ∘ to_dual) (of_dual ∘ l ∘ to_dual) :=
λ x, ⟨x.1, x.2.dual, x.3, x.4⟩

/-- Make a `galois_coinsertion` between `α` and `β` from a `galois_insertion` between `αᵒᵈ` and
`βᵒᵈ`. -/
def galois_insertion.of_dual [preorder α] [preorder β] {l : αᵒᵈ → βᵒᵈ} {u : βᵒᵈ → αᵒᵈ} :
  galois_insertion l u → galois_coinsertion (of_dual ∘ u ∘ to_dual) (of_dual ∘ l ∘ to_dual) :=
λ x, ⟨x.1, x.2.dual, x.3, x.4⟩

/-- Makes a Galois coinsertion from an order-preserving bijection. -/
protected def order_iso.to_galois_coinsertion [preorder α] [preorder β] (oi : α ≃o β) :
  galois_coinsertion oi oi.symm :=
{ choice := λ b h, oi.symm b,
  gc := oi.to_galois_connection,
  u_l_le := λ g, le_of_eq (oi.left_inv g),
  choice_eq := λ b h, rfl }

/-- A constructor for a Galois coinsertion with the trivial `choice` function. -/
def galois_coinsertion.monotone_intro [preorder α] [preorder β] {l : α → β} {u : β → α}
  (hu : monotone u) (hl : monotone l) (hlu : ∀ b, l (u b) ≤ b)
  (hul : ∀ a, u (l a) = a) :
  galois_coinsertion l u :=
(galois_insertion.monotone_intro hl.dual hu.dual hlu hul).of_dual

/-- Make a `galois_coinsertion l u` from a `galois_connection l u` such that `∀ b, b ≤ l (u b)` -/
def galois_connection.to_galois_coinsertion {α β : Type*} [preorder α] [preorder β]
  {l : α → β} {u : β → α} (gc : galois_connection l u) (h : ∀ a, u (l a) ≤ a) :
  galois_coinsertion l u :=
{ choice := λ x _, u x,
  gc := gc,
  u_l_le := h,
  choice_eq := λ _ _, rfl }

/-- Lift the top along a Galois connection -/
def galois_connection.lift_order_top {α β : Type*} [partial_order α] [preorder β] [order_top β]
  {l : α → β} {u : β → α} (gc : galois_connection l u) :
  order_top α :=
{ top    := u ⊤,
  le_top := λ b, gc.le_u $ le_top }

namespace galois_coinsertion

variables {l : α → β} {u : β → α}

lemma u_l_eq [partial_order α] [preorder β] (gi : galois_coinsertion l u) (a : α) :
  u (l a) = a :=
gi.dual.l_u_eq a

lemma u_l_left_inverse [partial_order α] [preorder β] (gi : galois_coinsertion l u) :
  left_inverse u l :=
gi.u_l_eq

lemma u_surjective [partial_order α] [preorder β] (gi : galois_coinsertion l u) :
  surjective u :=
gi.dual.l_surjective

lemma l_injective [partial_order α] [preorder β] (gi : galois_coinsertion l u) :
  injective l :=
gi.dual.u_injective

lemma u_inf_l [semilattice_inf α] [semilattice_inf β] (gi : galois_coinsertion l u) (a b : α) :
  u (l a ⊓ l b) = a ⊓ b :=
gi.dual.l_sup_u a b

lemma u_infi_l [complete_lattice α] [complete_lattice β] (gi : galois_coinsertion l u)
  {ι : Sort x} (f : ι → α) :
  u (⨅ i, l (f i)) = ⨅ i, (f i) :=
gi.dual.l_supr_u _

lemma u_Inf_l_image [complete_lattice α] [complete_lattice β] (gi : galois_coinsertion l u)
  (s : set α) : u (Inf (l '' s)) = Inf s :=
gi.dual.l_Sup_u_image _

lemma u_sup_l [semilattice_sup α] [semilattice_sup β] (gi : galois_coinsertion l u) (a b : α) :
  u (l a ⊔ l b) = a ⊔ b :=
gi.dual.l_inf_u _ _

lemma u_supr_l [complete_lattice α] [complete_lattice β] (gi : galois_coinsertion l u)
  {ι : Sort x} (f : ι → α) :
  u (⨆ i, l (f i)) = ⨆ i, (f i) :=
gi.dual.l_infi_u _

lemma u_bsupr_l [complete_lattice α] [complete_lattice β] (gi : galois_coinsertion l u)
  {ι : Sort x} {p : ι → Prop} (f : Π i (hi : p i), α) :
  u (⨆ i hi, l (f i hi)) = ⨆ i hi, f i hi :=
gi.dual.l_binfi_u _

lemma u_Sup_l_image [complete_lattice α] [complete_lattice β] (gi : galois_coinsertion l u)
  (s : set α) : u (Sup (l '' s)) = Sup s :=
gi.dual.l_Inf_u_image _

lemma u_supr_of_lu_eq_self [complete_lattice α] [complete_lattice β] (gi : galois_coinsertion l u)
  {ι : Sort x} (f : ι → β) (hf : ∀ i, l (u (f i)) = f i) :
  u (⨆ i, (f i)) = ⨆ i, u (f i) :=
gi.dual.l_infi_of_ul_eq_self _ hf

lemma u_bsupr_of_lu_eq_self [complete_lattice α] [complete_lattice β] (gi : galois_coinsertion l u)
  {ι : Sort x} {p : ι → Prop} (f : Π i (hi : p i), β) (hf : ∀ i hi, l (u (f i hi)) = f i hi) :
  u (⨆ i hi, f i hi) = ⨆ i hi, u (f i hi) :=
gi.dual.l_binfi_of_ul_eq_self _ hf

lemma l_le_l_iff [preorder α] [preorder β] (gi : galois_coinsertion l u) {a b} :
  l a ≤ l b ↔ a ≤ b :=
gi.dual.u_le_u_iff

lemma strict_mono_l [preorder α] [preorder β] (gi : galois_coinsertion l u) : strict_mono l :=
λ a b h, gi.dual.strict_mono_u h

lemma is_glb_of_l_image [preorder α] [preorder β] (gi : galois_coinsertion l u) {s : set α} {a : β}
  (hs : is_glb (l '' s) a) : is_glb s (u a) :=
gi.dual.is_lub_of_u_image hs

lemma is_lub_of_l_image [preorder α] [preorder β] (gi : galois_coinsertion l u) {s : set α} {a : β}
  (hs : is_lub (l '' s) a) : is_lub s (u a) :=
gi.dual.is_glb_of_u_image hs

section lift

variables [partial_order α]

/-- Lift the infima along a Galois coinsertion -/
@[reducible] -- See note [reducible non instances]
def lift_semilattice_inf [semilattice_inf β] (gi : galois_coinsertion l u) : semilattice_inf α :=
{ inf := λ a b, u (l a ⊓ l b),
  .. ‹partial_order α›, .. @order_dual.semilattice_inf _ gi.dual.lift_semilattice_sup }

/-- Lift the suprema along a Galois coinsertion -/
@[reducible] -- See note [reducible non instances]
def lift_semilattice_sup [semilattice_sup β] (gi : galois_coinsertion l u) : semilattice_sup α :=
{ sup := λ a b, gi.choice (l a ⊔ l b) $
    (sup_le (gi.gc.monotone_l $ gi.gc.le_u $ le_sup_left)
      (gi.gc.monotone_l $ gi.gc.le_u $ le_sup_right)),
  .. ‹partial_order α›, .. @order_dual.semilattice_sup _ gi.dual.lift_semilattice_inf }

/-- Lift the suprema and infima along a Galois coinsertion -/
@[reducible] -- See note [reducible non instances]
def lift_lattice [lattice β] (gi : galois_coinsertion l u) : lattice α :=
{ .. gi.lift_semilattice_sup, .. gi.lift_semilattice_inf }

/-- Lift the bot along a Galois coinsertion -/
@[reducible] -- See note [reducible non instances]
def lift_order_bot [preorder β] [order_bot β] (gi : galois_coinsertion l u) : order_bot α :=
{ bot    := gi.choice ⊥ $ bot_le,
  .. @order_dual.order_bot _ _ gi.dual.lift_order_top }

/-- Lift the top, bottom, suprema, and infima along a Galois coinsertion -/
@[reducible] -- See note [reducible non instances]
def lift_bounded_order [preorder β] [bounded_order β]
  (gi : galois_coinsertion l u) : bounded_order α :=
{ .. gi.lift_order_bot, .. gi.gc.lift_order_top }

/-- Lift all suprema and infima along a Galois coinsertion -/
@[reducible] -- See note [reducible non instances]
def lift_complete_lattice [complete_lattice β] (gi : galois_coinsertion l u) : complete_lattice α :=
{ Inf := λ s, u (Inf (l '' s)),
  Sup := λ s, gi.choice (Sup (l '' s)) _,
  .. @order_dual.complete_lattice _ gi.dual.lift_complete_lattice }

end lift

end galois_coinsertion

/-- If `α` is a partial order with bottom element (e.g., `ℕ`, `ℝ≥0`), then `with_bot.unbot' ⊥` and
coercion form a Galois insertion. -/
def with_bot.gi_unbot'_bot [preorder α] [order_bot α] :
  galois_insertion (with_bot.unbot' ⊥) (coe : α → with_bot α) :=
{ gc := λ a b, with_bot.unbot'_bot_le_iff,
  le_l_u := λ a, le_rfl,
  choice := λ o ho, o.unbot' ⊥,
  choice_eq := λ _ _, rfl }


/-
Copyright (c) 2022 Sina Hazratpour. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
----------------

# Algebraic identities
Sina Hazratpour
Introduction to Proof
MATH 301, Johns Hopkins University, Fall 2022
-/
import ..prooflab
-- import lectures.lec1_def_lem_thm

set_option pp.beta true
set_option pp.generalized_field_notation false
-- set_option pp.all true

/-
In this lesson, we learn new tactics which help us to prove some basic algebraic identities and polynomial arithmetic (such as difference of squares, difference of cubes, binomial identities):

The tactics we learned so far:
1. `refl`
2. `exact`
3. `rw` and its variants
4. `change`

The new tactics we learn
5. `calc`
6. `ring`
7. `linear_combination`
-/

namespace PROOFS

/-! ### Tactic calc
- `calc` (short for calculation) should be terminated with a comma. We put the comma only after the last tactic.  See the comma after the last `sorry` in the example below.
- Using `calc`, in order to prove our goal (`x + 1 = w + 1`) we introduce several __subgoals__ each of which needs a separate proof. The subgoals in the example below are
1. `x + 1 = y + 1` this is true since `x = y` by virtue of `h₁`.
2. `y + 1 = z + 2` this is true since `y + 1 = z + 2` by virtue of `h₂`
3. `z = w ` this is true since `x = y` by virtue of `h₁`

Then the tactic `calc` takes advanatge of the transitivity of equality to bind all these proofs togehter and prove that `x + 1 = w + 2`.
-/

example (x y z w : ℝ) (h₁ : x = y) (h₂ : y + 1 = z + 2) (h₃ : z = w) : x + 1 = w + 2 :=
begin
rw ← h₃,  -- there is `w` in the goal and we want to replace it by `z` because we know `h₂` says something `z`.
rw h₁, -- we replace `x` in the goal by `y`.
exact h₂, -- proof from the context.
end

example (x y z w : ℝ) (h₁ : x = y) (h₂ : y + 1 = z + 2) (h₃ : z = w) : x + 1 = w + 2 :=
begin
  calc x + 1 = y + 1 : by rw h₁ -- `x + 1 = y + 1` is the first subgoal. `by` converts tactics to terms which we need to supply as the justification for the subgoal.
  ...    = z + 2 : by exact h₂ -- the second subgoal is that `y + 1 = z + 2`
  ...    = w + 2 : by rw h₃, -- the third subgoal is that `z + 2 = w + 2`
end

/-
After fixing our subgoals, in the second stage, we provide the proofs of each subgoal by replacing `sorry` with a valid proof.
-/

example (x y z w : ℝ) (h₁ : x = y) (h₂ : y + 1 = z + 2) (h₃ : z = w) : x + 1 = w + 2 :=
begin
  calc x + 1 = y + 1 : by rw h₁
  ...        = z + 2 : by rw h₂
  ...        = w + 2 : by rw h₃,
end

example (x y z w : ℝ) (h₁ : x = y) (h₂ : y + 1 = z + 2) (h₃ : z = w) : x + 1 = w + 2 :=
begin
  calc x + 1 = y + 1 : sorry
  ...        = z + 2 : sorry
  ...        = w + 2 : sorry, -- this is where the `calc` tactic ends so we need a comma.
end

/-! #### Getting effective __feedback__ while using `calc`:
To get helpful error messages, keep the calc structure even before the proof is complete. First use `sorry` (or `_`) as in above, then replace each `sorry` (or `_`) with a valid proof. Note that `sorry` will supress error messages entirely.

If the structure of calc is incorrect (e.g., missing `:` or the justification after it), you may see error messages that are obscure and/or red squiggles that end up under a random .... To avoid these, you might first populate a skeleton proof.
-/

/-
In the example below we use the lemmas  `mul_comm` and `two_mul` (proved in mathlib/src/algebra/group/defs.lean).
-/

section
variables a b : ℝ
#check (mul_comm : ∀ (a b : ℝ), a * b = b * a)
#check (two_mul : ∀ (a: ℝ),  2 * a = a + a)

#check mul_two

#check (mul_comm a b : a * b = b * a)
#check (two_mul a : 2 * a = a + a)
end

-- CHALLENGE: provide comments for each line
example (a b c d : ℝ) (h₁ : c = d * a + b) (h₂ : b = a * d) : c = 2 * a * d :=
begin
  calc c = d * a + b   : h₁ -- or `by exact h₁`
  ... = d * a + a * d  : by rw h₂
  ... = a * d + a * d  : by rw mul_comm
  ... = 2 * (a * d)    : by rw ← two_mul (a * d)
  ... = 2 * a * d      : by rw ← mul_assoc,
end

-- Warning: Be careful to put exactly _three_ dots (...); otherwise you get an incomprehensile error.

/-
Use the following lemmas to prove the so-called "difference of two squares" identity, i.e. for any two numbers (say reals), the difference of squares `x^2 - y^2` is the same as the product `(x + y) (x - y)`. Think about what this says geometrically.
-/

section
variables a b c x : ℝ
#check (pow_two x : x^2 = x * x)

#check (mul_sub a b c : a * (b - c) = a * b - a * c)
#check (add_mul a b c : (a + b) * c = a * c + b * c)

#check (add_sub a b c : a + (b - c) = (a + b) - c)
#check (sub_add a b c : a - b + c = a - (b - c))
#check (sub_sub a b c : a - b - c = a - (b + c))

#check (add_zero a : a + 0 = a)
#check (sub_self a : a - a = 0)
#check (sub_zero a : a - 0 = a)
end

-- Difference of two squares
lemma diff_of_squares (a b : ℝ) :
  (a + b) * (a - b) = a^2 - b^2 :=
begin
  calc   (a + b) * (a - b) = (a + b) * a - (a + b) * b : mul_sub (a + b) a b
  ... =  (a * a + b * a) - (a * b + b * b)       : by rw [add_mul a b a, add_mul a b b]
  ... =  (a^2 + b * a) - (a * b + b^2)            : by rw [pow_two a, pow_two b]
  ... =  a^2 + b * a - a * b - b^2                : by rw [sub_sub _ _ _ ]
  ... =  a^2 + (b * a - a * b) - b^2              : by rw [add_sub _ _ _]
  ... =  a^2 - b^2                                : by rw [mul_comm b a, sub_self,add_zero],
end

/-!  A __system of linear equations__ problem can be solved using the tactic `calc`:
Let `a` and `b` be integers and suppose that `a - 5 * b = 4` and `b + 2 = 3`. Show that `a = 9`.
-/
example (a b : ℤ) (h₁ : a - 5 * b = 4) (h₂ : b + 2 = 3) :
  a = 9 :=
begin
  calc a = (a - 5 * b) + 5 * b : by rw [sub_add, sub_self, sub_zero]
  ...    = 4 + 5 * b : by rw [h₁]
  ...    = -6 + 5 * (b + 2) : by ring
  ...    = -6 + 5 * 3 : by rw [h₂]
  ...    = 9 : rfl,
end

/-! ### Tactic linear_combination
We have a special tactic for the system of linear equations called `linear_combination`. Note that from the type-theoretic perspective it is nonsense to add and multiply proofs (what `h₁` and `h₂` are), but since, in the example below, we are in the tactic mode, that does not cause problems.
-/

section
variables (a b : ℤ)
variables (h₁ : a - 5 * b = 4) (h₂ : b + 2 = 3)
#check h₁ + 5 * h₂ -- it is nonsense to add and multiply proofs (what `h₁` and `h₂` are), since there are no operations of addition (`+`) and multiplication (`*`) defined for propositions.
end

example (a b : ℤ) (h₁ : a - 5 * b = 4) (h₂ : b + 2 = 3) :
  a = 9 :=
begin
linear_combination h₁ + 5 * h₂,
end

/-
To make polyrith work on your system you need to have the following installed on your computer (these are separate than elan and leanproject):
1. This tactic only works with a working **internet connection**, since it calls Sage using the SageCell web API at https://sagecell.sagemath.org/.
2. Python 3 (which you can test by opening a terminal and executing `python3 --version`.
3. Make sure requests library is installed: `python3 -m pip install requests`.
-/

example (a b : ℤ) (h₁ : a - 5 * b = 4) (h₂ : b + 2 = 3) :
  a = 9 :=
begin
  -- polyrith
end

example {x y : ℤ} (h₁ : 2 * x + y = 4) (h₂ : x + y = 1) :
  x = 3 :=
begin
sorry,
end

example {x y : ℤ} (h₁ : 2 * x + y = 4) (h₂ : x + y = 1) :
  x = 3 :=
begin
sorry,
end

/-! ### Tactic ring
Tactic for solving equations in the language of commutative (semi)rings, that is whenever we have two binary operations `+` and `*` which furthermore satisfy the followin axioms:
-/

section
-- Associativity of addition:
#check add_assoc

-- Associativity of multiplication:
#check mul_assoc

-- Commutativity of addition
#check add_comm

-- Commutativity of multiplication
#check mul_comm

-- Distributivity of multiplication over addition:
#check mul_add
#check add_mul

-- Zero for addition
#check add_zero

-- One for multiplication
#check mul_one
#check one_mul

-- Inverse for addition
#check sub_self
end

-- Difference of two squares
example (a b : ℝ) :
  (a + b) * (a - b) = a^2 - b^2 :=
begin
  ring,
end

lemma binomial₂ (a b : ℝ) : (a + b)^2 = a^2 + 2 * (a * b) + b^2 :=
begin
  ring,
end

lemma binomial₃ (a b : ℝ) :
  (a + b)^3 = a^3 + 3 * a^2 * b + 3 * a * b^2 + b^3 :=
begin
  ring,
end

lemma sum_of_cubes (a b : ℝ) :
  a^3 + b^3 = (a + b)^3 - 3 * a * b * (a + b) :=
begin
  ring,
end

lemma sum_cubes_fac (a b : ℝ) :
a^3 + b^3 = (a + b) * (a^2 - a * b + b^2) :=
begin
  ring,
end

lemma diff_of_cube (a b : ℝ) :
  a^3 - b^3 = (a - b) * (a^2 + a * b + b^2) :=
begin
  ring,
end

/-!
`calc` can be used with a mix of equality and _inequality_ subgoal statements. Here is an example.
-/

section
variables a b c d : ℝ
#check (add_le_add : a ≤ b → c ≤ d → a + c ≤ b + d)
#check (lt_add_one a : a < a + 1)
#check le_of_eq
#check le_of_eq (refl a)
end

example (a b c d : ℝ)
  (h₁ : a = b) (h₂ : b^2 ≤ c) (h₃ : c + 1 < d) : a^2 < d :=
begin
  calc a^2 = b^2     : by rw h₁
    ...    < b^2 + 1 : lt_add_one (b ^ 2)
    ...    ≤ c + 1 : add_le_add h₂ (le_of_eq (refl 1))
    ...    < d     : h₃,
end

end PROOFS