import fol
import data.set
import tls_tactic

/-!
# ZFC set theory

In this file we define the signature and axioms of Zermelo–Fraenkel with axiom of choice
and give a natural deduction proof of the induction principle in its set theoretical form.

## Main results

- `omega_smallest_inductive_provable`:
    we show that ZFC proves that ω is the smallest inductive set. a direct consequence of
- `omega_smallest_inductive`:
    a natural deduction proof that ω is the smallest inductive set

## References

* [K. Kunen, *Set Theory*] [KUN83]
  -- for their axiomatization of ZF
* [H.D. Ebbinghaus, *Einführung in die Mengenlehre*] [EBB03]
  -- for their formalization of axiom of choice
-/

universe variable u
namespace zfc
open fol

-- for inserting elements into a data.set
local infix ` >> ` := insert

section zfc_language

/- We will use single predicate for membership and nothing else -/
inductive pred_symb : ℕ → Type u
| elem : pred_symb 2
inductive func_symb : ℕ → Type u

def σ : signature := { func_symb:= zfc.func_symb , pred_symb:= zfc.pred_symb }

/-- Definition of the membership predicate.-/
def memb (t₁ t₂: term σ): formula σ := papp (papp (pred pred_symb.elem) t₁) t₂
infix ` ∈' `:100 := memb

-- for the simplifier
@[simp, tls] lemma lift_memb (t₁ t₂: term σ) (m i) :
  (t₁ ∈' t₂) ↑ m ＠ i = (t₁ ↑ m ＠ i) ∈' (t₂ ↑ m ＠ i) := by refl
@[simp, tls] lemma subst_memb (t₁ t₂: term σ) (s k) :
  (t₁ ∈' t₂) [s ⁄ k] = (t₁ [s ⁄ k]) ∈' (t₂ [s ⁄ k]) := by refl

-- Predicates in our meta signature
/-- Definition of the subset predicate.-/
def subset (X Y : term σ) : (formula σ) := ∀' ((#0 ∈' (X ↑ 1 ＠  0)) →' (#0 ∈' (Y ↑ 1 ＠  0)))
infix ` ⊆' `:100 := subset

/-- Definition of the successor.-/
def successor_def (X Y: term σ) : formula σ
  := ∀'((#0 ∈' (X ↑ 1 ＠ 0)) ↔' ((#0 ∈' (Y ↑ 1 ＠  0) ∨' (#0 =' (Y ↑ 1 ＠  0)))))
infix ` is_successor_of `:100 := successor_def

/-- Definition of the empty set.-/
def empty_def (x : term σ) : formula σ := ∀' ((#0 ∈' (x ↑ 1 ＠ 0)) ↔' ¬'(#0 =' #0))
postfix ` is_empty`:100 := empty_def

/-- Definition of inductive sets.-/
def inductive_def (x : term σ) : formula σ :=
  (∀' (#0 is_empty →' (#0 ∈' (x ↑ 1 ＠ 0))))
    ∧' (∀'(#0 ∈' (x ↑ 1 ＠  0) →' (∀'(#0 is_successor_of #1 →' (#0 ∈' (x ↑ 2 ＠ 0))))))
postfix ` is_inductive`:100 := inductive_def

/-- Definition of `ω`.-/
def omega_def (x : term σ) : formula σ :=
  ∀' (#0 ∈' (x ↑ 1 ＠ 0) ↔' ∀' (#0 is_inductive →' (x ↑ 1 ＠ 0) ∈' #0))
postfix ` is_omega`:100 := omega_def

/-- Definition of uniqueness in the first variable. -/
@[simp] def unique_in_var0 (φ: formula σ) : formula σ :=
  ∀' ∀' ((φ ↑ 1 ＠ 1) ∧' (φ ↑ 1 ＠ 0) →' (#0 =' #1))

/-- Definition of the unique existential quantifier. -/
@[simp] def unique_ex (φ : formula σ) : formula σ := (∃'φ) ∧' (unique_in_var0 φ)
prefix `∃!`:110 := unique_ex

end zfc_language

/-
-- some notation for the pretty printer to make debugging easier
-- before
#check  #1 ∈' #2                        -- #1 ∈' #2 : formula σ
#reduce #1 ∈' #2                        -- ((pred pred_symb.elem).papp #1).papp #2
#reduce (#0 ∈' #2 ∧' #1 ∈' #2) ↑ 1 ＠ 1 -- ((pred pred_symb.elem).papp #0).papp #3 ∧' ((pred pred_symb.elem).papp #2).papp #3
notation s ` '∈ `:100 t := papp (papp (pred pred_symb.elem) s) t
-- after
#check  #1 ∈' #2                        -- #1 ∈' #2 : formula σ
#reduce #1 ∈' #2                        -- #1 ∈ #2
#reduce (#0 ∈' #2 ∧' #1 ∈' #2) ↑ 1 ＠ 1 -- (#0 ∈ #3) ∧' #2 ∈ #3
-- much better
-/

section zfc_axioms

/- Definitions and lemmas related to the axiom scheme of separation -/
namespace separation
open fol

/-- Defintion of the axiom scheme of separation with free variables. -/
@[simp] def free_formula (φ : formula σ): formula σ :=
  ∀' ∃' ∀' ((#0 ∈' #1)  ↔' (#0 ∈' #2 ∧' (φ ↑ 1 ＠ 1)))

lemma closed{k} {φ} (H: closed (k+2) φ) : closed k (free_formula φ)  :=
begin
  have h₁: ¬ k + 3 ≤ 2, by linarith,
  have h₂: 1 ≤ k+2, by linarith,
  have h₃:  φ ↑ 1 ＠  1 ↑ 1 ＠ (k + 3) = φ ↑ 1 ＠ 1,
    begin  rw ←(lift_lift φ 1 1 h₂), congr, exact H, end,
  simp[h₁, h₃],
end

/-- Defintion of the axiom scheme of separation. -/
def formula (φ : fol.formula σ) {n : ℕ} (φ_h: formula.closed (n+2) φ) : fol.formula σ :=
  formula.closure (free_formula φ) (closed φ_h)

lemma formula_is_sentence {k : ℕ} (φ : fol.formula σ) (H: formula.closed (k+2) φ) :
  (formula φ H) is_sentence := begin exact closure_is_sentence (closed H) end

lemma lift_sentence (φ) (n) (φ_h: fol.formula.closed (n+2) φ) (m i) :
  (formula φ φ_h) ↑ m ＠  i = formula φ φ_h := lift_sentence_id (formula_is_sentence _ _)

/- To following definition and lemmas are used to make future proofs more explicit and readable. -/
lemma mem {Γ:set $ fol.formula σ} (φ) (k) (φ_h: formula.closed (k+2) φ)
  {ψ} (h : ψ = separation.formula φ φ_h) (H: (separation.formula φ φ_h) ∈ Γ) : ψ ∈ Γ :=
begin subst h, exact H, end

/-- Defintion of the axiom scheme of separation as set. -/
def scheme : set $ fol.formula σ :=
  { (separation.formula φ φ_h) |  (φ : fol.formula σ) (k: ℕ) (φ_h : formula.closed (k+2) φ) }

lemma mem_scheme (φ : fol.formula σ) {k : ℕ} (φ_h: fol.formula.closed (k+2) φ) :
  separation.formula φ φ_h ∈ scheme := begin existsi [φ, k, φ_h], refl end

end separation

/- Definitions and lemmas related to the axiom scheme of replacement. -/
namespace replacement

/-- Defintion of the axiom scheme of replacement with free variables. -/
@[simp] def free_formula (φ: formula σ) :=
  (∀'(∀'(#0 ∈' #1 →' ∃!φ) →' (∃' ∀'(#0 ∈' #2 →' (∃'(#0 ∈' #2 ∧' (φ ↑ 1 ＠ 2)))))))

lemma closed {k} {φ} (H: closed (k+3) φ) : closed k (free_formula φ) :=
begin
  have : ¬ k+4 ≤ 3, by linarith,
  have : ¬ k+4 ≤ 2, by linarith,
  have : ¬ k+3 ≤ 2, by linarith,
  have h₁ : 0 ≤ k+3, from (k+3).zero_le,
  have h₂ : 1 ≤ k+3, by linarith,
  have h₃ : 2 ≤ k+3, by linarith,
  have H₁ : (φ ↑ 1 ＠ 0) ↑ 1 ＠  (k + 4) = φ ↑ 1 ＠ 0, from
    begin rw ←(lift_lift φ 1 1 h₁), congr, exact H, end,
  have H₂: (φ ↑ 1 ＠ 1) ↑ 1 ＠ (k + 4) = φ ↑ 1 ＠ 1, from
    begin rw ←(lift_lift φ 1 1 h₂), congr, exact H, end,
  have H₃: (φ ↑ 1 ＠ 2) ↑ 1 ＠ (k + 4) = φ ↑ 1 ＠ 2, from
    begin rw ←(lift_lift φ 1 1 h₃), congr, exact H, end,
  rw closed at H, clear h₂,
  simp[*, closed],
end

/-- Defintion of the axiom scheme of replacement-/
def formula (φ : fol.formula σ) {n : ℕ} (φ_h: formula.closed (n+3) φ) : fol.formula σ
  := formula.closure (free_formula φ) (closed φ_h)

lemma formula_is_sentence  (φ : fol.formula σ) {k : ℕ} (H: fol.formula.closed (k+3) φ) :
  (formula φ H) is_sentence := begin exact closure_is_sentence (closed H) end

lemma lift_sentence (φ) (n) (φ_h: fol.formula.closed (n+3) φ) (m i)
  : (formula φ φ_h) ↑ m ＠  i = formula φ φ_h := lift_sentence_id (formula_is_sentence _ _)

/- To following definition and lemmas are used to make future proofs more explicit and readable. -/
lemma mem {Γ:set $ fol.formula σ} {ψ} (φ) {k} (φ_h: formula.closed (k+3) φ)
  (h : ψ = formula φ φ_h) (H: (formula φ φ_h) ∈ Γ) : ψ ∈ Γ :=
begin subst h, exact H end

/-- Defintion of the axiom scheme of replacement as set-/
def scheme : set $ fol.formula σ :=
  { (formula φ φ_h) |  (φ : fol.formula σ) (k: ℕ) (φ_h : fol.formula.closed (k+3) φ) }

lemma mem_scheme (φ : fol.formula σ) {k : ℕ} (φ_h: fol.formula.closed (k+3) φ) :
  formula φ φ_h ∈ scheme := begin existsi [φ, k, φ_h], refl, end

end replacement

/- ∀b ∀a (∀x (x ∈ a ↔ x ∈ b) → a = b) -/
@[simp] def extensionality  : formula σ := ∀' ∀' ((∀' (#0 ∈' #1 ↔' #0 ∈' #2)) →' (#0 =' #1))
/- ∀b ∀a ∃A ∀x (x = a ∨ x = b → x ∈ A) -/
@[simp] def pair_ax         : formula σ := ∀' ∀' ∃' ∀' ((#0 =' #2) ∨' (#0 =' #3) →' (#0 ∈' #1))
/- ∀F ∃A ∀x (∃y (x ∈ y ∧ y ∈ F) → x ∈ A)  -/
@[simp] def union_ax        : formula σ := ∀' ∃' ∀' ((∃'(#1 ∈' #0 ∧' #0 ∈' #3)) →' (#0 ∈' #1))
/- ∀y ∃A ∀x (x ⊆ y → x ∈ A) -/
@[simp] def power_ax        : formula σ := ∀' ∃' ∀' (#0 ⊆' #2 →' #0 ∈' #1)
/-- ∃w (w is inductive) -/
@[simp] def infinity_ax     : formula σ := ∃' (#0 is_inductive)
/- x (¬(x is empty) → ∃y(y ∈ x ∧ ¬(∃z (z ∈ y ∧ z ∈ x))) -/
@[simp] def regularity      : formula σ :=
  ∀' (¬'(#0 is_empty) →' (∃' ((#0 ∈' #1) ∧' ¬' ∃'(#0 ∈' #1 ∧' #0 ∈' #2))))

/- For every set `X` of nonempty, pairwise disjoint sets,
  there exists a set `Y` containing exactly one element of each element of `X`.

  ∀X (∀x ∀y (x ∈ X ∧ y ∈ X → (¬(x is empty_def) ∧ (x=y ∨ ∀z ¬ (z ∈ x ∧ z ∈ y)))
        → ∃Y ∀x (x ∈ X → ∃!z (z ∈ x ∧ z ∈ Y))
-/
@[simp] def axiom_of_choice : formula σ :=
  ∀' (∀' ∀' (#0 ∈' #2 ∧' #1 ∈' #2 →' ∃' (#0 ∈' #1) ∧' (#0 =' #1 ∨'  ∀' (¬'((#0 ∈' #1 ∧' #0 ∈' #2)))))
      →' ∃' ∀' (#0 ∈' #2 →' ∃! (#0 ∈' #1 ∧' #0 ∈' #2)))

/-- ∀A ∃B ∀x (x ∈ B ↔ x ∈ A ∧ φ ↑ 1 ＠ 1) -/
@[simp] def separation_ax  (φ : formula σ) {n} (φ_h: closed (n+2) φ) : formula σ :=
  separation.formula φ φ_h
/-- ∀A (∀x(x ∈ A → ∃!y φ) → ∃B ∀x (x ∈ A →  ∃y (y ∈ B ∧ φ) -/
@[simp] def replacement_ax (φ : formula σ) {n} (φ_h: closed (n+3) φ) : formula σ :=
  replacement.formula φ φ_h

/-- The axioms of ZFC set theory as set. -/
def zfc_ax : set $ formula σ := { extensionality, pair_ax, union_ax, power_ax, infinity_ax,
                                  regularity, axiom_of_choice}
                                    ∪ separation.scheme
                                    ∪ replacement.scheme

lemma zfc_ax_set_of_sentences: ∀ x ∈ zfc_ax, (x is_sentence) :=
begin
  intros φ  h,
  repeat{cases h,};
  try {unfold sentence closed, refl, },
  { cases h_h with n hn,
    cases hn with h hh,
    subst hh, apply separation.formula_is_sentence, },
  { cases h_h with n hn,
    cases hn with h hh,
    subst hh, apply replacement.formula_is_sentence, },
end

lemma lift_zfc_ax {m i} : (λ ϕ: formula σ, ϕ ↑ m ＠ i) '' zfc_ax = zfc_ax
  := lift_set_of_sentences_id zfc_ax_set_of_sentences

/- We mainly use the following lemmas to make usage of axioms more explicit in the text. -/
-- for arbitrary sets
lemma extensionality_mem {Γ: set $ formula σ}{φ}(h: φ = extensionality)(H: extensionality ∈ Γ) : φ ∈ Γ :=
begin subst h, exact H end
lemma pair_ax_mem {Γ: set $ formula σ} {φ} (h: φ = pair_ax) (H: pair_ax ∈ Γ)    : φ ∈ Γ :=
begin subst h, exact H end
lemma union_ax_mem {Γ: set $ formula σ} {φ} (h: φ = union_ax) (H: union_ax ∈ Γ) : φ ∈ Γ :=
begin subst h, exact H end
lemma power_ax_mem {Γ: set $ formula σ} {φ} (H: power_ax ∈ Γ) (h: φ = power_ax) : φ ∈ Γ :=
begin subst h, exact H end
lemma infinity_ax_mem {Γ: set $ formula σ} {φ} (h: φ = infinity_ax) (H: infinity_ax ∈ Γ)  : φ ∈ Γ :=
begin subst h, exact H end
lemma regularity_mem {Γ: set $ formula σ}{φ}(h: φ = regularity)(H: regularity ∈ Γ) : φ ∈ Γ :=
begin subst h, exact H end
lemma aoc_mem {Γ: set $ formula σ}{φ}(h: φ = axiom_of_choice)(H: axiom_of_choice ∈ Γ) : φ ∈ Γ :=
begin subst h, exact H end

-- for zfc_ax
lemma extensionality_mem_zfc_ax : extensionality ∈ zfc_ax := by simp[-extensionality, zfc_ax]
lemma pair_ax_mem_zfc_ax : pair_ax ∈ zfc_ax := by simp[-pair_ax, zfc_ax]
lemma union_ax_mem_zfc_ax : union_ax ∈ zfc_ax := by simp[-union_ax, zfc_ax]
lemma power_ax_mem_zfc_ax : power_ax ∈ zfc_ax := by simp[-power_ax, zfc_ax]
lemma infinity_ax_mem_zfc_ax : infinity_ax ∈ zfc_ax := by simp[-infinity_ax, zfc_ax]
lemma regularity_mem_zfc_ax : regularity ∈ zfc_ax := by simp[zfc_ax]
lemma aoc_mem_zfc_ax : axiom_of_choice ∈ zfc_ax := by simp[zfc_ax]

namespace separation
lemma mem_zfc_ax (φ k) (φ_h: formula.closed (k+2) φ) : formula φ φ_h ∈ zfc_ax :=
begin simp[-sentence, zfc_ax, mem_scheme], end
end separation

namespace replacement
lemma mem_zfc_ax (φ k) (φ_h: formula.closed (k+3) φ) : formula φ φ_h ∈ zfc_ax :=
begin simp[-sentence, zfc_ax, mem_scheme], end
end replacement

end zfc_axioms

section zfc_proofs
/-
  ### On comments inside the proofs
  The first proof is the only one with excessive use of comments/
  In the following proofs we will give readable goals
  and the current variable environment, hoping that the context should be clear.

  for example the current goal might look like
    (λ (ϕ : formula σ), ϕ ↑ 1 ＠ 0) ''
        (∀'(#0 ∈' #1 ↔' #0 =' #3 ∨' #0 =' #3) >>
          (λ (ϕ : formula σ), ϕ ↑ 1 ＠ 0) '' ((λ (ϕ : formula σ), ϕ ↑ 1 ＠ 0) '' zfc_ax)) ⊢
      ((#0 ∈' #1 →' #0 =' #3) ↑ 1 ＠ (0 + 1 + 1))[#0 ⁄ 0 + 1]
  while the comment reads
  `a {a,a} x ⊢ x ∈ {a,a} → x = a`
  * a {a,a} x are sets (usually with associated properties hidden in the context, or obvious from the name)
  * indices pointing to 0 talk about x
  * indices pointing to 1 talk about {a,a}
  * indices pointing to 2 talk about a
  * the goal should be read as `x ∈ {a,a} → x = a`
  -//-
  Lastly we use "-- meta" to denote parts of a proof not directly involving terms of type `fol.proof`.
  This is usually the case at the leaves of of a natural deduction proof tree
  where we have to reason about formulas being equal or element of the context.

-/

/--
  A formal proof that for all sets `b,a` there exists a set containing exactly `a` and `b`.

  Informally: `zfc_ax ⊢ ∀b ∀a ∃A ∀x (x ∈ A ↔ x=a ∨ x=b)`
-/
def pairset_ex: zfc_ax ⊢ ∀' ∀' ∃' ∀' ((#0 ∈' #1) ↔' (#0 =' #2) ∨' (#0 =' #3)) :=
begin
  apply allI, -- given a
  apply allI, -- given b
  apply exE ∀'((#0 =' #2) ∨' (#0 =' #3) →' (#0 ∈' #1)), -- let A be a set containing b and a,
  { -- such a set exists pair pairing:
    apply allE' _ #0,         -- bind b   --(∃' ∀'((#0 =' #2) ∧' (#0 =' #4) →' (#0 ∈' #1))) #0,
    apply allE' _ #1,         -- bind a  --(∀' ∃' ∀'((#0 =' #2) ∧' (#0 =' #3) →' (#0 ∈' #1))) #1,
    apply hypI,               -- this is a hypothesis
    -- meta
    simp only [lift_zfc_ax],
    apply pair_ax_mem_zfc_ax,
    simp[zfc_ax],
    all_goals { simp } },
  { -- now we can use A and its defining property for further arguments
    -- reminder: sets (in order) a b A
    apply exE (∀'(#0 ∈' #1 ↔' (#0 ∈' #2) ∧' (#0 =' #3 ∨' #0 =' #4))), -- let {b,a} be the set {x | x ∈ A ∧ (x=b ∨ x=a)}
    { -- such a set exists by separation:
      apply allE' _ #0,                                           -- bind A
      apply allE' _ #1,                                           -- bind b
      apply allE' _ #2,                                           -- bind a
      apply hypI,                                                 -- this is a hypothesis
      -- meta
      apply separation.mem (#0 =' #2 ∨' #0 =' #3) 2 (rfl) (rfl),   -- an instance of separation
      simp only [lift_zfc_ax],
      right, apply separation.mem_zfc_ax,
      all_goals{ simp[alls] }, refl },
    { -- variables (in order) a b A { x | x ∈ A ∧ (x=b ∨ x=a)}
      apply exI #0, -- put X := {b,a}:= { x | x ∈ A ∧ (x=b ∨ x=a)} , we need to show that it satisfies the defining property
      apply allI,
      -- stack : a b A {b,a} x
      apply andI,
      { -- ⊢ x ∈ {b,a} → x=b ∨ x=a
        apply impI, -- assume x ∈ {b,a} we want to show x=b ∨ x=a
        apply andE₂ (#0 ∈' #2), -- it suffices to show  x ∈ A ∧ (x=b ∨ x=a)
        apply impE_insert,  -- moreover it suffices to show x ∈ {b,a} →  x ∈ A ∧ (x=b ∨ x=a)
        apply iffE_r,      -- it suffices to show  x ∈ {b,a} ↔ x ∈ A ∧ (x=b ∨ x=a)
        apply allE_var0,   -- bind x
        apply hypI,         -- then this is a hypothesis, namely the defining property of  { x | x ∈ A ∧ (x=b ∨ x=a)
        -- meta
        simp only [set.image_insert_eq],
        apply set.mem_insert, },
      { -- ⊢ x ∈ {b,a} ← x=b ∨ x=a
        apply impI,             -- assume x=b ∨ x=a, we need to show x ∈ {b,a}
        apply impE (#0 ∈' #2),  -- it suffices to show x ∈ A and x ∈ A → x ∈ {b,a}
        { -- first we show x ∈ A
          apply impE ((#0 =' #3) ∨' (#0 =' #4)), -- it suffices to show x = b ∨ x=a and x = b ∨ x=a → x ∈ A
          { -- we show x = b ∨ x = a
            apply hypI1 },  -- which is true by assumption
          { -- we show  x = b ∨ x = a → x ∈ A
            apply allE_var0, -- if we bind x
            apply hypI,       -- then this is how A was defined
            -- meta
            simp only [set.image_insert_eq],
            right, right, apply set.mem_insert } },
        { -- next we show x ∈ A → x ∈ {b,a}
          apply impI,   -- assume x ∈ A
          apply impE (#0 ∈' #2 ∧' ((#0 =' #3) ∨' (#0 =' #4))), -- then it suffices to show ...
          { -- x ∈ A ∧ x=0 ∨ x=b
            apply andI, -- we need to show ...
            { -- ⊢ x ∈ A
              apply hypI1 }, -- by assumption
            { -- ⊢ x = 0 ∨ x=b
              apply hypI2 } },-- by assumption
          { -- ⊢ x ∈ A ∧ x=0 ∨ x=b → x ∈ {b,a}
            apply iffE_l, -- it suffices to show x ∈ {b,a} ↔ x ∈ A ∧ x=0 ∨ x=b
            apply allE_var0,  -- binding x
            apply hypI,        -- this how we defined {b,a} in the first place
            -- meta
            simp only [set.image_insert_eq],
            right, right, apply set.mem_insert } } } } },
end

/--
  Formal proof that an empty_def set exists.

  Informally: `zfc_ax ⊢ ∃A (∀x (x ∈ A ↔ x≠x)) `
-/
def emptyset_ex : zfc_ax ⊢ ∃' (#0 is_empty):=
begin
  -- consider the set { x | x ∈ A ∧ ¬'(#0 =' #0) }
  apply exE ∀'(#0 ∈' #1 ↔' #0 ∈' #2 ∧' ¬'(#0 =' #0)),
  { -- such a set exists by separation
      apply allE_var0,           -- bind A
      apply hypI,                 -- then this is true by separation
      apply separation.mem (¬'(#0 =' #0)) 0 (rfl) (rfl),
      apply separation.mem_zfc_ax, },
  { -- ⊢ ∃X ∀x (x ∈ X ↔ ¬ (x = x))
    apply exI #0, -- Put X:={ x | x ∈ A ∧ ¬'(#0 =' #0) }
    apply allI,   -- given x
    apply andI,
    { -- ⊢  x ∈ X → ¬ (x = x)
      apply impI,
      apply andE₂ _,
      apply impE_insert,
      apply iffE_r,
      apply allE_var0,
      apply hypI,
      -- meta
      simp only [set.image_insert_eq],
      left, refl },
    { -- ⊢ ¬ (x = x) →  x ∈ X
      apply impI,
      apply botE,
      apply impE (#0 =' #0),
      apply eqI,
      apply hypI,
      -- meta
      left, refl } },
end

/--
  Formal proof that for all sets `a` there exists a set containing just `a`.

  Informally: `zfc_ax ⊢ ∀a ∃A (∀x (x ∈ A ↔ x = a)) `
-/
def singleton_ex : zfc_ax ⊢ ∀' ∃' ∀' (#0 ∈' #1 ↔' #0 =' #3) :=
begin
  apply allI, --given a
  apply exE ∀' (#0 ∈' #1 ↔' #0 =' #3 ∨' #0 =' #3), -- have the set {a,a}
  { -- a ⊢ ∃A (A = {a,a})
    apply allE' _ #1,
    apply allE' _ #1,
    rw [lift_zfc_ax],
    apply pairset_ex,
    -- meta
    dsimp, refl,
    dsimp, refl },
  { -- a ⊢ ∃ A ∀x (x ∈ A ↔ x = a)
    apply exI #0, -- put `A := {a,a}`
    apply allI,   -- given x
    apply andI,
    { -- a {a,a} x ⊢ x ∈ {a,a} → x = a
      apply impI, -- assume `x ∈ {a,a}`
      apply orE (#0 =' #3) (#0 =' #3), -- suffices to show (x = a) ∨ (x = a)
      { -- a {a,a} x ⊢ x = a ∨ x = a
        apply impE_insert,
        apply iffE_r,
        apply allE_var0,
        apply hypI,
        -- meta
        simp only [set.image_insert_eq],
        left, refl },
      { -- assume `x = a`
        -- a {a,a} x⊢ x = a
        apply hypI1 },
      { -- assume `x = a`
        -- a {a,a} x ⊢ x = a
        apply hypI1 } },
    { -- a {a,a} x ⊢ x = a → x ∈ {a,a}
      apply impI, -- assume `x = a`
      apply impE ((#0 =' #3) ∨' (#0 =' #3)),
      { -- a {a,a} ⊢ x=a ∨ x=a
        apply orI₁,
        apply hypI1 },
      { -- a {a,a} x ⊢ x=a ∨ x=a → x ∈ {a,a}
        apply iffE_l,
        apply allE_var0,
        apply hypI,
        -- meta
        simp only [set.image_insert_eq],
        right, left, refl } } }
end

/--
  Proof scheme.
  Provides a formal proof of uniqueness of y
  satisfying formulas of the form `∀x (x ∈ y ↔ φ)`,
  provided `y` is not free in `φ`.

  Informally : {extensionality} ⊢ ∀y₁ ∀y₀ (y₀ = { x | φ } ∧ y₁ = { x | φ } → y₀ = y₁)
-/
def extensionality_implies_uniqueness (φ : formula σ)
  : {extensionality} ⊢ unique_in_var0  ∀'(#0 ∈' #1 ↔' (φ ↑ 1 ＠ 1)) :=
begin
  apply allI, -- y₁
  apply allI, -- y₀
  apply impI, -- assume `∀ x (x ∈ y₀ ↔ φ(x, y₀)) ∧ ∀ x (x ∈ y₁ ↔ φ(x,y₁))`
  apply impE (∀' (#0 ∈' #1 ↔' #0 ∈' #2)),
  { -- y₁ y₀ ⊢ (∀' (#0 ∈' #1 ↔' #0 ∈' #2))
    apply allI, -- x
    apply iffI_trans (φ ↑ 2 ＠  1),
    { -- y₁ y₀ x ⊢ x ∈ y₀ ↔ φ (x, y₀)
      apply allE_var0,
      apply andE₁ _ ,
      apply hypI,
      -- meta argument
      simp [set.image_insert_eq],
      simp [subst_var0_for_0_lift_by_1, lift_lift_merge φ 1] },
    { -- y₁ y₀ x ⊢ φ (x, y₁) ↔ x ∈ y₁
      apply iffI_symm,
      apply allE_var0,
      apply andE₂ _ ,
      apply hypI,
      -- meta argument
      simp [set.image_insert_eq] } },
  { -- y₁ y₀ ⊢ ∀ x (x ∈ y₀ ↔ x ∈ y₁) → y₀ = y₁
    apply allE_var0,
    apply allE' _ #1,
    apply weak1,
    apply hypI,
    -- meta argument
    simp,
    simp, },
end

/--
  QoL version of `extensionality_implies_uniqueness`

  Informally : `Γ ⊢ ∀y₁ ∀y₀ (ψ(y₀) ∧ ψ(y₁) → y₀ = y₁`,
  provided  `ψ(y) = ∀x (x ∈ y ↔ φ)`, `y` not free in `φ` and `extensionality ∈ Γ`.
-/
def extensionality_implies_uniqueness' {Γ} (φ) {ψ} (h: ψ = ∀'(#0 ∈' #1 ↔' (φ ↑ 1 ＠ 1))) (H: extensionality ∈ Γ)
  : Γ ⊢ unique_in_var0 ψ :=
begin
  subst h,
  apply weak_singleton extensionality (extensionality_implies_uniqueness φ),
  exact H,
end

/--
  `n`-closure variant of `extensionality_implies_uniqueness`

  Informally : `{extensionality} ⊢ ∀xₙ ... ∀x₁ ∀y₁ ∀y₀ (y₀ = { x | φ } ∧ y₁ = { x | φ } → y₀ = y₁)`
-/
def extensionality_implies_uniqueness_alls  (n)  (φ : formula σ)
  : {extensionality} ⊢ alls n (unique_in_var0 ∀'(#0 ∈' #1 ↔' (φ ↑ 1 ＠ 1))) :=
begin
  apply allsI,
  apply extensionality_implies_uniqueness' φ (rfl),
  rw set.mem_image,
  use extensionality,
  exact ⟨ set.mem_singleton _ , rfl ⟩,
end

/--
  Formal proof that for all sets `b,a` the pair set `{a,b}` exists and is unique.

  Informally: `zfc_ax ⊢ ∀b ∀a ∃!A (∀x (x ∈ A ↔ x = a ∨ x = b))`
-/
def pairset_unique_ex : zfc_ax ⊢ (∀' ∀' ∃! ∀' ((#0 ∈' #1) ↔' (#0 =' #2) ∨' (#0 =' #3))) :=
begin
  apply allI, -- b
  apply allI, -- a
  simp only [lift_zfc_ax],
  apply andI,
  { -- b a ⊢ ∃A (∀x (x ∈ A ↔ x = a ∨ x = b))
    apply allE' _ #0,
    apply allE' _ #1,
    exact pairset_ex,
    simp, simp },
  { apply extensionality_implies_uniqueness' (#0 =' #1 ∨' #0 =' #2) (rfl),
    simp[-extensionality, zfc_ax] },
end
/--
  Formal proof that there exists an unique empty_def set.

  Informally: `zfc_ax ⊢ ∃! A (∀x (x ∈ A ↔ ¬(x=x))) `
-/
def emptyset_unique_ex : zfc_ax ⊢ ∃! (#0 is_empty) :=
begin
  apply andI,
  { exact emptyset_ex, },
  { apply extensionality_implies_uniqueness' (¬'(#0 =' #0)) (rfl),
    simp[-extensionality, zfc_ax] },
end

/--
  Formal proof that for all sets `a` the singleton `{a}` exists and is unique.

  Informally: `zfc_ax ⊢ ∀a ∃!A (A = {a}) `
-/
def singleton_unique_ex : zfc_ax ⊢ ∀' ∃! ∀' (#0 ∈' #1 ↔' #0 =' #3) :=
begin
  apply allsI 1,
  apply andI,
  { apply allsE' 1,
    exact singleton_ex, },
  { apply extensionality_implies_uniqueness' (#0 =' #2) (rfl),
    simp only [lift_zfc_ax],
    simp[-extensionality, zfc_ax] },
end

/--
  Proof scheme. Provides a formal proof of `∃B ∀x(x ∈ B ↔ φ)`
  from `∃B ∀x (φ → x ∈ B)` by using the axiom of separation for `φ`.
-/
def separation_proof_scheme
  (φ k) (φ_h₁: closed (k+2) φ)              -- given a formula φ(x_1,...,x_{k+1})
  (φ_h₂ : not_free 1 φ)                     -- such that the x₂ is not among its free variables
  {Γ} (h : separation_ax φ φ_h₁ ∈ Γ)        -- ...
  (H : Γ ⊢ alls k ∃' ∀'(φ →' (#0 ∈' #1)))
  : Γ ⊢ alls k (∃' ∀'((#0 ∈' #1) ↔' φ)) :=
begin
  apply allsI,
  apply exE ∀'(φ →' (#0 ∈' #1)), -- A with ∀ x (φ → x ∈ A)
  { -- xₖ ... x₁ ⊢ ∃ A ∀x (φ → x ∈ A)
    apply allsE',
    exact H },
  { -- xₖ ... x₁ A ⊢ ∃ B ∀ x (x ∈ B ↔ φ)
    apply exE (∀'((#0 ∈' #1) ↔' ((#0 ∈' #2) ∧' (φ ↑ 1 ＠ 1)))), -- B with ∀ x (x ∈ B ↔ x ∈ A ∧ φ)
    { -- xₖ ... x₁ A ⊢ ∃ B ∀ x (x ∈ B ↔ x ∈ A ∧ φ)
      apply weak1,
      apply allsE' 1,
      apply allsE' k,
      rw [alls,alls],
      apply hypI,
      -- meta
      apply separation.mem φ k φ_h₁ (rfl),
      assumption, },
    { -- A B ⊢ ∃ B ∀ x (x ∈ B ↔ φ)
      apply exI #0,
      apply allI, -- x
      apply andI,
      { -- A B x ⊢ x ∈ B → φ
        apply impI, -- assume `x ∈ B`
        apply andE₂ (#0 ∈' #2),
        apply impE_insert,
        apply iffE_r,
        apply allE_var0,
        apply hypI,
        -- meta
        rw[set.image_insert_eq],
        left,
        cases φ_h₂ with ψ ψ_h,
        subst ψ_h,
        rw [subst_var0_lift_by_1, subst_var0_lift_by_1],
        rw [←lift_lift ψ _ _ (le_refl 1)],
        refl },
      { --  A B x ⊢ φ → x ∈ B
        apply impI, -- assume `φ`
        apply impE (#0 ∈' #2),
        { --  A B x ⊢ x ∈ A
          apply impE (φ ↑ 1 ＠ 1),
          { -- A B x ⊢ φ
            apply hypI,
            left,
            cases φ_h₂ with ψ ψ_h,
            subst ψ_h,
            rw [subst_var0_lift_by_1, ←lift_lift ψ _ _ (le_rfl)] },
          { -- A B x ⊢ φ → x ∈ A
            apply allE_var0,
            apply hypI,
            -- meta
            simp only [set.image_insert_eq],
            right, right, left, refl } },
        { --  A B x ⊢ x ∈ A → x ∈ B
          apply impI, -- assume `x ∈ A`
          apply impE (#0 ∈' #2 ∧' (φ ↑ 1 ＠ 1)),
          { -- A B x ⊢ x ∈ A ∧ φ
            apply andI,
            { -- A B x ⊢ x ∈ A
              apply hypI1 },
            { -- A B x ⊢ φ
              apply hypI,
              -- meta
              right, left,
              cases φ_h₂ with ψ ψ_h,
              subst ψ_h,
              rw [subst_var0_lift_by_1, lift_lift ψ _ _ (le_rfl)] } },
          { -- A B x ⊢  x ∈ A ∧ φ → x ∈ B
            apply iffE_l,
            apply allE_var0,
            apply hypI,
            --meta
            simp only [set.image_insert_eq],
            right, right, left,
            simp } } } } }
end

/--
  QoL version of `separation_proof_scheme`.

  Proof scheme. Provides a formal proof `ψ`
  from `∃B ∀x (φ → x ∈ B)` and `ψ = ∃B ∀x(x ∈ B ↔ φ)`.
-/
def separation_proof_scheme' (φ) (k) (φ_h: closed (k+2) (φ ↑ 1 ＠ 1))
  {ψ : formula σ} (ψ_h : ψ = alls k ∃' ∀'((#0 ∈' #1) ↔' (φ ↑ 1 ＠ 1)))
  {Γ} (h : separation.formula (φ ↑ 1 ＠ 1) φ_h ∈ Γ)
  (H: Γ ⊢ alls k ∃' ∀'(φ ↑ 1 ＠ 1  →' (#0 ∈' #1)))
  : Γ ⊢ ψ  :=
begin
  subst ψ_h,
  apply separation_proof_scheme (φ ↑ 1 ＠ 1) k φ_h (by use φ) h H,
end

/--
  Formal proof that for all sets `F` there exists a set
  containing exactly the elements of its elements.

  Informally : `zfc_ax ⊢ ∀F ∃A ∀x (x ∈ A ↔ ∃y (x ∈ y ∧ y ∈ F))`
-/
def unionset_ex : zfc_ax ⊢ ∀' ∃' ∀' ((#0 ∈' #1) ↔' ∃'(#1 ∈' #0 ∧' #0 ∈' #3)):=
begin
  apply separation_proof_scheme' (∃'(#1 ∈' #0 ∧' #0 ∈' #2)) 1, -- enough to show one direction,
  { refl, },
  { apply separation.mem_zfc_ax, },                             -- which is an axiom
  { apply hypI,
    apply union_ax_mem_zfc_ax },
  { dsimp, refl, },
end

/--
  Formal proof that for all sets `F` the union `⋃F` exists and is unique.

  Informally : `zfc_ax ⊢ ∀F ∃!A (A = ⋃F)`
-/
def unionset_unique_ex : zfc_ax ⊢ ∀' ∃! ∀' ((#0 ∈' #1) ↔' ∃'(#1 ∈' #0 ∧' #0 ∈' #3)) :=
begin
  apply allI,
  simp only [lift_zfc_ax],
  apply andI,
  { apply allE' _ #0,
    exact unionset_ex,
    simp, },
  { apply extensionality_implies_uniqueness' (∃'(#1 ∈' #0 ∧' #0 ∈' #2)) (rfl),
    simp[-extensionality, zfc_ax] },
end

/--
  Formal proof that for all sets `y`  there exists a set
  containing exactly all its subsets exists.

  Informally : `zfc_ax ⊢ ∀y ∃!A ∀x (x ∈ A  ↔ x ⊆ y)`
-/
def powerset_ex: zfc_ax ⊢ ∀' ∃' ∀' ((#0 ∈' #1) ↔' (#0 ⊆' #2)) :=
begin
  apply separation_proof_scheme' (#0 ⊆' #1) 1,      -- enough to show oen direction
  { refl },
  { apply separation.mem_zfc_ax, },                  -- which is an axiom
  { apply hypI,
    apply power_ax_mem_zfc_ax, },
  { dsimp, refl, },
end

/--
  Formal proof that for all sets `y` the powerset `𝒫y` exists and is unique.

  Informally : `zfc_ax ⊢ ∀y ∃!A (A = 𝒫y)`
-/
def powerset_unique_ex : zfc_ax ⊢ ∀' ∃! ∀' ((#0 ∈' #1) ↔' (#0 ⊆' #2)) :=
begin
  apply allI,
  simp only [lift_zfc_ax],
  apply andI,
  { apply allE_var0,
    exact powerset_ex, },
  { apply extensionality_implies_uniqueness' (#0 ⊆' #1) (rfl),
    simp[-extensionality, zfc_ax] },
end

/--
  Formal proof that for all sets `b, a` there exists a set containing exactly
  the elements of `a` and `b`.

  Informally: `zfc_ax ⊢ ∀b ∀a ∃A ∀ x (x ∈ A  ↔ x ∈ a ∨ x ∈ b)`
-/
def binary_union_ex : zfc_ax ⊢ ∀' ∀' ∃' ∀' (#0 ∈' #1 ↔' #0 ∈' #2 ∨' #0 ∈' #3) :=
begin
  apply separation_proof_scheme' (#0 ∈' #1 ∨' #0 ∈' #2) 2, -- only need to show one direction
  { refl, },
  { apply separation.mem_zfc_ax, },
  { apply allI, -- b
    apply allI, -- a
    apply exE ∀'((#0 ∈' #1) ↔' (#0 =' #2) ∨' (#0 =' #3)),
    { -- b a ⊢ ∃B (B = {a,b})
      apply allE' _ #0,
      apply allE' _ #1,
      simp only [lift_zfc_ax],
      exact pairset_ex,
      simp, simp },
    { -- b a {a,b} ⊢ ∃A ∀x (x ∈ a  ∨ x ∈ b → x ∈ A)
      apply exE  ∀'((#0 ∈' #1) ↔' ∃'(#1 ∈' #0 ∧' #0 ∈' #3)),
      { -- b a {a,b} ⊢ ∃B (B = ⋃{a,b})
        apply allE' _ #0,
        simp only [lift_zfc_ax],
        apply weak1,
        exact unionset_ex,
        simp },
      { -- b a {a,b} ⋃{a,b} ⊢ ∃A ∀x (x ∈ a  ∨ x ∈ b → x ∈ A)
        apply exI #0, -- let `A := ⋃{a,b}`
        apply allI, -- x
        apply impI, -- assume `x ∈ a ∨ x ∈ b`
        apply orE (#0 ∈' #3)  (#0 ∈' #4),
        { apply hypI1 },
        { -- assume `x ∈ a`
          -- b a {a,b} ⋃{a,b} ⊢ x ∈ ⋃{a,b}
          apply impE (∃'(#1 ∈' #0 ∧' #0 ∈' #3)),
          { -- b a {a,b} ⋃{a,b} ⊢ ∃y (x ∈ y ∧  y ∈ {a,b})
            apply exI #3,  -- put `y:= a`
            apply andI,
            { apply hypI1, },
            { -- b a {a,b} ⋃{a,b} ⊢ a ∈ {a,b}
              apply impE (#3 =' #3 ∨' #3 =' #4),
              { -- b a {a,b} ⋃{a,b} y ⊢ a = a ∨ a = b
                apply orI₁,
                apply eqI, },
              { -- b a {a,b} ⋃{a,b} ⊢ a = a ∨ a = b → a ∈ {a,b}
                apply iffE_l,
                apply allE' _ #3,
                apply hypI,
                -- meta
                simp only [set.image_insert_eq],
                right, right, right, left, refl,
                simp } } },
          { -- b a {a,b} ⋃{a,b} y ⊢ ∃(x ∈ y ∧  y ∈ {a,b}) → x ∈ ⋃{a,b}
            apply iffE_l,
            apply allE_var0,
            apply hypI,
            -- meta
            simp only [set.image_insert_eq],
            right, right, left, refl } },
        { -- assume `x ∈ b`
          -- b a {a,b} ⋃{a,b} ⊢ x ∈ ⋃{a,b}
          apply impE (∃'(#1 ∈' #0 ∧' #0 ∈' #3)),
          { -- -- b a {a,b} ⋃{a,b} ⊢ ∃y (x ∈ y ∧  y ∈ {a,b})
            apply exI #4, -- put `y:=b`
            apply andI,
            { apply hypI1, },
            { -- b a {a,b} ⋃{a,b} ⊢ b ∈ {a,b}
              apply impE (#4 =' #3 ∨' #4 =' #4),
              { -- b a {a,b} ⋃{a,b} y ⊢ b = a ∨ b = b
                apply orI₂,
                apply eqI, },
              { -- b a {a,b} ⋃{a,b} ⊢ b = a ∨ b = b → b ∈ {a,b}
                apply iffE_l,
                apply allE' _ #4,
                apply hypI,
                -- meta
                simp only [set.image_insert_eq],
                right, right, right, left, refl,
                simp } } },
          { -- b a {a,b} ⋃{a,b} y ⊢ ∃(x ∈ y ∧  y ∈ {a,b}) → x ∈ ⋃{a,b}
            apply iffE_l,
            apply allE_var0,
            apply hypI,
            -- meta
            simp only [set.image_insert_eq],
            right, right, left, refl } } } } },
  { dsimp, refl, },
end

/--
  Formal proof that for all sets `b, a` the binary union `a ∪ b` exists and is unique.

  Informally: `zfc_ax ⊢ ∀b ∀a ∃!A (A = a ∪ b)`
-/
def binary_union_unique_ex : zfc_ax ⊢ ∀' ∀' ∃! ∀' (#0 ∈' #1 ↔' #0 ∈' #2 ∨' #0 ∈' #3) :=
begin
  apply allsI 2,
  apply andI,
  { apply allsE' 2,
    exact binary_union_ex,},
  { apply extensionality_implies_uniqueness' (#0 ∈' #1 ∨' #0 ∈' #2) (rfl),
    simp only [lift_zfc_ax],
    simp[-extensionality, zfc_ax] }
end

/--
  Formal proof that for all sets `a` there exists a successor set containing exactly `a` and
  the elements of `a` .

  Informally: `zfc_ax ⊢ ∀a ∃A ∀x (x ∈ A ↔ x ∈ a ∨ x = a)`
-/
def successor_ex : zfc_ax ⊢ ∀' ∃' (#0 is_successor_of #1) :=
begin
  apply separation_proof_scheme' (#0 ∈' #1  ∨' (#0 =' #1)) 1, -- only need to show one direction
  { refl, },
  { apply separation.mem_zfc_ax, },
  { apply allI, -- a
    apply exE ∀' (#0 ∈' #1 ↔' #0 =' #2),
    { -- a ⊢ ∃ A  (A = {a})
      apply allE' _ #0,
      simp only [lift_zfc_ax],
      exact singleton_ex,
      dsimp, refl, },
    { -- a {a} ⊢ ∃ S ∀ x (x ∈ a ∨ x = {a} → x ∈ S)
      apply exE ∀'(#0 ∈' #1 ↔' #0 ∈' #3 ∨' #0 ∈' #2),
      { -- a {a} ⊢ ∃ B (B = a ∪ {a})
        apply allE' _ #1,
        apply allE' _ #0,
        simp only [lift_zfc_ax],
        apply weak1,
        exact binary_union_ex,
        simp, dsimp, refl },
      { -- a {a} (a ∪ {a}) ⊢ ∃ S ∀ x (x ∈ a ∨ x = {a} → x ∈ S)
        apply exI #0, -- put `S = a ∪ {a}`
        apply allI,   -- x
        apply impI,   -- assume `x ∈ a ∨ x = a`
        apply orE (#0 ∈' #3) (#0 =' #3),
        { apply hypI1, },
        { -- case `x ∈ a`
          -- a {a} (a ∪ {a}) x ⊢ x ∈ a ∪ {a}
          apply impE (#0 ∈' #3 ∨' #0 ∈' #2),
          { -- a {a} (a ∪ {a}) x ⊢  x ∈ a ∨ x ∈ {a}
            apply orI₁,
            apply hypI1 },
          { -- a {a} (a ∪ {a}) x ⊢ x ∈ a ∨ x ∈ {a} → x ∈ a ∪ {a}
            apply iffE_l,
            apply allE_var0,
            apply hypI,
            -- meta
            simp only [set.image_insert_eq],
            right, right, left, refl } },
        { -- case `x = a`
          -- a {a} (a ∪ {a}) x ⊢ x ∈ a ∪ {a}
          apply impE (#0 ∈' #3 ∨' #0 ∈' #2),
          { -- a {a} (a ∪ {a}) x ⊢  x ∈ a ∨ x ∈ {a}
            apply orI₂,
            apply impE_insert,
            apply iffE_l,
            apply allE_var0,
            apply hypI,
            -- meta
            simp only [set.image_insert_eq],
            right, right, left, refl },
          { -- a {a} (a ∪ {a}) x ⊢  x ∈ a ∨ x ∈ {a} → x ∈ a ∪ {a}
            apply iffE_l,
            apply allE_var0,
            apply hypI,
            -- meta
            simp only [set.image_insert_eq],
            right, right, left, refl } } } } },
  { dsimp, refl, },
end

/--
  Formal proof that for all sets `a` the successor set `S(a)` exists and is unique.

  Informally: `zfc_ax ⊢ ∀a ∃!A (A = S(a))`
-/
def successor_unique_ex : zfc_ax ⊢ ∀' ∃! (#0 is_successor_of #1) :=
begin
  apply allsI 1,
  apply andI,
  { apply allsE' 1,
    exact successor_ex, },
  { apply extensionality_implies_uniqueness' (#0 ∈' #1  ∨' (#0 =' #1)) (rfl),
    simp only [lift_zfc_ax],
    simp[-extensionality, zfc_ax] },
end

/--
  Formal proof that there exists a set containing exactly the elements common to all inductive sets.
-/
def omega_ex : zfc_ax ⊢ ∃' (#0 is_omega) :=
begin
  apply separation_proof_scheme' (∀' (#0 is_inductive →' #1 ∈' #0)) 0, -- enough to show one direction
  { refl, },
  { apply separation.mem_zfc_ax, },
  { apply exE (#0 is_inductive),
    { -- ⊢ ∃A (A is inductive)
      apply hypI,
      exact infinity_ax_mem_zfc_ax }, -- this exists because of the axiom of infinity
    { -- A ⊢ ∃ω ∀x (∀w (w is inductive → w ∈ ω)) → x ∈ ω)
      apply exE ∀'(#0 ∈' #1 ↔' #0 ∈' #2  ∧'  ∀' (#0 is_inductive →' #1 ∈' #0)),
      { -- A ⊢ ∃B ∀x (x ∈ B ↔ (x ∈ A) ∧ ∀w (w is inductive → x ∈ w)
        apply allE_var0,
        apply hypI,
        -- meta
        simp only [lift_zfc_ax],
        right,
        apply separation.mem_zfc_ax (∀'(#0 is_inductive →' #1 ∈' #0)) 0,
        dsimp, refl },
      { -- B with `∀x (x ∈ B ↔ ((x ∈ A) ∧ ∀w (w is inductive → x ∈ w)))`
        -- A B ⊢ ∃ω ∀x  (∀w (w is inductive → x ∈ ω)) → x ∈ ω)
        apply exI #0, -- let `ω := B`
        apply allI,
        apply impI,   -- assume `x` with `(∀w (w is inductive → x ∈ ω))`
        apply iffE₁ (#0 ∈' #2 ∧' ∀' (#0 is_inductive →' #1 ∈' #0)),
        { -- A B x ⊢ (x ∈ A ∧ ∀w(w is inductive → x ∈ w)
          apply andI,
          { -- A B x ⊢ x ∈ A
            apply impE (#2 is_inductive),
            { -- A B x ⊢ A is inductive
              apply hypI,
              -- meta
              simp only [set.image_insert_eq],
              right, right, left,
              simp[inductive_def, empty_def, successor_def] },
            { -- A B x ⊢  A is inductive → x ∈ A
              apply allE' _ #2,
              apply hypI,
              -- meta
              left, refl, dsimp, refl } },
          { -- A B x ⊢ ∀w(w is inductive → x ∈ w)
            apply hypI1, } },
        { -- A B x ⊢ x ∈ B ↔ (x ∈ A ∧ ∀w(w is inductive → x ∈ w))
          apply allE_var0,
          apply hypI,
          -- meta
          simp only [set.image_insert_eq],
          right, left, refl } } } },
  { -- meta
    dsimp, refl }
end

/--
  Formal proof that `ω` exists and is unique.

  Informally: `zfc_ax ⊢  ∃!A (A = ω)`
-/
def omega_unique_ex : zfc_ax ⊢ ∃! (#0 is_omega) :=
begin
  apply andI,
  { exact omega_ex, },
  { apply extensionality_implies_uniqueness' (∀' (#0 is_inductive →' #1 ∈' #0)) (rfl),
    simp[-extensionality, zfc_ax] },
end

/--
  A formal proof that `ω` is a subset of all inductive sets.

  Informally : `zfc_ax ⊢ ∀ A (A = ω → ∀ w (w is inductive → A ⊆ w))`
-/
def omega_subset_all_inductive :
  zfc_ax ⊢ ∀' ((#0 is_omega) →' ∀' (#0 is_inductive →' #1 ⊆' #0)) :=
begin
  apply allI,
  apply impI,
  apply allI,
  apply impI,
  apply allI,
  apply impI,
  apply impE (#1 is_inductive),
  { apply hypI, simp only [set.image_insert_eq], right, left, refl },
  { apply allE' _ #1,
    apply iffE₂ (#0 ∈' #2),
    { apply hypI1, },
    { apply allE_var0,
      apply hypI,
      simp only [set.image_insert_eq],
      right, right, left, refl },
    { dsimp, refl, } },
end

/--
  A formal proof that `ω` is inductive.

  Informally : `zfc_ax ⊢ ∀ A (A = ω → A is inductive)`
-/
def omega_inductive :
  zfc_ax ⊢ ∀' ((#0 is_omega) →' (#0 is_inductive)) :=
begin
  apply allI, -- ω
  apply impI, -- assume `ω = { x | ∀ w (w is inductive → x ∈ w) }`
  apply andI,
  { -- ω ⊢ ∀ x (x is empty_def → x ∈ ω)
    apply allI, -- ∅
    apply impI, -- assume `∅ is empty_def`
    apply iffE₁ ∀'(#0 is_inductive →' #1 ∈' #0),
    { -- ω ∅ ⊢ ∀ w (w is inductive → ∅ ∈ w)
      apply allI, -- w
      apply impI, -- assume `w is inductive`
      apply impE (#1 is_empty),
      { -- ω ∅ w ⊢ ∅ is empty_def
        apply hypI,
        simp only [set.image_insert_eq],
        right, left, refl, },
      { -- ω ∅ w ⊢ ∅ is empty_def → ∅ ∈ w
        apply allE' _ #1,
        apply andE₁,
        apply hypI1,
        unfold empty_def, refl } },
    { -- ω ∅ ⊢ ∅ ∈ ω ↔ ∀ w (w is inductive → ∅ ∈ w)
      apply allE_var0,
      apply hypI,
      simp only[set.image_insert_eq],
      right, left, refl } },
  { -- ω ⊢ ∀ (x ∈ ω → (∀ y (y = S(x) → y ∈ ω))
    apply allI, -- x
    apply impI, -- assume `x ∈ ω`
    apply allI, -- y
    apply impI, -- assume `y=S(x)`
    apply impE ∀'(#0 is_inductive →' #1 ∈' #0),
    { -- ω x y ⊢ ∀w (w is inductive → y ∈ w)
      apply allI, -- w
      apply impI, -- assume `w is inductive`
      apply impE (#2 ∈' #0),
      { -- ω x y w ⊢ x ∈ w
        apply impE (#2 ∈' #3),
        { -- ω x y  ⊢ x ∈ ω
          apply hypI,
          simp only [set.image_insert_eq],
          right, right, left, refl },
        { -- ω x y w ⊢ x ∈ ω → x ∈ w
          apply allE' (#0 ∈' #4 →' #0 ∈' #1) #2,
          apply impE (#0 is_inductive),
          { -- ω x y w ⊢ w is inductive
            apply hypI1 },
          { -- ω x y w ⊢ (w is inductive) → ω ⊆ w
            apply allE_var0,
            apply impE (∀' (#0 ∈' #4 ↔' ∀' (#0 is_inductive →' #1 ∈' #0))),
            { -- ω x y w ⊢ ω = ω = { x | ∀ w (w is inductive → x ∈ w) }
              apply hypI,
              simp only [set.image_insert_eq],
                right, right, right, left, refl },
            { -- ω x y w ⊢ ω = ω = { x | ∀ w (w is inductive → x ∈ w) } → ((w is inductive) → ω ⊆ w)
              apply allE' _ #3,
              apply weak zfc_ax,
              exact omega_subset_all_inductive,
              simp only [set.image_insert_eq, lift_zfc_ax],
              assume y yh, simp[yh],
              unfold inductive_def,
              refl, } },
            refl }, },
      { -- ω x y w ⊢ x ∈ w → y ∈ w
        apply impI, -- assume `x ∈ w`
        apply impE (#1 is_successor_of #2),
        { -- ω x y w ⊢ y = S(x)
          apply hypI,
          simp only [set.image_insert_eq],
          right, right, left,
          unfold successor_def, refl },
        { -- ω x y w ⊢ y = S(x) → y ∈ w
          apply allE' _ #1,
          apply impE (#2 ∈' #0),
          { -- ω x y w ⊢ x ∈ w
            apply hypI1, },
          { -- ω x y w ⊢ x ∈ w → (∀ y (y = S(x) → y ∈ w))
            apply allE' _ #2,
            apply andE₂,
            apply hypI,
            simp only[set.image_insert_eq],
            right, left, refl,
            unfold successor_def, refl },
        { unfold successor_def,
          refl } } } },
    { -- ω x y ⊢ ∀w (w is inductive → y ∈ w) → y ∈ ω
      apply iffE_l,
      apply allE_var0,
      apply hypI,
      simp only [set.image_insert_eq],
      right, right, left, refl } },
end

/--
  A formal proof that `ω` is the smallest inductive set.

  Informally :
  `zfc_ax ⊢ ∀ X (A = ω → (A is inductive ∧ ∀ w (w is inductive → X ⊆ w))`
-/
def omega_smallest_inductive : zfc_ax ⊢
    ∃!(#0 is_omega) ∧' ∀'((#0 is_omega) →' (#0 is_inductive ∧' ∀'(#0 is_inductive →' #1 ⊆' #0))) :=
begin
  apply andI,
  { exact omega_unique_ex, },
  { apply allI, -- ω
    apply impI, -- ω = { x | ∀ w (w is inductive → x ∈ w) }
    apply andI,
    { -- ω ⊢ ω is inductive
      apply impE_insert,
      apply allE_var0,
      simp only [lift_zfc_ax],
      apply omega_inductive },
    { -- ω ⊢ ∀ w (w is inductive → ω ⊆ w)
      apply impE_insert,
      apply allE_var0,
      simp only [lift_zfc_ax],
      apply omega_subset_all_inductive } }
end

end zfc_proofs

/--
  Main Theorem: ZFC proves that `ω` is the smallest inductive set.
-/
theorem omega_smallest_inductive_provable_within_zfc :
  (∃!(#0 is_omega) ∧' ∀'((#0 is_omega) →' (#0 is_inductive ∧' ∀'(#0 is_inductive →' #1 ⊆' #0))))
   is_provable_within zfc_ax :=
begin use omega_smallest_inductive, end

end zfc


import data.nat.basic data.int.nat_prime data.rat.basic data.complex.basic tactic
import data.real.basic data.nat.prime
import ring_theory.principal_ideal_domain
import ring_theory.roots_of_unity
import algebra.ring algebra.euclidean_domain
import algebra.associated
import algebra.algebra.ordered

lemma h1_lt_3 : 1 < 3
:= by norm_num

/-! Construction of Z[ζ] primitive root of x^3 = 1. The whole process just copies the definitions
of those of zsqrt, by the construction, hope to show that Z[ζ] is an euclidean domain-/

/-- basic structure definition of the Eisenstein Integers -/
structure int_cubic_root :=
(a : ℤ)
(b : ℤ)

notation `ℤ_ζ`  := int_cubic_root

namespace int_cubic_root
section

instance : decidable_eq ℤ_ζ:=
by tactic.mk_dec_eq_instance

theorem ext : ∀ {z w : ℤ_ζ }, z = w ↔ z.a = w.a ∧ z.b = w.b
| ⟨x, y⟩ ⟨x', y'⟩ :=
⟨λ h, by injection h; split; assumption,
                      λ ⟨h₁, h₂⟩, by congr; assumption⟩

/-- Convert an integer to a Z_ζ n -/
def of_int(m : ℤ) : ℤ_ζ := ⟨m,0⟩
theorem of_int_a(m : ℤ) : (of_int m).a = m := rfl
theorem of_int_b(m : ℤ) : (of_int m).b = 0 := rfl

/-- zero-/
def zero : ℤ_ζ  := of_int 0
instance : has_zero ℤ_ζ := ⟨int_cubic_root.zero⟩
theorem zero_a : (0 : ℤ_ζ ).a = 0 := rfl
theorem zero_b : (0 : ℤ_ζ ).b = 0 := rfl

instance : inhabited (ℤ_ζ) := ⟨0⟩

/-- one-/
def one : ℤ_ζ := of_int 1
instance : has_one (ℤ_ζ) := ⟨int_cubic_root.one⟩
@[simp] theorem one_a : (1 : (ℤ_ζ)).a = 1 := rfl
@[simp] theorem one_b : (1 : (ℤ_ζ)).b = 0 := rfl
lemma one_eq: (1 : (ℤ_ζ)) = ⟨1, 0⟩  := by simp[ext]

/-- representative of the primitive root of order 3 in the ring ℤ[ζ]-/
def ζ : ℤ_ζ := ⟨0, 1⟩
@[simp] theorem ζ_a : (ζ : (ℤ_ζ)).a = 0 := rfl
@[simp] theorem ζ_b : (ζ : (ℤ_ζ)).b = 1 := rfl

/-- addition-/
def add: (ℤ_ζ) → (ℤ_ζ) → (ℤ_ζ)
|⟨x, y⟩ ⟨x', y'⟩ := ⟨x + x', y + y'⟩
instance : has_add ℤ_ζ := ⟨int_cubic_root.add⟩
@[simp] theorem add_def(x y x' y' : ℤ) :
   (⟨x, y⟩ + ⟨x', y'⟩ : ℤ_ζ) = ⟨x + x', y + y'⟩ := rfl
@[simp] theorem add_a : ∀ z w : ℤ_ζ, (z + w).a = z.a + w.a
|⟨x, y⟩⟨x', y'⟩ := rfl
@[simp] theorem add_b : ∀ z w : ℤ_ζ, (z + w).b = z.b + w.b
|⟨x, y⟩⟨x', y'⟩ := rfl

@[simp] theorem bit0_a(z) : (bit0 z: ℤ_ζ).a = bit0 z.a := add_a _ _
@[simp] theorem bit0_b(z) : (bit0 z: ℤ_ζ).b = bit0 z.b := add_b _ _

@[simp] theorem bit1_re (z) : (bit1 z : ℤ_ζ).a = bit1 z.a := by simp [bit1]
@[simp] theorem bit1_im (z) : (bit1 z : ℤ_ζ).b = bit0 z.b := by simp [bit1]

/-- negation-/
def neg : ℤ_ζ → ℤ_ζ
|⟨x, y⟩ := ⟨-x, -y⟩
instance : has_neg ℤ_ζ := ⟨int_cubic_root.neg⟩
@[simp] theorem neg_a : ∀ z : ℤ_ζ, (-z).a = - z.a
|⟨x, y⟩ := rfl
@[simp] theorem neg_b : ∀ z : ℤ_ζ, (-z).b = - z.b
|⟨x, y⟩ := rfl

/-- muliplication-/
def mul : ℤ_ζ → ℤ_ζ → ℤ_ζ
| ⟨x, y⟩ ⟨x', y'⟩ := ⟨x * x' - y * y', x * y' + y * x' - y * y'⟩
instance : has_mul ℤ_ζ := ⟨int_cubic_root.mul⟩
@[simp] theorem mul_def(x y x' y' : ℤ) :
   (⟨x, y⟩ * ⟨x', y'⟩ : ℤ_ζ) = ⟨x * x' - y * y', x * y' + y * x' - y * y'⟩ := rfl
@[simp] theorem mul_a : ∀ z w : ℤ_ζ, (z * w).a = z.a * w.a - z.b * w.b
| ⟨x, y⟩ ⟨x', y'⟩ := rfl
@[simp] theorem mul_b : ∀ z w : ℤ_ζ, (z * w).b = z.a * w.b + z.b * w.a - z.b * w.b
| ⟨x, y⟩ ⟨x', y'⟩ := rfl
@[simp] theorem zero_prop : (0 : ℤ_ζ).a = 0 ∧ (0 : ℤ_ζ).b = 0 := by exact ⟨zero_a, zero_b⟩

@[simp] theorem zero_add (a : ℤ_ζ) : 0 + a = a := by simp[ext]

/-- z = ⟨z.a, z.b⟩; notations-/
theorem eql(z : ℤ_ζ) : z = ⟨z.a, z.b⟩ :=
begin
     have h1 : z.a = (⟨z.a, z.b⟩ : ℤ_ζ).a, refl,
     have h2 : z.b = (⟨z.a, z.b⟩ : ℤ_ζ).b, refl,
     exact ext.mpr ⟨h1, h2⟩,
end

theorem eql'(z : ℤ_ζ)(m n : ℤ)(h : z.a = m)(h': z.b = n) : z = ⟨m, n⟩ :=
begin
     simp[ext], split, rw h, rw h',
end

/-- a * b * c = a * (b * c)-/
@[simp] theorem mul_assoc (a b c: ℤ_ζ) : a * b * c = a * (b * c):=
begin
     simp[ext], split, ring, ring,
end

/-- a * (b + c) = a * b + a * c-/
@[simp] theorem left_distrib (a b c : ℤ_ζ) : a.a * b.a + a.a * c.a - (a.b * b.b + a.b * c.b) = a.a * b.a - a.b * b.b + (a.a * c.a - a.b * c.b)
      ∧a.a * b.b + (a.a * c.b + (b.a * a.b + c.a * a.b)) - (a.b * b.b + a.b * c.b) =
      a.a * b.b + b.a * a.b - a.b * b.b + (a.a * c.b + c.a * a.b - a.b * c.b)
      :=
begin
     split, ring, ring,
end
/-- (a + b) * c = a * c + b * c-/
@[simp] theorem right_distrib(a b c : ℤ_ζ) :a.a * c.a + b.a * c.a - (a.b * c.b + b.b * c.b) = a.a * c.a - a.b * c.b + (b.a * c.a - b.b * c.b)
    ∧a.a * c.b + (b.a * c.b + (c.a * a.b + c.a * b.b)) - (a.b * c.b + b.b * c.b) =
      a.a * c.b + c.a * a.b - a.b * c.b + (b.a * c.b + c.a * b.b - b.b * c.b)
      :=
begin
     split, ring, ring,
end

/-- use the structure definition of commutative ring, fill in the properties needed to
prove that ℤ[ζ] is a commutative ring-/
instance : comm_ring ℤ_ζ :=
by refine_struct
{ add            := (+),
  zero           := (0 : ℤ_ζ),
  neg            := has_neg.neg,
  mul            := (*),
  sub            := λ a b, a + -b,
  one            := (1 : ℤ_ζ),
  npow           := @npow_rec _ ⟨1⟩ ⟨(*)⟩,
  nsmul          := @nsmul_rec _ ⟨0⟩ ⟨(+)⟩,
  gsmul          := @gsmul_rec _ ⟨0⟩ ⟨(+)⟩ ⟨int_cubic_root.neg⟩ };
{intros; try { refl };
simp [ext, zero_add, add_mul, mul_add, add_comm, add_left_comm,
  left_distrib, mul_comm, mul_left_comm, mul_assoc, right_distrib],}

instance : add_comm_monoid ℤ_ζ    := by apply_instance
instance : add_monoid ℤ_ζ         := by apply_instance
instance : monoid ℤ_ζ             := by apply_instance
instance : comm_monoid ℤ_ζ        := by apply_instance
instance : comm_semigroup ℤ_ζ     := by apply_instance
instance : semigroup ℤ_ζ          := by apply_instance
instance : add_comm_semigroup ℤ_ζ := by apply_instance
instance : add_semigroup ℤ_ζ      := by apply_instance
instance : comm_semiring ℤ_ζ      := by apply_instance
instance : semiring ℤ_ζ           := by apply_instance
instance : ring ℤ_ζ               := by apply_instance
instance : distrib ℤ_ζ            := by apply_instance

instance : nontrivial ℤ_ζ :=
⟨⟨0, 1, dec_trivial⟩⟩

/--  ∃ lifts ℕ, ℤ → ℤ_ζ  -/
@[simp] theorem coe_nat_val(m : ℕ): (m : ℤ_ζ) = ⟨m, 0⟩ :=
begin
     simp[ext],
     induction m; simp*,
end

@[simp] theorem coe_int_val (n : ℤ) : (n : ℤ_ζ) = ⟨n, 0⟩ :=
begin
     simp[ext],
     cases n; simp[*, int.of_nat_eq_coe, int.neg_succ_of_nat_eq],
end

/-- char(ℤ[ζ])= 0 -/
instance : char_zero ℤ_ζ :=
{ cast_injective := λ m n, by simp [ext]}

/-- ℕ coe : ℕ → ℤ_ζ-/
@[simp] theorem of_int_eq_coe (n : ℤ) : (of_int n : ℤ_ζ) = n :=
by simp [ext, of_int_a, of_int_b]

@[simp] theorem smul_val (n x y : ℤ) : (⟨x * n, y * n⟩ : ℤ_ζ) = ⟨n * x, n * y⟩ :=
begin
     simp[ext], split, ring, ring,
end

/-- ζ is a primitive root of order 3-/
theorem prop_3_3: ζ^3 = ⟨1, 0⟩        :=            by ring

theorem prop_3_4: 1 + ζ + ζ^2 = 0    :=            by ring

/-- surprised how powerful simp[ext] can be-/
@[simp] theorem muld_val (x y : ℤ) : ζ * ⟨x, y⟩ = ⟨-y, x - y⟩ :=
by simp[ext]

@[simp] theorem ζmulζ : ζ * ζ = - 1 - ζ :=
calc ζ * ζ  = ζ ^ 2 - 0                                   : by ring
     ...    = ζ ^ 2 - (1 + ζ + ζ^2)                       : by rw[←prop_3_4]
     ...    = -1 - ζ                                      : by ring

theorem decompose {x y : ℤ} : (⟨x, y⟩ : ℤ_ζ) = x + ζ * y :=
by simp [ext]

/-- ζ is the primitive root-/
theorem primitive_ζ : is_primitive_root ζ 3 :=
begin
     have h1: ζ^3 = 1,
     calc ζ^3   = ⟨1, 0⟩       : by exact prop_3_3
            ... = 1 + ζ * 0   : by exact decompose
            ... = 1           : by ring,
     have h2 : ∀ l : ℕ, (0 < l) → (l < 3) → ζ^l ≠ 1,
     {intros l h' h'',
     have h2_1: l = 1 ∨ l = 2, by omega,
     cases h2_1,
     calc ζ^l = ζ^1           : by rw h2_1
          ... = ⟨0, 1⟩         : by simp [ext]
          ... ≠ ⟨1, 0⟩         : by simp [ext]
          ... = 1 + ζ * 0     : by exact decompose
          ... = 1             : by ring,
     calc ζ^l = ζ^2           : by rw h2_1
           ...= ζ * ζ         : by ring
           ...= -1 - ζ        : by exact ζmulζ
           ... = -(1 + ζ)     : by ring
           ... = -(⟨1, 0⟩  + ⟨0, 1⟩)   : rfl
           ... = -(⟨1, 1⟩)     : by ring
          ... ≠ ⟨1, 0⟩         : by simp [ext],
     },
     have h3: 0 < 3, by norm_num,
     exact is_primitive_root.mk_of_lt ζ h3 h1 h2,
end

@[simp] theorem add_left_neg(a : ℤ_ζ): -a + a = 0 := by ring

@[simp] theorem exists_pair_ne : ∃ (x y : ℤ_ζ), x ≠ y :=
begin
     have h: (0 : ℤ_ζ) ≠ (1 : ℤ_ζ), by simp[ext],
     exact ⟨0, 1, h⟩,
end

/-- conjugation of an Eisenstein Integer:
the function conj turns an Eisenstein integer to its conjugation-/
def conj : ℤ_ζ → ℤ_ζ
| ⟨x, y⟩ := ⟨x-y, -y⟩
@[simp] theorem conj_a: ∀ z : ℤ_ζ, (conj z).a = z.a - z.b
| ⟨x, y⟩ := rfl
@[simp] theorem conj_b: ∀ z : ℤ_ζ, (conj z).b = - z.b
| ⟨x, y⟩ := rfl

theorem hom_1(a ai b bi: ℤ):
(⟨a, ai⟩ + ⟨b, bi⟩ : ℤ_ζ).conj.a = ((⟨a, ai⟩ : ℤ_ζ).conj + (⟨b, bi⟩ : ℤ_ζ).conj).a :=
begin
     simp*, ring,
end

/-- map `conj` is an `add_monoid_hom`. -/
def conj_hom : ℤ_ζ →+ ℤ_ζ :=
{ to_fun := conj,
  map_add' := λ ⟨a, ai⟩ ⟨b, bi⟩, ext.mpr ⟨hom_1 a ai b bi, neg_add _ _⟩,
  map_zero' := ext.mpr ⟨rfl, neg_zero⟩ }

@[simp] lemma conj_zero : conj (0 : ℤ_ζ) = 0 :=
conj_hom.map_zero

@[simp] lemma conj_one : conj (1 : ℤ_ζ) = 1 := rfl

@[simp] lemma conj_neg (x : ℤ_ζ) : (-x).conj = -x.conj :=
conj_hom.map_neg x
@[simp] lemma conj_add (x y : ℤ_ζ) : (x + y).conj = x.conj + y.conj :=
conj_hom.map_add x y

@[simp] lemma conj_conj_1 (x y : ℤ):  x - y - -y = x := by ring
@[simp] lemma conj_conj (x : ℤ_ζ) : x.conj.conj = x :=
by simp only [ext, true_and, conj_a, conj_conj_1, eq_self_iff_true,
neg_neg, conj_b]

theorem mul_conj (x y : ℤ) : (⟨x, y⟩ * conj ⟨x, y⟩ : ℤ_ζ) = (⟨x^2 - x * y + y^2, 0⟩ : ℤ_ζ):=
begin
     have h: conj ⟨x, y⟩ = ⟨x - y, -y⟩, refl,
     calc (⟨x, y⟩ * conj ⟨x, y⟩ : ℤ_ζ) = ⟨x, y⟩ * ⟨x - y, -y⟩  :  by rw h
                       ...            = ⟨x^2 - x * y + y^2, 0⟩  : by {simp[ext], split, ring, ring,}
end

theorem conj_mul {a b : ℤ_ζ} : conj (a * b) = conj a * conj b :=
begin
     simp[ext], split, ring, ring,
end

theorem conj_mul_0 : ∀ (x y : ℤ_ζ), conj(x * y) = conj x * conj y :=
begin
     intros x y,
     exact conj_mul,
end

/-- `conj` as a `monoid_hom`. -/
def conj_monoid_hom : ℤ_ζ →* ℤ_ζ :=
{ to_fun := conj,
  map_mul' := conj_mul_0,
  map_one' := conj_one }

/-- norm(x) represents the norm of x -/
def norm (n : ℤ_ζ) : ℤ := n.a * n.a - n.a * n.b + n.b * n.b
lemma norm_def (n : ℤ_ζ) : n.norm = n.a * n.a - n.a * n.b + n.b * n.b := rfl

@[simp] theorem norm_nonneg : ∀ x : ℤ_ζ, 0 ≤ x.norm :=
begin
     intro x,
     rw norm_def, nlinarith,
end

@[simp] lemma norm_mul (n m : ℤ_ζ) : norm (n * m) = norm n * norm m :=
begin
     rw [eql n, eql m, norm_def, norm_def, norm_def],
     simp[ext], ring,
end

@[simp] lemma norm_zero : norm 0 = 0 := by simp [norm]
@[simp] lemma norm_one : norm 1 = 1 := by simp [norm]
theorem norm_int_cast (n : ℤ) : norm n = n * n := by simp [norm]
theorem norm_nat_cast (n : ℕ) : norm n = n * n := norm_int_cast n

/-- `norm` as a `monoid_hom`. -/
def norm_monoid_hom : ℤ_ζ →* ℤ :=
{ to_fun := norm,
  map_mul' := norm_mul,
  map_one' := norm_one }

@[simp] lemma norm_eq_mul_conj (n : ℤ_ζ) : (norm n : ℤ_ζ) = n * n.conj :=
begin
     have h1: (norm n : ℤ_ζ) = ⟨n.a * n.a - n.a * n.b + n.b * n.b, 0⟩,
     calc (norm n : ℤ_ζ) = ⟨norm n, 0⟩  : by exact coe_int_val (norm n)
               ...       = ⟨n.a * n.a - n.a * n.b + n.b * n.b, 0⟩   : rfl,
     have h2: n * n.conj = ⟨n.a * n.a - n.a * n.b + n.b * n.b, 0⟩,
     {rw eql n, simp[ext], split, ring, ring,},
     rw[h1,h2],
end

@[simp] lemma norm_neg (x : ℤ_ζ) : (-x).norm = x.norm :=
begin
     rw norm_def (-x), rw norm_def x, simp[ext],
end

@[simp] lemma norm_conj (x : ℤ_ζ) : x.conj.norm = x.norm :=
begin
     rw norm_def, rw norm_def, simp[ext], ring,
end

theorem norm_nat: ∀ n : ℤ, ∀ x : ℤ_ζ, (of_int n * x).norm = n^2 * x.norm :=
begin
     intros n x,
     have h1: of_int n * x = ⟨n * x.a, n * x.b⟩, by simp[ext],
     rw [h1, norm_def, norm_def],
     simp[ext], ring,
end

lemma norm_eq_one_0(a : ℤ) : 0 ≤ a ∧ a ≠ 0 → 0 < a :=
begin
     intro h, contrapose! h, finish,
end

lemma lt_le_succ(a b : ℤ) : a < b → a.succ ≤ b := by tauto
lemma left_add_nonneg(a b : ℤ):  0 ≤ a → b ≤ a + b := by omega

lemma pow_two_abs(b : ℤ) : b^2 = (abs b)^2 :=
begin
     have h1: abs b = b ∨ abs b = -b, by exact abs_choice b,
     cases h1,
     rw h1,
     rw h1, ring,
end

lemma smaller_1(n : ℤ) : n ≤ 1 ∧ 0 ≤ n → n = 0 ∨ n = 1 := by omega

/-- We prove that ℤ[ζ] is a Euclidean domain in this part. The main task is to show
∀ a b ∈ ℤ[ζ], ∃ q r ∈ ℤ[ζ], a = qb + r, with norm(r) < norm(b). ∀ a b, q is defined
by function quotient, and r by remainder.-/

def quotient: ℤ_ζ → ℤ_ζ → ℤ_ζ | ⟨x, y⟩ ⟨x', y'⟩
       := ⟨round ((x * x' - x * y' + y * y' : ℚ)/(x'^2 - x' * y' + y'^2 : ℚ)),
          round ((-x * y' + x' * y : ℚ)/(x'^2 - x' * y' + y'^2 : ℚ))⟩
lemma quotient_def (x y x' y': ℤ) : quotient ⟨x, y⟩ ⟨x', y'⟩  =
          ⟨round ((x * x' - x * y' + y * y' : ℚ)/(x'^2 - x' * y' + y'^2 : ℚ)),
          round ((-x * y' + x' * y : ℚ)/(x'^2 - x' * y' + y'^2 : ℚ))⟩  := rfl

lemma div_zero (n : ℤ_ζ): quotient n 0 = 0 :=
begin
have h1: round ((n.a * 0 - n.a * 0 + n.b * 0 : ℚ)/(0^2 - 0 * 0 + 0^2 : ℚ)) = 0,
by norm_num,
have h2: round ((-n.a * 0 + 0 * n.b : ℚ)/(0^2 - 0 * 0 + 0^2 : ℚ)) = 0,
by norm_num,
rw [eql n, eql 0], rw quotient_def, simp[ext],
end

@[simp] theorem add_assoc : ∀ (a b c : ℤ_ζ), a + b + c = a + (b + c) :=
begin
     intros a b c,
     simp[ext], split, ring, ring,
end

@[simp] theorem nsmul_zero' : ∀ (x : ℤ_ζ), nsmul 0 x = 0 :=
begin
     intro x,
     rw eql x, simp[ext],
end

@[simp] theorem nsmul_succ' : ∀ (n : ℕ) (x : ℤ_ζ), nsmul n.succ x = x + nsmul n x :=
begin
     intros;
     try{refl'},
end

@[simp] theorem sub_eq_add_neg :  ∀ (a b : ℤ_ζ), a - b = a + -b :=
begin
     intros a b,
     rw[eql a, eql b],
     simp[ext], split, ring, ring,
end

@[simp] theorem gsmul_zero' : ∀ (a : ℤ_ζ), gsmul_rec 0 a = 0 :=
 begin
     intro x, rw eql x, try{refl},
end

theorem gsmul_succ': ∀ (n : ℕ) (a : ℤ_ζ), gsmul_rec (int.of_nat n.succ) a = a + gsmul_rec (int.of_nat n) a :=
begin
     intros; try{refl},
end

@[simp] theorem gsmul_neg' : ∀ (n : ℕ) (a : ℤ_ζ), gsmul_rec -[1+ n] a = -gsmul_rec ↑(n.succ) a :=
begin
     intros;
     try{refl},
end

theorem add_comm :  ∀ (a b : ℤ_ζ), a + b = b + a :=
begin
intros a b,
rw[eql a, eql b],
simp[ext], split, ring, ring,
end

@[simp] theorem one_mul : ∀ (a : ℤ_ζ), 1 * a = a :=
begin
     intros a,
     rw [eql 1, eql a],
     simp[ext],
end

@[simp] theorem mul_one : ∀ (a : ℤ_ζ), a * 1 = a :=
begin
     intro a,
     rw [eql 1, eql a], simp[ext],
end

@[simp] theorem npow_zero' :  ∀ (x : ℤ_ζ), npow_rec 0 x = 1 :=
begin
intros;
try {refl},
end

@[simp] theorem npow_succ' :  ∀ (n : ℕ) (x : ℤ_ζ), npow_rec n.succ x = x * npow_rec n x :=
begin
intros;
try{refl},
end

@[simp] theorem left_distrib_0 : ∀ (a b c : ℤ_ζ), a * (b + c) = a * b + a * c :=
begin
     intros a b c,
     simp[ext],
     split, ring, ring,
end

@[simp] theorem right_distrib_0 : ∀ (a b c : ℤ_ζ), (a + b) * c = a * c + b * c :=
begin
     intros a b c,
     simp[ext], split, ring, ring,
end

theorem mul_comm:  ∀ (a b : ℤ_ζ), a * b = b * a :=
begin
     intros a b,
     simp[ext], split, ring, ring,
end

/-- the definition of r in a = bq + r described above-/
def remainder : ℤ_ζ → ℤ_ζ → ℤ_ζ |  a b := a - b * (quotient a b)

@[simp] theorem quotient_mul_add_remainder_eq :∀ (a b : ℤ_ζ), b * quotient a b + (remainder a b) = a :=
begin
     intros a b,
     calc b * a.quotient b + (remainder a b) = b * quotient a b + (a - b * (quotient a b))  : by refl
                                         ... = a           : by ring,
end

lemma nat_abs_ge0(a b : ℤ) : 0 ≤ a ∧ 0 ≤ b ∧ b ≤ a → b.nat_abs ≤ a.nat_abs:=
begin
     intro h,
     have h1 : a * a ≥ b * b, by nlinarith[h.1, h.2.1, h.2.2],
     exact int.nat_abs_le_iff_mul_self_le.mpr h1,
end

lemma nat_abs_lt(a b: ℤ): 0 ≤ a ∧ 0 ≤ b ∧ a < b → a.nat_abs < b.nat_abs :=
begin
     intro h,
     exact int.nat_abs_lt_nat_abs_of_nonneg_of_lt h.1 h.2.2,
end

/-- Follow the structure definition of Euclidean domain we should define a
well-founded relation r, s.t. r a b : |a| < |b|, and prove that r (remainder a b)
 b-/
def f := λ (a : ℤ_ζ), a.norm.nat_abs
/-- To make use of current results in mathlib, we define f, and use f to define r-/
def r := inv_image nat.lt f

@[simp] theorem r_well_founded : well_founded r :=
begin
     have h : well_founded nat.lt, by exact nat.lt_wf,
     exact inv_image.wf f h,
end
end
end int_cubic_root

/-- define ℚ_ζ-/
structure ra_cubic_root :=
(c : ℚ)
(d : ℚ)

notation `ℚ_ζ`  := ra_cubic_root

namespace ra_cubic_root
section

instance : decidable_eq ℚ_ζ:=
by tactic.mk_dec_eq_instance

theorem ext : ∀ {z w : ℚ_ζ }, z = w ↔ z.c = w.c ∧ z.d = w.d
| ⟨x, y⟩ ⟨x', y'⟩ :=
⟨λ h, by injection h; split; assumption,
                      λ ⟨h₁, h₂⟩, by congr; assumption⟩

/-- lift an Eisenstein integer to ℚ[ζ]-/
def of_eisen_int(x : ℤ_ζ) : ℚ_ζ := ⟨(x.a : ℚ), (x.b : ℚ)⟩
theorem of_eisen_int_def: ∀ x y : ℤ, of_eisen_int ⟨x, y⟩ = ⟨(x : ℚ), (y : ℚ)⟩ :=
begin
     intros x y,
     try{refl},
end

/-- zero ∈ ℚ[ζ]-/
def zero : ℚ_ζ  := of_eisen_int 0
instance : has_zero ℚ_ζ := ⟨ra_cubic_root.zero⟩
theorem zero_c : (0 : ℚ_ζ).c = (0 : ℚ) := rfl
theorem zero_d : (0 : ℚ_ζ).d = (0 : ℚ) := rfl
instance : inhabited (ℚ_ζ) := ⟨0⟩

/-- one ∈ ℚ[ζ]-/
def one : ℚ_ζ := of_eisen_int 1
instance : has_one (ℚ_ζ) := ⟨ra_cubic_root.one⟩
@[simp] theorem one_c : (1 : (ℚ_ζ)).c = 1 :=
begin
have h1 : (1 : ℚ) = (1 : ℤ), by norm_num,
have h0 : (0 : ℚ) = (0 : ℤ), by norm_num,
calc (1 : (ℚ_ζ)).c = (of_eisen_int (1 : ℤ_ζ)).c : rfl
               ... =  (of_eisen_int⟨1, 0⟩ : ℚ_ζ).c           : by try {refl}
               ... =  (⟨1, 0⟩ : ℚ_ζ).c                       : by rw[of_eisen_int_def 1 0, h0, h1]
               ... =  1                                      : rfl,
end
@[simp] theorem one_d : (1 : (ℚ_ζ)).d = 0 := rfl

/-- representative of ζ in ℚ[ζ], we use ζ0 to emphasize that ζ0 and ζ defined above
are two different elements of different types, ℤ[ζ] and ℚ[ζ], and avoid
misunderstanding.-/
def ζ0 : ℚ_ζ := ⟨0, 1⟩
@[simp] theorem ζ_c : (ζ0 : (ℚ_ζ)).c = 0 := rfl
@[simp] theorem ζ_d : (ζ0 : (ℚ_ζ)).d = 1 := rfl

/-- addition in ℚ[ζ]-/
def add: (ℚ_ζ) → (ℚ_ζ) → (ℚ_ζ)
|⟨x, y⟩ ⟨x', y'⟩ := ⟨x + x', y + y'⟩
instance : has_add ℚ_ζ := ⟨ra_cubic_root.add⟩
@[simp] theorem add_def(x y x' y' : ℚ) :
   (⟨x, y⟩ + ⟨x', y'⟩ : ℚ_ζ) = ⟨x + x', y + y'⟩ := rfl

/-- negation in ℚ[ζ]-/
def neg : ℚ_ζ → ℚ_ζ
|⟨x, y⟩ := ⟨-x, -y⟩
instance : has_neg ℚ_ζ := ⟨ra_cubic_root.neg⟩
@[simp] theorem neg_c : ∀ z : ℚ_ζ, (-z).c = - z.c
|⟨x, y⟩ := rfl
@[simp] theorem neg_d : ∀ z : ℚ_ζ, (-z).d = - z.d
|⟨x, y⟩ := rfl

/-- subtraction in ℚ[ζ]-/
def sub: ℚ_ζ → (ℚ_ζ) → (ℚ_ζ) := λ a b, a + -b
instance : has_sub ℚ_ζ := ⟨ra_cubic_root.sub⟩

/-- multiplication in ℚ[ζ]-/
def mul : ℚ_ζ → ℚ_ζ → ℚ_ζ
| ⟨x, y⟩ ⟨x', y'⟩ := ⟨x * x' - y * y', x * y' + y * x' - y * y'⟩
instance : has_mul ℚ_ζ := ⟨ra_cubic_root.mul⟩
@[simp] theorem mul_def(x y x' y' : ℚ) :
   (⟨x, y⟩ * ⟨x', y'⟩ : ℚ_ζ) = ⟨x * x' - y * y', x * y' + y * x' - y * y'⟩ := rfl
@[simp] theorem mul_c : ∀ z w : ℚ_ζ, (z * w).c = z.c * w.c - z.d * w.d
| ⟨x, y⟩ ⟨x', y'⟩ := rfl
@[simp] theorem mul_d : ∀ z w : ℚ_ζ, (z * w).d = z.c * w.d + z.d * w.c - z.d * w.d
| ⟨x, y⟩ ⟨x', y'⟩ := rfl

/-- z = ⟨z.a, z.b⟩; notations-/
theorem eql0(z : ℚ_ζ) : z = ⟨z.c, z.d⟩ :=
begin
     have h1 : z.c = (⟨z.c, z.d⟩ : ℚ_ζ).c, refl,
     have h2 : z.d = (⟨z.c, z.d⟩ : ℚ_ζ).d, refl,
     exact ext.mpr ⟨h1, h2⟩,
end

/-- norm of x ∈ ℚ[ζ], denoted by norm1-/
def norm1 (a : ℚ_ζ) : ℚ := a.c * a.c - a.c * a.d + a.d * a.d
@[simp] lemma norm1_def (a b : ℚ) : (⟨a, b⟩ : ℚ_ζ).norm1 = a * a - a * b + b * b  :=
by try {refl}

@[simp] theorem norm1_nonneg : ∀ x : ℚ_ζ, 0 ≤ norm1 x :=
begin
     intro x, rw eql0 x,
     simp, nlinarith,
end

@[simp] theorem norm1_nezero : ∀ x : ℚ_ζ, x ≠ 0 → 0 < x.norm1 :=
begin
     intros x h,
     have h1 : 4 * x.norm1 > 0,
     begin
     have h2 : x.c ≠ 0 ∨ x.d ≠ 0, by {contrapose! h, simp[ext], exact h,},
     cases h2,
     {have h3: x.c^2 > 0, by exact pow_two_pos_of_ne_zero x.c h2,
     rw eql0 x, simp, nlinarith[h3]},
     {have h3: x.d^2 > 0, by exact pow_two_pos_of_ne_zero x.d h2,
     rw eql0 x, simp, nlinarith[h3]},
     end,
     nlinarith[h1],
end

@[simp] lemma norm1_mul : ∀ x y : ℚ_ζ, (x * y).norm1 = x.norm1 * y.norm1 :=
begin
intros x y,
have h1: x.norm1 = (x.c)^2 - x.c * x.d + (x.d)^2,
{rw eql0 x, simp, ring,},
have h2: y.norm1 = (y.c)^2 - y.c * y.d + (y.d)^2,
{rw eql0 y, simp, ring,},
have h3: (x * y).norm1 = (x.c * y.c - x.d * y.d)^2 - (x.c * y.c - x.d* y.d) * (x.c * y.d + x.d * y.c - x.d * y.d)
                       + (x.c * y.d + x.d * y.c - x.d * y.d)^2,
{rw [eql0 x, eql0 y], simp, ring,},
have t : x.norm1 * y.norm1 = (x * y).norm1,
{rw [h1, h2], rw h3, ring,},
rw t,
end

lemma norm_lt_1: ∀ x : ℚ_ζ, abs x.c ≤ 1/2 ∧ abs x.d ≤ 1/2 → x.norm1 < 1 :=
begin
     intros x h,
     have a0: (1/2 : ℚ) > 0,  by norm_num,
     have a01 : (1/2 : ℚ) ≥ 0, by norm_num,
     have a1: abs(abs x.c) ≤ abs (1/2),
     calc abs(abs x.c) = abs (x.c)      : by exact abs_abs x.c
                 ...   ≤ (1/2 : ℚ)      : by exact h.1
                 ...   = abs(1/2)       : by rw abs_of_pos a0,
     have a2 : abs(abs x.d) ≤ abs(1/2),
     calc abs(abs x.d) = abs(x.d)       :  by exact abs_abs x.d
                 ...   ≤ (1/2 : ℚ)     :  by exact h.2
                 ...   = abs(1/2)       : by rw abs_of_pos a0,
     have h1: x.c^2 + (-x.c * x.d + x.d^2) = x.c^2 - x.c * x.d + x.d^2, by ring,
     have h2: abs (x.c^2) ≤ 1/4,
     calc abs (x.c^2) = (abs x.c)^2     :  by exact abs_pow x.c 2
                ...   ≤ (1/2)^2         :  by exact sq_le_sq a1
                ...   = 1/4             :  by norm_num,
     have h3: abs (-x.c * x.d) ≤ 1/4,
     calc abs (-x.c * x.d) = abs (x.c) * abs (x.d) : by rw [abs_mul, abs_neg]
                   ...     ≤  (1/2) * (1/2)  :  by exact mul_le_mul h.1 h.2 (abs_nonneg x.d) a01
                   ...     = 1/4         :  by norm_num,
     have h4: abs (x.d^2) ≤ 1/4,
     calc abs(x.d^2) = (abs x.d)^2      :  by exact abs_pow x.d 2
                ...   ≤ (1/2)^2         :  by exact sq_le_sq a2
                ...   = 1/4             :  by norm_num,
     calc x.norm1 = x.c * x.c - x.c * x.d + x.d * x.d       : rfl
             ... ≤ abs (x.c * x.c - x.c * x.d + x.d * x.d) : by exact le_abs_self (x.c * x.c - x.c * x.d + x.d * x.d)
             ... = abs (x.c^2 - x.c * x.d + x.d^2)         : by ring_nf
             ... = abs (x.c^2 + (-x.c * x.d + x.d^2))      : by rw h1
             ... ≤ abs (x.c^2) + abs (-x.c * x.d + x.d^2)  : by exact abs_add (x.c^2) (-x.c * x.d + x.d^2)
             ... ≤ abs (x.c^2) + abs (-x.c * x.d) + abs (x.d^2)
                 : by linarith[abs_add (- x.c * x.d) (x.d^2)]
             ... ≤ 1/4 + 1/4 + 1/4                         : by linarith[h2, h3, h4]
             ... < 1                                       : by norm_num,
end

/-- division in ℚ_ζ-/
def div: ℚ_ζ → ℚ_ζ → ℚ_ζ
| ⟨x, y⟩ ⟨x', y'⟩ := ⟨(x * x' - x * y' + y * y')/(x'^2 - x' * y' + y'^2),
                    (-x * y' + x' * y)/(x'^2 - x' * y' + y'^2)⟩
instance : has_div ℚ_ζ := ⟨ra_cubic_root.div⟩
@[simp] theorem div_def(x y x' y' : ℚ) :
   (⟨x, y⟩ / ⟨x', y'⟩ : ℚ_ζ) = ⟨(x * x' - x * y' + y * y')/(x'^2 - x' * y' + y'^2),
                    (-x * y' + x' * y)/(x'^2 - x' * y' + y'^2)⟩ := rfl
@[simp] theorem div_a : ∀ z w : ℚ_ζ, (z / w).c = (z.c * w.c - z.c * w.d + z.d * w.d)/(w.c^2 - w.c * w.d + w.d^2)
| ⟨x, y⟩ ⟨x', y'⟩ := rfl
@[simp] theorem div_b : ∀ z w : ℚ_ζ, (z / w).d = (-z.c * w.d + w.c * z.d)/(w.c^2 - w.c * w.d + w.d^2)
| ⟨x, y⟩ ⟨x', y'⟩ := rfl

@[simp] theorem div_mul : ∀ a b : ℚ_ζ, b ≠ 0 → b * (a / b) = a :=
begin
     intros a b h,
     have s: b.c^2 - b.c * b.d + b.d^2 ≠ 0, {
     have this : b.c^2 - b.c * b.d + b.d^2 > 0,
     calc b.c^2 - b.c * b.d + b.d^2 = b.c * b.c - b.c * b.d + b.d * b.d: by ring
                         ...        =  (⟨b.c, b.d⟩ : ℚ_ζ).norm1 : by rw norm1_def b.c b.d
                         ...        =  b.norm1                 : rfl
                         ...        > 0                        : by exact norm1_nezero b h,
     nlinarith[this],},
     have h1: b.c * ((a.c * b.c - a.c * b.d + a.d * b.d)/(b.c^2 - b.c * b.d + b.d^2))
                       - b.d * ((-a.c * b.d + b.c * a.d)/(b.c^2 - b.c * b.d + b.d^2)) = a.c,
     calc b.c * ((a.c * b.c - a.c * b.d + a.d * b.d)/(b.c^2 - b.c * b.d + b.d^2))
                       - b.d * ((-a.c * b.d + b.c * a.d)/(b.c^2 - b.c * b.d + b.d^2))
              =  a.c * ((b.c^2 - b.c * b.d + b.d^2)/(b.c^2 - b.c * b.d + b.d^2)) : by ring
          ... =  a.c * ((b.c^2 - b.c * b.d + b.d^2)* (b.c^2 - b.c * b.d + b.d^2)⁻¹) : by try{refl}
          ... =  a.c * 1: by rw mul_inv_cancel s
          ... =  a.c    : by ring,
     have h2: b.c * ((-a.c * b.d + b.c * a.d)/(b.c^2 - b.c * b.d + b.d^2))
                       + b.d * ((a.c * b.c - a.c * b.d + a.d * b.d)/(b.c^2 - b.c * b.d + b.d^2))
                       - b.d * ((-a.c * b.d + b.c * a.d)/(b.c^2 - b.c * b.d + b.d^2)) = a.d,
     calc b.c * ((-a.c * b.d + b.c * a.d)/(b.c^2 - b.c * b.d + b.d^2))
                       + b.d * ((a.c * b.c - a.c * b.d + a.d * b.d)/(b.c^2 - b.c * b.d + b.d^2))
                       - b.d * ((-a.c * b.d + b.c * a.d)/(b.c^2 - b.c * b.d + b.d^2))
               = a.d * ((b.c^2 - b.c * b.d + b.d^2)/(b.c^2 - b.c * b.d + b.d^2))  : by ring
          ...  = a.d * ((b.c^2 - b.c * b.d + b.d^2) * (b.c^2 - b.c * b.d + b.d^2)⁻¹) : by try {refl}
          ...  = a.d * 1 : by rw mul_inv_cancel s
          ...  = a.d     : by ring,
     calc b * (a/b) = ⟨b.c, b.d⟩ * (⟨a.c, a.d⟩ / ⟨b.c, b.d⟩)    :  by rw [eql0 a, eql0 b]
              ...   = ⟨b.c, b.d⟩ * ⟨(a.c * b.c - a.c * b.d + a.d * b.d)/(b.c^2 - b.c * b.d + b.d^2),
                                   (-a.c * b.d + b.c * a.d)/(b.c^2 - b.c * b.d + b.d^2)⟩  : rfl
              ...   = ⟨b.c * ((a.c * b.c - a.c * b.d + a.d * b.d)/(b.c^2 - b.c * b.d + b.d^2))
                       - b.d * ((-a.c * b.d + b.c * a.d)/(b.c^2 - b.c * b.d + b.d^2)),
                       b.c * ((-a.c * b.d + b.c * a.d)/(b.c^2 - b.c * b.d + b.d^2))
                       + b.d * ((a.c * b.c - a.c * b.d + a.d * b.d)/(b.c^2 - b.c * b.d + b.d^2))
                       - b.d * ((-a.c * b.d + b.c * a.d)/(b.c^2 - b.c * b.d + b.d^2))⟩  : rfl
              ...   = ⟨a.c, a.d⟩                               : by rw[h1, h2]
              ...   = a                                       : by rw ← eql0 a,
end
@[simp] theorem zero_prop : (0 : ℚ_ζ).c = 0 ∧ (0 : ℚ_ζ).d = 0 := by exact ⟨zero_c, zero_d⟩
@[simp] theorem zero_add (x : ℚ_ζ) : 0 + x = x :=
begin
     simp[ext],
     split,
     rw [eql0 0, eql0 x], simp,
     rw [eql0 0, eql0 x], simp,
end
@[simp] theorem add_zero (x : ℚ_ζ) : x + 0 = x :=
begin
     simp[ext],
     split,
     rw [eql0 0, eql0 x], simp,
     rw [eql0 0, eql0 x], simp,
end

@[simp]lemma add_assoc : ∀ a b c : ℚ_ζ, (a + b + c) = (a + (b + c)) :=
begin
     intros a b c,
     simp[ext],
     split,
     rw [eql0 a, eql0 b, eql0 c], simp, ring,
     rw [eql0 a, eql0 b, eql0 c], simp, ring,
end
lemma add_comm : ∀ x y: ℚ_ζ, x + y = y + x :=
begin
     intros x y,
     simp[ext], split,
     rw[eql0 x, eql0 y], simp, ring,
     rw[eql0 x, eql0 y], simp, ring,
end

lemma add_assoc_0 : ∀ x y z : ℚ_ζ, x + (y + z) = z + (x + y)       :=
begin
     intros x y z,
     rw [← add_assoc x y z, add_comm (x + y) z],
end

@[simp]lemma add_left_neg: ∀ x : ℚ_ζ, (-x) + x = 0 :=
begin
     intro x,
     simp[ext],
     rw [eql0 (-x), eql0 x], split, simp, simp,
end
@[simp]lemma add_right_neg: ∀ x : ℚ_ζ, x + -x = 0 :=
begin
     intro x,
     simp[ext],
     rw [eql0 (-x), eql0 x], split, simp, simp,
end

@[simp] theorem mul_assoc (a b c: ℚ_ζ) : a * b * c = a * (b * c):=
begin
     simp[ext],
     split,
     ring, ring,
end
@[simp] theorem left_distrib (a b c : ℚ_ζ) : a * (b + c) = a * b + a * c :=
begin
     rw[eql0 a, eql0 b, eql0 c],
     simp[ext],
     split,
     ring, ring,
end
@[simp] theorem right_distrib (a b c : ℚ_ζ) : (a + b) * c = a * c + b * c :=
begin
     rw[eql0 a, eql0 b, eql0 c],
     simp[ext],
     split,
     ring, ring,
end

theorem mul_comm (a b : ℚ_ζ) : a * b = b * a :=
begin
     rw [eql0 a, eql0 b],
     simp[ext], split, ring, ring,
end

/-- Combined the theorems above, we have ℚ[ζ] is a commmutative ring, and thus we
are able to define a ring homomorphism from ℤ[ζ] to ℚ[ζ] in Lean.-/
instance : comm_ring ℚ_ζ :=
by refine_struct
{ add            := (+),
  zero           := (0 : ℚ_ζ),
  neg            := has_neg.neg,
  mul            := (*),
  sub            := λ a b, a + -b,
  one            := (1 : ℚ_ζ),
  npow           := @npow_rec _ ⟨1⟩ ⟨(*)⟩,
  nsmul          := @nsmul_rec _ ⟨0⟩ ⟨(+)⟩,
  gsmul          := @gsmul_rec _ ⟨0⟩ ⟨(+)⟩ ⟨ra_cubic_root.neg⟩,
  zero_add       := zero_add,
  add_zero       := add_zero,
  add_left_neg   := add_left_neg,
  add_comm       := add_comm,
  add_assoc      := add_assoc,
  mul_assoc      := mul_assoc,
  left_distrib   := left_distrib,
  right_distrib  := right_distrib,
  mul_comm       := mul_comm,};
{intros; try { refl };
simp [ext, add_mul, mul_add, add_comm, add_left_comm,
  left_distrib, mul_comm, mul_left_comm, mul_assoc, right_distrib],}

open int_cubic_root

/-- the ring homomorphism from ℤ[ζ] to ℚ[ζ] is defined as follows-/
@[simp] def lift0: ℤ_ζ →+* ℚ_ζ :=
{
  to_fun := λ x, ⟨(x.a : ℚ), (x.b : ℚ)⟩,
  map_zero' := by try{refl},
  map_add' := λ a b, by { simp, },
  map_one' := by try{refl},
  map_mul' := λ x y, by { simp[ext],},
}
instance : has_coe (ℤ_ζ) ℚ_ζ := ⟨lift0⟩

/-- The following properties facilitates later calculations.-/
theorem coe_add : ∀ x y : ℤ_ζ, (x : ℚ_ζ) + (y : ℚ_ζ) = (coe(x + y) : ℚ_ζ) :=
begin
     intros x y,
     calc (x : ℚ_ζ) + (y : ℚ_ζ) = ⟨(x.a : ℚ), (x.b : ℚ)⟩ + ⟨(y.a : ℚ), (y.b : ℚ)⟩  : by try{refl}
                         ...     = ⟨(x.a + y.a : ℚ), (x.b + y.b : ℚ)⟩               : rfl
                         ...     = ⟨(coe (x.a + y.a) : ℚ), (coe (x.b + y.b) : ℚ)⟩   : by simp*
                         ...     = (coe(⟨x.a, x.b⟩ + ⟨y.a, y.b⟩ : ℤ_ζ) : ℚ_ζ)        : by try {refl}
                         ...     = (coe(x + y) : ℚ_ζ)                              : by rw [eql x, eql y],
end

theorem coe_sub : ∀ x y : ℤ_ζ, (x : ℚ_ζ) - (y : ℚ_ζ) = (coe(x - y) : ℚ_ζ)   :=
begin
     intros x y,
     calc (x : ℚ_ζ) - (y : ℚ_ζ) = ⟨(x.a : ℚ), (x.b : ℚ)⟩ - ⟨(y.a : ℚ), (y.b : ℚ)⟩  : by try{refl}
                         ...     = ⟨(x.a - y.a : ℚ), (x.b - y.b : ℚ)⟩               : rfl
                         ...     = ⟨(coe (x.a - y.a) : ℚ), (coe (x.b - y.b) : ℚ)⟩   : by simp*
                         ...     = (coe(⟨x.a, x.b⟩ - ⟨y.a, y.b⟩ : ℤ_ζ) : ℚ_ζ)        : by try {refl}
                         ...     = (coe(x - y) : ℚ_ζ)                              : by rw [eql x, eql y],
end
theorem coe_mul : ∀ x y : ℤ_ζ, (x : ℚ_ζ) * (y : ℚ_ζ) = (coe(x * y) : ℚ_ζ) :=
begin
     intros x y,
     calc (x : ℚ_ζ) * (y : ℚ_ζ) = ⟨(x.a : ℚ), (x.b : ℚ)⟩ * ⟨(y.a : ℚ), (y.b : ℚ)⟩  : by try{refl}
                       ...       = ⟨(x.a * y.a - x.b * y.b : ℚ), (x.a * y.b + x.b * y.a - x.b * y.b : ℚ)⟩ : rfl
                       ...       = ⟨(coe (x.a * y.a - x.b * y.b) : ℚ), (coe (x.a * y.b + x.b * y.a - x.b * y.b) : ℚ)⟩ : by simp*
                       ...       = (coe (⟨x.a, x.b⟩ * ⟨y.a, y.b⟩ : ℤ_ζ) : ℚ_ζ)       : by try {refl}
                       ...       = (coe (x * y) : ℚ_ζ)                              : by rw [eql x, eql y],
end
theorem coe_neg : ∀ x : ℤ_ζ, (-x : ℚ_ζ) = -(x : ℚ_ζ) := by simp*

@[simp] theorem int_rat_cubic_coe(x y: ℤ_ζ) :
(x : ℚ_ζ).norm1 < (y : ℚ_ζ).norm1 → x.norm < y.norm :=
begin
     intro h,
     have h1 : (x.norm : ℚ) = (x : ℚ_ζ).norm1,
     calc (x.norm : ℚ) = (coe (x.a * x.a - x.a * x.b + x.b * x.b) : ℚ)  : rfl
             ... = (x.a * x.a - x.a * x.b + x.b * x.b : ℚ)      : by norm_num
             ... = (x : ℚ_ζ).norm1                              : by try {refl},
     have h2 : (y.norm : ℚ) = (y : ℚ_ζ).norm1,
     calc (y.norm : ℚ) = (coe (y.a * y.a - y.a * y.b + y.b * y.b) : ℚ)  : rfl
             ... = (y.a * y.a - y.a * y.b + y.b * y.b : ℚ)      : by norm_num
             ... = (y : ℚ_ζ).norm1                              : by try {refl},
     have h3 : (x.norm : ℚ) < (y.norm : ℚ),
     calc (x.norm : ℚ)  = (x : ℚ_ζ).norm1 :  by rw h1
           ...   < (y : ℚ_ζ).norm1         :  by exact h
           ...   = (y.norm : ℚ)            :  by rw h2,
     have h4 : ∀ a b : ℤ, (a : ℚ) < (b : ℚ) → a < b, by norm_num,
     exact h4 x.norm y.norm h3,
end
end
end ra_cubic_root

theorem int_ne_zero(x : ℤ_ζ) : x ≠ 0 → x.a ≠ 0 ∨ x.b ≠ 0 :=
begin
     intro h,
     contrapose! h,
     simp[int_cubic_root.ext],
     exact h,
end
theorem ra_c_ne (x : ℚ_ζ) : x.c ≠ 0 → x ≠ 0 :=
begin
     intro h, contrapose! h, simp*,
end
theorem ra_d_ne (x : ℚ_ζ) : x.d ≠ 0 → x ≠ 0 :=
begin
     intro h, contrapose! h, simp*,
end

/- Now we begin to prove the Euclidean property-/
open int_cubic_root
open ra_cubic_root
section
theorem remainder_lt:  ∀ (a : ℤ_ζ) {b : ℤ_ζ}, b ≠ 0 → r (a - b * a.quotient b) b :=
begin
intros a b h,
let r0 := a - b * a.quotient b,
have t : (r0 : ℚ_ζ).norm1 < (b : ℚ_ζ).norm1,
begin
     have hb: (b : ℚ_ζ) ≠ 0,
     begin
          have b1 : b.a ≠ 0 ∨ b.b ≠ 0, by exact int_ne_zero b h,
          cases b1,
          {have ba : (b.a : ℚ) ≠ 0, by simp*,
           calc (b : ℚ_ζ) = ⟨(b.a : ℚ), (b.b : ℚ)⟩  :  by try {refl}
                     ...  ≠ 0                        :  by exact ra_c_ne ⟨(b.a : ℚ), (b.b : ℚ)⟩ ba, },
          {have bb : (b.b : ℚ) ≠ 0, by simp*,
           calc (b : ℚ_ζ) = ⟨(b.a : ℚ), (b.b : ℚ)⟩  :  by try {refl}
                     ...  ≠ 0                        :  by exact ra_d_ne ⟨(b.a : ℚ), (b.b : ℚ)⟩ bb, },
     end,
     have s0 : (r0 : ℚ_ζ) = (a : ℚ_ζ) - (b : ℚ_ζ) * (coe(a.quotient b)),
     calc (r0 : ℚ_ζ) = (coe (a - b * a.quotient b) : ℚ_ζ)                   : by try {refl}
                ...   = (a : ℚ_ζ) - (coe(b * a.quotient b) : ℚ_ζ)           : by rw ←coe_sub a (b * a.quotient b)
                ...   = (a : ℚ_ζ) - (b : ℚ_ζ) * (coe(a.quotient b))         : by rw ←coe_mul b (a.quotient b),
     have s1 : (a : ℚ_ζ) = (b : ℚ_ζ) * ((a : ℚ_ζ)/(b : ℚ_ζ)), by rw div_mul (a : ℚ_ζ) (b : ℚ_ζ) hb,
     let r1 := (a : ℚ_ζ)/(b : ℚ_ζ) - (a.quotient b : ℚ_ζ),
     have s2 : (r0 : ℚ_ζ).norm1 = (b : ℚ_ζ).norm1 * r1.norm1,
     calc (r0 : ℚ_ζ).norm1 = ((a : ℚ_ζ) - (b : ℚ_ζ) * (coe(a.quotient b))).norm1  :  by rw s0
                      ...   = ((b : ℚ_ζ) * ((a : ℚ_ζ)/(b : ℚ_ζ)) + (b : ℚ_ζ) * -(coe(a.quotient b))).norm1   : by {rw ←s1, ring_nf}
                      ...   = ((b : ℚ_ζ) * ((a : ℚ_ζ)/(b : ℚ_ζ) + -coe(a.quotient b))).norm1                 : by simp*
                      ...   = ((b : ℚ_ζ) * ((a : ℚ_ζ)/(b : ℚ_ζ) - coe(a.quotient b))).norm1                  : by ring_nf
                      ...   = (coe b * r1).norm1                                                               : rfl
                      ...   = (b : ℚ_ζ).norm1 * r1.norm1                                   : by exact norm1_mul (coe b) r1,
     have s3: (b : ℚ_ζ).norm1 > 0, by exact norm1_nezero (b : ℚ_ζ) hb,
     let first := (a.a * b.a - a.a * b.b + a.b * b.b : ℚ)/(b.a^2 - b.a * b.b + b.b^2 : ℚ),
     have hf : abs (first - round first : ℚ) ≤  1/2, by exact abs_sub_round first,
     let second := (-a.a * b.b + b.a * a.b : ℚ)/(b.a^2 - b.a * b.b + b.b^2 : ℚ),
     have hs : abs (second - round second : ℚ) ≤  1/2, by exact abs_sub_round second,
     have s4: r1.norm1 < 1,
     begin
          calc r1.norm1 = ((a : ℚ_ζ)/(b : ℚ_ζ) - (a.quotient b : ℚ_ζ)).norm1 : rfl
                    ... = ((⟨(a.a : ℚ), (a.b : ℚ)⟩ : ℚ_ζ) / ⟨(b.a : ℚ), (b.b : ℚ)⟩ - (a.quotient b : ℚ_ζ)).norm1 : by try{refl}
                    ... = ((⟨(a.a * b.a - a.a * b.b + a.b * b.b : ℚ)/(b.a^2 - b.a * b.b + b.b^2 : ℚ),
                    (-a.a * b.b + b.a * a.b : ℚ)/(b.a^2 - b.a * b.b + b.b^2 : ℚ)⟩ : ℚ_ζ)
                    - (a.quotient b : ℚ_ζ)).norm1 : by try {refl}
                    ... =  ((⟨(a.a * b.a - a.a * b.b + a.b * b.b : ℚ)/(b.a^2 - b.a * b.b + b.b^2 : ℚ),
                    (-a.a * b.b + b.a * a.b : ℚ)/(b.a^2 - b.a * b.b + b.b^2 : ℚ)⟩ : ℚ_ζ)
                    - ((⟨a.a, a.b⟩ : ℤ_ζ) .quotient (⟨b.a, b.b⟩ : ℤ_ζ) : ℚ_ζ)).norm1 : by rw [eql a, eql b]
                    ... = ((⟨(a.a * b.a - a.a * b.b + a.b * b.b : ℚ)/(b.a^2 - b.a * b.b + b.b^2 : ℚ),
                    (-a.a * b.b + b.a * a.b : ℚ)/(b.a^2 - b.a * b.b + b.b^2 : ℚ)⟩ : ℚ_ζ)
                    - (coe(⟨round ((a.a * b.a - a.a * b.b + a.b * b.b : ℚ)/(b.a^2 - b.a * b.b + b.b^2 : ℚ)),
          round ((-a.a * b.b + b.a * a.b : ℚ)/(b.a^2 - b.a * b.b + b.b^2 : ℚ))⟩ : ℤ_ζ) : ℚ_ζ)).norm1 : by rw quotient_def
          ...  = ((⟨first, second⟩: ℚ_ζ) - (⟨(round first : ℚ), (round second : ℚ)⟩ : ℚ_ζ)).norm1      : by refl
          ...  = (⟨(first - round first : ℚ), (second - round second : ℚ)⟩ : ℚ_ζ).norm1           : rfl
          ...  < 1         : by exact norm_lt_1 (⟨(first - round first : ℚ), (second - round second : ℚ)⟩ : ℚ_ζ)
                                ⟨hf, hs⟩,
     end,
     calc (r0 : ℚ_ζ).norm1 = (b : ℚ_ζ).norm1 * r1.norm1  : by rw s2
           ...           = r1.norm1 * (b : ℚ_ζ).norm1  : by ring_nf
           ...           < 1 * (b : ℚ_ζ).norm1         : by exact mul_lt_mul s4 (le_refl (b : ℚ_ζ).norm1) s3 zero_le_one
           ...           = (b : ℚ_ζ).norm1 * 1         : by ring
           ...           = (b : ℚ_ζ).norm1             : by norm_num,
end,
have h0: (a - b * a.quotient b).norm < b.norm,
by exact int_rat_cubic_coe (a - b * a.quotient b) b t,
have h1: (a - b * a.quotient b).norm.nat_abs < b.norm.nat_abs,
begin
     apply nat_abs_lt ((a - b * a.quotient b).norm) (b.norm),
     split,
     all_goals{try {split}},
     exact norm_nonneg (a - b * a.quotient b),
     exact norm_nonneg b,
     exact h0,
end,
exact h1,
end

@[simp] theorem mul_left_not_lt :  ∀ (a : ℤ_ζ) {b : ℤ_ζ}, b ≠ 0 → ¬ r (a * b) a
:=
begin
     intros a b h,
     have t: b.a ≠ 0 ∨ b.b ≠ 0, {contrapose! h, simp[int_cubic_root.ext], exact h,},
     have h1 : b.norm ≥  1,
     {cases t,
     {have t1 : (2 * b.b - b.a)^2 ≥ 0, by exact pow_two_nonneg (2 * b.b - b.a),
     have t2 : 0 + 3 * b.a^2 ≤ (2 * b.b - b.a)^2 + 3 * b.a^2, by apply add_le_add_right t1 (3 * b.a^2),
     have h2: b.a^2 > 0, by exact pow_two_pos_of_ne_zero b.a t,
     have h3: 3 * b.a^2 ≥ 3, linarith,
     have h4: 4 * b.norm ≥ 3,
     calc 4 * b.norm = 4 * (b.a * b.a - b.a * b.b + b.b * b.b)    : rfl
            ...   = (2 * b.b - b.a)^2 + 3 * b.a^2                 : by ring
            ...   ≥ 0 + 3 * b.a^2                                 : by exact t2
            ...   = 3 * b.a^2                                     : by ring
            ...   ≥ 3 * 1                                         : by exact h3
            ...   = 3                                             : by ring,
     contrapose! h4,
     have h5: b.norm = 0, {have h6: b.norm ≥ 0 ∧ b.norm < 1, by exact⟨norm_nonneg b, h4⟩, linarith,},
     linarith,
     },
     {have t1 : (2 * b.a - b.b)^2 ≥ 0, by exact pow_two_nonneg (2 * b.a - b.b),
     have t2 : 0 + 3 * b.b^2 ≤ (2 * b.a - b.b)^2 + 3 * b.b^2, by apply add_le_add_right t1 (3 * b.b^2),
     have h2: b.b^2 > 0, by exact pow_two_pos_of_ne_zero b.b t,
     have h3: 3 * b.b^2 ≥ 3, linarith,
     have h4: 4 * b.norm ≥ 3,
     calc 4 * b.norm = 4 * (b.a * b.a - b.a * b.b + b.b * b.b)    : rfl
            ...   = (2 * b.a - b.b)^2 + 3 * b.b^2                 : by ring
            ...   ≥ 0 + 3 * b.b^2                                 : by exact t2
            ...   = 3 * b.b^2                                     : by ring
            ...   ≥ 3 * 1                                         : by exact h3
            ...   = 3                                             : by ring,
     contrapose! h4,
     have h5: b.norm = 0, {have h6: b.norm ≥ 0 ∧ b.norm < 1, by exact⟨norm_nonneg b, h4⟩, linarith,},
     linarith,
     }},
     have h3 : (a * b).norm ≥ a.norm,
     calc (a * b).norm = a.norm * b.norm        : by exact norm_mul a b
                ...    = b.norm * a.norm        : by ring
                ...    ≥ 1 * a.norm             : by exact gsmul_le_gsmul (norm_nonneg a) h1
                ...    =   a.norm               : by ring,
     have h4_1 : (a * b).norm ≥ 0 ∧ a.norm ≥ 0 ∧ (a * b).norm ≥ a.norm,
     begin
     split,
     all_goals{try {split}},
     exact norm_nonneg (a * b),
     exact norm_nonneg a,
     exact h3,
     end,
     have h4: (a * b).norm.nat_abs ≥ a.norm.nat_abs,
     by exact nat_abs_ge0 ((a * b).norm) (a.norm) h4_1,
     contrapose! h4,
     exact h4,
end

/-euclidean domain-/
instance int_cubic_root.euclidean_domain : euclidean_domain ℤ_ζ :=
by refine_struct
{ add := (+),
  mul := (*),
  one := (1 : ℤ_ζ),
  zero := (0 : ℤ_ζ),
  neg := has_neg.neg,
  zero_add := int_cubic_root.zero_add,
  add_zero := add_zero,
  nsmul := nsmul,
  sub := λ a b, a + -b,
  gsmul          := @gsmul_rec _ ⟨0⟩ ⟨(+)⟩ ⟨int_cubic_root.neg⟩,
  add_left_neg   := int_cubic_root.add_left_neg,
  npow           := @npow_rec _ ⟨1⟩ ⟨(*)⟩,
  exists_pair_ne := exists_pair_ne,
  quotient       := quotient,
  quotient_zero  := div_zero,
  remainder      := λ a b, a - b * (quotient a b),
  quotient_mul_add_remainder_eq := quotient_mul_add_remainder_eq,
  add_assoc      := int_cubic_root.add_assoc,
  nsmul_zero'    := nsmul_zero',
  nsmul_succ'    := nsmul_succ',
  sub_eq_add_neg := int_cubic_root.sub_eq_add_neg,
  gsmul_zero'    := gsmul_zero',
  add_comm       := int_cubic_root.add_comm,
  mul_assoc      := int_cubic_root.mul_assoc,
  one_mul        := int_cubic_root.one_mul,
  mul_one        := int_cubic_root.mul_one,
  npow_zero'     := npow_zero',
  npow_succ'     := npow_succ',
  left_distrib   := left_distrib_0,
  right_distrib  := right_distrib_0,
  gsmul_succ'    := gsmul_succ',
  gsmul_neg'     := gsmul_neg',
  mul_comm       := int_cubic_root.mul_comm,
  r              := r,
  r_well_founded := r_well_founded,
  remainder_lt   := remainder_lt,
  mul_left_not_lt  := mul_left_not_lt,
  }

end
#lint


/-
Copyright (c) 2022 Rémi Bottinelli. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémi Bottinelli

! This file was ported from Lean 3 source module combinatorics.quiver.push
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Combinatorics.Quiver.Basic

/-!

# Pushing a quiver structure along a map

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

Given a map `σ : V → W` and a `quiver` instance on `V`, this files defines a `quiver` instance
on `W` by associating to each arrow `v ⟶ v'` in `V` an arrow `σ v ⟶ σ v'` in `W`.

-/

universe v v₁ v₂ u u₁ u₂

variable {V : Type _} [Quiver V] {W : Type _} (σ : V → W)

namespace Quiver

/- warning: quiver.push -> Quiver.Push is a dubious translation:
lean 3 declaration is
  forall {V : Type.{u_1}} [_inst_1 : Quiver.{u_2, u_1} V] {W : Type.{u_3}}, (V -> W) -> Type.{u_3}
but is expected to have type
  forall {V : Type.{u_1}} {_inst_1 : Type.{u_2}}, (V -> _inst_1) -> Type.{u_2}
Case conversion may be inaccurate. Consider using '#align quiver.push Quiver.Pushₓ'. -/
/-- The `quiver` instance obtained by pushing arrows of `V` along the map `σ : V → W` -/
@[nolint unused_arguments]
def Push (σ : V → W) :=
  W
#align quiver.push Quiver.Push

instance [h : Nonempty W] : Nonempty (Push σ) :=
  h

#print Quiver.PushQuiver /-
/-- The quiver structure obtained by pushing arrows of `V` along the map `σ : V → W` -/
@[nolint has_nonempty_instance]
inductive PushQuiver {V : Type u} [Quiver.{v} V] {W : Type u₂} (σ : V → W) : W → W → Type max u u₂ v
  | arrow {X Y : V} (f : X ⟶ Y) : push_quiver (σ X) (σ Y)
#align quiver.push_quiver Quiver.PushQuiver
-/

instance : Quiver (Push σ) :=
  ⟨PushQuiver σ⟩

namespace Push

#print Quiver.Push.of /-
/-- The prefunctor induced by pushing arrows via `σ` -/
def of : V ⥤q Push σ where
  obj := σ
  map X Y f := PushQuiver.arrow f
#align quiver.push.of Quiver.Push.of
-/

/- warning: quiver.push.of_obj -> Quiver.Push.of_obj is a dubious translation:
lean 3 declaration is
  forall {V : Type.{u1}} [_inst_1 : Quiver.{u2, u1} V] {W : Type.{u3}} (σ : V -> W), Eq.{max (succ u1) (succ u3)} (V -> (Quiver.Push.{u1, u2, u3} V _inst_1 W σ)) (Prefunctor.obj.{u2, succ (max u1 u3 u2), u1, u3} V _inst_1 (Quiver.Push.{u1, u2, u3} V _inst_1 W σ) (Quiver.Push.quiver.{u1, u2, u3} V _inst_1 W σ) (Quiver.Push.of.{u1, u2, u3} V _inst_1 W σ)) σ
but is expected to have type
  forall {V : Type.{u3}} [_inst_1 : Quiver.{u1, u3} V] {W : Type.{u2}} (σ : V -> W), Eq.{max (succ u3) (succ u2)} (V -> (Quiver.Push.{u3, u2} V W σ)) (Prefunctor.obj.{u1, max (max (succ u3) (succ u1)) (succ u2), u3, u2} V _inst_1 (Quiver.Push.{u3, u2} V W σ) (Quiver.instQuiverPush.{u3, u1, u2} V _inst_1 W σ) (Quiver.Push.of.{u3, u1, u2} V _inst_1 W σ)) σ
Case conversion may be inaccurate. Consider using '#align quiver.push.of_obj Quiver.Push.of_objₓ'. -/
@[simp]
theorem of_obj : (of σ).obj = σ :=
  rfl
#align quiver.push.of_obj Quiver.Push.of_obj

variable {W' : Type _} [Quiver W'] (φ : V ⥤q W') (τ : W → W') (h : ∀ x, φ.obj x = τ (σ x))

include φ h

#print Quiver.Push.lift /-
/-- Given a function `τ : W → W'` and a prefunctor `φ : V ⥤q W'`, one can extend `τ` to be
a prefunctor `W ⥤q W'` if `τ` and `σ` factorize `φ` at the level of objects, where `W` is given
the pushforward quiver structure `push σ`. -/
def lift : Push σ ⥤q W' where
  obj := τ
  map :=
    @PushQuiver.rec V _ W σ (fun X Y f => τ X ⟶ τ Y) fun X Y f =>
      by
      rw [← h X, ← h Y]
      exact φ.map f
#align quiver.push.lift Quiver.Push.lift
-/

/- warning: quiver.push.lift_obj -> Quiver.Push.lift_obj is a dubious translation:
lean 3 declaration is
  forall {V : Type.{u1}} [_inst_1 : Quiver.{u2, u1} V] {W : Type.{u3}} (σ : V -> W) {W' : Type.{u4}} [_inst_2 : Quiver.{u5, u4} W'] (φ : Prefunctor.{u2, u5, u1, u4} V _inst_1 W' _inst_2) (τ : W -> W') (h : forall (x : V), Eq.{succ u4} W' (Prefunctor.obj.{u2, u5, u1, u4} V _inst_1 W' _inst_2 φ x) (τ (σ x))), Eq.{max (succ u3) (succ u4)} ((Quiver.Push.{u1, u2, u3} V _inst_1 W σ) -> W') (Prefunctor.obj.{succ (max u1 u3 u2), u5, u3, u4} (Quiver.Push.{u1, u2, u3} V _inst_1 W σ) (Quiver.Push.quiver.{u1, u2, u3} V _inst_1 W σ) W' _inst_2 (Quiver.Push.lift.{u1, u2, u3, u4, u5} V _inst_1 W σ W' _inst_2 φ τ h)) τ
but is expected to have type
  forall {V : Type.{u3}} [_inst_1 : Quiver.{u2, u3} V] {W : Type.{u5}} (σ : V -> W) {W' : Type.{u4}} [_inst_2 : Quiver.{u1, u4} W'] (φ : Prefunctor.{u2, u1, u3, u4} V _inst_1 W' _inst_2) (τ : W -> W') (h : forall (x : V), Eq.{succ u4} W' (Prefunctor.obj.{u2, u1, u3, u4} V _inst_1 W' _inst_2 φ x) (τ (σ x))), Eq.{max (succ u5) (succ u4)} ((Quiver.Push.{u3, u5} V W σ) -> W') (Prefunctor.obj.{max (max (succ u3) (succ u2)) (succ u5), u1, u5, u4} (Quiver.Push.{u3, u5} V W σ) (Quiver.instQuiverPush.{u3, u2, u5} V _inst_1 W σ) W' _inst_2 (Quiver.Push.lift.{u3, u2, u5, u4, u1} V _inst_1 W σ W' _inst_2 φ τ h)) τ
Case conversion may be inaccurate. Consider using '#align quiver.push.lift_obj Quiver.Push.lift_objₓ'. -/
theorem lift_obj : (lift σ φ τ h).obj = τ :=
  rfl
#align quiver.push.lift_obj Quiver.Push.lift_obj

/- warning: quiver.push.lift_comp -> Quiver.Push.lift_comp is a dubious translation:
lean 3 declaration is
  forall {V : Type.{u1}} [_inst_1 : Quiver.{u2, u1} V] {W : Type.{u3}} (σ : V -> W) {W' : Type.{u4}} [_inst_2 : Quiver.{u5, u4} W'] (φ : Prefunctor.{u2, u5, u1, u4} V _inst_1 W' _inst_2) (τ : W -> W') (h : forall (x : V), Eq.{succ u4} W' (Prefunctor.obj.{u2, u5, u1, u4} V _inst_1 W' _inst_2 φ x) (τ (σ x))), Eq.{max (imax (succ u1) (succ u1) u2 u5) (succ u1) (succ u4)} (Prefunctor.{u2, u5, u1, u4} V _inst_1 W' _inst_2) (Prefunctor.comp.{u1, u2, u3, succ (max u1 u3 u2), u4, u5} V _inst_1 (Quiver.Push.{u1, u2, u3} V _inst_1 W σ) (Quiver.Push.quiver.{u1, u2, u3} V _inst_1 W σ) W' _inst_2 (Quiver.Push.of.{u1, u2, u3} V _inst_1 W σ) (Quiver.Push.lift.{u1, u2, u3, u4, u5} V _inst_1 W σ W' _inst_2 φ τ h)) φ
but is expected to have type
  forall {V : Type.{u5}} [_inst_1 : Quiver.{u4, u5} V] {W : Type.{u1}} (σ : V -> W) {W' : Type.{u3}} [_inst_2 : Quiver.{u2, u3} W'] (φ : Prefunctor.{u4, u2, u5, u3} V _inst_1 W' _inst_2) (τ : W -> W') (h : forall (x : V), Eq.{succ u3} W' (Prefunctor.obj.{u4, u2, u5, u3} V _inst_1 W' _inst_2 φ x) (τ (σ x))), Eq.{max (max (max (succ u5) u4) (succ u3)) u2} (Prefunctor.{u4, u2, u5, u3} V _inst_1 W' _inst_2) (Prefunctor.comp.{u5, u4, u1, max (max (succ u5) (succ u4)) (succ u1), u3, u2} V _inst_1 (Quiver.Push.{u5, u1} V W σ) (Quiver.instQuiverPush.{u5, u4, u1} V _inst_1 W σ) W' _inst_2 (Quiver.Push.of.{u5, u4, u1} V _inst_1 W σ) (Quiver.Push.lift.{u5, u4, u1, u3, u2} V _inst_1 W σ W' _inst_2 φ τ h)) φ
Case conversion may be inaccurate. Consider using '#align quiver.push.lift_comp Quiver.Push.lift_compₓ'. -/
theorem lift_comp : of σ ⋙q lift σ φ τ h = φ :=
  by
  fapply Prefunctor.ext
  · rintro
    simp only [Prefunctor.comp_obj]
    symm
    exact h X
  · rintro _ _ f
    simp only [Prefunctor.comp_map]
    apply eq_of_hEq
    iterate 2 apply (cast_hEq _ _).trans
    symm
    iterate 2 apply (eq_rec_hEq _ _).trans
    rfl
#align quiver.push.lift_comp Quiver.Push.lift_comp

/- warning: quiver.push.lift_unique -> Quiver.Push.lift_unique is a dubious translation:
lean 3 declaration is
  forall {V : Type.{u1}} [_inst_1 : Quiver.{u2, u1} V] {W : Type.{u3}} (σ : V -> W) {W' : Type.{u4}} [_inst_2 : Quiver.{u5, u4} W'] (φ : Prefunctor.{u2, u5, u1, u4} V _inst_1 W' _inst_2) (τ : W -> W') (h : forall (x : V), Eq.{succ u4} W' (Prefunctor.obj.{u2, u5, u1, u4} V _inst_1 W' _inst_2 φ x) (τ (σ x))) (Φ : Prefunctor.{succ (max u1 u3 u2), u5, u3, u4} (Quiver.Push.{u1, u2, u3} V _inst_1 W σ) (Quiver.Push.quiver.{u1, u2, u3} V _inst_1 W σ) W' _inst_2), (Eq.{max (succ u3) (succ u4)} ((Quiver.Push.{u1, u2, u3} V _inst_1 W σ) -> W') (Prefunctor.obj.{succ (max u1 u3 u2), u5, u3, u4} (Quiver.Push.{u1, u2, u3} V _inst_1 W σ) (Quiver.Push.quiver.{u1, u2, u3} V _inst_1 W σ) W' _inst_2 Φ) τ) -> (Eq.{max (imax (succ u1) (succ u1) u2 u5) (succ u1) (succ u4)} (Prefunctor.{u2, u5, u1, u4} V _inst_1 W' _inst_2) (Prefunctor.comp.{u1, u2, u3, succ (max u1 u3 u2), u4, u5} V _inst_1 (Quiver.Push.{u1, u2, u3} V _inst_1 W σ) (Quiver.Push.quiver.{u1, u2, u3} V _inst_1 W σ) W' _inst_2 (Quiver.Push.of.{u1, u2, u3} V _inst_1 W σ) Φ) φ) -> (Eq.{max (imax (succ u3) (succ u3) (succ (max u1 u3 u2)) u5) (succ u3) (succ u4)} (Prefunctor.{succ (max u1 u3 u2), u5, u3, u4} (Quiver.Push.{u1, u2, u3} V _inst_1 W σ) (Quiver.Push.quiver.{u1, u2, u3} V _inst_1 W σ) W' _inst_2) Φ (Quiver.Push.lift.{u1, u2, u3, u4, u5} V _inst_1 W σ W' _inst_2 φ τ h))
but is expected to have type
  forall {V : Type.{u5}} [_inst_1 : Quiver.{u4, u5} V] {W : Type.{u3}} (σ : V -> W) {W' : Type.{u1}} [_inst_2 : Quiver.{u2, u1} W'] (φ : Prefunctor.{u4, u2, u5, u1} V _inst_1 W' _inst_2) (τ : W -> W') (h : forall (x : V), Eq.{succ u1} W' (Prefunctor.obj.{u4, u2, u5, u1} V _inst_1 W' _inst_2 φ x) (τ (σ x))) (Φ : Prefunctor.{max (max (succ u5) (succ u4)) (succ u3), u2, u3, u1} (Quiver.Push.{u5, u3} V W σ) (Quiver.instQuiverPush.{u5, u4, u3} V _inst_1 W σ) W' _inst_2), (Eq.{max (succ u3) (succ u1)} ((Quiver.Push.{u5, u3} V W σ) -> W') (Prefunctor.obj.{max (max (succ u5) (succ u4)) (succ u3), u2, u3, u1} (Quiver.Push.{u5, u3} V W σ) (Quiver.instQuiverPush.{u5, u4, u3} V _inst_1 W σ) W' _inst_2 Φ) τ) -> (Eq.{max (max (max (succ u5) u4) (succ u1)) u2} (Prefunctor.{u4, u2, u5, u1} V _inst_1 W' _inst_2) (Prefunctor.comp.{u5, u4, u3, max (max (succ u5) (succ u4)) (succ u3), u1, u2} V _inst_1 (Quiver.Push.{u5, u3} V W σ) (Quiver.instQuiverPush.{u5, u4, u3} V _inst_1 W σ) W' _inst_2 (Quiver.Push.of.{u5, u4, u3} V _inst_1 W σ) Φ) φ) -> (Eq.{max (max (max (max (succ u5) (succ u4)) (succ u3)) (succ u1)) u2} (Prefunctor.{max (max (succ u5) (succ u4)) (succ u3), u2, u3, u1} (Quiver.Push.{u5, u3} V W σ) (Quiver.instQuiverPush.{u5, u4, u3} V _inst_1 W σ) W' _inst_2) Φ (Quiver.Push.lift.{u5, u4, u3, u1, u2} V _inst_1 W σ W' _inst_2 φ τ h))
Case conversion may be inaccurate. Consider using '#align quiver.push.lift_unique Quiver.Push.lift_uniqueₓ'. -/
theorem lift_unique (Φ : Push σ ⥤q W') (Φ₀ : Φ.obj = τ) (Φcomp : of σ ⋙q Φ = φ) :
    Φ = lift σ φ τ h := by
  dsimp only [of, lift]
  fapply Prefunctor.ext
  · rintro
    simp_rw [← Φ₀]
  · rintro _ _ ⟨⟩
    subst_vars
    simp only [Prefunctor.comp_map, cast_eq]
    rfl
#align quiver.push.lift_unique Quiver.Push.lift_unique

end Push

end Quiver