/-
Copyright (c) 2023 Bruno Bentzen. All rights reserved.
Released under the Apache License 2.0 (see "License");
Author: Bruno Bentzen
-/

import ..encoding.encode .theory .semantics

open nat set classical

local attribute [instance, priority 0] prop_decidable

/- maximal set of a context -/

namespace  ctx

def is_closed (Γ :  set form) :=
∀ {p : form}, (Γ ⊢ᵢ p) → p ∈ Γ

def has_disj (Γ :  set form) :=
∀ {p q : form}, ((p ∨ q) ∈ Γ) → ((p ∈ Γ) ∨ (q ∈ Γ))

def is_max (Γ :  set form) :=
is_closed Γ ∧ has_disj Γ

/-- extension -/

def insert_form (Γ :  set form) (p q r : form) :  set form :=
if (Γ ⸴ p ⊢ᵢ r) then Γ ⸴ q else Γ ⸴ p

@[simp]
def insert_code (Γ :  set form) (r : form) (n : nat) :  set form :=
match encodable.decode (form) n with
| none := Γ
| some (p ∨ q) := if Γ ⊢ᵢ p ∨ q then insert_form Γ p q r else Γ
| some _ := Γ
end

@[simp]
def insertn (Γ :  set form) (r : form) : nat →  set form
| 0     := Γ
| (n+1) := insert_code (insertn n) r n

@[simp]
def maxn (Γ :  set form) (r : form) : nat →  set form
| 0     := Γ
| (n+1) := ⋃ i, insertn (maxn n) r i

@[simp]
def max (Γ :  set form) (r : form) :  set form :=
⋃ n, maxn Γ r n

/- max extends the original set -/

lemma subset_insert_code {Γ :  set form} {r : form} (n) :
  Γ ⊆ insert_code Γ r n :=
begin
  intros v hv, simp,
  cases (encodable.decode (form) _),
    { assumption },
    { induction val,
      repeat { assumption },
      unfold insert_code ite,
      induction (prop_decidable _),
      { assumption },
      { unfold insert_form ite,
      induction (prop_decidable _),
        repeat { right, assumption } } }
end

lemma maxn_subset_max {Γ :  set form} {r : form} (n) :
  maxn Γ r n ⊆ max Γ r :=
subset_Union _ _

lemma subset_insertn {Γ :  set form} {r : form} {n} :
  Γ ⊆ insertn Γ r n :=
begin
  induction n,
  { simp },
  { simp, cases (encodable.decode (form) _) with p,
    { assumption },
      induction p,
        repeat {assumption},
      { simp [ite],
        induction (prop_decidable _),
        { simp, assumption },
        { simp [insert_form, ite],
          induction (prop_decidable _),
            repeat {intros q hq, right, exact n_ih hq} } } }
end

lemma subset_max_self {Γ :  set form} {r : form} :
  Γ ⊆ max Γ r :=
maxn_subset_max 0

lemma insertn_sub_maxn {Γ :  set form} {r : form} {n m : nat} :
  insertn (maxn Γ r n) r m ⊆ maxn Γ r (n+1) :=
subset_Union _ _

lemma insertn_to_max {Γ :  set form} {r : form} {n m : nat} :
  insertn (maxn Γ r n) r m ⊆ max Γ r :=
by induction m;
[ apply maxn_subset_max,
  exact subset.trans insertn_sub_maxn (maxn_subset_max _) ]

/- max has the disjunction property -/

lemma in_max_in_maxn {Γ :  set form} {p r : form} :
  (p ∈ max Γ r ) → ∃ n, p ∈ maxn Γ r n :=
mem_Union.1

lemma in_maxn_in_insertn {Γ :  set form} {p r : form} {n} :
  (p ∈ maxn Γ r (n+1) ) → ∃ i, p ∈ insertn (maxn Γ r n) r i :=
mem_Union.1

lemma maxn_subset_succ {Γ :  set form} {r : form} {n : nat} :
  maxn Γ r n ⊆ maxn Γ r (n+1) :=
begin
  apply subset.trans,
  { apply subset_insertn,
    repeat {assumption} },
  { exact subset_Union _ _}
end

lemma maxn_mono {Γ :  set form} {r : form} {m n : nat} (h : n ≤ m) :
  maxn Γ r n ⊆ maxn Γ r m :=
by induction h; [refl, exact subset.trans h_ih maxn_subset_succ ]

lemma insertn_mono {Γ :  set form} {r : form} {m n : nat} (h : n ≤ m) :
  insertn Γ r n ⊆ insertn Γ r m :=
by induction h; [refl, exact subset.trans h_ih (subset_insert_code _)]

def maxn_sub_prf {Γ :  set form} {p r : form} :
  (max Γ r ⊢ᵢ p) → ∃ n, maxn Γ r n ⊢ᵢ p :=
begin
  generalize eq : max Γ r = Γ',
  intro h, induction h; subst eq,
  { cases in_max_in_maxn h_h with n hpq,
    exact ⟨n, prf.ax hpq⟩ },

  repeat {
      constructor,
      apply prf.k <|> apply prf.s <|> apply prf.exf <|>
      apply prf.pr1 <|> apply prf.pr2 <|> apply prf.pair <|>
      apply prf.inr <|> apply prf.inl <|> apply prf.case,
      exact 0
    },

  { cases h_ih_hpq rfl with i h_ext_pq,
    cases h_ih_hp rfl with j h_ext_p,
    cases (prop_decidable (i ≤ j)),
    { have hn: j ≤ i :=
        begin
          cases nat.le_total,
          assumption,
          contradiction
      end,
      constructor,
      { apply prf.mp,
        { assumption },
        { apply prf.sub_weak,
          { exact h_ext_p },
          { apply maxn_mono,
            assumption } } } },
    { constructor,
      { apply prf.mp,
        { apply prf.sub_weak,
          { exact h_ext_pq },
          { apply maxn_mono,
            assumption } },
          assumption } } }
end

lemma prf_maxn_prf_insertn {Γ :  set form} {p r : form} {n} :
  (maxn Γ r (n+1) ⊢ᵢ p) → ∃ i, insertn (maxn Γ r n) r i ⊢ᵢ p :=
begin
  generalize eq : maxn Γ r (n+1) = Γ',
  intro h, induction h; subst eq,
  { cases in_maxn_in_insertn h_h with n hpq,
    exact ⟨n, prf.ax hpq⟩ },

    repeat {
      constructor,
      apply prf.k <|> apply prf.s <|> apply prf.exf <|>
      apply prf.pr1 <|> apply prf.pr2 <|> apply prf.pair <|>
      apply prf.inr <|> apply prf.inl <|> apply prf.case,
      exact 0
    },

    { cases h_ih_hpq rfl with i h_ext_pq,
      cases h_ih_hp rfl with j h_ext_p,
      cases (prop_decidable (i ≤ j)),
      { have hn: j ≤ i :=
              begin
                cases nat.le_total,
                assumption,
                contradiction
            end,
        constructor,
        { apply prf.mp,
          { assumption },
          { apply prf.sub_weak,
            { exact h_ext_p },
            { apply insertn_mono,
              assumption } } } },
      { constructor,
        { apply prf.mp,
          { apply prf.sub_weak,
            { exact h_ext_pq },
            { apply insertn_mono, assumption } },
          { assumption } } } }
end

def max_insertn_disj {Γ :  set form} {p q r : form} (h : (p ∨ q) ∈ max Γ r) :
  ∃ n, p ∈ (insertn (maxn Γ r n) r (encodable.encode (p ∨ q)+1)) ∨
       q ∈ (insertn (maxn Γ r n) r (encodable.encode (p ∨ q)+1)) :=
begin
  cases in_max_in_maxn h with n hpq,
  fapply exists.intro,
  { exact n },
  { unfold insertn insert_code,
    rw (encodable.encodek ((p ∨ q))),
    simp [insert_code, ite],
    induction (prop_decidable _) with h1 h2,
    { exact false.elim (h1 (prf.sub_weak (prf.ax hpq) (subset_insertn))) },
    { simp [insert_form, ite],
      induction (prop_decidable _),
        { left,left, refl },
        { right,left, refl } } }
end

def max_has_disj {Γ :  set form} {p q r : form} :
  ((p ∨ q) ∈ max Γ r) → p ∈ max Γ r ∨ q ∈ max Γ r :=
begin
  intro h, cases max_insertn_disj h with n hpq, cases hpq,
  { left, apply insertn_to_max hpq },
  { right, apply insertn_to_max hpq }
end

/- max is closed -/

lemma max_prf_disj_self {Γ :  set form} {p r : form} :
  (max Γ r ⊢ᵢ r ∨ p) → ∃ n, p ∈ (insertn (maxn Γ r n) r (encodable.encode (r ∨ p)+1)) :=
begin
  intros h,
  cases maxn_sub_prf h with n hpq,
  constructor,
    unfold insertn insert_code,
    rw (encodable.encodek ((r ∨ p))),
    simp [insert_code, ite],
    induction (prop_decidable _) with h1 h2,
    { exact false.elim (h1 (prf.sub_weak hpq (subset_insertn))) },
    { simp [insert_form, ite],
      induction (prop_decidable _) with h1' h2',
      { apply false.elim,
        apply h1',
        apply prf.ax,
        { left, refl} },
      { left, refl } }
end

def max_is_closed {Γ :  set form} {p q r : form} :
  (max Γ r ⊢ᵢ p) → p ∈ max Γ r :=
by { intros h, cases max_prf_disj_self (prf.or_intro2 r h), apply insertn_to_max, repeat {assumption} }

/- max preserves consistency -/

lemma insertn_prf {Γ :  set form} {p : form} {i} :
  (insertn Γ p i ⊢ᵢ p) → (Γ ⊢ᵢ p) :=
begin
  induction i,
  { simp },
  { simp [insertn, insert_code],
    cases (encodable.decode (form) _) with p,
    { assumption },
    { induction p,
        repeat {assumption},
        { simp [ite],
          induction (prop_decidable _),
            { assumption },
            { simp [insert_form, ite],
              induction (prop_decidable _),
              { intro, contradiction },
              { intro, apply i_ih,
                apply prf.or_elim,
                repeat {assumption } } } } } }
end

-- these two are better (positive)

def maxn_not_prfn {Γ :  set form} {p : form} {n} :
  (maxn Γ p n ⊢ᵢ p) → (Γ ⊢ᵢ p) :=
begin
  induction n with k ih,
    simp,

    unfold maxn,
    intro h,
    cases prf_maxn_prf_insertn h,
    apply ih, apply insertn_prf h_1
end

def max_not_prf {Γ :  set form} {p : form} :
  (max Γ p ⊢ᵢ p) → (Γ ⊢ᵢ p) :=
begin
  intros hm,
  cases maxn_sub_prf hm,
  apply maxn_not_prfn h
end

-- Closure under derivability

end  ctx

lemma max_of_max {Γ :  set form} {r : form} :
 ctx.is_max (ctx.max Γ r) :=
begin
  split,
    intro, apply ctx.max_is_closed, assumption,
    intros p q, apply ctx.max_has_disj
end

lemma max_no_prf {Γ :  set form} {r : form} (h : Γ ⊬ᵢ r) :
 ctx.max Γ r ⊬ᵢ r :=
λ hm, h (ctx.max_not_prf hm)

/- the canonical model construction -/

-- domain

namespace canonical

def is_consist (Γ :  set form) := Γ ⊬ᵢ ⊥

def domain : set (wrld) := {w | is_consist w ∧  ctx.is_max w}

-- accessibility

def access : wrld → wrld → Prop :=
λ w v, w ⊆ v

-- valuation

def val : ℕ → wrld → Prop :=
λ q w, w ∈ domain ∧ (#q) ∈ w

-- reflexivity

lemma access.refl :
  ∀ w ∈ domain, access w w :=
begin
  intros, unfold access
end

-- transitivity

lemma access.trans : ∀ w ∈ domain, ∀ v ∈ domain, ∀ u ∈ domain,
  access w v → access v u → access w u :=
begin
  unfold access,
  intros _ hw _ hu u  hu hwv hvu q hq,
  apply hvu, apply hwv, assumption
end

def model : @model :=
begin
  fapply model.mk,
    apply domain,
    apply access,
    apply val,
    apply access.refl,
    apply access.trans
end

/- simple lemmas -/

lemma consist_of_not_prf {Γ :  set form} {p : form} :
  (Γ ⊬ᵢ p) → is_consist Γ :=
λ nhp nc, nhp (prf.mp prf.exf nc)

/- truth is membership in the canonical model -/

lemma model_tt_iff_prf {p : form} :
  ∀ (w ∈ domain), (w ⊩⦃model⦄ p) ↔ (w ⊢ᵢ p) :=
begin
  induction p with p p q hp hq p q hp hq p q hp hq,
  -- atom
  { intros,
    split,
    { intro h, exact prf.ax h.right },
    { intro,
      split,
      { assumption },
      { apply H.2.1, assumption } } },
  -- ⊥
  { simp [forces_form],
    intros w H hn, exact H.1 hn },
  -- ⊃
  intros,
  split,
  { intro Hw,
    cases (em _),
    { assumption },
    { have hd : ctx.max (w ⸴ p) q ∈ domain :=
        begin
          split,
          exact consist_of_not_prf (max_no_prf (prf.contradeduction h)),
          apply max_of_max,
        end,
      apply false.elim,
      apply max_no_prf (prf.contradeduction h),
      cases hq ( ctx.max (w ⸴ p) q) _,
      apply mp,
      apply Hw _ hd,
      { exact H },
      intros p Hp,
      apply ctx.subset_max_self,
      { right, assumption },
      { apply (hp (ctx.max (w ⸴ p) q) _).2,
        { apply prf.ax,
          apply ctx.subset_max_self,
          left, simp },
        exact hd },
      exact hd } },
  { intro hpq,
    intros v Hv Hw hwv hp2,
    apply (hq v Hv).2,
    apply prf.mp,
    { apply prf.sub_weak, assumption, assumption },
    { apply (hp v Hv).1, assumption } },
    -- &
    { intros, split,
      { intro hpq,
        apply prf.mp, apply prf.mp, apply prf.pair,
        apply (hp w H).1,
        exact hpq.1,
        apply (hq w H).1,
        exact hpq.2 },
      { intro hpq, split,
        apply (hp w H).2,
        apply prf.and_elim1 hpq,
        apply (hq w H).2,
        apply prf.and_elim2 hpq } },
    -- ∨
  { intros,
    split,
    { intro hpq,
      cases hpq,
      { apply prf.or_intro1,
        apply (hp w H).1 hpq },
      { apply prf.or_intro2,
        apply (hq w H).1 hpq } },
    { intro hpq,
      cases (H.2.2 (H.2.1 hpq)),
      { left, apply (hp w H).2,
        apply prf.ax, assumption },
      { right, apply (hq w H).2,
        apply prf.ax, assumption } } },
end

lemma ctx_tt_of_prf {Γ :  set form} (wm : Γ ∈ domain) :
  (Γ ⊩⦃model⦄ Γ) :=
by { intros p hp, apply (model_tt_iff_prf Γ wm).2, apply prf.ax, assumption }

/- the completeness theorem -/

theorem completeness {Γ :  set form} {p : form} :
  (Γ ⊨ᵢ p) → (Γ ⊢ᵢ p) :=
begin
  apply (@not_imp_not (Γ ⊢ᵢ p) (Γ ⊨ᵢ p) (prop_decidable _)).1,
  intros nhp hp,
  have hd: ctx.max Γ p ∈ domain :=
    begin
      split,
      apply consist_of_not_prf,
      exact max_no_prf nhp,
      apply (max_of_max)
    end,
  apply absurd,
  fapply hp,
  { exact model },
  { exact ctx.max Γ p },
  { exact hd },

  { apply ctx_tt_to_subctx_tt,
    apply ctx_tt_of_prf hd,
    apply ctx.subset_max_self },

  { intro hpm,
    apply max_no_prf nhp,
    exact (model_tt_iff_prf _ hd).1 hpm },
end

end canonical


import category_theory.abelian.homology
import algebra.homology.homology
import for_mathlib.has_homology

noncomputable theory

universes v

open category_theory category_theory.limits opposite

variables {C : Type*} [category.{v} C] [abelian C]
variables {D : Type*} [category.{v} D] [abelian D]

variables {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (H : C) (w : f ≫ g = 0)

/- Eventually, all of this should be refactored using `short_complex`. -/

/-- This structure expresses that there is a candidate `H` for the
homology of composable maps `f : X ⟶ Y` and `g : Y ⟶ Z`.
When `0 ⟶ K ⟶ Y ⟶ Z` and `X ⟶ K ⟶ Q ⟶ 0` are exact, this
will give a `h : homology_iso_datum f g H` and there shall
be an isomorphism `h.iso : H ≅ homology f g h.w`. The differences with
`has_homology f g H` are :
* this definition is not self dual: the homology is thought as the
quotient of cycles by boundaries;
* the object `K` can be any choice for the kernel of `Y ⟶ Z` and
`H` can be any choice of cokernel for `X ⟶ K`. -/
@[nolint has_inhabited_instance]
structure homology_iso_predatum :=
(w : f ≫ g = 0)
(K : C) (ι : K ⟶ Y) (f' : X ⟶ K) (fac' : f' ≫ ι = f) (zero₁' : ι ≫ g = 0)
(π : K ⟶ H) (zero₂' : f' ≫ π = 0)

namespace homology_iso_predatum

restate_axiom fac'
restate_axiom zero₁'
restate_axiom zero₂'
attribute [simp, reassoc] fac zero₁ zero₂

@[simps]
def tautological : homology_iso_predatum f g (cokernel (kernel.lift g f w)) :=
{ w := w,
  K := kernel g,
  ι := kernel.ι _,
  f' := kernel.lift g f w,
  fac' := kernel.lift_ι _ _ _,
  zero₁' := kernel.condition _,
  π := cokernel.π _,
  zero₂' := cokernel.condition _, }

@[simps]
def tautological' : homology_iso_predatum f g (homology f g w):=
{ w := w,
  K := kernel g,
  ι := kernel.ι _,
  f' := kernel.lift g f w,
  fac' := kernel.lift_ι _ _ _,
  zero₁' := kernel.condition _,
  π := homology.π' f g w,
  zero₂' := homology.condition_π' _ _ _, }

variables {f g}

variables {H} (h : homology_iso_predatum f g H)

@[simps]
def fork : kernel_fork g := kernel_fork.of_ι h.ι h.zero₁

@[simps]
def cofork : cokernel_cofork h.f' := cokernel_cofork.of_π h.π h.zero₂

@[simps]
def apply_functor {D : Type*} [category D] [abelian D] (F : C ⥤ D) [F.additive] :
  homology_iso_predatum (F.map f) (F.map g) (F.obj H):=
{ w := by rw [← F.map_comp, h.w, F.map_zero],
  K := F.obj h.K,
  ι := F.map h.ι,
  f' := F.map h.f',
  fac' := by rw [← F.map_comp, h.fac],
  zero₁' := by simp only [← F.map_comp, zero₁, F.map_zero],
  π := F.map h.π,
  zero₂' := by simp only [← F.map_comp, zero₂, F.map_zero], }

include h

@[simps]
def map_iso {X' Y' Z' : C} (f' : X' ⟶ Y') (g' : Y' ⟶ Z') (e₁ : arrow.mk f ≅ arrow.mk f')
  (e₂ : arrow.mk g ≅ arrow.mk g') (eq : e₁.hom.right = e₂.hom.left) :
  homology_iso_predatum f' g' H :=
begin
  have comm₁ : e₁.hom.left ≫ f' = f ≫ e₁.hom.right := arrow.w e₁.hom,
  have comm₂ : e₂.hom.left ≫ g' = g ≫ e₂.hom.right := arrow.w e₂.hom,
  have h₁ : e₁.inv.left ≫ e₁.hom.left = 𝟙 X',
  { rw [← comma.comp_left, e₁.inv_hom_id, arrow.id_left], refl, },
  exact
  { w := by { rw [← cancel_epi e₁.hom.left, ← category.assoc, comm₁, eq, category.assoc, comm₂,
      ← category.assoc, h.w, zero_comp, comp_zero], },
    K := h.K,
    ι := h.ι ≫ e₁.hom.right,
    f' := e₁.inv.left ≫ h.f',
    fac' := begin
      slice_lhs 2 3 { rw h.fac', },
      rw [← comm₁, ← category.assoc, h₁, category.id_comp],
    end,
    zero₁' := by rw [eq, category.assoc, comm₂, ← category.assoc, h.zero₁', zero_comp],
    π := h.π,
    zero₂' := by rw [category.assoc, h.zero₂', comp_zero], }
end

omit h

end homology_iso_predatum

@[nolint has_inhabited_instance]
structure homology_iso_datum (H : C) extends homology_iso_predatum f g H :=
(fork_is_limit : is_limit to_homology_iso_predatum.fork)
(cofork_is_colimit : is_colimit to_homology_iso_predatum.cofork)

namespace homology_iso_datum

variables {H f g}

@[protected]
def H (h : homology_iso_datum f g H) : C := H
variables (f g)

@[simps]
def tautological : homology_iso_datum f g (cokernel (kernel.lift g f w)) :=
{ to_homology_iso_predatum := homology_iso_predatum.tautological f g w,
  fork_is_limit := by apply kernel_is_kernel,
  cofork_is_colimit := by apply cokernel_is_cokernel, }

@[simps]
def tautological' : homology_iso_datum f g (homology f g w) :=
{ to_homology_iso_predatum := homology_iso_predatum.tautological' f g w,
  fork_is_limit := by apply kernel_is_kernel,
  cofork_is_colimit := begin
    dsimp [homology_iso_predatum.cofork],
    refine is_colimit.of_iso_colimit (cokernel_is_cokernel (kernel.lift g f w)) _ ,
    refine cocones.ext (homology_iso_cokernel_lift f g w).symm _,
    rintro (_|_),
    tidy,
  end, }

variables {f g} (h : homology_iso_datum f g H)

def map_iso {X' Y' Z' : C} (f' : X' ⟶ Y') (g' : Y' ⟶ Z') (e₁ : arrow.mk f ≅ arrow.mk f')
  (e₂ : arrow.mk g ≅ arrow.mk g') (eq : e₁.hom.right = e₂.hom.left) :
  homology_iso_datum f' g' H :=
{ to_homology_iso_predatum := h.to_homology_iso_predatum.map_iso f' g' e₁ e₂ eq,
  fork_is_limit := begin
    refine (is_limit.equiv_of_nat_iso_of_iso _ _ _ _).to_fun h.fork_is_limit,
    { refine parallel_pair.ext (arrow.right_func.map_iso e₁) (arrow.right_func.map_iso e₂)
       _ (by simp),
      have h₂ := arrow.w e₂.hom,
      dsimp at h₂ ⊢,
      rw [eq, h₂], },
    { refine cones.ext (iso.refl _) _,
      rintro (_|_),
      tidy, },
  end,
  cofork_is_colimit := begin
    refine (is_colimit.equiv_of_nat_iso_of_iso _ _ _ _).to_fun h.cofork_is_colimit,
    { refine parallel_pair.ext ((arrow.left_func.map_iso e₁)) (iso.refl _) _ (by tidy),
      { dsimp,
        have h₁ : e₁.hom.left ≫ e₁.inv.left = 𝟙 X,
        { rw [← comma.comp_left, e₁.hom_inv_id, arrow.id_left], refl, },
        rw [category.comp_id, ← category.assoc, h₁, category.id_comp], }, },
    { refine cocones.ext (iso.refl _) _,
      rintro (_|_),
      tidy, },
  end, }

def iso₁ : h.K ≅ kernel g :=
is_limit.cone_point_unique_up_to_iso h.fork_is_limit (limit_cone.is_limit _)

@[simp, reassoc]
lemma iso₁_hom_kernel_ι : h.iso₁.hom ≫ kernel.ι g = h.ι :=
is_limit.cone_point_unique_up_to_iso_hom_comp _ _ _

instance : mono h.ι := by { rw ← h.iso₁_hom_kernel_ι, apply_instance, }

@[simp, reassoc]
lemma f'_iso₁_hom : h.f' ≫ h.iso₁.hom = kernel.lift g f h.w :=
begin
  ext,
  simp only [category.assoc, iso₁_hom_kernel_ι, homology_iso_predatum.fac, kernel.lift_ι],
end

def iso₂ : H ≅ cokernel h.f' :=
is_colimit.cocone_point_unique_up_to_iso h.cofork_is_colimit (colimit_cocone.is_colimit _)

@[simp, reassoc]
lemma cokernel_π_iso₂_inv : cokernel.π h.f' ≫ h.iso₂.inv = h.π :=
is_colimit.comp_cocone_point_unique_up_to_iso_inv _ _ _

@[reassoc]
lemma cokernel_f'_eq_π_iso₂_hom : cokernel.π h.f' = h.π ≫ h.iso₂.hom :=
by rw [← cokernel_π_iso₂_inv, category.assoc, h.iso₂.inv_hom_id, category.comp_id]

instance : epi h.π := by { rw ← h.cokernel_π_iso₂_inv, apply epi_comp, }

def iso₃ : cokernel h.f' ≅ cokernel (kernel.lift g f h.w) :=
cokernel.map_iso _ _ (iso.refl _) h.iso₁
  (by simp only [f'_iso₁_hom, iso.refl_hom, category.id_comp])

@[simp, reassoc]
lemma cokernel_π_iso₃_hom :
  cokernel.π h.f' ≫ h.iso₃.hom = h.iso₁.hom ≫ cokernel.π (kernel.lift g f h.w) :=
begin
  dsimp only [iso₃],
  simp only [cokernel.map_iso_hom, cokernel.π_desc],
end

variables (f g)

@[simp]
lemma tautological_iso₁ : (tautological f g w).iso₁ = iso.refl _ :=
begin
  ext,
  dsimp only [iso₁],
  simp only [equalizer_as_kernel, iso.refl_hom, category.id_comp],
  change kernel.lift _ _ _ ≫ _ = _,
  simpa only [equalizer_as_kernel, kernel.lift_ι],
end

@[simp]
lemma tautological'_iso₁ : (tautological' f g w).iso₁ = iso.refl _ :=
begin
  ext,
  dsimp only [iso₁],
  simp only [equalizer_as_kernel, iso.refl_hom, category.id_comp],
  change kernel.lift _ _ _ ≫ _ = _,
  simpa only [equalizer_as_kernel, kernel.lift_ι],
end

@[simp]
lemma tautological_iso₂ : (tautological f g w).iso₂ = iso.refl _ :=
begin
  suffices : (tautological f g w).iso₂.symm = iso.refl _,
  { change (tautological f g w).iso₂.symm.symm = _,
    simpa only [this], },
  ext,
  simpa only [iso.symm_hom, cokernel_π_iso₂_inv, iso.refl_hom, category.comp_id],
end

@[simp]
lemma tautological_iso₃ : (tautological f g w).iso₃ = iso.refl _ :=
begin
  ext,
  simpa only [cokernel_π_iso₃_hom, tautological_iso₁, iso.refl_hom, category.id_comp, category.comp_id],
end

variables {f g}

def iso : H ≅ homology f g h.w :=
h.iso₂ ≪≫ h.iso₃ ≪≫ (homology_iso_cokernel_lift f g h.w).symm

variables (f g)

@[simp]
lemma tautological_iso : (tautological f g w).iso =
  (homology_iso_cokernel_lift f g w).symm :=
by { dsimp only [iso], simp only [tautological_iso₂, tautological_iso₃, iso.refl_trans], }

lemma tautological_iso_hom : (tautological f g w).iso.hom =
  (homology_iso_cokernel_lift f g w).inv :=
by simp only [tautological_iso, iso.symm_hom]

variables {f g}

@[nolint has_inhabited_instance]
structure change {H₁ H₂ : C} (h₁ : homology_iso_datum f g H₁)
  (h₂ : homology_iso_datum f g H₂) :=
(κ : h₁.K ⟶ h₂.K) (fac₁' : h₁.f' ≫ κ = h₂.f') (fac₂' : κ ≫ h₂.ι = h₁.ι)
(η : H₁ ⟶ H₂) (fac₃' : h₁.π ≫ η = κ ≫ h₂.π)

namespace change

restate_axiom fac₁'
restate_axiom fac₂'
restate_axiom fac₃'
attribute [simp, reassoc] fac₁ fac₂
attribute [reassoc] fac₃

variables {H₁ H₂ : C} {h₁ : homology_iso_datum f g H₁}
  {h₂ : homology_iso_datum f g H₂} (c : change h₁ h₂)

@[simp, reassoc]
lemma fac_iso₁ : c.κ ≫ h₂.iso₁.hom = h₁.iso₁.hom :=
by { ext, simp only [category.assoc, iso₁_hom_kernel_ι, fac₂], }

instance : is_iso c.κ := is_iso.of_is_iso_fac_right (c.fac_iso₁)

def coker_iso : cokernel h₁.f' ≅ cokernel h₂.f' :=
cokernel.map_iso _ _ (iso.refl _) (as_iso c.κ)
(by simp only [as_iso_hom, fac₁, iso.refl_hom, category.id_comp])

@[simp, reassoc]
lemma coker_iso_comm : cokernel.π h₁.f' ≫ c.coker_iso.hom = c.κ ≫ cokernel.π h₂.f' :=
begin
  dsimp only [coker_iso],
  simp only [as_iso_hom, cokernel.map_iso_hom, cokernel.π_desc],
end

@[reassoc]
lemma fac_iso₂ : c.coker_iso.hom ≫ h₂.iso₂.inv = h₁.iso₂.inv ≫ c.η :=
begin
  ext,
  simp only [coker_iso_comm_assoc, cokernel_π_iso₂_inv, cokernel_π_iso₂_inv_assoc,
    fac₃],
end

instance : is_iso c.η :=
begin
  haveI : is_iso (h₁.iso₂.inv ≫ c.η) := by { rw ← fac_iso₂, apply_instance, },
  apply is_iso.of_is_iso_comp_left (h₁.iso₂.inv),
end

@[simp, reassoc]
lemma coker_iso_iso₃_hom : c.coker_iso.hom ≫ h₂.iso₃.hom = h₁.iso₃.hom :=
begin
  ext,
  simp only [coker_iso_comm_assoc, cokernel_π_iso₃_hom, fac_iso₁_assoc],
end

@[simp, reassoc]
lemma η_iso₂_hom_iso₃_hom : c.η ≫ h₂.iso₂.hom ≫ h₂.iso₃.hom = h₁.iso₂.hom ≫ h₁.iso₃.hom :=
by rw [← cancel_epi h₁.iso₂.inv, iso.inv_hom_id_assoc, ← c.coker_iso_iso₃_hom,
  ← fac_iso₂_assoc, iso.inv_hom_id_assoc]

@[simp, reassoc]
lemma η_iso_hom : c.η ≫ h₂.iso.hom = h₁.iso.hom :=
begin
  dsimp only [iso],
  simp only [iso.trans_hom, η_iso₂_hom_iso₃_hom_assoc],
end

lemma η_iso : as_iso c.η ≪≫ h₂.iso = h₁.iso :=
by { ext, simp only [iso.trans_hom, as_iso_hom, η_iso_hom], }

variables (f g)

@[simps]
def tautological : change (homology_iso_datum.tautological' f g w)
  (homology_iso_datum.tautological f g w) :=
{ κ := 𝟙 _,
  η := (homology_iso_cokernel_lift f g w).hom,
  fac₁' := category.comp_id _,
  fac₂' := category.id_comp _,
  fac₃' := begin
    dsimp [homology.π', homology_iso_cokernel_lift, homology_iso_cokernel_image_to_kernel'],
    simp only [cokernel_iso_of_eq_inv_comp_desc, cokernel.π_desc_assoc, category.assoc,
      π_comp_cokernel_iso_of_eq_hom, iso.inv_hom_id_assoc, category.id_comp],
  end, }

end change

variables (f g)

@[simp]
lemma tautological'_iso : (tautological' f g w).iso = iso.refl _ :=
begin
  ext1,
  rw ← (change.tautological f g w).η_iso_hom,
  simp only [← (change.tautological f g w).η_iso_hom, change.tautological_η,
    iso.refl_hom, tautological_iso, iso.symm_hom, iso.hom_inv_id],
end

variables {f g}

section apply_exact_functor

variables (F : C ⥤ D) [functor.additive F]

variables [preserves_finite_limits F] [preserves_finite_colimits F]

@[simps]
def apply_exact_functor : homology_iso_datum (F.map f) (F.map g) (F.obj H) :=
{ to_homology_iso_predatum := h.to_homology_iso_predatum.apply_functor F,
  fork_is_limit := begin
    let e : parallel_pair g 0 ⋙ F ≅ parallel_pair (F.map g) 0 :=
      parallel_pair.ext (iso.refl _) (iso.refl _) (by simp) (by simp),
    have hF := (is_limit.postcompose_inv_equiv e.symm _).inv_fun
      (is_limit_of_preserves F h.fork_is_limit),
    refine is_limit.of_iso_limit hF (cones.ext (iso.refl _) _),
    rintro (_|_),
    tidy,
  end,
  cofork_is_colimit := begin
    let e : parallel_pair h.f' 0 ⋙ F ≅ parallel_pair (F.map h.f') 0 :=
      parallel_pair.ext (iso.refl _) (iso.refl _) (by simp) (by simp),
    have hF := (is_colimit.precompose_inv_equiv e _).inv_fun
      (is_colimit_of_preserves F h.cofork_is_colimit),
    refine is_colimit.of_iso_colimit hF (cocones.ext (iso.refl _) _),
    rintro (_|_),
    tidy,
  end, }

end apply_exact_functor

section homological_complex

variables {A : Type*} [category A] [abelian A]
variables {M : Type*} {c : complex_shape M}

def of_homological_complex (X : homological_complex A c) (i j k : M)
  (hij : c.rel i j) (hjk : c.rel j k) :
  homology_iso_datum (X.d i j) (X.d j k) (X.homology j) :=
begin
  refine (homology_iso_datum.tautological' (X.d_to j) (X.d_from j)
    (X.d_to_comp_d_from j)).map_iso _ _ _ _ _,
  { refine arrow.iso_mk (X.X_prev_iso hij) (iso.refl _) _,
    dsimp,
    simp only [X.d_to_eq hij, category.comp_id], },
  { refine arrow.iso_mk (iso.refl _) (X.X_next_iso hjk) _,
    dsimp,
    simp only [X.d_from_eq hjk, category.id_comp, category.assoc, iso.inv_hom_id,
      category.comp_id], },
  { refl, },
end

open_locale zero_object

end homological_complex

section has_homology

variables (f g)

lemma homology_iso_cokernel_lift_comp_ι :
  (homology_iso_cokernel_lift f g w).inv ≫ homology.ι f g w =
  cokernel.map _ _ (𝟙 X) (kernel.ι g) (by simp only [kernel.lift_ι, category.id_comp]) :=
begin
  ext,
  dsimp [homology_iso_cokernel_lift, homology.ι,
    homology_iso_cokernel_image_to_kernel', homology_iso_kernel_desc],
  simp only [cokernel_iso_of_eq_inv_comp_desc, category.assoc, cokernel.π_desc_assoc, cokernel.π_desc,
    cokernel_iso_of_eq_hom_comp_desc_assoc, kernel.lift_ι, kernel_subobject_arrow_assoc,
    kernel_subobject_arrow'_assoc],
end

lemma homology_ι_eq :
  homology.ι f g w = (homology_iso_cokernel_lift f g w).hom ≫
    cokernel.map _ _ (𝟙 X) (kernel.ι g) (by simp only [kernel.lift_ι, category.id_comp]) :=
by simp only [← homology_iso_cokernel_lift_comp_ι, iso.hom_inv_id_assoc]

variables {f g}

lemma iso_hom_homology_ι_eq_iso₂_hom_cokernel_map :
  h.iso.hom ≫ homology.ι f g h.w = h.iso₂.hom ≫ cokernel.map h.f' f (𝟙 X) h.ι (by simp) :=
begin
  dsimp only [iso, iso₂, iso₃],
  simp only [homology_ι_eq f g h.w, iso.refl_hom, iso.trans_hom, cokernel.map_iso_hom,
    iso.symm_hom, category.assoc, iso.inv_hom_id_assoc, iso.cancel_iso_hom_left],
  ext,
  simp only [cokernel.π_desc_assoc, category.assoc, cokernel.π_desc, iso₁_hom_kernel_ι_assoc],
end

lemma homology_π'_eq :
  homology.π' f g h.w = h.iso₁.inv ≫ h.π ≫ h.iso.hom :=
begin
  rw ← cancel_mono (homology.ι f g h.w),
  dsimp only [iso],
  simp only [homology.π'_ι, category.assoc, iso.trans_hom, iso.symm_hom,
    homology_iso_cokernel_lift_comp_ι, ← cokernel_π_iso₂_inv, iso.inv_hom_id_assoc,
    cokernel_π_iso₃_hom_assoc, cokernel.π_desc],
end

lemma iso_inv : h.iso.inv = homology.desc' f g h.w (h.iso₁.inv ≫ h.π)
  (by simp only [← h.f'_iso₁_hom, category.assoc, h.iso₁.hom_inv_id_assoc,
    homology_iso_predatum.zero₂]) :=
by rw [← cancel_epi (homology.π' f g h.w), homology.π'_desc', homology_π'_eq,
    category.assoc, category.assoc, h.iso.hom_inv_id, category.comp_id]

lemma iso_hom : h.iso.hom = homology.lift f g h.w
  (h.iso₂.hom ≫ cokernel.map h.f' f (𝟙 X) h.ι (by simp))
  begin
    rw ← cancel_epi h.iso₂.inv,
    ext,
    simp only [category.assoc, iso.inv_hom_id_assoc, cokernel.π_desc_assoc,
      cokernel.π_desc, homology_iso_predatum.zero₁, comp_zero],
  end :=
begin
  rw [← cancel_epi h.iso.inv, h.iso.inv_hom_id, h.iso_inv,
    ← cancel_mono (homology.ι f g h.w), ← cancel_epi (homology.π' f g h.w),
    ← cancel_epi h.iso₁.hom],
  simp only [category.assoc, category.id_comp, homology.π'_ι, homology.lift_ι,
    homology.π'_desc'_assoc, h.iso₁.hom_inv_id_assoc, h.iso₁_hom_kernel_ι_assoc,
    ← cokernel_π_iso₂_inv, h.iso₂.inv_hom_id_assoc, cokernel.π_desc],
end

@[simps]
def has_homology : has_homology f g H :=
{ w := h.w,
  π := h.iso₁.inv ≫ h.π,
  ι := h.iso₂.hom ≫ cokernel.map h.f' f (𝟙 X) h.ι (by simp),
  π_ι := by simp only [category.assoc, ← cokernel_π_iso₂_inv_assoc, iso.inv_hom_id_assoc,
      cokernel.π_desc, ← h.iso₁_hom_kernel_ι],
  ex_π := begin
    refine preadditive.exact_of_iso_of_exact (kernel.lift g f h.w)
      (cokernel.π (kernel.lift g f h.w)) _ _ (iso.refl _) _ _ (abelian.exact_cokernel _),
    { refine arrow.iso_mk (iso.refl _) (h.iso₃.symm ≪≫ h.iso₂.symm) _,
      dsimp,
      simp only [← cancel_mono h.iso₂.hom, ← cancel_mono h.iso₃.hom,
        category.id_comp, category.assoc, ← cokernel_π_iso₂_inv,
        iso.inv_hom_id_assoc, cokernel_π_iso₃_hom,
        iso.inv_hom_id, category.comp_id], },
    { refl, },
  end,
  ι_ex := begin
    refine preadditive.exact_of_iso_of_exact (homology.ι f g h.w) (cokernel.desc f g h.w)
      _ _ _ (iso.refl _) _ (homology.has f g h.w).ι_ex,
    { refine arrow.iso_mk h.iso.symm (iso.refl _) _,
      dsimp,
      simp only [← h.iso_hom_homology_ι_eq_iso₂_hom_cokernel_map,
        iso.inv_hom_id_assoc, category.comp_id], },
    { refl, },
  end,
  epi_π := epi_comp _ _,
  mono_ι := begin
    rw ← iso_hom_homology_ι_eq_iso₂_hom_cokernel_map,
    apply_instance,
  end, }

end has_homology

variables (f g)

@[simps]
def of_f_is_zero (hf : f = 0) : homology_iso_datum f g (kernel g) :=
{ w := by rw [hf, zero_comp],
  K := kernel g,
  ι := kernel.ι g,
  f' := 0,
  fac' := by rw [hf, zero_comp],
  zero₁' := kernel.condition g,
  π := 𝟙 _,
  zero₂' := by rw zero_comp,
  fork_is_limit := kernel_is_kernel g,
  cofork_is_colimit := is_colimit_aux _ (λ s, s.π) (λ s, by apply category.id_comp)
    (λ s m hm, begin rw [← hm], symmetry, apply category.id_comp, end), }

@[simps]
def of_g_is_zero (hg : g = 0) : homology_iso_datum f g (cokernel f) :=
{ w := by rw [hg, comp_zero],
  K := Y,
  ι := 𝟙 Y,
  f' := f,
  fac' := category.comp_id _,
  zero₁' := by rw [hg, comp_zero],
  π := cokernel.π f,
  zero₂' := cokernel.condition f,
  fork_is_limit := is_limit_aux _ (λ s, s.ι) (λ s, by apply category.comp_id)
    (λ s m hm, begin rw [← hm], symmetry, apply category.comp_id, end),
  cofork_is_colimit := by apply cokernel_is_cokernel, }

@[simps]
def of_both_zeros (hf : f = 0) (hg : g = 0) : homology_iso_datum f g Y :=
{ w := by rw [hg, comp_zero],
  K := Y,
  ι := 𝟙 Y,
  f' := 0,
  fac' := by rw [hf, zero_comp] ,
  zero₁' := by rw [hg, comp_zero],
  π := 𝟙 Y,
  zero₂' := zero_comp,
  fork_is_limit := is_limit_aux _ (λ s, s.ι) (λ s, by apply category.comp_id)
    (λ s m hm, begin rw [← hm], symmetry, apply category.comp_id, end),
  cofork_is_colimit := is_colimit_aux _ (λ s, s.π) (λ s, by apply category.id_comp)
    (λ s m hm, begin rw [← hm], symmetry, dsimp, apply category.id_comp, end), }

end homology_iso_datum


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

import ring_theory.adjoin_root
import algebra.direct_limit
import set_theory.schroeder_bernstein
import ring_theory.integral_closure

universes u v w
open polynomial zorn set function
variables {K : Type u} [discrete_field K]
noncomputable theory

/- Turn down the instance priority for subtype.decidable_eq and use classical.dec_eq everywhere,
  to avoid diamonds -/
local attribute [instance, priority 0] subtype.decidable_eq

lemma injective_eq {α : Sort*} : injective (eq : α → α → Prop) :=
λ _ _ h, h.symm ▸ rfl

section minimal_polynomial
/- To be moved -/
variables {α : Type u} {β : Type v} [discrete_field α] [discrete_field β] [algebra α β]

def minimal_polynomial {x : β} (hx : is_integral α x) : polynomial α := sorry

lemma minimal_polynomial_irreducible {x : β} (hx : is_integral α x) :
  irreducible (minimal_polynomial hx) := sorry

lemma minimal_polynomial_monic {x : β} (hx : is_integral α x) : monic (minimal_polynomial hx) := sorry

@[simp] lemma aeval_minimal_polynomial {x : β} (hx : is_integral α x) :
  aeval α β x (minimal_polynomial hx) = 0 := sorry

lemma root_minimal_polynomial {x : β} (hx : is_integral α x) {y : α}
  (h : (minimal_polynomial hx).eval y = 0) : algebra_map β y = x := sorry

end minimal_polynomial

@[instance] lemma equiv.is_ring_hom {α β : Type*} [ring β] (e : α ≃ β) :
  @is_ring_hom β α _ (equiv.ring e) e.symm :=
by split; simp [equiv.mul_def, equiv.add_def, equiv.one_def]

instance equiv.is_ring_hom.symm {α β : Type*} [ring β] (e : α ≃ β) :
  @is_ring_hom α β (equiv.ring e) _ e :=
by split; simp [equiv.mul_def, equiv.add_def, equiv.one_def]

def equiv.ring_equiv {α β : Type*} [ring β] (e : α ≃ β) :
  @ring_equiv α β (equiv.ring e) _ :=
{ hom := by apply_instance, ..e }

lemma exists_root_of_equiv {α β : Type*} [comm_ring α] [comm_ring β] [decidable_eq α]
  [decidable_eq β] (e : α ≃r β) {f : polynomial α} {x : β} (hx : f.eval₂ e.to_equiv x = 0) :
  f.eval (e.symm.to_equiv x) = 0 :=
begin
  letI : is_ring_hom e.to_equiv := e.hom,
  rw [← e.to_equiv.injective.eq_iff,
    ← eval₂_hom e.to_equiv, ring_equiv.to_equiv_symm,
    equiv.apply_symm_apply, is_ring_hom.map_zero e.to_equiv, hx],
end

set_option old_structure_cmd true

structure alg_equiv (α β γ : Type*) [comm_ring α] [ring β] [ring γ]
  [algebra α β] [algebra α γ] extends alg_hom α β γ, equiv β γ

set_option old_structure_cmd false

infix ` ≃ₐ `:25 := alg_equiv _
notation A ` ≃ₐ[`:25 R `] ` B := alg_equiv R A B

namespace alg_equiv
variables {α : Type u} {β : Type v} {γ : Type w} [comm_ring α] [ring β] [ring γ]
  [algebra α β] [algebra α γ]

protected def symm (e : β ≃ₐ[α] γ) : γ ≃ₐ[α] β := sorry

end alg_equiv

section thing

local attribute [instance] classical.dec

private lemma thing_aux {X : Type u} {Y : Type v} {Z : Type w} (fxy : X ↪ Y) (fxz : X ↪ Z)
  (hYZ : (Z ↪ Y) → false) : ↥-range fxy.1 ↪ ↥-range fxz.1 :=
classical.choice $ or.resolve_left embedding.total $
  λ ⟨f⟩, hYZ $
    calc Z ↪ range fxz ⊕ ↥-range fxz :
      (equiv.set.sum_compl _).symm.to_embedding
    ... ↪ range fxy ⊕ ↥-range fxy :
      embedding.sum_congr
        (((equiv.set.range _ fxz.2).symm.to_embedding).trans
          (equiv.set.range _ fxy.2).to_embedding)
        f
    ... ↪ Y : (equiv.set.sum_compl _).to_embedding

private def thing {X : Type u} {Y : Type v} {Z : Type w} (fxy : X ↪ Y) (fxz : X ↪ Z)
  (hYZ : (Z ↪ Y) → false) : Y ↪ Z :=
calc Y ↪ range fxy ⊕ ↥-range fxy : (equiv.set.sum_compl _).symm.to_embedding
... ↪ range fxz ⊕ ↥-range fxz : embedding.sum_congr
  ((equiv.set.range _ fxy.2).symm.to_embedding.trans
    (equiv.set.range _ fxz.2).to_embedding)
  (thing_aux fxy fxz hYZ)
... ↪ Z : (equiv.set.sum_compl _).to_embedding

private lemma thing_commutes {X : Type u} {Y : Type v} {Z : Type w}  (fxy : X ↪ Y) (fxz : X ↪ Z)
  (hYZ : (Z ↪ Y) → false) (x : X) : thing fxy fxz hYZ (fxy x) = fxz x :=
have (⟨fxy x, mem_range_self _⟩ : range fxy) = equiv.set.range _ fxy.2 x, from rfl,
begin
  dsimp only [thing, embedding.trans_apply, equiv.trans_apply, function.comp,
    equiv.to_embedding_coe_fn],
  simp only [equiv.set.sum_compl_symm_apply_of_mem (mem_range_self _),
    embedding.sum_congr_apply_inl, equiv.set.sum_compl_apply_inl,
    embedding.trans_apply, equiv.to_embedding_coe_fn, this, equiv.symm_apply_apply],
  refl
end

end thing

class is_algebraically_closed (K : Type u) [nonzero_comm_ring K] [decidable_eq K] :=
(exists_root : ∀ f : polynomial K, 0 < degree f → ∃ x, is_root f x)

section is_algebraically_closed

lemma is_algebraically_closed_of_irreducible_has_root
  (h : ∀ f : polynomial K, irreducible f → ∃ x, is_root f x) :
  is_algebraically_closed K :=
⟨λ f hf0, let ⟨g, hg⟩ := is_noetherian_ring.exists_irreducible_factor
  (show ¬ is_unit f, from λ h, by rw [is_unit_iff_degree_eq_zero] at h;
    rw h at hf0; exact lt_irrefl _ hf0)
  (λ h, by rw ← degree_eq_bot at h;
    rw h at hf0; exact absurd hf0 dec_trivial) in
  let ⟨x, hx⟩ := h g hg.1 in
  let ⟨i, hi⟩ := hg.2 in
  ⟨x, by rw [hi, is_root.def, eval_mul, show _ = _, from hx, zero_mul]⟩⟩

-- /- An algebraic extension of -/
-- lemma equiv_of_algebraic

end is_algebraically_closed

namespace algebraic_closure

section classical

local attribute [instance, priority 1] classical.dec

/-- The `big_type` with cardinality strictly larger than any algebraic extension -/
private def big_type (K : Type u) [discrete_field K] := set (ℕ × polynomial K)

private def algebraic_embedding_aux {L : Type*} [discrete_field L] [algebra K L]
  (h : ∀ l : L, is_integral K l) (x : L) : ℕ × polynomial K :=
let f := classical.some (h x) in
⟨list.index_of x (quotient.out ((f.map (algebra_map L)).roots.1)), f⟩

private lemma algebraic_embedding_aux_injective
  {L : Type*} [discrete_field L] [algebra K L]
  (h : ∀ l : L, is_integral K l) : injective (algebraic_embedding_aux h) :=
λ x y hxy,
let f := classical.some (h x) in
let g := classical.some (h y) in
have hf : monic f ∧ aeval K L x f = 0, from classical.some_spec (h x),
have hg : monic g ∧ aeval K L y g = 0, from classical.some_spec (h y),
have hfg : f = g, from (prod.ext_iff.1 hxy).2,
have hfg' : list.index_of x (quotient.out ((f.map (algebra_map L)).roots.1)) =
    list.index_of y (quotient.out ((f.map (algebra_map L)).roots.1)),
  from (prod.ext_iff.1 hxy).1.trans (hfg.symm ▸ rfl),
have hx : x ∈ quotient.out ((f.map (algebra_map L)).roots.1),
  from multiset.mem_coe.1 begin
    show x ∈ quotient.mk _,
    rw [quotient.out_eq, ← finset.mem_def, mem_roots (mt (map_eq_zero (algebra_map L)).1
      (ne_zero_of_monic hf.1)), is_root.def, eval_map, ← aeval_def, hf.2],
  end,
have hy : y ∈ quotient.out ((g.map (algebra_map L)).roots.1),
  from multiset.mem_coe.1 begin
    show y ∈ quotient.mk _,
    rw [quotient.out_eq, ← finset.mem_def, mem_roots (mt (map_eq_zero (algebra_map L)).1
      (ne_zero_of_monic hg.1)), is_root.def, eval_map, ← aeval_def, hg.2],
  end,
(list.index_of_inj hx (by rwa hfg)).1 hfg'

private def algebraic_embedding_big_type {L : Type*} [discrete_field L] [algebra K L]
  (h : ∀ l : L, is_integral K l) : L ↪ big_type K :=
⟨_, injective_comp injective_eq $ algebraic_embedding_aux_injective h⟩

private def algebraic_embedding {L : Type*} [discrete_field L] [algebra K L]
  (h : ∀ l : L, is_integral K l) : L ↪ ℕ × polynomial K :=
⟨_, algebraic_embedding_aux_injective h⟩

private def bembedding (K : Type u) [discrete_field K] : K ↪ big_type K :=
⟨λ a, show set _, from {(0, X - C a)}, λ a b, by simp [C_inj]⟩

instance range_bembedding.discrete_field : discrete_field (set.range (bembedding K)) :=
equiv.discrete_field (equiv.set.range _ (bembedding K).2).symm

private structure extension (K : Type u) [discrete_field K] : Type u :=
(carrier : set (big_type K))
[field : discrete_field ↥carrier]
[algebra : algebra K ↥carrier]
(algebraic : ∀ x : carrier, is_integral K x)

attribute [instance] extension.field extension.algebra

private def base_extension (K : Type u) [discrete_field K] : extension K :=
{ carrier := set.range (bembedding K),
  algebra := algebra.of_ring_hom (equiv.set.range _ (bembedding K).2).symm.symm
    (by apply_instance),
  algebraic := sorry } --a field is algebraic over an isomorphic field

/-- not used but might help woth sorries -/
private def extension.of_algebraic {L : Type v} [discrete_field L] [algebra K L]
  (hL : ∀ x : L, is_integral K x) : extension K :=
{ carrier := set.range (algebraic_embedding_big_type hL),
  field := equiv.discrete_field (equiv.set.range _ (algebraic_embedding_big_type hL).2).symm,
  algebra := sorry, -- a field isomorphic to an algebra is an algebra
  algebraic := sorry -- a field isomorphic to an algebraic extension is algebraic
  }

instance : preorder (extension K) :=
{ le := λ L M, ∃ hLM : L.carrier ⊆ M.carrier, is_ring_hom (inclusion hLM),
  le_refl := λ _, ⟨set.subset.refl _, by convert is_ring_hom.id; ext; simp⟩,
  le_trans := λ L M N ⟨hLM₁, hLM₂⟩ ⟨hMN₁, hMN₂⟩, ⟨set.subset.trans hLM₁ hMN₁,
    by resetI; convert is_ring_hom.comp (inclusion hLM₁) (inclusion hMN₁)⟩ }

private structure chain' (c : set (extension K)) : Prop :=
(chain : chain (≤) c)

local attribute [class] chain'

private lemma is_chain (c : set (extension K)) [chain' c]: chain (≤) c :=
chain'.chain (by apply_instance)

section chain

variables (c : set (extension K)) [hcn : nonempty c]
include c  hcn

variable [hcn' : chain' c]
include hcn'

instance chain_directed_order : directed_order c :=
⟨λ ⟨i, hi⟩ ⟨j, hj⟩, let ⟨k, hkc, hk⟩ := chain.directed_on
  (is_chain c) i hi j hj in ⟨⟨k, hkc⟩, hk⟩⟩

private def chain_map (i j : c) (hij : i ≤ j) : i.1.carrier → j.1.carrier :=
inclusion (exists.elim hij (λ h _, h))

instance chain_field_hom (i j : c) (hij : i ≤ j) : is_field_hom (chain_map c i j hij) :=
exists.elim hij (λ _, id)

instance chain_directed_system : directed_system (λ i : c, i.1.carrier) (chain_map c) :=
by split; intros; simp [chain_map]

private def chain_limit : Type u := ring.direct_limit (λ i : c, i.1.carrier) (chain_map c)

private lemma of_eq_of (x : big_type K) (i j : c) (hi : x ∈ i.1.carrier) (hj : x ∈ j.1.carrier) :
  ring.direct_limit.of (λ i : c, i.1.carrier) (chain_map c) i ⟨x, hi⟩ =
  ring.direct_limit.of (λ i : c, i.1.carrier) (chain_map c) j ⟨x, hj⟩ :=
have hij : i ≤ j ∨ j ≤ i,
  from show i.1 ≤ j.1 ∨ j.1 ≤ i.1, from chain.total (is_chain c) i.2 j.2,
hij.elim
  (λ hij, begin
    rw ← @ring.direct_limit.of_f c _ _ _ (λ i : c, i.1.carrier) _ _ (chain_map c) _
      _ _ _ hij,
    simp [chain_map, inclusion]
  end)
  (λ hij, begin
    rw ← @ring.direct_limit.of_f c _ _ _ (λ i : c, i.1.carrier) _ _ (chain_map c) _
      _ _ _ hij,
    simp [chain_map, inclusion]
  end)

private lemma injective_aux (i j : c)
  (x y : ⋃ i : c, i.1.carrier) (hx : x.1 ∈ i.1.carrier) (hy : y.1 ∈ j.1.carrier) :
  ring.direct_limit.of (λ i : c, i.1.carrier) (chain_map c) i ⟨x, hx⟩ =
  ring.direct_limit.of (λ i : c, i.1.carrier) (chain_map c) j ⟨y, hy⟩ →
  x = y :=
have hij : i ≤ j ∨ j ≤ i,
  from show i.1 ≤ j.1 ∨ j.1 ≤ i.1, from chain.total (is_chain c) i.2 j.2,
have hinj : ∀ (i j : c) (hij : i ≤ j), injective (chain_map c i j hij),
  from λ _ _ _, is_field_hom.injective _,
hij.elim
  (λ hij h, begin
    rw ← @ring.direct_limit.of_f c _ _ _ (λ i : c, i.1.carrier) _ _ (chain_map c) _
      _ _ _ hij at h,
    simpa [chain_map, inclusion, subtype.coe_ext.symm] using ring.direct_limit.of_inj hinj j h,
  end)
  (λ hji h, begin
    rw ← @ring.direct_limit.of_f c _ _ _ (λ i : c, i.1.carrier) _ _ (chain_map c) _
      _ _ _ hji at h,
    simpa [chain_map, inclusion, subtype.coe_ext.symm] using ring.direct_limit.of_inj hinj i h,
  end)

private def equiv_direct_limit : (⋃ (i : c), i.1.carrier) ≃
  ring.direct_limit (λ i : c, i.1.carrier) (chain_map c) :=
@equiv.of_bijective (⋃ i : c, i.1.carrier)
  (ring.direct_limit (λ i : c, i.1.carrier) (chain_map c))
  (λ x, ring.direct_limit.of _ _ (classical.some (set.mem_Union.1 x.2))
    ⟨_, classical.some_spec (set.mem_Union.1 x.2)⟩)
  ⟨λ x y, injective_aux _ _ _ _ _ _ _,
    λ x, let ⟨i, ⟨y, hy⟩, hy'⟩ := ring.direct_limit.exists_of x in
      ⟨⟨y, _, ⟨i, rfl⟩, hy⟩, begin
        convert hy',
        exact of_eq_of _ _ _ _ _ _
      end⟩⟩

instance Union_field : discrete_field (⋃ i : c, i.1.carrier) :=
@equiv.discrete_field _ _ (equiv_direct_limit c)
  (field.direct_limit.discrete_field _ _)

set_option class.instance_max_depth 50

instance is_field_hom_Union (i : c) : is_field_hom
  (inclusion (set.subset_Union (λ i : c, i.1.carrier) i)) :=
suffices inclusion (set.subset_Union (λ i : c, i.1.carrier) i) =
    ((equiv_direct_limit c).symm ∘
    ring.direct_limit.of (λ i : c, i.1.carrier) (chain_map c) i),
  by rw this; exact is_ring_hom.comp _ _,
funext $ λ ⟨_, _⟩,
  (equiv_direct_limit c).injective $
    by rw [function.comp_app, equiv.apply_symm_apply];
      exact of_eq_of _ _ _ _ _ _

end chain

--def maximal_extension (c : set (extension K)) (hc : chain (≤) c) : extension K :=

private def maximal_extension_chain (c : set (extension K)) (hc : chain (≤) c) :
  { ub : extension K // ∀ L, L ∈ c → L ≤ ub } :=
if h : nonempty c
  then by letI : chain' c := ⟨hc⟩; exact
    ⟨{ carrier := ⋃ (i : c), i.1.carrier,
       /- of_ring_hom probably works here. Field is isomorphic to direct limit of a bunch of extensions -/
        algebra := sorry,
        algebraic := sorry }, -- Field is isomorphic to direct limit of some algebraic extensions
    λ e he, ⟨by convert subset_Union _ (⟨e, he⟩ : c); refl,
      algebraic_closure.is_field_hom_Union c ⟨e, he⟩⟩⟩
  else ⟨base_extension K, λ a ha, (h ⟨⟨a, ha⟩⟩).elim⟩

section adjoin_root
variables {L : extension K} (f : polynomial L.carrier) [hif : irreducible f]
include hif

-- instance adjoin_root_algebraic_closure.field :
--   discrete_field (adjoin_root f) := adjoin_root.field

-- instance adjoin_root_algebraic_closure.is_ring_hom :
--   is_ring_hom (@adjoin_root.of _ _ _ f) := adjoin_root.is_ring_hom

-- uncommenting the above instance fixes this
private def adjoin_root.of_embedding : L.carrier ↪ adjoin_root f :=
⟨adjoin_root.of, @is_field_hom.injective _ _ _ _ _ $ by apply_instance⟩

/- TODO: move -/
instance adjoin_root.algebra : algebra K (adjoin_root f) :=
algebra.of_ring_hom (adjoin_root.of ∘ algebra_map _) (is_ring_hom.comp _ _)

variable (K)

private def adjoin_root_extension_map : adjoin_root f ↪ big_type K :=
thing (adjoin_root.of_embedding f) ⟨subtype.val, subtype.val_injective⟩
  (λ i, let e : big_type K ↪ ℕ × polynomial K := i.trans
      (algebraic_embedding sorry) in --adjoining a root to an algebraic extension gives an algebraic extension
    cantor_injective e.1 e.2)

private lemma adjoin_root_extension_map_apply (x : L.carrier) :
  (adjoin_root_extension_map K f) (@adjoin_root.of _ _ _ f x) = x.val :=
thing_commutes _ _ _ _

instance range_adjoin_root_extension_map.discrete_field :
  discrete_field (set.range (@adjoin_root_extension_map K _ _ f _)) :=
equiv.discrete_field (equiv.set.range _ (embedding.inj _)).symm

private def adjoin_root_extension : extension K :=
{ carrier := set.range (@adjoin_root_extension_map K _ _ f _),
  algebra := algebra.of_ring_hom
    ((equiv.set.range _ (embedding.inj' (adjoin_root_extension_map K f))).symm.symm ∘
      algebra_map _) (is_ring_hom.comp _ _),
  algebraic := sorry } -- adjoining a root to an algebraic extension gives an algebraic extension

variable {L}
private lemma subset_adjoin_root_extension : L.carrier ⊆ (adjoin_root_extension K f).carrier :=
λ x h, ⟨adjoin_root.of_embedding f ⟨x, h⟩, thing_commutes _ _ _ _⟩

private lemma adjoin_root_inclusion_eq : inclusion (subset_adjoin_root_extension K f) =
  ((equiv.set.range _ (adjoin_root_extension_map K f).2).symm.symm ∘ adjoin_root.of_embedding f) :=
funext $ λ ⟨_, _⟩, subtype.eq $ eq.symm $ adjoin_root_extension_map_apply _ _ _

private lemma le_adjoin_root_extension : L ≤ adjoin_root_extension K f :=
⟨subset_adjoin_root_extension K f,
  by rw [adjoin_root_inclusion_eq]; dsimp [adjoin_root.of_embedding]; exact is_ring_hom.comp _ _⟩

private def equiv_adjoin_root_of_le (h : adjoin_root_extension K f ≤ L) :
  L.carrier ≃r adjoin_root f :=
have left_inv : left_inverse (inclusion h.fst ∘ (equiv.set.range _
    (adjoin_root_extension_map K f).2)) adjoin_root.of,
  from λ _, by simp [adjoin_root_extension_map_apply, inclusion],
{ to_fun := coe,
  inv_fun := inclusion h.fst ∘ (equiv.set.range _ (adjoin_root_extension_map K f).2),
  left_inv := left_inv,
  right_inv := right_inverse_of_injective_of_left_inverse
    (injective_comp (inclusion_injective _) (equiv.injective _))
    left_inv,
  hom := by apply_instance }

private def adjoin_root_equiv_adjoin_root_extension : adjoin_root f ≃r (adjoin_root_extension K f).carrier :=
(equiv.set.range _ (adjoin_root_extension_map K f).2).symm.ring_equiv.symm

end adjoin_root

private lemma exists_algebraic_closure (K : Type u) [discrete_field K] :
  ∃ m : extension K, ∀ a, m ≤ a → a ≤ m :=
zorn (λ c hc, (maximal_extension_chain c hc).exists_of_subtype) (λ _ _ _, le_trans)

private def closed_extension (K : Type u) [discrete_field K] :=
classical.some (exists_algebraic_closure K)

def algebraic_closure (K : Type u) [discrete_field K] : Type u :=
((classical.some (exists_algebraic_closure K))).carrier

end classical

section is_algebraically_closed
/- In this section we prove the algebraic closure is algebraically closed -/

local attribute [reducible] algebraic_closure

variables (f : polynomial (algebraic_closure K)) [hif : irreducible f]
include hif

variable (K)

def algebraic_closure_equiv_adjoin_root : algebraic_closure K ≃r adjoin_root f :=
equiv_adjoin_root_of_le K f $
  classical.some_spec (exists_algebraic_closure K) _ (le_adjoin_root_extension _ _)

instance ring_equiv.is_semiring_hom {α β : Type*} [ring α] [ring β] (e : α ≃r β) :
  is_semiring_hom (e.to_equiv : α → β) :=
is_ring_hom.is_semiring_hom _

omit hif

private def is_algebraically_closed_aux : is_algebraically_closed (algebraic_closure K) :=
is_algebraically_closed_of_irreducible_has_root $
λ f hf, let e := by exactI algebraic_closure_equiv_adjoin_root K f in
⟨_, exists_root_of_equiv e (adjoin_root.eval₂_root f)⟩

end is_algebraically_closed

/- To avoid diamonds, the `decidable_eq` instance is set to `classical.dec_eq`,
  as opposed to the (noncomputable, but not def-eq to `classical.dec_eq`) instance given by
  `(closed_extension K).field` -/
instance : discrete_field (algebraic_closure K) :=
{ has_decidable_eq := classical.dec_eq _,
  ..(closed_extension K).field }

instance : algebra K (algebraic_closure K) := (closed_extension K).algebra

instance : is_algebraically_closed (algebraic_closure K) :=
by convert is_algebraically_closed_aux K

protected def is_integral : ∀ x : algebraic_closure K, is_integral K x :=
(closed_extension K).algebraic

attribute [irreducible] algebraic_closure closed_extension algebraic_closure.algebra

section lift
/- In this section, the homomorphism from any algebraic extension into an algebraically
  closed extension is proven to exist. The assumption that M is algebraically closed could probably
  easily be switched to an assumption that M contains all the roots of polynomials in K -/
variables {L : Type v} {M : Type w} [discrete_field L] [algebra K L]
  [discrete_field M] [algebra K M] [is_algebraically_closed M] (hL : ∀ x : L, is_integral K x)

/-- This structure is used to prove the existence of a homomorphism from any algebraic extension
  into an algebraic closure -/
variables (K L M)
include hL

private structure subfield_and_hom extends extension K :=
( to_algebraically_closed : carrier →ₐ[K] M )
( to_field : carrier →ₐ[K] L )

variables {K L M}

instance subfield_and_hom.preorder : preorder (subfield_and_hom K L M hL) :=
preorder.lift subfield_and_hom.to_extension (by apply_instance)

private def maximal_subfield_and_hom_chain (c : set (subfield_and_hom K L M hL)) (hc : chain (≤) c) :
  ∃ ub : subfield_and_hom K L M hL, ∀ N, N ∈ c → N ≤ ub :=
let ub := (maximal_extension_chain (subfield_and_hom.to_extension '' c) (chain.image (≤) _ _ (λ _ _, id) hc)) in
⟨{ to_algebraically_closed := sorry, --field in question is direct limit of a bunch of fields with
      --algebra homs into M
    to_field := sorry, -- direct limit of a bunch of subfields is also a subfield
    ..ub.1 },
   λ n hN, ub.2 _ (mem_image_of_mem _ hN)⟩

private lemma exists_maximal_subfield_and_hom : ∃ N : subfield_and_hom K L M hL,
  ∀ O, N ≤ O → O ≤ N :=
zorn (maximal_subfield_and_hom_chain _) (λ _ _ _, le_trans)

variable (M)

private def maximal_subfield_and_hom : subfield_and_hom K L M hL :=
classical.some (exists_maximal_subfield_and_hom hL)

instance akgh : algebra (maximal_subfield_and_hom M hL).carrier L :=
algebra.of_ring_hom (maximal_subfield_and_hom M hL).to_field (by apply_instance)

-- Given K:L:M, if M is algebraic over K it is algebraic over L (names are different)
private lemma is_integral_over_maximal (x : L) : is_integral (maximal_subfield_and_hom M hL).carrier x := sorry

variables (f : polynomial (maximal_subfield_and_hom M hL).carrier) [hif : irreducible f]
  {x : L} (hxf : f.eval₂ (maximal_subfield_and_hom M hL).to_field x = 0)

include hif hxf

private def adjoin_root_subfield_and_hom : subfield_and_hom K L M hL :=
{ to_algebraically_closed := sorry, -- should be adjoin_root.lift composed with an isomorphism
  to_field := sorry, --
  ..adjoin_root_extension K f }

private lemma le_adjoin_root_subfield_and_hom : maximal_subfield_and_hom M hL ≤
  adjoin_root_subfield_and_hom M hL f hxf :=
le_adjoin_root_extension _ _

private def maximal_subfield_and_hom_equiv_adjoin_root :=
equiv_adjoin_root_of_le K f $
  classical.some_spec (exists_maximal_subfield_and_hom hL) _
    (le_adjoin_root_subfield_and_hom M hL f hxf)

omit hif hxf

private lemma surjective_maximal_subfield_and_hom_to_field :
  function.surjective (maximal_subfield_and_hom M hL).to_field :=
λ x, let hx := is_integral_over_maximal M hL x in
by letI := minimal_polynomial_irreducible hx; exact
⟨_, root_minimal_polynomial hx
  (exists_root_of_equiv (maximal_subfield_and_hom_equiv_adjoin_root M hL _
    (aeval_minimal_polynomial hx)) (adjoin_root.eval₂_root _))⟩

private def equiv_maximal_subfield_and_hom :
  (maximal_subfield_and_hom M hL).carrier ≃ₐ[K] L :=
{ ..(maximal_subfield_and_hom M hL).to_field,
  ..equiv.of_bijective
    ⟨is_field_hom.injective _, surjective_maximal_subfield_and_hom_to_field _ _⟩ }

/-- The hom from an algebraic extension of K into an algebraic closure -/
def lift : L →ₐ[K] M :=
(maximal_subfield_and_hom M hL).to_algebraically_closed.comp
(equiv_maximal_subfield_and_hom M hL).symm.to_alg_hom

end lift

end algebraic_closure


/-
Copyright (c) 2017 Simon Hudon All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Mario Carneiro
-/

import Mathlib.Tactic.NormNum

/-!
# Tests for `norm_num` extensions
-/

-- We deliberately mock R and C here so that we don't have to import the deps
axiom Real : Type
notation "ℝ" => Real
@[instance] axiom Real.linearOrderedRing : LinearOrderedField ℝ

axiom Complex : Type
notation "ℂ" => Complex
@[instance] axiom Complex.field : Field ℂ
@[instance] axiom Complex.charZero : CharZero ℂ

example : 43 ≤ 74 + (33 : ℤ) := by norm_num1
-- example : 374 + (32 - (2 * 8123) : ℤ) - 61 * 50 = 86 + 32 * 32 - 4 * 5000
--       ∧ 43 ≤ 74 + (33 : ℤ) := by norm_num1

example : ¬ (7-2)/(2*3) ≥ (1:ℝ) + 2/(3^2) := by norm_num1
example : (6:ℝ) + 9 = 15 := by norm_num1
example : (2:ℝ)/4 + 4 = 3*3/2 := by norm_num1
example : (((3:ℝ)/4)-12)<6 := by norm_num1
example : (5:ℝ) ≠ 8 := by norm_num1
example : (10:ℝ) > 7 := by norm_num1
example : (2:ℝ) * 2 + 3 = 7 := by norm_num1
example : (6:ℝ) < 10 := by norm_num1
example : (7:ℝ)/2 > 3 := by norm_num1
example : (4:ℝ)⁻¹ < 1 := by norm_num1
example : ((1:ℝ) / 2)⁻¹ = 2 := by norm_num1
-- example : 2 ^ 17 - 1 = 131071 := by norm_num1
-- example : (3 : ℝ) ^ (-2 : ℤ) = 1/9 := by norm_num1
-- example : (3 : ℝ) ^ (-2 : ℤ) = 1/9 := by norm_num1
-- example : (-3 : ℝ) ^ (0 : ℤ) = 1 := by norm_num1
-- example : (-3 : ℝ) ^ (-1 : ℤ) = -1/3 := by norm_num1
-- example : (-3 : ℝ) ^ (2 : ℤ) = 9 := by norm_num1

section InvLit

variable [DivisionRing α]

example : (0 : α)⁻¹ = 0 := by norm_num1
example : (1 : α)⁻¹ = 1 := by norm_num1
example : (-1 : α)⁻¹ = -1 := by norm_num1

end InvLit

example (h : x = 1) : x = (1/5 + 4/5 : ℚ) := by norm_num1; exact h
example (h : x = 1) : x = (5 * 5⁻¹ : ℚ) := by norm_num1; exact h
example (h : x = 1) : x = (6/5 - 1/5 : ℚ) := by norm_num1; exact h
example (h : x = 1) : x = ((6/5) ^ 0 : ℚ) := by norm_num1; exact h

/-
# `=` and `≠`
-/

section Equality

section Bool

example : True := by norm_num1
example (h : False) : ¬True := by norm_num1; guard_target =ₛ False; exact h
example : ¬¬¬¬True := by norm_num1
example : ¬False := by norm_num1

end Bool

section Nat

variable [AddMonoidWithOne α] [CharZero α]

-- Normalize to True
example : 1 = 1 := by norm_num1
example : 1 ≠ 2 := by norm_num1

example : (1 : α) ≠ 2 := by norm_num1

-- Normalize to False
example : ¬(1 = 2) := by norm_num1
example : ¬((1 : α) = 2) := by norm_num1

example : ¬((1 : α) ≠ 1) := by norm_num1

end Nat

section Semiring

variable [Semiring α] [CharZero α]

example : (1 : α) ≠ 2 := by norm_num1

end Semiring

section Int

variable [Ring α] [CharZero α]

-- Normalize to True
example : (1 : ℤ) = 1 := by norm_num1
example : (-1 : ℤ) = -1 := by norm_num1
example : (1 : α) = 1 := by norm_num1
example : (-1 : α) = -1 := by norm_num1

example : (1 : ℤ) ≠ 2 := by norm_num1
example : (1 : ℤ) ≠ -2 := by norm_num1
example : (-1 : ℤ) ≠ -2 := by norm_num1
example : (1 : α) ≠ 2 := by norm_num1
example : (-1 : α) ≠ 2 := by norm_num1
example : (-1 : α) ≠ -2 := by norm_num1

-- Normalize to False
example : ((1 : ℤ) = 2) = False := by norm_num1
example : ((-1 : ℤ) = 2) = False := by norm_num1
example : ((1 : α) = 2) = False := by norm_num1
example : ((-1 : α) = 2) = False := by norm_num1

example : ((1 : ℤ) ≠ 1) = False := by norm_num1
example : ((-1 : ℤ) ≠ -1) = False := by norm_num1
example : ((1 : α) ≠ 1) = False := by norm_num1
example : ((-1 : α) = 2) = False := by norm_num1

end Int

section Rat

variable [DivisionRing α] [CharZero α]

-- Normalize to True
example : (1 : ℚ) = 1 := by norm_num1
example : (-1 : ℚ) = -1 := by norm_num1
example : (1/2 : ℚ) = 1/2 := by norm_num1
example : (-1/2 : ℚ) = -1/2 := by norm_num1
example : (-1/(-2) : ℚ) = -1/(-2) := by norm_num1
example : (1 : α) = 1 := by norm_num1
example : (-1 : α) = -1 := by norm_num1
example : (1/2 : α) = 1/2 := by norm_num1
example : (-1/2 : α) = -1/2 := by norm_num1
example : (-1/(-2) : α) = -1/(-2) := by norm_num1

example : (1 : ℚ) ≠ 2 := by norm_num1
example : (1 : ℚ) ≠ -2 := by norm_num1
example : (-1 : ℚ) ≠ -2 := by norm_num1
example : (1/2 : ℚ) ≠ 1 := by norm_num1
example : (1/2 : ℚ) ≠ -1 := by norm_num1
example : (1/2 : ℚ) ≠ 1/3 := by norm_num1
example : (1/2 : ℚ) ≠ 5/2 := by norm_num1
example : (1/2 : α) ≠ 1/3 := by norm_num1
example : (1/2 : α) ≠ 5/2 := by norm_num1
example : (1/2 : α) ≠ -2 := by norm_num1
example : (-1 : α) ≠ 2 := by norm_num1
example : (1 : α) / 3 ≠ 0 := by norm_num1
example : (1 : α) / 3 ≠ 2 / 7 := by norm_num1

-- Normalize to False
example : ((1 : ℚ) = 2) = False := by norm_num1
example : ((-1 : ℚ) = 2) = False := by norm_num1
example : ((1/2 : ℚ) = 2) = False := by norm_num1
example : ((1 : α) = 2) = False := by norm_num1
example : ((-1 : α) = 2) = False := by norm_num1
example : ((1/2 : α) = 2) = False := by norm_num1

example : ((1 : ℚ) ≠ 1) = False := by norm_num1
example : ((-1 : ℚ) ≠ -1) = False := by norm_num1
example : ((1/2 : ℚ) ≠ 1/2) = False := by norm_num1
example : ((1/2 : α) ≠ 1/2) = False := by norm_num1

end Rat

end Equality

/-
# `<` and `≤`
-/

section Order

section Nat

variable [OrderedSemiring α] [CharZero α]

-- Normalize to True
example : 1 ≤ 1 := by norm_num1
example : (1 : α) ≤ 2 := by norm_num1

example : 1 < 2 := by norm_num1
example : (1 : α) < 2 := by norm_num1

-- Normalize to False
example : ¬(2 ≤ 1) := by norm_num1
example : ¬((2 : α) ≤ 1) := by norm_num1

example : ¬(1 < 1) := by norm_num1
example : ¬((2 : α) < 2) := by norm_num1

end Nat

section Int

variable [OrderedRing α] [Nontrivial α]

-- Normalize to True
example : (1 : ℤ) ≤ 1 := by norm_num1
example : (-1 : ℤ) ≤ -1 := by norm_num1
example : (-1 : ℤ) ≤ 1 := by norm_num1
example : (1 : α) ≤ 1 := by norm_num1
example : (-1 : α) ≤ -1 := by norm_num1
example : (-1 : α) ≤ 1 := by norm_num1

example : (1 : ℤ) < 2 := by norm_num1
example : (-2 : ℤ) < 1 := by norm_num1
example : (-1 : ℤ) < 1 := by norm_num1
example : (1 : α) < 2 := by norm_num1
example : (-1 : α) < 2 := by norm_num1
example : (-1 : α) < 1 := by norm_num1

-- Normalize to False
example : ¬((2 : ℤ) ≤ 1) := by norm_num1
example : ¬((2 : ℤ) ≤ -1) := by norm_num1
example : ¬((2 : α) ≤ 1) := by norm_num1
example : ¬((2 : α) ≤ -1) := by norm_num1

example : ¬((2 : ℤ) < 1) := by norm_num1
example : ¬((2 : ℤ) < -1) := by norm_num1
example : ¬((2 : α) < 1) := by norm_num1
example : ¬((2 : α) < -1) := by norm_num1

end Int

section OrderedCharZeroRing

variable [OrderedRing α] [CharZero α]

example : (-1 : α) < 2 := by norm_num1

end OrderedCharZeroRing

section LinearOrderedRing

variable [LinearOrderedRing α]

example : (1 : α) ≤ 1 := by norm_num1
example : (-1 : α) ≤ -1 := by norm_num1
example : (-1 : α) ≤ 1 := by norm_num1

example : (1 : α) < 2 := by norm_num1
example : (-1 : α) < 2 := by norm_num1
example : (-1 : α) < 1 := by norm_num1

end LinearOrderedRing

section Rat

variable [LinearOrderedField α] [Nontrivial α]

-- Normalize to True
example : (1 : ℚ) ≤ 1 := by norm_num1
example : (-1 : ℚ) ≤ -1 := by norm_num1
example : (-1 : ℚ) ≤ 1 := by norm_num1
example : (-1/2 : ℚ) ≤ 1 := by norm_num1
example : (1/2 : ℚ) ≤ 5/4 := by norm_num1
example : (1 : α) ≤ 1 := by norm_num1
example : (-1 : α) ≤ -1 := by norm_num1
example : (-1 : α) ≤ 1 := by norm_num1
example : (-1/2 : α) ≤ 1 := by norm_num1
example : (1/2 : α) ≤ 5/4 := by norm_num1

example : (1 : ℤ) < 2 := by norm_num1
example : (-2 : ℤ) < 1 := by norm_num1
example : (-1 : ℤ) < 1 := by norm_num1
example : (-1/2 : ℚ) < 1 := by norm_num1
example : (1/2 : ℚ) < 5/4 := by norm_num1
example : (1 : α) < 2 := by norm_num1
example : (-1 : α) < 2 := by norm_num1
example : (-1 : α) < 1 := by norm_num1
example : (-1/2 : α) < 1 := by norm_num1
example : (1/2 : α) < 5/4 := by norm_num1

-- Normalize to False
example : ¬((2 : ℚ) ≤ 1) := by norm_num1
example : ¬((2 : ℚ) ≤ -1) := by norm_num1
example : ¬((1/2 : ℚ) ≤ -1) := by norm_num1
example : ¬((2 : α) ≤ 1) := by norm_num1
example : ¬((2 : α) ≤ -1) := by norm_num1
example : ¬((1/2 : α) ≤ -1) := by norm_num1

example : ¬((2 : ℚ) < 1) := by norm_num1
example : ¬((2 : ℚ) < -1) := by norm_num1
example : ¬((1/2 : ℚ) < -1) := by norm_num1
example : ¬((2 : α) < 1) := by norm_num1
example : ¬((2 : α) < -1) := by norm_num1
example : ¬((1/2 : α) < -1) := by norm_num1

end Rat

end Order

example : (1:ℂ) ≠ 2 := by norm_num1
example : (1:ℂ) / 3 ≠ 2 / 7 := by norm_num1

example : (1:ℝ) ≠ 2 := by norm_num1

-- example : (5 / 2:ℕ) = 2 := by norm_num1
-- example : (5 / -2:ℤ) < -1 := by norm_num1
-- example : (0 + 1) / 2 < 0 + 1 := by norm_num1
-- example : Nat.succ (Nat.succ (2 ^ 3)) = 10 := by norm_num1
-- example : 10 = (-1 : ℤ) % 11 := by norm_num1 -- [fixme] ⊢ False ???
example : (12321 - 2 : ℤ) = 12319 := by norm_num1
example : (63:ℚ) ≥ 5 := by norm_num1

example (x : ℤ) (h : 1000 + 2000 < x) : 100 * 30 < x :=
by norm_num at *; exact h

example : (1103 : ℤ) ≤ (2102 : ℤ) := by norm_num1
example : (110474 : ℤ) ≤ (210485 : ℤ) := by norm_num1
example : (11047462383473829263 : ℤ) ≤ (21048574677772382462 : ℤ) := by norm_num1
example : (210485742382937847263 : ℤ) ≤ (1104857462382937847262 : ℤ) := by norm_num1
example : (210485987642382937847263 : ℕ) ≤ (11048512347462382937847262 : ℕ) := by norm_num1
example : (210485987642382937847263 : ℚ) ≤ (11048512347462382937847262 : ℚ) := by norm_num1
example : (2 * 12868 + 25705) * 11621 ^ 2 ≤ 23235 ^ 2 * 12868 := by norm_num1

-- example (x : ℕ) : ℕ := by
--   let n : ℕ := by apply_normed (2^32 - 71)
--   exact n

example (a : ℚ) (h : 3⁻¹ * a = a) : True := by
  norm_num1 at h
  guard_hyp h : 1 / 3 * a = a
  trivial

-- example (h : (5 : ℤ) ∣ 2) : False := by norm_num1 at h
example (h : False) : False := by norm_num1 at h
example : True := by norm_num1
-- example : True ∧ True := by norm_num1

/-!
# Nat operations
-/

section Nat.sub

example : 10 - 1 = 9 := by norm_num1
example : 12 - 5 = 3 + 4 := by norm_num1
example : 5 - 20 = 0 := by norm_num1
example : 0 - 2 = 0 := by norm_num1
example : 4 - (5 - 10) = 2 + (3 - 1) := by norm_num1
example : 0 - 0 = 0 := by norm_num1
example : 100 - 100 = 0 := by norm_num1
example : 5 * (2 - 3) = 0 := by norm_num1
example : 10 - 5 * 5 + (7 - 3) * 6 = 27 - 3 := by norm_num1

end Nat.sub

section Nat.mod

example : 10 % 1 = 0 := by norm_num1
example : 5 % 4 = 1 := by norm_num1
example : (9 % 4) % (12 % 8) = 1 := by norm_num1
example : 0 % 10 = 0 := by norm_num1
example : 10 % 0 = 10 := by norm_num1
example : 1 % 1 = 0 := by norm_num1

end Nat.mod

/-!
# Numbers in algebraic structures
-/

-- noncomputable def foo : ℝ := 1

-- example : foo = 1 := by norm_num [foo]

section
  variable [AddMonoidWithOne α]
  example : (1 + 0 : α) = (0 + 1 : α) := by norm_num1
  example : (0 + (2 + 3) + 1 : α) = 6 := by norm_num1
end

section
  variable [Semiring α]
  example : (70 * (33 + 2) : α) = 2450 := by norm_num1
  example : (8 + 2 ^ 2 * 3 : α) = 20 := by norm_num1
  example : ((2 * 1 + 1) ^ 2 : α) = (3 * 3 : α) := by norm_num1
end
section
  variable [Ring α]

  example : (-1 : α) * 1 = -1 := by norm_num1
  example : (-2 : α) * 1 = -2 := by norm_num1
  example : (-2 : α) * -1 = 2 := by norm_num1
  example : (-2 : α) * -2 = 4 := by norm_num1
  example : (1 : α) * 0 = 0 := by norm_num1

  example : ((1 : α) + 1) * 5 = 6 + 4 := by norm_num1

  example : (1 : α) = 0 + 1 := by norm_num1
  example : (1 : α) = 1 + 0 := by norm_num1
  example : (2 : α) = 1 + 1 := by norm_num1
  example : (2 : α) = 0 + 2 := by norm_num1
  example : (3 : α) = 1 + 2 := by norm_num1
  example : (3 : α) = 2 + 1 := by norm_num1
  example : (4 : α) = 3 + 1 := by norm_num1
  example : (4 : α) = 2 + 2 := by norm_num1
  example : (5 : α) = 4 + 1 := by norm_num1
  example : (5 : α) = 3 + 2 := by norm_num1
  example : (5 : α) = 2 + 3 := by norm_num1
  example : (6 : α) = 0 + 6 := by norm_num1
  example : (6 : α) = 3 + 3 := by norm_num1
  example : (6 : α) = 4 + 2 := by norm_num1
  example : (6 : α) = 5 + 1 := by norm_num1
  example : (7 : α) = 4 + 3 := by norm_num1
  example : (7 : α) = 1 + 6 := by norm_num1
  example : (7 : α) = 6 + 1 := by norm_num1
  example : 33 = 5 + (28 : α) := by norm_num1

  example : (12 : α) = 0 + (2 + 3) + 7 := by norm_num1
  example : (105 : α) = 70 + (33 + 2) := by norm_num1

  example : (45000000000 : α) = 23000000000 + 22000000000 := by norm_num1

  example : (0 : α) - 3 = -3 := by norm_num1
  example : (0 : α) - 2 = -2 := by norm_num1
  example : (1 : α) - 3 = -2 := by norm_num1
  example : (1 : α) - 1 = 0 := by norm_num1
  example : (0 : α) - 3 = -3 := by norm_num1
  example : (0 : α) - 3 = -3 := by norm_num1
  example : (12 : α) - 4 - (5 + -2) = 5 := by norm_num1
  example : (12 : α) - 4 - (5 + -2) - 20 = -15 := by norm_num1

  example : (0 : α) * 0 = 0 := by norm_num1
  example : (0 : α) * 1 = 0 := by norm_num1
  example : (0 : α) * 2 = 0 := by norm_num1
  example : (2 : α) * 0 = 0 := by norm_num1
  example : (1 : α) * 0 = 0 := by norm_num1
  example : (1 : α) * 1 = 1 := by norm_num1
  example : (2 : α) * 1 = 2 := by norm_num1
  example : (1 : α) * 2 = 2 := by norm_num1
  example : (2 : α) * 2 = 4 := by norm_num1
  example : (3 : α) * 2 = 6 := by norm_num1
  example : (2 : α) * 3 = 6 := by norm_num1
  example : (4 : α) * 1 = 4 := by norm_num1
  example : (1 : α) * 4 = 4 := by norm_num1
  example : (3 : α) * 3 = 9 := by norm_num1
  example : (3 : α) * 4 = 12 := by norm_num1
  example : (4 : α) * 4 = 16 := by norm_num1
  example : (11 : α) * 2 = 22 := by norm_num1
  example : (15 : α) * 6 = 90 := by norm_num1
  example : (123456 : α) * 123456 = 15241383936 := by norm_num1
end

section
  variable [LinearOrderedField α]
  example : (4 : α) / 2 = 2 := by norm_num1
  example : (4 : α) / 1 = 4 := by norm_num1
  example : (4 : α) / 3 = 4 / 3 := by norm_num1
  example : (50 : α) / 5 = 10 := by norm_num1
  example : (1056 : α) / 1 = 1056 := by norm_num1
  example : (6 : α) / 4 = 3/2 := by norm_num1
  example : (0 : α) / 3 = 0 := by norm_num1
  example : (3 : α) / 0 = 0 := by norm_num1
  example : (9 * 9 * 9) * (12 : α) / 27 = 81 * (2 + 2) := by norm_num1
  example : (-2 : α) * 4 / 3 = -8 / 3 := by norm_num1
  example : - (-4 / 3) = 1 / (3 / (4 : α)) := by norm_num1
end

section Transparency

example : Add.add 10 2 = 12 := by norm_num1
example : Nat.sub 10 1 = 9 := by norm_num1
example : Nat.mod 10 5 = 0 := by norm_num1
example : Sub.sub 10 1 = 9 := by norm_num1
example : Sub.sub 10 (-2) = 12 := by norm_num1
example : Mul.mul 10 1 = 10 := by norm_num1
example : (Div.div 10 1 : ℚ) = 10 := by norm_num1

end Transparency

-- user command

#norm_num 1 = 1
example : 1 = 1 := by norm_num1
-- #norm_num 2^4-1 ∣ 2^16-1
-- example : 2^4-1 ∣ 2^16-1 := by norm_num1
-- #norm_num (3 : Real) ^ (-2 : ℤ) = 1/9
-- example : (3 : Real) ^ (-2 : ℤ) = 1/9 := by norm_num1

section norm_num_cmd_variable

-- [fixme] obsolete?
-- variables (x y : ℕ)
-- #norm_num bit0 x < bit0 (y + x) ↔ 0 < y
-- example : bit0 x < bit0 (y + x) ↔ 0 < y := by norm_num1
-- #norm_num bit0 x < bit0 (y + (2^10%11 - 1) + x) ↔ 0 < y
-- example : bit0 x < bit0 (y + (2^10%11 - 1) + x) ↔ 0 < y := by norm_num1
-- #norm_num bit0 x < bit0 (y + (2^10%11 - 1) + x) + 3*2-6 ↔ 0 < y
-- example : bit0 x < bit0 (y + (2^10%11 - 1) + x) + 3*2-6 ↔ 0 < y := by norm_num1

end norm_num_cmd_variable

section norm_num_erase

example : 3 ^ 3 + 4 = 31 := by norm_num1

attribute [-norm_num] Mathlib.Meta.NormNum.evalPow in
example : 3 ^ 3 + 4 = 31 := by
  norm_num1
  guard_target =ₛ 3 ^ 3 + 4 = 31
  rfl

/- Check that the scoping above works: -/
example : 3 ^ 3 + 4 = 31 := by norm_num1

attribute [-norm_num] Mathlib.Meta.NormNum.evalPow
/-
  If run, the following commented line of code will produce the error
  "'Mathlib.Meta.NormNum.evalPow' does not have [norm_num] attribute".

  This checks that the `norm_num` attribute is indeed considered to be erased from
  `Mathlib.Meta.NormNum.evalPow` in this scope.
-/
-- attribute [-norm_num] Mathlib.Meta.NormNum.evalPow

end norm_num_erase

-- auto gen tests
variable [LinearOrderedField α]
example : ((25 * (1 / 1)) + (30 - 16)) = (39 : α) := by norm_num1
example : ((19 * (- 2 - 3)) / 6) = (-95/6 : α) := by norm_num1
example : - (3 * 28) = (-84 : α) := by norm_num1
example : - - (16 / ((11 / (- - (6 * 19) + 12)) * 21)) = (96/11 : α) := by norm_num1
example : (- (- 21 + 24) - - (- - (28 + (- 21 / - (16 / ((1 * 26) * ((0 * - 11) + 13))))) * 21)) =
  (79209/8 : α) := by norm_num1
example : (27 * (((16 + - (12 + 4)) + (22 - - 19)) - 23)) = (486 : α) := by norm_num1
example : - (13 * (- 30 / ((7 / 24) + - 7))) = (-9360/161 : α) := by norm_num1
example : - (0 + 20) = (-20 : α) := by norm_num1
example : (- 2 - (27 + (((2 / 14) - (7 + 21)) + (16 - - - 14)))) = (-22/7 : α) := by norm_num1
example : (25 + ((8 - 2) + 16)) = (47 : α) := by norm_num1
example : (- - 26 / 27) = (26/27 : α) := by norm_num1
example : ((((16 * (22 / 14)) - 18) / 11) + 30) = (2360/77 : α) := by norm_num1
example : (((- 28 * 28) / (29 - 24)) * 24) = (-18816/5 : α) := by norm_num1
example : ((- (18 - ((- - (10 + - 2) - - (23 / 5)) / 5)) - (21 * 22)) -
  (((20 / - ((((19 + 18) + 15) + 3) + - 22)) + 14) / 17)) = (-394571/825 : α) := by norm_num1
example : ((3 + 25) - - 4) = (32 : α) := by norm_num1
example : ((1 - 0) - 22) = (-21 : α) := by norm_num1
example : (((- (8 / 7) / 14) + 20) + 22) = (2054/49 : α) := by norm_num1
example : ((21 / 20) - 29) = (-559/20 : α) := by norm_num1
example : - - 20 = (20 : α) := by norm_num1
example : (24 - (- 9 / 4)) = (105/4 : α) := by norm_num1
example : (((7 / ((23 * 19) + (27 * 10))) - ((28 - - 15) * 24)) + (9 / - (10 * - 3))) =
  (-1042007/1010 : α) := by norm_num1
example : (26 - (- 29 + (12 / 25))) = (1363/25 : α) := by norm_num1
example : ((11 * 27) / (4 - 5)) = (-297 : α) := by norm_num1
example : (24 - (9 + 15)) = (0 : α) := by norm_num1
example : (- 9 - - 0) = (-9 : α) := by norm_num1
example : (- 10 / (30 + 10)) = (-1/4 : α) := by norm_num1
example : (22 - (6 * (28 * - 8))) = (1366 : α) := by norm_num1
example : ((- - 2 * (9 * - 3)) + (22 / 30)) = (-799/15 : α) := by norm_num1
example : - (26 / ((3 + 7) / - (27 * (12 / - 16)))) = (-1053/20 : α) := by norm_num1
example : ((- 29 / 1) + 28) = (-1 : α) := by norm_num1
example : ((21 * ((10 - (((17 + 28) - - 0) + 20)) + 26)) + ((17 + - 16) * 7)) = (-602 : α) :=
by norm_num1
example : (((- 5 - ((24 + - - 8) + 3)) + 20) + - 23) = (-43 : α) := by norm_num1
example : ((- ((14 - 15) * (14 + 8)) + ((- (18 - 27) - 0) + 12)) - 11) = (32 : α) := by norm_num1
example : (((15 / 17) * (26 / 27)) + 28) = (4414/153 : α) := by norm_num1
example : (14 - ((- 16 - 3) * - (20 * 19))) = (-7206 : α) := by norm_num1
example : (21 - - - (28 - (12 * 11))) = (125 : α) := by norm_num1
example : ((0 + (7 + (25 + 8))) * - (11 * 27)) = (-11880 : α) := by norm_num1
example : (19 * - 5) = (-95 : α) := by norm_num1
example : (29 * - 8) = (-232 : α) := by norm_num1
example : ((22 / 9) - 29) = (-239/9 : α) := by norm_num1
example : (3 + (19 / 12)) = (55/12 : α) := by norm_num1
example : - (13 + 30) = (-43 : α) := by norm_num1
example : - - - (((21 * - - ((- 25 - (- (30 - 5) / (- 5 - 5))) /
  (((6 + ((25 * - 13) + 22)) - 3) / 2))) / (- 3 / 10)) * (- 8 - 0)) = (-308/3 : α) := by norm_num1
example : - (2 * - (- 24 * 22)) = (-1056 : α) := by norm_num1
example : - - (((28 / - ((- 13 * - 5) / - (((7 - 30) / 16) + 6))) * 0) - 24) = (-24 : α) :=
by norm_num1
example : ((13 + 24) - (27 / (21 * 13))) = (3358/91 : α) := by norm_num1
example : ((3 / - 21) * 25) = (-25/7 : α) := by norm_num1
example : (17 - (29 - 18)) = (6 : α) := by norm_num1
example : ((28 / 20) * 15) = (21 : α) := by norm_num1
example : ((((26 * (- (23 - 13) - 3)) / 20) / (14 - (10 + 20))) / ((16 / 6) / (16 * - (3 / 28)))) =
(-1521/2240 : α) := by norm_num1

example : (46 / (- ((- 17 * 28) - 77) + 87)) = (23/320 : α) := by norm_num1
example : (73 * - (67 - (74 * - - 11))) = (54531 : α) := by norm_num1
example : ((8 * (25 / 9)) + 59) = (731/9 : α) := by norm_num1
example : - ((59 + 85) * - 70) = (10080 : α) := by norm_num1
example : (66 + (70 * 58)) = (4126 : α) := by norm_num1
example : (- - 49 * 0) = (0 : α) := by norm_num1
example : ((- 78 - 69) * 9) = (-1323 : α) := by norm_num1
example : - - (7 - - (50 * 79)) = (3957 : α) := by norm_num1
example : - (85 * (((4 * 93) * 19) * - 31)) = (18624180 : α) := by norm_num1
example : (21 + (- 5 / ((74 * 85) / 45))) = (26373/1258 : α) := by norm_num1
example : (42 - ((27 + 64) + 26)) = (-75 : α) := by norm_num1
example : (- ((38 - - 17) + 86) - (74 + 58)) = (-273 : α) := by norm_num1
example : ((29 * - (75 + - 68)) + (- 41 / 28)) = (-5725/28 : α) := by norm_num1
example : (- - (40 - 11) - (68 * 86)) = (-5819 : α) := by norm_num1
example : (6 + ((65 - 14) + - 89)) = (-32 : α) := by norm_num1
example : (97 * - (29 * 35)) = (-98455 : α) := by norm_num1
example : - (66 / 33) = (-2 : α) := by norm_num1
example : - ((94 * 89) + (79 - (23 - (((- 1 / 55) + 95) * (28 - (54 / - - - 22)))))) =
(-1369070/121 : α) := by norm_num1
example : (- 23 + 61) = (38 : α) := by norm_num1
example : - (93 / 69) = (-31/23 : α) := by norm_num1
example : (- - ((68 / (39 + (((45 * - (59 - (37 + 35))) / (53 - 75)) -
 - (100 + - (50 / (- 30 - 59)))))) - (69 - (23 * 30))) / (57 + 17)) = (137496481/16368578 : α) :=
by norm_num1
example : (- 19 * - - (75 * - - 41)) = (-58425 : α) := by norm_num1
example : ((3 / ((- 28 * 45) * (19 + ((- (- 88 - (- (- 1 + 90) + 8)) + 87) * 48)))) + 1) =
  (1903019/1903020 : α) := by norm_num1
example : ((- - (28 + 48) / 75) + ((- 59 - 14) - 0)) = (-5399/75 : α) := by norm_num1
example : (- ((- (((66 - 86) - 36) / 94) - 3) / - - (77 / (56 - - - 79))) + 87) =
  (312254/3619 : α) := by norm_num1

-- example : 2 ^ 13 - 1 = Int.ofNat 8191 := by norm_num1


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov

! This file was ported from Lean 3 source module analysis.special_functions.non_integrable
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Integrals
import Mathbin.Analysis.Calculus.FderivMeasurable

/-!
# Non integrable functions

In this file we prove that the derivative of a function that tends to infinity is not interval
integrable, see `interval_integral.not_integrable_has_deriv_at_of_tendsto_norm_at_top_filter` and
`interval_integral.not_integrable_has_deriv_at_of_tendsto_norm_at_top_punctured`.  Then we apply the
latter lemma to prove that the function `λ x, x⁻¹` is integrable on `a..b` if and only if `a = b` or
`0 ∉ [a, b]`.

## Main results

* `not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_punctured`: if `f` tends to infinity
  along `𝓝[≠] c` and `f' = O(g)` along the same filter, then `g` is not interval integrable on any
  nontrivial integral `a..b`, `c ∈ [a, b]`.

* `not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_filter`: a version of
  `not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_punctured` that works for one-sided
  neighborhoods;

* `not_interval_integrable_of_sub_inv_is_O_punctured`: if `1 / (x - c) = O(f)` as `x → c`, `x ≠ c`,
  then `f` is not interval integrable on any nontrivial interval `a..b`, `c ∈ [a, b]`;

* `interval_integrable_sub_inv_iff`, `interval_integrable_inv_iff`: integrability conditions for
  `(x - c)⁻¹` and `x⁻¹`.

## Tags

integrable function
-/

open MeasureTheory Topology Interval NNReal ENNReal

open MeasureTheory TopologicalSpace Set Filter Asymptotics intervalIntegral

variable {E F : Type _} [NormedAddCommGroup E] [NormedSpace ℝ E] [SecondCountableTopology E]
  [CompleteSpace E] [NormedAddCommGroup F]

/-- If `f` is eventually differentiable along a nontrivial filter `l : filter ℝ` that is generated
by convex sets, the norm of `f` tends to infinity along `l`, and `f' = O(g)` along `l`, where `f'`
is the derivative of `f`, then `g` is not integrable on any interval `a..b` such that
`[a, b] ∈ l`. -/
theorem not_intervalIntegrable_of_tendsto_norm_atTop_of_deriv_isO_filter {f : ℝ → E} {g : ℝ → F}
    {a b : ℝ} (l : Filter ℝ) [NeBot l] [TendstoIxxClass Icc l l] (hl : [a, b] ∈ l)
    (hd : ∀ᶠ x in l, DifferentiableAt ℝ f x) (hf : Tendsto (fun x => ‖f x‖) l atTop)
    (hfg : deriv f =O[l] g) : ¬IntervalIntegrable g volume a b :=
  by
  intro hgi
  obtain ⟨C, hC₀, s, hsl, hsub, hfd, hg⟩ :
    ∃ (C : ℝ)(hC₀ : 0 ≤ C),
      ∃ s ∈ l,
        (∀ x ∈ s, ∀ y ∈ s, [x, y] ⊆ [a, b]) ∧
          (∀ x ∈ s, ∀ y ∈ s, ∀ z ∈ [x, y], DifferentiableAt ℝ f z) ∧
            ∀ x ∈ s, ∀ y ∈ s, ∀ z ∈ [x, y], ‖deriv f z‖ ≤ C * ‖g z‖ :=
    by
    rcases hfg.exists_nonneg with ⟨C, C₀, hC⟩
    have h :
      ∀ᶠ x : ℝ × ℝ in l.prod l,
        ∀ y ∈ [x.1, x.2], (DifferentiableAt ℝ f y ∧ ‖deriv f y‖ ≤ C * ‖g y‖) ∧ y ∈ [a, b] :=
      (tendsto_fst.uIcc tendsto_snd).Eventually ((hd.and hC.bound).And hl).smallSets
    rcases mem_prod_self_iff.1 h with ⟨s, hsl, hs⟩
    simp only [prod_subset_iff, mem_set_of_eq] at hs
    exact
      ⟨C, C₀, s, hsl, fun x hx y hy z hz => (hs x hx y hy z hz).2, fun x hx y hy z hz =>
        (hs x hx y hy z hz).1.1, fun x hx y hy z hz => (hs x hx y hy z hz).1.2⟩
  replace hgi : IntervalIntegrable (fun x => C * ‖g x‖) volume a b
  · convert hgi.norm.smul C
  obtain ⟨c, hc, d, hd, hlt⟩ : ∃ c ∈ s, ∃ d ∈ s, (‖f c‖ + ∫ y in Ι a b, C * ‖g y‖) < ‖f d‖ :=
    by
    rcases Filter.nonempty_of_mem hsl with ⟨c, hc⟩
    have : ∀ᶠ x in l, (‖f c‖ + ∫ y in Ι a b, C * ‖g y‖) < ‖f x‖ :=
      hf.eventually (eventually_gt_at_top _)
    exact ⟨c, hc, (this.and hsl).exists.imp fun d hd => ⟨hd.2, hd.1⟩⟩
  specialize hsub c hc d hd
  specialize hfd c hc d hd
  replace hg : ∀ x ∈ Ι c d, ‖deriv f x‖ ≤ C * ‖g x‖
  exact fun z hz => hg c hc d hd z ⟨hz.1.le, hz.2⟩
  have hg_ae : ∀ᵐ x ∂volume.restrict (Ι c d), ‖deriv f x‖ ≤ C * ‖g x‖ :=
    (ae_restrict_mem measurableSet_uIoc).mono hg
  have hsub' : Ι c d ⊆ Ι a b := uIoc_subset_uIoc_of_uIcc_subset_uIcc hsub
  have hfi : IntervalIntegrable (deriv f) volume c d :=
    (hgi.mono_set hsub).monoFun' (aeStronglyMeasurableDeriv _ _) hg_ae
  refine' hlt.not_le (sub_le_iff_le_add'.1 _)
  calc
    ‖f d‖ - ‖f c‖ ≤ ‖f d - f c‖ := norm_sub_norm_le _ _
    _ = ‖∫ x in c..d, deriv f x‖ := (congr_arg _ (integral_deriv_eq_sub hfd hfi).symm)
    _ = ‖∫ x in Ι c d, deriv f x‖ := (norm_integral_eq_norm_integral_Ioc _)
    _ ≤ ∫ x in Ι c d, ‖deriv f x‖ := (norm_integral_le_integral_norm _)
    _ ≤ ∫ x in Ι c d, C * ‖g x‖ :=
      (set_integral_mono_on hfi.norm.def (hgi.def.mono_set hsub') measurableSet_uIoc hg)
    _ ≤ ∫ x in Ι a b, C * ‖g x‖ :=
      set_integral_mono_set hgi.def (ae_of_all _ fun x => mul_nonneg hC₀ (norm_nonneg _))
        hsub'.eventually_le

#align not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_filter not_intervalIntegrable_of_tendsto_norm_atTop_of_deriv_isO_filter

/-- If `a ≠ b`, `c ∈ [a, b]`, `f` is differentiable in the neighborhood of `c` within
`[a, b] \ {c}`, `‖f x‖ → ∞` as `x → c` within `[a, b] \ {c}`, and `f' = O(g)` along
`𝓝[[a, b] \ {c}] c`, where `f'` is the derivative of `f`, then `g` is not interval integrable on
`a..b`. -/
theorem not_intervalIntegrable_of_tendsto_norm_atTop_of_deriv_isO_within_diff_singleton {f : ℝ → E}
    {g : ℝ → F} {a b c : ℝ} (hne : a ≠ b) (hc : c ∈ [a, b])
    (h_deriv : ∀ᶠ x in 𝓝[[a, b] \ {c}] c, DifferentiableAt ℝ f x)
    (h_infty : Tendsto (fun x => ‖f x‖) (𝓝[[a, b] \ {c}] c) atTop)
    (hg : deriv f =O[𝓝[[a, b] \ {c}] c] g) : ¬IntervalIntegrable g volume a b :=
  by
  obtain ⟨l, hl, hl', hle, hmem⟩ :
    ∃ l : Filter ℝ, tendsto_Ixx_class Icc l l ∧ l.ne_bot ∧ l ≤ 𝓝 c ∧ [a, b] \ {c} ∈ l :=
    by
    cases' (min_lt_max.2 hne).lt_or_lt c with hlt hlt
    · refine' ⟨𝓝[<] c, inferInstance, inferInstance, inf_le_left, _⟩
      rw [← Iic_diff_right]
      exact diff_mem_nhdsWithin_diff (Icc_mem_nhdsWithin_Iic ⟨hlt, hc.2⟩) _
    · refine' ⟨𝓝[>] c, inferInstance, inferInstance, inf_le_left, _⟩
      rw [← Ici_diff_left]
      exact diff_mem_nhdsWithin_diff (Icc_mem_nhdsWithin_Ici ⟨hc.1, hlt⟩) _
  skip
  have : l ≤ 𝓝[[a, b] \ {c}] c := le_inf hle (le_principal_iff.2 hmem)
  exact
    not_intervalIntegrable_of_tendsto_norm_atTop_of_deriv_isO_filter l
      (mem_of_superset hmem (diff_subset _ _)) (h_deriv.filter_mono this) (h_infty.mono_left this)
      (hg.mono this)
#align not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_within_diff_singleton not_intervalIntegrable_of_tendsto_norm_atTop_of_deriv_isO_within_diff_singleton

/-- If `f` is differentiable in a punctured neighborhood of `c`, `‖f x‖ → ∞` as `x → c` (more
formally, along the filter `𝓝[≠] c`), and `f' = O(g)` along `𝓝[≠] c`, where `f'` is the derivative
of `f`, then `g` is not interval integrable on any nontrivial interval `a..b` such that
`c ∈ [a, b]`. -/
theorem not_intervalIntegrable_of_tendsto_norm_atTop_of_deriv_isO_punctured {f : ℝ → E} {g : ℝ → F}
    {a b c : ℝ} (h_deriv : ∀ᶠ x in 𝓝[≠] c, DifferentiableAt ℝ f x)
    (h_infty : Tendsto (fun x => ‖f x‖) (𝓝[≠] c) atTop) (hg : deriv f =O[𝓝[≠] c] g) (hne : a ≠ b)
    (hc : c ∈ [a, b]) : ¬IntervalIntegrable g volume a b :=
  have : 𝓝[[a, b] \ {c}] c ≤ 𝓝[≠] c := nhdsWithin_mono _ (inter_subset_right _ _)
  not_intervalIntegrable_of_tendsto_norm_atTop_of_deriv_isO_within_diff_singleton hne hc
    (h_deriv.filter_mono this) (h_infty.mono_left this) (hg.mono this)
#align not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_punctured not_intervalIntegrable_of_tendsto_norm_atTop_of_deriv_isO_punctured

/-- If `f` grows in the punctured neighborhood of `c : ℝ` at least as fast as `1 / (x - c)`,
then it is not interval integrable on any nontrivial interval `a..b`, `c ∈ [a, b]`. -/
theorem not_intervalIntegrable_of_sub_inv_isO_punctured {f : ℝ → F} {a b c : ℝ}
    (hf : (fun x => (x - c)⁻¹) =O[𝓝[≠] c] f) (hne : a ≠ b) (hc : c ∈ [a, b]) :
    ¬IntervalIntegrable f volume a b :=
  by
  have A : ∀ᶠ x in 𝓝[≠] c, HasDerivAt (fun x => Real.log (x - c)) (x - c)⁻¹ x :=
    by
    filter_upwards [self_mem_nhdsWithin]with x hx
    simpa using ((hasDerivAt_id x).sub_const c).log (sub_ne_zero.2 hx)
  have B : tendsto (fun x => ‖Real.log (x - c)‖) (𝓝[≠] c) at_top :=
    by
    refine' tendsto_abs_at_bot_at_top.comp (real.tendsto_log_nhds_within_zero.comp _)
    rw [← sub_self c]
    exact ((hasDerivAt_id c).sub_const c).tendsto_punctured_nhds one_ne_zero
  exact
    not_intervalIntegrable_of_tendsto_norm_atTop_of_deriv_isO_punctured
      (A.mono fun x hx => hx.DifferentiableAt) B
      (hf.congr' (A.mono fun x hx => hx.deriv.symm) eventually_eq.rfl) hne hc
#align not_interval_integrable_of_sub_inv_is_O_punctured not_intervalIntegrable_of_sub_inv_isO_punctured

/-- The function `λ x, (x - c)⁻¹` is integrable on `a..b` if and only if `a = b` or `c ∉ [a, b]`. -/
@[simp]
theorem intervalIntegrable_sub_inv_iff {a b c : ℝ} :
    IntervalIntegrable (fun x => (x - c)⁻¹) volume a b ↔ a = b ∨ c ∉ [a, b] :=
  by
  constructor
  · refine' fun h => or_iff_not_imp_left.2 fun hne hc => _
    exact not_intervalIntegrable_of_sub_inv_isO_punctured (is_O_refl _ _) hne hc h
  · rintro (rfl | h₀)
    exacts[IntervalIntegrable.refl,
      interval_integrable_inv (fun x hx => sub_ne_zero.2 <| ne_of_mem_of_not_mem hx h₀)
        (continuous_on_id.sub continuousOn_const)]
#align interval_integrable_sub_inv_iff intervalIntegrable_sub_inv_iff

/-- The function `λ x, x⁻¹` is integrable on `a..b` if and only if `a = b` or `0 ∉ [a, b]`. -/
@[simp]
theorem intervalIntegrable_inv_iff {a b : ℝ} :
    IntervalIntegrable (fun x => x⁻¹) volume a b ↔ a = b ∨ (0 : ℝ) ∉ [a, b] := by
  simp only [← intervalIntegrable_sub_inv_iff, sub_zero]
#align interval_integrable_inv_iff intervalIntegrable_inv_iff


import analysis.convex.specific_functions
import analysis.special_functions.trigonometric.complex
import algebra.is_prime_pow

lemma int.Ico_succ_right {a b : ℤ} : finset.Ico a (b+1) = finset.Icc a b :=
by { ext x, simp only [finset.mem_Icc, finset.mem_Ico, int.lt_add_one_iff] }

lemma int.Ioc_succ_right {a b : ℤ} (h : a ≤ b) :
  finset.Ioc a (b+1) = insert (b+1) (finset.Ioc a b) :=
begin
  ext x,
  simp only [finset.mem_Ioc, finset.mem_insert],
  rw [le_iff_lt_or_eq, int.lt_add_one_iff, or_comm, and_or_distrib_left, or_congr_left'],
  rw and_iff_right_of_imp,
  rintro rfl,
  exact int.lt_add_one_iff.2 h
end

lemma int.insert_Ioc_succ_left {a b : ℤ} (h : a < b) :
  insert (a+1) (finset.Ioc (a+1) b) = finset.Ioc a b :=
begin
  ext x,
  simp only [finset.mem_Ioc, finset.mem_insert],
  rw [or_and_distrib_left, eq_comm, ←le_iff_eq_or_lt, int.add_one_le_iff, and_congr_right'],
  rw or_iff_right_of_imp,
  rintro rfl,
  rwa int.add_one_le_iff,
end

lemma int.Ioc_succ_left {a b : ℤ} (h : a < b) :
  finset.Ioc (a+1) b = (finset.Ioc a b).erase (a+1) :=
begin
  rw [←@int.insert_Ioc_succ_left a b h, finset.erase_insert],
  simp only [finset.left_not_mem_Ioc, not_false_iff],
end

lemma int.Ioc_succ_succ {a b : ℤ} (h : a ≤ b) :
  finset.Ioc (a+1) (b+1) = (insert (b+1) (finset.Ioc a b)).erase (a+1) :=
begin
  rw [int.Ioc_succ_left, int.Ioc_succ_right h],
  rwa int.lt_add_one_iff,
end

lemma finset.Icc_subset_range_add_one {x y : ℕ} : finset.Icc x y ⊆ finset.range (y+1) :=
begin
  rw [finset.range_eq_Ico, nat.Ico_succ_right],
  exact finset.Icc_subset_Icc_left (nat.zero_le _),
end

lemma finset.Ico_union_Icc_eq_Icc {x y z : ℕ} (h₁ : x ≤ y) (h₂ : y ≤ z) :
  finset.Ico x y ∪ finset.Icc y z = finset.Icc x z :=
by rw [←finset.coe_inj, finset.coe_union, finset.coe_Ico, finset.coe_Icc, finset.coe_Icc,
    set.Ico_union_Icc_eq_Icc h₁ h₂]

@[simp] lemma Ico_inter_Icc_consecutive {α : Type*} [linear_order α]
  [locally_finite_order α] (a b c : α) : finset.Ico a b ∩ finset.Icc b c = ∅ :=
begin
  refine finset.eq_empty_of_forall_not_mem (λ x hx, _),
  rw [finset.mem_inter, finset.mem_Ico, finset.mem_Icc] at hx,
  exact hx.1.2.not_le hx.2.1,
end

lemma Ico_disjoint_Icc_consecutive {α : Type*} [linear_order α]
  [locally_finite_order α] (a b c : α) : disjoint (finset.Ico a b) (finset.Icc b c) :=
(Ico_inter_Icc_consecutive a b c).le

lemma finset.Icc_sdiff_Icc_right {x y z : ℕ} (h₁ : x ≤ y) (h₂ : y ≤ z) :
  finset.Icc x z \ finset.Icc y z = finset.Ico x y :=
begin
  rw ←finset.Ico_union_Icc_eq_Icc h₁ h₂,
  rw finset.union_sdiff_self,
  rw finset.sdiff_eq_self_of_disjoint,
  apply Ico_disjoint_Icc_consecutive,
end

lemma finset.Icc_sdiff_Icc_left {x y z : ℕ} (h₁ : z ≤ y) (h₂ : x ≤ z) :
  finset.Icc x y \ finset.Icc x z = finset.Ioc z y :=
begin
  ext m,
  simp only [finset.mem_Icc, finset.mem_sdiff, finset.mem_Ioc, not_and, not_le],
  exact ⟨λ h, ⟨h.2 h.1.1, h.1.2⟩, λ h, ⟨⟨h₂.trans h.1.le, h.2⟩, λ _, h.1⟩⟩,
end

lemma range_sdiff_Icc {x y : ℕ} (h : x ≤ y) :
  finset.range (y+1) \ finset.Icc x y = finset.Ico 0 x :=
begin
  rw [finset.range_eq_Ico, nat.Ico_succ_right, finset.Icc_sdiff_Icc_right (nat.zero_le _) h],
end

lemma Ici_diff_Icc {a b : ℝ} (hab : a ≤ b) : set.Ici a \ set.Icc a b = set.Ioi b :=
begin
  rw [←set.Icc_union_Ioi_eq_Ici hab, set.union_diff_left, set.diff_eq_self],
  rintro x ⟨⟨_, hx⟩, hx'⟩,
  exact not_le_of_lt hx' hx,
end

lemma Ioi_diff_Icc {a b : ℝ} (hab : a ≤ b) : set.Ioi a \ set.Ioc a b = set.Ioi b :=
begin
  rw [←set.Ioc_union_Ioi_eq_Ioi hab, set.union_diff_left, set.diff_eq_self, set.subset_def],
  simp,
end

open_locale big_operators

@[simp, norm_cast] lemma rat.cast_sum {α β : Type*} [division_ring β] [char_zero β] (s : finset α)
  (f : α → ℚ) :
  ↑(∑ x in s, f x : ℚ) = (∑ x in s, (f x : β)) :=
(rat.cast_hom β).map_sum f s

lemma finset.prod_rpow {ι : Type*} {s : finset ι} {f : ι → ℝ}
  (c : ℝ) (hf : ∀ x ∈ s, 0 ≤ f x) :
  (∏ i in s, f i) ^ c = ∏ i in s, f i ^ c :=
begin
  induction s using finset.cons_induction_on with a s has ih generalizing hf,
  { simp },
  simp only [finset.mem_cons, forall_eq_or_imp] at hf,
  rw [finset.prod_cons has, real.mul_rpow hf.1 (finset.prod_nonneg hf.2),
    finset.prod_cons has, ih hf.2],
end

lemma one_le_prod {ι R : Type*} [ordered_comm_semiring R] {f : ι → R} {s : finset ι}
  (h1 : ∀ i ∈ s, 1 ≤ f i) : 1 ≤ ∏ i in s, f i :=
(finset.prod_le_prod (λ _ _, zero_le_one) h1).trans' (by simp)

lemma finset.filter_comm {α : Type*} (p q : α → Prop) [decidable_eq α]
  [decidable_pred p] [decidable_pred q] (s : finset α) :
  (s.filter p).filter q = (s.filter q).filter p :=
by simp only [finset.filter_filter, and_comm]

lemma real.le_rpow_self_of_one_le {x r : ℝ} (hx : 1 ≤ x) (hr : 1 ≤ r) :
  x ≤ x ^ r :=
by simpa using real.rpow_le_rpow_of_exponent_le hx hr

lemma real.le_rpow_self_of {x : ℝ} {r : ℝ} (hx₀ : 0 ≤ x) (hx₁ : x ≤ 1) (h_one_le : r ≤ 1) :
  x ≤ x ^ r :=
begin
  rcases eq_or_ne r 0 with rfl | hr,
  { simp [hx₁] },
  rcases eq_or_lt_of_le hx₀ with rfl | hx₀,
  { rw real.zero_rpow hr },
  simpa using real.rpow_le_rpow_of_exponent_ge hx₀ hx₁ h_one_le
end

@[to_additive]
lemma prod_powerset_compl {α β : Type*} [decidable_eq α] [comm_monoid β]
  (s : finset α) (f : finset α → β) :
  ∏ x in s.powerset, f (s \ x) = ∏ x in s.powerset, f x :=
begin
  refine finset.prod_bij' (λ x _, s \ x) (by simp) (λ _ _, rfl) (λ x _, s \ x) (by simp) _ _;
  simp [finset.inter_eq_right_iff_subset],
end


-- Tarski's axioms formalized
import tactic

noncomputable theory
open_locale classical

constant Point : Type  -- There is a type called point

-- There is an infinite hierarchy of types
-- Type 0 == Type
-- Type 1
-- Type 2
-- .....

-- This is the Betweenness relation.
-- This is saying "y" is in between "x" and "z".
constant B (x y z : Point) : Prop

-- Axioms for betweenness that Tarski asked us to include
@[refl] axiom B_includes_end1 (x z : Point) : B x x z
@[refl] axiom B_includes_end2 (x z : Point) : B x z z

-- Congruence relation between 4 points.
-- A Segment just contains two pieces of data, i.e. the two end point.
structure Segment : Type := (p1 p2 : Point)
-- Lean automatically makes a definition for Segment.mk
constant C (s1 s2 : Segment) : Prop  -- s1 has the same length as s2

/-
-- Let us make some segments
variables x y : Point
#check Segment.mk x y
#check ({p1 := x,  p2 := y} : Segment)-/

-- We are defining our own operator here
local infix ` ≃ `:55 := C  -- \ equiv == equivalence/congruence
local infix `⬝`:56 := Segment.mk  -- \ cdot == center-dot

--- Next, we look at congruence axioms.

--- xy is congruent to yx
@[symm] axiom C_swap (x y : Point) : x⬝y ≃ y⬝x
@[tidy] axiom C_iden (x y z : Point) :  x⬝y ≃ z⬝z → x = y
@[trans] axiom C_trans (u v w x y z : Point) : (u⬝v ≃ z⬝w) → (u⬝v ≃ x⬝y) → z⬝w ≃ x⬝y
-- used to be (u⬝v ≃ z⬝w) ∧ (u⬝v ≃ x⬝y) → z⬝w ≃ x⬝y

--- Equivalence relations: (~ means is related to)
-- 1. Reflexive x ~ x
-- 2. Symmetric x ~ y → y ~ x
-- 3. Transitive x ~ y ∧ y ~ z → x ~ z
--- Example : Equality =
--- Non-example : Less-than-or-equal relation "≤"

--  Tarski is claiming that the congruence relation is an equivalence relation
-- Marking this lemma with a "refl" attribute.
-- This means, we are training the Lean AI called "refl" to learn this lemma
-- and apply it wherever appropriate.

@[refl] lemma C_refl (s : Segment) : s ≃ s :=
begin
  cases s with x y,  -- s is made of 2 points. Let's call these x and y.
  fapply C_trans,    -- fapply means apply the C_trans axiom.
  use y,
  use x,
  repeat {symmetry},     -- simmplify. Same as apply C_swap.
end

@[symm] lemma C_symm (s1 s2 : Segment) : s1 ≃ s2 → s2 ≃ s1 :=
begin
  intro H,
  cases s1 with x1 y1,
  cases s2 with x2 y2,
  fapply C_trans,
    use x1,
    use y1,
    assumption, -- "use statements from the hypothesis". Same as apply H,
    refl,      -- "refl" means this is true by definition. Same as apply C_refl.
end

@[trans] lemma C_trans2 (s1 s2 s3 : Segment): s1 ≃ s2 → s2 ≃ s3 → s1 ≃ s3 :=
begin
  intros H1 H2,
  cases s1 with x1 y1,
  cases s2 with x2 y2,
  cases s3 with x3 y3,
  fapply C_trans,
    use x2,
    use y2,
    -- {...} helps us separate the proof of the two goals.
    { symmetry,  -- uses lemmas tagged with @[symm]. Same as apply C_symm.
      assumption}, -- Same as apply H1,
    { assumption},
end

lemma C_equiv : equivalence C :=
begin
  unfold equivalence,  -- replace with the definition of equivalence in the Goal
  split,
    { exact C_refl},
    split,
      { exact C_symm},
      { exact C_trans2},
end

@[symm] lemma C_swap_right (x y w z : Point) : x⬝y ≃ z⬝w → x⬝y ≃ w⬝z :=
begin
  intro H,
  transitivity,
    apply H,  -- this means use z⬝w for the unknown variable.
    exact C_swap z w,
end

@[symm] lemma C_swap_left (x y w z : Point) : x⬝y ≃ z⬝w → y⬝x ≃ z⬝w :=
begin
  intro H,
  fapply C_trans,
    use x,
    use y,
    { symmetry, refl},
    { exact H},
end

@[symm] lemma C_swap_both (x y w z : Point) : x⬝y ≃ z⬝w → y⬝x ≃ w⬝z :=
begin
  intro H,
  apply C_swap_right,
  apply C_swap_left,
  apply H,
end

-- Betweeness Axioms:
-- The only point on the line segment xx is itself
axiom B_id (x y : Point) : B x y x → x = y

-- Pasch's axiom
-- If uvxy is a quadrilateral then its diagonals must meet at a point "a".
axiom pasch (u v x y z : Point) :
  (B x u z) → (B y v z) → ∃ (a : Point), B u a y ∧ B v a x

-- Defining the axiom schema
-- Phi and Psi are just some "properties"
axiom dedekind_cut (φ ψ : Point → Prop) :
    ∃ (a : Point), ∀ (x y : Point), φ x ∧ ψ y → B a x y
  → ∃ (b : Point), ∀ (x y : Point), φ x ∧ ψ y → B x b y
--  a--------x-------y  (this is the hypothesis)
--  Then we can find a point b such that
--  a--------x---b---y

-- This means our geometry has more than 1 dimension
axiom plane_geom1 : ∃ (a b c : Point),
  (¬ B a b c) ∧ (¬ B b a a) ∧ (¬ B c a b)

-- This means our geometry has less than 3 dimensions
axiom plane_geom2 (u v x y z : Point) :
  (x⬝u ≃ x⬝v) → (y⬝u ≃ z⬝v) → (z⬝u ≃ z⬝v) → (u ≠ v)
  → (B x y z) ∨ (B y z x) ∨ (B z x y)

-- # Axioms of Euclid
---------------------
axiom euclid_a (u v w x y z : Point) :
     B x y w → x⬝y ≃ y⬝w
  → B x u v → x⬝u ≃ u⬝v
  → B y u z → y⬝u ≃ z⬝u
  → y⬝z ≃ v⬝w

lemma euclid_b (x y z : Point) :
  (B x y z) ∨ (B y z x) ∨ (B z x y) ∨ (∃ a : Point, (x⬝a ≃ y⬝a) ∧ (x⬝a ≃ z⬝a)) :=
begin
  have euclid_a := euclid_a,
  right,
  right,
  right,
  tidy,
   { exact x},
   { apply euclid_a, tidy, repeat {sorry}},
   { apply euclid_a, tidy, repeat {sorry}},
end

-- We need to prove Euclid variant C starting with varint B
lemma euclid_c (u v x y z : Point) :
  B x u v → B y u z →  x ≠ u
  → ∃ (a b : Point), (B x y a ∧ B x z b ∧ B a v b) :=
begin
  have euclid_b, from euclid_b,
  sorry
end

-- Axiom of five segments
axiom five_segments (x y z u x' y' z' u' : Point) :
  (x ≠ y) → (B x y z) → (B x' y' z')
  → (x⬝y ≃ x'⬝y') → (y⬝z ≃ y'⬝z') → (x⬝u ≃ x'⬝u') → (y⬝u ≃ y'⬝u')
  → (z⬝u ≃ z'⬝u')

-- Axiom of segment construction
axiom segment_construct (x y a b : Point) :
  ∃ z : Point, (B x y z) ∧ (y⬝z ≃ a⬝b)

-- More results:
@[refl] lemma B_refl (x y : Point) : B x x y :=
  by fapply B_includes_end1

@[symm] lemma B_symm (x y z : Point) : B x y z → B z y x :=
begin
   intro H,
   hint,
    sorry,
end

@[trans] lemma B_trans (w x y z : Point) : B x y w → B y z w → B x y z :=
begin
   intros hp hq,
   sorry,
end

lemma B_connect (w x y z : Point) : B x y w → B x z w → B x y z ∨ B x z y :=
sorry

-- TODO: Need to figure out how Bxyz can translate to a total order?
-- lemma total_order_segment : is_total B :=  sorry

lemma zero_segments_are_congruent (y v : Point) : y⬝y ≃ v⬝v :=
begin
  have h := segment_construct v y v y,
  choose x h using h,
  cases h with h₁ h₂,
  have h₃ : v⬝y ≃ y⬝x,
    {exact C_symm (y⬝x) (v⬝y) h₂},
  fapply euclid_a,
  use y,
  use x,
    repeat {solve_by_elim},
    repeat {refl},
end

-- TFAE is short for "the following are equivalent"
-- The usual strategy to prove such results is to prove a cycle:
-- Either show 1 → 2 → 3 → 1, or show 1 → 3 → 2 → 1.
theorem extend_identity (x y z : Point): tfae [(x⬝y ≃ z⬝z), (x=y), (B x y x)] :=
begin
  tfae_have: 1 → 2,
    apply C_iden,
  tfae_have: 2 → 3,
    intro H,
    rw H,
    fapply B_includes_end1,
  tfae_have: 3 → 2,
    apply B_id,
  tfae_have: 2 → 1,
    intro H,
    rw H,
    fapply zero_segments_are_congruent,
  tfae_finish,
end