/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.set_theory.ordinal_arithmetic
import Mathlib.PostPort

universes l u_1

namespace Mathlib

/-!
# Ordinal notations

constructive ordinal arithmetic for ordinals `< ε₀`.
-/

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

namespace onote

/-- Notation for 0 -/
protected instance has_zero : HasZero onote := { zero := zero }

@[simp] theorem zero_def : zero = 0 := rfl

protected instance inhabited : Inhabited onote := { default := 0 }

/-- Notation for 1 -/
protected instance has_one : HasOne onote := { one := oadd 0 1 0 }

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

/-- The ordinal denoted by a notation -/
@[simp] def repr : onote → ordinal := sorry

/-- Auxiliary definition to print an ordinal notation -/
def to_string_aux1 (e : onote) (n : ℕ) (s : string) : string :=
  ite (e = 0) (to_string n)
    (ite (e = 1)
        (string.str string.empty
          (char.of_nat (bit1 (bit0 (bit0 (bit1 (bit0 (bit0 (bit1 (bit1 (bit1 1)))))))))))
        (string.str
              (string.str
                (string.str string.empty
                  (char.of_nat (bit1 (bit0 (bit0 (bit1 (bit0 (bit0 (bit1 (bit1 (bit1 1)))))))))))
                (char.of_nat (bit0 (bit1 (bit1 (bit1 (bit1 (bit0 1))))))))
              (char.of_nat (bit0 (bit0 (bit0 (bit1 (bit0 1)))))) ++
            s ++
          string.str string.empty (char.of_nat (bit1 (bit0 (bit0 (bit1 (bit0 1))))))) ++
      ite (n = 1) string.empty
        (string.str string.empty (char.of_nat (bit0 (bit1 (bit0 (bit1 (bit0 1)))))) ++ to_string n))

/-- Print an ordinal notation -/
def to_string : onote → string := sorry

/-- Print an ordinal notation -/
def repr' : onote → string := sorry

protected instance has_to_string : has_to_string onote := has_to_string.mk to_string

protected instance has_repr : has_repr onote := has_repr.mk repr'

protected instance preorder : preorder onote :=
  preorder.mk (fun (x y : onote) => repr x ≤ repr y) (fun (x y : onote) => repr x < repr y) sorry
    sorry

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

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

/-- Convert a `nat` into an ordinal -/
@[simp] def of_nat : ℕ → onote := sorry

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

@[simp] theorem repr_of_nat (n : ℕ) : repr (of_nat n) = ↑n := sorry

@[simp] theorem repr_one : repr 1 = 1 := sorry

theorem omega_le_oadd (e : onote) (n : ℕ+) (a : onote) :
    ordinal.omega ^ repr e ≤ repr (oadd e n a) :=
  sorry

theorem oadd_pos (e : onote) (n : ℕ+) (a : onote) : 0 < oadd e n a :=
  lt_of_lt_of_le (ordinal.power_pos (repr e) ordinal.omega_pos) (omega_le_oadd e n a)

/-- Compare ordinal notations -/
def cmp : onote → onote → ordering := sorry

theorem eq_of_cmp_eq {o₁ : onote} {o₂ : onote} : cmp o₁ o₂ = ordering.eq → o₁ = o₂ := sorry

theorem zero_lt_one : 0 < 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 < 1)) (propext lt_def)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (repr 0 < repr 1)) repr.equations._eqn_1))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 < repr 1)) repr_one)) ordinal.zero_lt_one))

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

/-- A normal form ordinal notation has the form

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

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

protected instance NF.zero : NF 0 := Exists.intro 0 NF_below.zero

theorem NF_below.oadd {e : onote} {n : ℕ+} {a : onote} {b : ordinal} :
    NF e → NF_below a (repr e) → repr e < b → NF_below (oadd e n a) b :=
  sorry

theorem NF_below.fst {e : onote} {n : ℕ+} {a : onote} {b : ordinal} (h : NF_below (oadd e n a) b) :
    NF e :=
  sorry

theorem NF.fst {e : onote} {n : ℕ+} {a : onote} : NF (oadd e n a) → NF e :=
  fun (ᾰ : NF (oadd e n a)) =>
    Exists.dcases_on ᾰ
      fun (ᾰ_w : ordinal) (ᾰ_h : NF_below (oadd e n a) ᾰ_w) => idRhs (NF e) (NF_below.fst ᾰ_h)

theorem NF_below.snd {e : onote} {n : ℕ+} {a : onote} {b : ordinal} (h : NF_below (oadd e n a) b) :
    NF_below a (repr e) :=
  sorry

theorem NF.snd' {e : onote} {n : ℕ+} {a : onote} : NF (oadd e n a) → NF_below a (repr e) :=
  fun (ᾰ : NF (oadd e n a)) =>
    Exists.dcases_on ᾰ
      fun (ᾰ_w : ordinal) (ᾰ_h : NF_below (oadd e n a) ᾰ_w) =>
        idRhs (NF_below a (repr e)) (NF_below.snd ᾰ_h)

theorem NF.snd {e : onote} {n : ℕ+} {a : onote} (h : NF (oadd e n a)) : NF a :=
  Exists.intro (repr e) (NF.snd' h)

theorem NF.oadd {e : onote} {a : onote} (h₁ : NF e) (n : ℕ+) (h₂ : NF_below a (repr e)) :
    NF (oadd e n a) :=
  Exists.intro (ordinal.succ (repr e)) (NF_below.oadd h₁ h₂ (ordinal.lt_succ_self (repr e)))

protected instance NF.oadd_zero (e : onote) (n : ℕ+) [h : NF e] : NF (oadd e n 0) :=
  NF.oadd h n NF_below.zero

theorem NF_below.lt {e : onote} {n : ℕ+} {a : onote} {b : ordinal} (h : NF_below (oadd e n a) b) :
    repr e < b :=
  sorry

theorem NF_below_zero {o : onote} : NF_below o 0 ↔ o = 0 := sorry

theorem NF.zero_of_zero {e : onote} {n : ℕ+} {a : onote} (h : NF (oadd e n a)) (e0 : e = 0) :
    a = 0 :=
  sorry

theorem NF_below.repr_lt {o : onote} {b : ordinal} (h : NF_below o b) :
    repr o < ordinal.omega ^ b :=
  sorry

theorem NF_below.mono {o : onote} {b₁ : ordinal} {b₂ : ordinal} (bb : b₁ ≤ b₂) (h : NF_below o b₁) :
    NF_below o b₂ :=
  sorry

theorem NF.below_of_lt {e : onote} {n : ℕ+} {a : onote} {b : ordinal} (H : repr e < b) :
    NF (oadd e n a) → NF_below (oadd e n a) b :=
  sorry

theorem NF.below_of_lt' {o : onote} {b : ordinal} :
    repr o < ordinal.omega ^ b → NF o → NF_below o b :=
  sorry

theorem NF_below_of_nat (n : ℕ) : NF_below (of_nat n) 1 :=
  nat.cases_on n (idRhs (NF_below 0 1) NF_below.zero)
    fun (n : ℕ) =>
      idRhs (NF_below (oadd 0 (nat.succ_pnat n) 0) 1)
        (NF_below.oadd NF.zero NF_below.zero ordinal.zero_lt_one)

protected instance NF_of_nat (n : ℕ) : NF (of_nat n) := Exists.intro 1 (NF_below_of_nat n)

protected instance NF_one : NF 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (NF 1)) (Eq.symm of_nat_one))) (onote.NF_of_nat 1)

theorem oadd_lt_oadd_1 {e₁ : onote} {n₁ : ℕ+} {o₁ : onote} {e₂ : onote} {n₂ : ℕ+} {o₂ : onote}
    (h₁ : NF (oadd e₁ n₁ o₁)) (h : e₁ < e₂) : oadd e₁ n₁ o₁ < oadd e₂ n₂ o₂ :=
  lt_of_lt_of_le (NF_below.repr_lt (NF.below_of_lt h h₁)) (omega_le_oadd e₂ n₂ o₂)

theorem oadd_lt_oadd_2 {e : onote} {o₁ : onote} {o₂ : onote} {n₁ : ℕ+} {n₂ : ℕ+}
    (h₁ : NF (oadd e n₁ o₁)) (h : ↑n₁ < ↑n₂) : oadd e n₁ o₁ < oadd e n₂ o₂ :=
  sorry

theorem oadd_lt_oadd_3 {e : onote} {n : ℕ+} {a₁ : onote} {a₂ : onote} (h : a₁ < a₂) :
    oadd e n a₁ < oadd e n a₂ :=
  sorry

theorem cmp_compares (a : onote) (b : onote) [NF a] [NF b] : ordering.compares (cmp a b) a b :=
  sorry

theorem repr_inj {a : onote} {b : onote} [NF a] [NF b] : repr a = repr b ↔ a = b := sorry

theorem NF.of_dvd_omega_power {b : ordinal} {e : onote} {n : ℕ+} {a : onote} (h : NF (oadd e n a))
    (d : ordinal.omega ^ b ∣ repr (oadd e n a)) : b ≤ repr e ∧ ordinal.omega ^ b ∣ repr a :=
  sorry

theorem NF.of_dvd_omega {e : onote} {n : ℕ+} {a : onote} (h : NF (oadd e n a)) :
    ordinal.omega ∣ repr (oadd e n a) → repr e ≠ 0 ∧ ordinal.omega ∣ repr a :=
  sorry

/-- `top_below b o` asserts that the largest exponent in `o`, if
  it exists, is less than `b`. This is an auxiliary definition
  for decidability of `NF`. -/
def top_below (b : onote) : onote → Prop := sorry

protected instance decidable_top_below : DecidableRel top_below :=
  id
    fun (b o : onote) =>
      onote.cases_on o (id decidable.true)
        fun (o_ᾰ : onote) (o_ᾰ_1 : ℕ+) (o_ᾰ_2 : onote) =>
          id (ordering.decidable_eq (cmp o_ᾰ b) ordering.lt)

theorem NF_below_iff_top_below {b : onote} [NF b] {o : onote} :
    NF_below o (repr b) ↔ NF o ∧ top_below b o :=
  sorry

protected instance decidable_NF : decidable_pred NF := sorry

/-- Addition of ordinal notations (correct only for normal input) -/
def add : onote → onote → onote := sorry

protected instance has_add : Add onote := { add := add }

@[simp] theorem zero_add (o : onote) : 0 + o = o := rfl

theorem oadd_add (e : onote) (n : ℕ+) (a : onote) (o : onote) :
    oadd e n a + o = add._match_1 e n (a + o) :=
  rfl

/-- Subtraction of ordinal notations (correct only for normal input) -/
def sub : onote → onote → onote := sorry

protected instance has_sub : Sub onote := { sub := sub }

theorem add_NF_below {b : ordinal} {o₁ : onote} {o₂ : onote} :
    NF_below o₁ b → NF_below o₂ b → NF_below (o₁ + o₂) b :=
  sorry

protected instance add_NF (o₁ : onote) (o₂ : onote) [NF o₁] [NF o₂] : NF (o₁ + o₂) := sorry

@[simp] theorem repr_add (o₁ : onote) (o₂ : onote) [NF o₁] [NF o₂] :
    repr (o₁ + o₂) = repr o₁ + repr o₂ :=
  sorry

theorem sub_NF_below {o₁ : onote} {o₂ : onote} {b : ordinal} :
    NF_below o₁ b → NF o₂ → NF_below (o₁ - o₂) b :=
  sorry

protected instance sub_NF (o₁ : onote) (o₂ : onote) [NF o₁] [NF o₂] : NF (o₁ - o₂) := sorry

@[simp] theorem repr_sub (o₁ : onote) (o₂ : onote) [NF o₁] [NF o₂] :
    repr (o₁ - o₂) = repr o₁ - repr o₂ :=
  sorry

/-- Multiplication of ordinal notations (correct only for normal input) -/
def mul : onote → onote → onote := sorry

protected instance has_mul : Mul onote := { mul := mul }

@[simp] theorem zero_mul (o : onote) : 0 * o = 0 :=
  onote.cases_on o (Eq.refl (0 * zero))
    fun (o_ᾰ : onote) (o_ᾰ_1 : ℕ+) (o_ᾰ_2 : onote) => Eq.refl (0 * oadd o_ᾰ o_ᾰ_1 o_ᾰ_2)

@[simp] theorem mul_zero (o : onote) : o * 0 = 0 :=
  onote.cases_on o (Eq.refl (zero * 0))
    fun (o_ᾰ : onote) (o_ᾰ_1 : ℕ+) (o_ᾰ_2 : onote) => Eq.refl (oadd o_ᾰ o_ᾰ_1 o_ᾰ_2 * 0)

theorem oadd_mul (e₁ : onote) (n₁ : ℕ+) (a₁ : onote) (e₂ : onote) (n₂ : ℕ+) (a₂ : onote) :
    oadd e₁ n₁ a₁ * oadd e₂ n₂ a₂ =
        ite (e₂ = 0) (oadd e₁ (n₁ * n₂) a₁) (oadd (e₁ + e₂) n₂ (oadd e₁ n₁ a₁ * a₂)) :=
  rfl

theorem oadd_mul_NF_below {e₁ : onote} {n₁ : ℕ+} {a₁ : onote} {b₁ : ordinal}
    (h₁ : NF_below (oadd e₁ n₁ a₁) b₁) {o₂ : onote} {b₂ : ordinal} :
    NF_below o₂ b₂ → NF_below (oadd e₁ n₁ a₁ * o₂) (repr e₁ + b₂) :=
  sorry

protected instance mul_NF (o₁ : onote) (o₂ : onote) [NF o₁] [NF o₂] : NF (o₁ * o₂) := sorry

@[simp] theorem repr_mul (o₁ : onote) (o₂ : onote) [NF o₁] [NF o₂] :
    repr (o₁ * o₂) = repr o₁ * repr o₂ :=
  sorry

/-- Calculate division and remainder of `o` mod ω.
  `split' o = (a, n)` means `o = ω * a + n`. -/
def split' : onote → onote × ℕ := sorry

/-- Calculate division and remainder of `o` mod ω.
  `split o = (a, n)` means `o = a + n`, where `ω ∣ a`. -/
def split : onote → onote × ℕ := sorry

/-- `scale x o` is the ordinal notation for `ω ^ x * o`. -/
def scale (x : onote) : onote → onote := sorry

/-- `mul_nat o n` is the ordinal notation for `o * n`. -/
def mul_nat : onote → ℕ → onote := sorry

/-- Auxiliary definition to compute the ordinal notation for the ordinal
exponentiation in `power` -/
def power_aux (e : onote) (a0 : onote) (a : onote) : ℕ → ℕ → onote := sorry

/-- `power o₁ o₂` calculates the ordinal notation for
  the ordinal exponential `o₁ ^ o₂`. -/
def power (o₁ : onote) (o₂ : onote) : onote := sorry

protected instance has_pow : has_pow onote onote := has_pow.mk power

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

theorem split_eq_scale_split' {o : onote} {o' : onote} {m : ℕ} [NF o] :
    split' o = (o', m) → split o = (scale 1 o', m) :=
  sorry

theorem NF_repr_split' {o : onote} {o' : onote} {m : ℕ} [NF o] :
    split' o = (o', m) → NF o' ∧ repr o = ordinal.omega * repr o' + ↑m :=
  sorry

theorem scale_eq_mul (x : onote) [NF x] (o : onote) [NF o] : scale x o = oadd x 1 0 * o := sorry

protected instance NF_scale (x : onote) [NF x] (o : onote) [NF o] : NF (scale x o) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (NF (scale x o))) (scale_eq_mul x o)))
    (onote.mul_NF (oadd x 1 0) o)

@[simp] theorem repr_scale (x : onote) [NF x] (o : onote) [NF o] :
    repr (scale x o) = ordinal.omega ^ repr x * repr o :=
  sorry

theorem NF_repr_split {o : onote} {o' : onote} {m : ℕ} [NF o] (h : split o = (o', m)) :
    NF o' ∧ repr o = repr o' + ↑m :=
  sorry

theorem split_dvd {o : onote} {o' : onote} {m : ℕ} [NF o] (h : split o = (o', m)) :
    ordinal.omega ∣ repr o' :=
  sorry

theorem split_add_lt {o : onote} {e : onote} {n : ℕ+} {a : onote} {m : ℕ} [NF o]
    (h : split o = (oadd e n a, m)) : repr a + ↑m < ordinal.omega ^ repr e :=
  sorry

@[simp] theorem mul_nat_eq_mul (n : ℕ) (o : onote) : mul_nat o n = o * of_nat n := sorry

protected instance NF_mul_nat (o : onote) [NF o] (n : ℕ) : NF (mul_nat o n) :=
  eq.mpr
    (id
      ((fun (o o_1 : onote) (e_1 : o = o_1) => congr_arg NF e_1) (mul_nat o n) (o * of_nat n)
        (mul_nat_eq_mul n o)))
    (onote.mul_NF o (of_nat n))

protected instance NF_power_aux (e : onote) (a0 : onote) (a : onote) [NF e] [NF a0] [NF a] (k : ℕ)
    (m : ℕ) : NF (power_aux e a0 a k m) :=
  sorry

protected instance NF_power (o₁ : onote) (o₂ : onote) [NF o₁] [NF o₂] : NF (o₁ ^ o₂) := sorry

theorem scale_power_aux (e : onote) (a0 : onote) (a : onote) [NF e] [NF a0] [NF a] (k : ℕ) (m : ℕ) :
    repr (power_aux e a0 a k m) = ordinal.omega ^ repr e * repr (power_aux 0 a0 a k m) :=
  sorry

theorem repr_power_aux₁ {e : onote} {a : onote} [Ne : NF e] [Na : NF a] {a' : ordinal}
    (e0 : repr e ≠ 0) (h : a' < ordinal.omega ^ repr e) (aa : repr a = a') (n : ℕ+) :
    (ordinal.omega ^ repr e * ↑↑n + a') ^ ordinal.omega =
        (ordinal.omega ^ repr e) ^ ordinal.omega :=
  sorry

theorem repr_power_aux₂ {a0 : onote} {a' : onote} [N0 : NF a0] [Na' : NF a'] (m : ℕ)
    (d : ordinal.omega ∣ repr a') (e0 : repr a0 ≠ 0) (h : repr a' + ↑m < ordinal.omega ^ repr a0)
    (n : ℕ+) (k : ℕ) :
    let R : ordinal := repr (power_aux 0 a0 (oadd a0 n a' * of_nat m) k m);
      (k ≠ 0 → R < (ordinal.omega ^ repr a0) ^ ordinal.succ ↑k) ∧
        (ordinal.omega ^ repr a0) ^ ↑k * (ordinal.omega ^ repr a0 * ↑↑n + repr a') + R =
          (ordinal.omega ^ repr a0 * ↑↑n + repr a' + ↑m) ^ ordinal.succ ↑k :=
  sorry

theorem repr_power (o₁ : onote) (o₂ : onote) [NF o₁] [NF o₂] : repr (o₁ ^ o₂) = repr o₁ ^ repr o₂ :=
  sorry

end onote

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

protected instance nonote.decidable_eq : DecidableEq nonote :=
  eq.mpr sorry fun (a b : Subtype fun (o : onote) => onote.NF o) => subtype.decidable_eq a b

namespace nonote

protected instance NF (o : nonote) : onote.NF (subtype.val o) := subtype.property o

/-- Construct a `nonote` from an ordinal notation
  (and infer normality) -/
def mk (o : onote) [h : onote.NF o] : nonote := { val := o, property := h }

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

protected instance has_to_string : has_to_string nonote :=
  has_to_string.mk fun (x : nonote) => onote.to_string (subtype.val x)

protected instance has_repr : has_repr nonote :=
  has_repr.mk fun (x : nonote) => onote.repr' (subtype.val x)

protected instance preorder : preorder nonote :=
  preorder.mk (fun (x y : nonote) => repr x ≤ repr y) (fun (x y : nonote) => repr x < repr y) sorry
    sorry

protected instance has_zero : HasZero nonote := { zero := { val := 0, property := onote.NF.zero } }

protected instance inhabited : Inhabited nonote := { default := 0 }

/-- Convert a natural number to an ordinal notation -/
def of_nat (n : ℕ) : nonote := { val := onote.of_nat n, property := sorry }

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

theorem cmp_compares (a : nonote) (b : nonote) : ordering.compares (cmp a b) a b := sorry

protected instance linear_order : linear_order nonote := linear_order_of_compares cmp cmp_compares

/-- Asserts that `repr a < ω ^ repr b`. Used in `nonote.rec_on` -/
def old_below (a : nonote) (b : nonote) := onote.NF_below (subtype.val a) (repr b)

/-- The `oadd` pseudo-constructor for `nonote` -/
def oadd (e : nonote) (n : ℕ+) (a : nonote) (h : old_below a e) : nonote :=
  { val := onote.oadd (subtype.val e) n (subtype.val a), property := sorry }

/-- This is a recursor-like theorem for `nonote` suggesting an
  inductive definition, which can't actually be defined this
  way due to conflicting dependencies. -/
def rec_on {C : nonote → Sort u_1} (o : nonote) (H0 : C 0)
    (H1 :
      (e : nonote) → (n : ℕ+) → (a : nonote) → (h : old_below a e) → C e → C a → C (oadd e n a h)) :
    C o :=
  subtype.cases_on o
    fun (o : onote) (h : onote.NF o) =>
      onote.rec (fun (h : onote.NF onote.zero) => H0)
        (fun (e : onote) (n : ℕ+) (a : onote)
          (IHe : (h : onote.NF e) → C { val := e, property := h })
          (IHa : (h : onote.NF a) → C { val := a, property := h })
          (h : onote.NF (onote.oadd e n a)) =>
          H1 { val := e, property := onote.NF.fst h } n { val := a, property := onote.NF.snd h }
            (onote.NF.snd' h) (IHe (onote.NF.fst h)) (IHa (onote.NF.snd h)))
        o h

/-- Addition of ordinal notations -/
protected instance has_add : Add nonote :=
  { add := fun (x y : nonote) => mk (subtype.val x + subtype.val y) }

theorem repr_add (a : nonote) (b : nonote) : repr (a + b) = repr a + repr b :=
  onote.repr_add (subtype.val a) (subtype.val b)

/-- Subtraction of ordinal notations -/
protected instance has_sub : Sub nonote :=
  { sub := fun (x y : nonote) => mk (subtype.val x - subtype.val y) }

theorem repr_sub (a : nonote) (b : nonote) : repr (a - b) = repr a - repr b :=
  onote.repr_sub (subtype.val a) (subtype.val b)

/-- Multiplication of ordinal notations -/
protected instance has_mul : Mul nonote :=
  { mul := fun (x y : nonote) => mk (subtype.val x * subtype.val y) }

theorem repr_mul (a : nonote) (b : nonote) : repr (a * b) = repr a * repr b :=
  onote.repr_mul (subtype.val a) (subtype.val b)

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

theorem repr_power (a : nonote) (b : nonote) : repr (power a b) = ordinal.power (repr a) (repr b) :=
  onote.repr_power (subtype.val a) (subtype.val b)

end Mathlib


import data.real.basic

--OUTPUT 1
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) : by {
    have h1 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = ((a + b + c) / (b + c)) + ((a + b + c) / (a + c)) + ((a + b + c) / (a + b)), from sorry,
    have h2 : ((a + b + c) / (b + c)) + ((a + b + c) / (a + c)) + ((a + b + c) / (a + b)) ≥ (9 / 2), from sorry,
    have h3 : ((a + b + c) / (b + c)) + ((a + b + c) / (a + c)) + ((a + b + c) / (a + b)) ≥ (9 / 2) * ((a + b + c) / (b + c) + (a + c) / (a + c) + (a + b) / (a + b)), from sorry,
    have h4 : ((a + b + c) / (b + c)) + ((a + b + c) / (a + c)) + ((a + b + c) / (a + b)) ≥ (9 / 2) * (1 / 2), from sorry,
    have h5 : ((a + b + c) / (b + c)) + ((a + b + c) / (a + c)) + ((a + b + c) / (a + b)) ≥ (3 / 2), from sorry,
    show (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from sorry,
  },
end

--OUTPUT 2
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by sorry
  ... ≥ (9 * (a + b + c)) / ((b + c) + (a + c) + (a + b)) : by sorry
  ... ≥ (9 * (a + b + c)) / (3 * (a + b + c)) : by sorry
  ... ≥ (3 / 2) : by sorry,
end

--OUTPUT 3
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (9 / 2), from sorry,
  have h2 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (3 / 2) * (a + b + c), from sorry,
  have h3 : (1 / (b + c) + 1 / (a + c) + 1 / (a + b)) / 3 ≥ (3 / 2) * (a + b + c), from sorry,
  have h4 : (1 / (b + c) + 1 / (a + c) + 1 / (a + b)) / 3 ≥ (3 / 2) * (a + b + c) / (b + c + a + c + a + b), from sorry,
  have h5 : (1 / (b + c) + 1 / (a + c) + 1 / (a + b)) / 3 ≥ (3 / 2) * (1 / 2), from sorry,
  have h6 : (1 / (b + c) + 1 / (a + c) + 1 / (a + b)) / 3 ≥ (3 / 4), from sorry,
  have h7 : (1 / (b + c) + 1 / (a + c) + 1 / (a + b)) ≥ (9 / 4), from sorry,
  have h8 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (9 / 4), from sorry,
  have h9 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from sorry,
  show (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from sorry,
end

--OUTPUT 4
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by sorry
  ... ≥ (9 * (a + b + c)) / ((b + c) + (a + c) + (a + b)) : by sorry
  ... ≥ (3 / ((b + c) + (a + c) + (a + b))) : by sorry
  ... ≥ (3 / 2) : by sorry,
end

--OUTPUT 5
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) : by {
    calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
      sorry,
    }
    ... ≥ (9 * (a + b + c)) / ((b + c) + (a + c) + (a + b)) : by {
      sorry,
    }
    ... ≥ (3 / ((b + c) + (a + c) + (a + b))) : by {
      sorry,
    }
    ... ≥ (3 / 2) : by {
      sorry,
    }
  }
end

--OUTPUT 6
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) : by {
    calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) : by {
      calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
        calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
          calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
            calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
              calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                    calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                      calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                        calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                          calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                            calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                              calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                                calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                                  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                                    calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                                      calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                                        calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                                          calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                                            calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                                              calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                                                calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                                                  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                                                    calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                                                      calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by {
                                                        calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
Nesbitt's inequality
Let $a$, $b$ and $c$ be positive real numbers.

Then:
:$\dfrac a {b + c} + \dfrac b {a + c} + \dfrac c {a + b} \ge \dfrac 3 2$

`proof`
{{begin-eqn}}
{{eqn | l = \frac a {b + c} + \frac b {a + c} + \frac c {a + b}
      | o = \ge
      | r = \dfrac 3 2
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {a + b + c} {b + c} + \frac {a + b + c} {a + c} + \frac {a + b + c} {a + b}
      | o = \ge
      | r = \frac 9 2
      | c = by adding $3$
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {a + b + c} {b + c} + \frac {a + b + c} {a + c} + \frac {a + b + c} {a + b}
      | o = \ge
      | r = \frac {9 \paren {a + b + c} } {\paren {b + c} + \paren {a + c} + \paren {a + b} }
      | c = as $\dfrac {a + b + c} {\paren {b + c} + \paren {a + c} + \paren {a + b} } = \dfrac 1 2$
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {\frac 1 {b + c} + \frac 1 {a + c} + \frac 1 {a + b} } 3
      | o = \ge
      | r = \frac 3 {\paren {b + c} + \paren {a + c} + \paren {a + b} }
      | c = dividing by $3 \paren {a + b + c}$
}}
{{end-eqn}}
These are the arithmetic mean and the harmonic mean of $\dfrac 1 {b + c}$, $\dfrac 1 {a + c}$ and $\dfrac 1 {a + b}$.

From Arithmetic Mean is Never Less than Harmonic Mean the last inequality is true.

Thus Nesbitt's Inequality holds.
{{qed}}

-/
theorem  nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
FEW SHOT PROMPTS TO CODEX(END)-/


import fol
import data.set

/-!
# IZF set theory

In this file we define the signature and axioms of intuitionistic Zermelo-Fraenkel set theory
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
* [P. Aczel, M. Rathjen, *Notes on Constructive Set Theory*] [AR01]
  -- for the axioms of IZF
* [L. Crosilla, *Set Theory: Constructive and Intuitionistic ZF*] [LC20]
  -- for cross referencing
-/

namespace izf
open fol
universe variable u

section izf_signature

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

/- We will use single predicate for membership -/
inductive pred_symb : ℕ → Type u
| elem : pred_symb 2
--| subset : pred_symb 2

/- We allow constants for the empty set and ω,
  unary function symbols for the union set and the powerset
  and a binary function symbol for the pair set -/
inductive func_symb : ℕ → Type u
| empty : func_symb 0
| omega : func_symb 0
| union : func_symb 1
| power : func_symb 1
| pair  : func_symb 2
--| succ  : func_symb 1

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

-- Definitions and notations for our functions
@[simp]def emptyset                 : term σ := (func func_symb.empty : term σ)
@[simp]def omegaset                 : term σ := (func func_symb.omega : term σ)
@[simp]def unionset (t : term σ)    : term σ :=  fapp (func func_symb.union) t
@[simp]def powerset (t : term σ)    : term σ := fapp (func func_symb.power) t
@[simp]def pairset (t₁ t₂ : term σ) : term σ := fapp (fapp (func func_symb.pair) t₁) t₂
--def successorset (t: term σ) : term σ :=  fapp (func func_symb.succ) t

notation `⌀`  := emptyset -- this is not ∅; type ⌀ using \diameter
notation `ω`  := omegaset
prefix ⋃      := unionset
prefix 𝒫      := powerset
--prefix S:max := successorset
notation ⦃ a ` , ` b ⦄ := pairset a b  -- type ⦃ and ⦄ using \{{ and \}}
notation ⦃ a ⦄ := pairset a a

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

-- Meta predicates and functions
-- def subset (t₁ t₂: term σ): formula σ := papp (papp (pred_symb pred_symb.subset) t₁) t₂
/-- Definition of the subset predicate.-/
@[simp] def subset (t₁ t₂: term σ): formula σ := ∀'(#0 ∈' (t₁ ↑ 1 ＠ 0) →' #0 ∈' (t₂ ↑ 1 ＠ 0))
infix ` ⊆' `:100 := subset

/-- Definition of the successor set.-/
@[simp] def successor_set (t: term σ) : term σ := ⋃⦃ t , ⦃ t ⦄ ⦄
prefix `S`:max := successor_set

/-- Definition of inductive sets.-/
@[simp] def inductive_def (t : term σ) :=
  ⌀ ∈' t ∧' ∀' (#0 ∈' (t ↑ 1 ＠ 0) →' S #0 ∈' (t ↑ 1 ＠ 0))
postfix ` is_inductive`:max := inductive_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 izf_signature

-- reducing terms helps with evaluating lifts and substitutions
-- however, pred_symb and func_symb will make more difficult:
-- #reduce (⌀ ∈' ω  ∧' ⦃ ⌀, S⦃ #3 ⦄ ⦄ ∈' 𝒫#1) ↑ 1 ＠ 1
/-
((pred pred_symb.elem).papp (func func_symb.empty)).papp (func func_symb.omega) ∧'
  ((pred pred_symb.elem).papp
     (((func func_symb.pair).fapp (func func_symb.empty)).fapp
        ((func func_symb.union).fapp
           (((func func_symb.pair).fapp (((func func_symb.pair).fapp #4).fapp #4)).fapp
              (((func func_symb.pair).fapp (((func func_symb.pair).fapp #4).fapp #4)).fapp
                 (((func func_symb.pair).fapp #4).fapp #4)))))).papp
    ((func func_symb.power).fapp #2)
-/

-- this seems helps pretty printing reduced terms and formulas and makes them much easier to read
-- notation `'⌀` := func func_symb.empty
-- notation `'ω` := func func_symb.omega
-- notation `'⋃` t :=  fapp (func func_symb.union) t
-- notation `'𝒫` t := fapp (func func_symb.power) t
-- --notation `'S` t := fapp (func func_symb.succ) t
-- notation `'{ ` a ` , `b` }` := fapp (fapp (func func_symb.pair) a) b
-- notation s ` '∈ `:100 t := papp (papp (pred pred_symb.elem) s) t
-- notation s ` '⊆ `:100 t := papp (papp (pred pred_symb.subset) s) t

-- after
-- #reduce (⌀ ∈' ω  ∧' ⦃ ⌀, S⦃ #3 ⦄ ⦄∈' 𝒫#1) ↑ 1 ＠ 1
/-
  ('⌀ '∈ 'ω) ∧' '{ '⌀ , '⋃'{ '{ #4 , #4 } , '{ '{ #4 , #4 } , '{ #4 , #4 } } } } '∈ '𝒫#2
-/
-- much better

section izf_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

namespace collection

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

lemma closed  {φ} {k} (H: formula.closed (k+3) φ) : formula.closed k (free_formula φ) :=
begin
  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,
    begin rw ←(lift_lift φ 1 1 h₁), congr, exact H, end,
  have H₂ : (φ ↑ 1 ＠ 1) ↑ 1 ＠ (k + 4) = φ ↑ 1 ＠ 1,
    begin rw ←(lift_lift φ 1 1 h₂), congr, exact H, end,
  have H₃ : (φ ↑ 1 ＠ 2) ↑ 1 ＠ (k + 4) = φ ↑ 1 ＠ 2,
    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 collection -/
def formula (φ : fol.formula σ) {k : ℕ} (H: formula.closed (k+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

/- 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 collection 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 collection

namespace set_induction
/-- Defintion of the axiom scheme of set induction with free variables. -/
@[simp] def free_formula (φ: formula σ) :=
  (∀'(∀'(#0 ∈' #1 →' (φ ↑ 1 ＠ 1)) →' φ) →' (∀'φ))

lemma closed  {φ} {n} (φ_h: closed (n+1) φ) : closed n (free_formula φ) :=
begin
  have : φ ↑ 1 ＠ 1 ↑ 1 ＠ (n + 1 + 1) = φ ↑ 1 ＠ 1 :=
  begin rw ←(lift_lift φ 1 1 (nat.succ_pos n)), congr, exact φ_h, end,
  rw closed at φ_h,
  simp*,
end

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

lemma formula_is_sentence (φ : fol.formula σ) {n : ℕ} (φ_h: fol.formula.closed (n+1) φ) :
  (formula φ φ_h) is_sentence := begin exact closure_is_sentence (closed φ_h) end

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

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

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

end set_induction

/- ∀b ∀a (∀x (x ∈ a ↔ x ∈ b) → a = b) -/
@[simp] def extensionality : formula σ := ∀' ∀' ((∀' (#0 ∈' #1 ↔' #0 ∈' #2)) →' (#0 =' #1))
/- ∀x (x ∈ ⌀ ↔ x ≠ x) -/
@[simp] def emptyset_ax    : formula σ := ∀' (#0 ∈' ⌀ ↔' ¬'(#0 =' #0))
/- ∀b ∀a ∀x (x ∈{a,b} ↔ x = a ∨ x = b) -/
@[simp] def pairset_ax     : formula σ := ∀' ∀' ∀' (#0 ∈' ⦃ #1 , #2 ⦄ ↔' (#0 =' #1 ∨' #0 =' #2))
/- ∀F ∀x (x ∈ ⋃F ↔ ∃y (x ∈ y ∧ y ∈ x))  -/
@[simp] def unionset_ax    : formula σ := ∀' ∀' (#0 ∈' ⋃#1 ↔' ∃'(#1 ∈' #0 ∧' #0 ∈' #2))
/- ∀y ∀x (x ∈ 𝒫(y) → x ⊆ y) -/
@[simp] def powerset_ax    : formula σ := ∀' ∀' (#0 ∈' 𝒫#1 ↔' #0 ⊆' #1)
/- ∀x (x ∈ ω ↔ ∀w (w is inductive → x ∈ w)) -/
@[simp] def omega_ax       : formula σ := ∀' (#0 ∈' ω ↔' ∀'((#0 is_inductive) →' #1 ∈' #0))
/- ∀xₙ ... ∀x₁ ∀A (∀x (x ∈ A → φ(x)) → φ(A)) → ∀A φ(A) -/
@[simp] def set_induction_ax  (φ : formula σ) {n : ℕ} (φ_h: closed (n+1) φ) : formula σ
  := set_induction.formula φ φ_h
/-- ∀xₙ ... ∀x₁ ∀A ∃B ∀x (x ∈ B ↔ x ∈ A ∧ φ ↑ 1 ＠ 1) -/
@[simp] def separation_ax  (φ : formula σ) {n: ℕ} (φ_h: closed (n+2) φ) : formula σ
  := separation.formula φ φ_h
/-- ∀xₙ ... ∀x₁ ∀A (∀x(x ∈ A → ∃y φ) → ∃B ∀x (x ∈ A →  ∃y (y ∈ B ∧ φ) -/
@[simp] def collection_ax (φ : formula σ) {n : ℕ} (φ_h: closed (n+3) φ) : formula σ
  := collection.formula φ φ_h

-- optional: definition of the subset predicate
-- @[simp] def subset_def   : formula σ := ∀' ∀' (#0 ⊆' #1  ↔' ∀' (#0 ∈' #1 →' #0 ∈' #2))

/-
 The following lemmas provide a convenient way to make explicit which axioms are used inside our proofs.
-/
lemma extensionality_mem {Γ: set $ formula σ}{φ}(h: φ = extensionality)(H: extensionality ∈ Γ) : φ ∈ Γ :=
begin subst h, exact H end
lemma emptyset_ax_mem {Γ: set $ formula σ} {φ} (h: φ = emptyset_ax) (H: emptyset_ax ∈ Γ)  : φ ∈ Γ :=
begin subst h, exact H end
lemma pairset_ax_mem {Γ: set $ formula σ} {φ} (h: φ = pairset_ax) (H: pairset_ax ∈ Γ)  : φ ∈ Γ :=
begin subst h, exact H end
lemma unionset_ax_mem {Γ: set $ formula σ} {φ} (h: φ = unionset_ax) (H: unionset_ax ∈ Γ)  : φ ∈ Γ :=
begin subst h, exact H end
lemma powerset_ax_mem {Γ: set $ formula σ} {φ} (H: powerset_ax ∈ Γ) (h: φ = powerset_ax) : φ ∈ Γ :=
begin subst h, exact H end
lemma omega_ax_mem {Γ: set $ formula σ} {φ} (h: φ = omega_ax) (H: omega_ax ∈ Γ) : φ ∈ Γ :=
begin subst h, exact H end

/-- The set of axioms for IZF. -/
def izf_ax : set $ formula σ := { extensionality, emptyset_ax, pairset_ax,
                                  unionset_ax, powerset_ax, omega_ax }
                                  ∪ set_induction.scheme
                                  ∪ separation.scheme
                                  ∪ collection.scheme

lemma izf_ax_set_of_sentences : ∀ φ ∈ izf_ax, φ is_sentence :=
begin
  intros φ h,
  repeat {cases h,};
  try {unfold sentence closed, refl, },
  all_goals { cases h_h with k H,
              cases H with ϕ_closed,
              subst H_h },
  exact set_induction.formula_is_sentence _ ϕ_closed,
  exact separation.formula_is_sentence _ ϕ_closed,
  exact collection.formula_is_sentence _ ϕ_closed,
end

lemma lift_izf_ax {m i : ℕ}: (λ (ϕ: formula σ) , ϕ ↑ m ＠ i) '' izf_ax = izf_ax
  := lift_set_of_sentences_id izf_ax_set_of_sentences

end izf_axioms

section izf_proofs

/--
  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

/--
  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 showing that `{a} := {a,a}` satisfies the defining property of the singleton set,
  derived from the pairset axiom.

  Informally: `{pairset_ax} ⊢ ∀ a : {a} = { x | x = a }`.
-/
def singleton_def: {pairset_ax} ⊢ ∀' ∀' (#0 ∈' ⦃ #1 ⦄ ↔' #0 =' #1) :=
begin
  apply allI, -- a
  apply allI, -- x
  apply andI,
  { -- a x ⊢ x ∈ {a} → x = a
    apply impI, -- assume `x ∈ {a}`
    apply orE (#0 =' #1) (#0 =' #1),
    { -- a x ⊢ x = a ∨ x = a
      apply impE_insert,
      apply iffE_r,
      apply allE_var0,
      apply allE' _ #1,
      apply allE' _ #1,
      apply hypI,
      -- meta
      apply pairset_ax_mem (rfl),
      all_goals {simp [set.image_singleton] } },
    { -- assume x = a
      -- a x ⊢  x = a
      apply hypI1 },
    { -- assume x = a
      -- a x ⊢  x = a
      apply hypI1 },
  },
  { -- a x ⊢ x = a → x ∈ {a}
    apply impI, -- assume `x = a`
    apply impE (#0 =' #1 ∨' #0 =' #1),
    { -- a x ⊢ x = a ∨ x = a
      apply orI₁,
      apply hypI1, },
    { -- a x ⊢ (x = a ∨ x = a) → x ∈ {a}
      apply iffE_l,
      apply allE_var0,
      apply allE' _ #1,
      apply allE' _ #1,
      apply hypI,
      -- meta
      apply pairset_ax_mem (rfl),
      all_goals {simp [set.image_singleton] } } }
end

/--
  Informally: `Γ ⊢ φ` provided `φ = ∀ a : { a } = { x | x = a }`
  and `pairset_ax ∈ Γ`.
-/
def singleton_def' {Γ} {φ : formula σ} (h₁: φ = ∀' ∀' (#0 ∈' ⦃ #1 ⦄ ↔' #0 =' #1)) (h₂ : pairset_ax ∈ Γ) :
  Γ ⊢ φ  :=
begin
  subst h₁,
  apply weak_singleton pairset_ax,
  apply singleton_def,
  assumption,
end

/--
  A formal proof showing that `a ∪ b := ⋃{a,b}` satisfies the defining property of the binary union,
  derived from the pairset and unionset axioms.

  Informally: `{pairset_ax, unionset_ax} ⊢ ∀b ∀a : a ∪ b = { x | x ∈ a ∨ x ∈ b }`.
-/
def binary_union_def : {pairset_ax, unionset_ax} ⊢ ∀' ∀' ∀' (#0 ∈' ⋃ ⦃ #1, #2 ⦄ ↔' #0 ∈' #1 ∨' #0 ∈' #2) :=
begin
  apply allI, -- b
  apply allI, -- a
  apply allI, -- x
  apply andI,
  { -- b a x ⊢ x ∈ a ∪ b → x ∈ a ∨ x ∈ b
    apply impI,  -- assume `x ∈ a ∪ b`
    apply exE (#1 ∈' #0 ∧' #0 ∈' ⦃#2 , #3⦄), -- y with `x ∈ y ∧ y ∈ {a,b}`
    { -- b a x ⊢ ∃y (x ∈ y ∧ y ∈ {a,b})
      apply impE_insert,
      apply iffE_r,
      apply allE' _ #0,
      apply allE' _ ⦃#1 , #2⦄,
      apply hypI,
      -- meta
      apply unionset_ax_mem (rfl),
      all_goals { try { simp[set.image_insert_eq], }, },
      split; refl },
    { -- b a x y ⊢ x ∈ a ∨ x ∈ b
      apply impE (#0 =' #2 ∨' #0 =' #3),
      { -- b a x y ⊢ y = a ∨ y = b
        apply impE (#0 ∈'  ⦃#2 , #3⦄),
        { -- b a x y ⊢ y ∈ {a,b}
          apply andE₂,
          apply hypI1 },
        { -- b a x y ⊢ y ∈ {a,b} →  y = a ∨ y = b
          apply iffE_r ,
          apply allE' _ #0,
          apply allE' _ #2,
          apply allE' _ #3,
          apply hypI,
          -- meta
          apply pairset_ax_mem (rfl),
          all_goals { try { simp[set.image_insert_eq] } },
          split; refl } },
      { -- b a x y ⊢ y = a ∨ y = b → x ∈ a ∨ x ∈ b
        apply impI, -- assume `y = a ∨ y = b`
        apply orE (#0 =' #2) (#0 =' #3),
        { -- b a x y ⊢ y = a ∨ y = b
          apply hypI1, },
        { -- assume `y = a`
          -- b a x y ⊢ x ∈ a ∨ x ∈ b
          apply orI₁,
          apply eqE' #0 #2 (#2 ∈' #0),
          { -- b a x y ⊢ y = a
            apply hypI1, },
          { -- b a x y ⊢ x ∈ y
            apply andE₁,
            apply hypI,
            simp[set.image_insert_eq] },
          { refl } },
        { -- assume `y = b`
          -- b a x y ⊢ x ∈ a ∨ x ∈ b
          apply orI₂,
          apply eqE' #0 #3 (#2 ∈' #0),
          { -- b a x y ⊢ y = b
            apply hypI1, },
          { -- b a x y ⊢ x ∈ y
            apply andE₁,
            apply hypI,
            simp[set.image_insert_eq] },
          { refl } } } } },
  { -- b a x ⊢ (x ∈ a ∨ x ∈ b) → x ∈ a ∪ b
    apply impI, -- assume `(x ∈ a) ∨ (x ∈ b)`
    apply orE (#0 ∈' #1)  (#0 ∈' #2),
    { -- b a x ⊢ (x ∈ a) ∨ (x ∈ b)
      apply hypI1 },
    { -- assume `x ∈ a`
      -- b a x ⊢ x ∈ a ∪ b
      apply impE (∃'(#1 ∈' #0 ∧' #0 ∈'  ⦃#2 , #3⦄)),
      { -- b a x ⊢ ∃y (x ∈ y ∧ y ∈ {a,b})
        apply exI #1,
        apply andI,
        { -- b a x ⊢ x ∈ a
          apply hypI1, },
        { -- b a x ⊢ a ∈ {a,b}
          apply impE (#1 =' #1 ∨' #1 =' #2),
          { -- b a x ⊢ (a = a ∨ a = b)
            apply orI₁,
            apply eqI, },
          { -- b a x ⊢ (a = a ∨ a = b) → a ∈ {a,b}
            apply iffE_l,
            apply allE' _ #1,
            apply allE' _ #1,
            apply allE' _ #2,
            apply hypI,
            apply pairset_ax_mem (rfl),
            all_goals { try { simp[set.image_insert_eq], }, },
            split; refl } } },
      { -- b a x ⊢ ∃y (x ∈ y ∧ y ∈ {a,b}) → x ∈ a ∪ b
        apply iffE_l ,
        apply allE_var0,
        apply allE' _ ⦃ #1 , #2 ⦄,
        apply hypI,
        apply unionset_ax_mem (rfl),
        all_goals{ simp[set.image_insert_eq] },
        refl } },
    { -- assume `x ∈ b`
      -- b a x ⊢ x ∈ a ∪ b
      apply impE (∃'(#1 ∈' #0 ∧' #0 ∈' ⦃#2 , #3⦄)),
      { -- b a x ⊢ ∃y (x ∈ y ∧ y ∈ {a,b})
        apply exI #2,
        apply andI,
        { -- b a x ⊢ x ∈ b
          apply hypI1, },
        { -- b a x ⊢ b ∈ {a,b}
          apply impE (#2 =' #1 ∨' #2 =' #2),
          { -- b a x ⊢ (b = a ∨ b = b)
            apply orI₂,
            apply eqI, },
          { -- b a x ⊢ (b = a ∨ b = b) → a ∈ {a,b}
            apply andE₂ _,
            apply allE' _ #2,
            apply allE' _ #1,
            apply allE' _ #2,
            apply hypI,
            apply pairset_ax_mem (rfl),
            all_goals { try { simp[set.image_insert_eq], }, },
            split; refl } } },
      { -- b a x ⊢ ∃y (x ∈ y ∧ y ∈ {a,b}) → x ∈ a ∪ b
        apply iffE_l ,
        apply allE_var0,
        apply allE' _ ⦃ #1 , #2 ⦄,
        apply hypI,
        apply unionset_ax_mem (rfl),
        all_goals { simp[set.image_insert_eq] },
        refl } } }
end

/--
  Informally: `Γ ⊢ φ` provided `φ =  ∀ b ∀ a : a ∪ b = { x | x ∈ a ∨ x ∈ b }`
  and `pairset_ax, unionset_ax ∈ Γ`.
-/
def binary_union_def' {Γ} {φ : formula σ} (h₁: φ = ∀' ∀' ∀'(#0 ∈' ⋃ ⦃ #1, #2 ⦄ ↔' #0 ∈' #1 ∨' #0 ∈' #2))
  (h₂: pairset_ax ∈ Γ) (h₃ : unionset_ax ∈ Γ) : Γ  ⊢ φ :=
begin
  subst h₁,
  apply weak {pairset_ax, unionset_ax},
  apply binary_union_def,
  intros x h,
  cases h,
  { subst h,
    exact h₂ },
  { rw set.mem_singleton_iff at h,
    subst h,
    exact h₃ }
end

/--
  A formal proof showing that `S(a) := a ∪ {a}` satisfies the defining property of the successor set,
  derived from the pairset and unionset axioms.

  Informally: `{pairset_ax, unionset_ax} ⊢  ∀a : S(a) = { x | x ∈ a ∨ x = a }`.
-/
def successor_def : {pairset_ax, unionset_ax} ⊢ ∀' ∀' (#0 ∈' S#1 ↔' #0 ∈' #1 ∨' #0 =' #1) :=
begin
  apply allI, -- a
  apply allI, -- x
  apply andI,
  { -- a x ⊢ x ∈ S(a) → x ∈ a ∨ x = a
    apply impI, -- assume `x ∈ S(a)`
    apply impE (#0 ∈' #1 ∨' #0 ∈' ⦃ #1 ⦄),
    { -- a x ⊢ x ∈ a ∨ x ∈ {a}
      apply impE (#0 ∈' S#1),
      { -- a x ⊢ x ∈ S(a)
        apply hypI1, },
      { -- a x ⊢ x ∈ S(a) → x ∈ a ∨ x ∈ {a}
        apply iffE_r,
        apply allE_var0,
        apply allE' _ #1,
        apply allE' _ ⦃ #1 ⦄,
        apply binary_union_def' (rfl),
        all_goals{ simp[set.image_insert_eq] } } },
    { -- a x ⊢ x ∈ a ∨ x ∈ {a} → x ∈ a ∨ x = a
      apply impI, -- assume `x ∈ a ∨ x ∈ {a}`
      apply orE (#0 ∈' #1) (#0 ∈' ⦃ #1 ⦄),
      { -- a x ⊢ x ∈ a ∨ x ∈ {a}
        apply hypI1, },
      { -- assume `x ∈ a`
        -- a x ⊢ x ∈ a ∨ x = a
        apply orI₁,
        apply hypI1 },
      { -- assume `x ∈ {a}`
        -- a x ⊢ x ∈ a ∨ x = a
        apply orI₂,
        apply impE_insert,
        apply iffE_r,
        apply allE_var0,
        apply allE' _ #1,
        apply singleton_def' (rfl),
        all_goals{ simp[set.image_insert_eq] } } } },
  { -- a x ⊢ x ∈ a ∨ x = a → x ∈ S(a)
    apply impI, -- assume `x ∈ a ∨ x = a`
    apply orE (#0 ∈' #1) (#0 =' #1),
    { -- a x ⊢ x ∈ a ∨ x = a
      apply hypI1, },
    { -- assume `x ∈ a`
      -- a x ⊢ x ∈ S(a)
      apply impE (#0 ∈' #1 ∨' #0 ∈' ⦃ #1 ⦄),
      { -- a x ⊢ x ∈ a ∨ x ∈ {a}
        apply orI₁,
        apply hypI1,},
      { -- a x ⊢ x ∈ a ∨ x ∈ {a} → x ∈ S(a)
        apply iffE_l,
        apply allE' _ #0,
        apply allE' _ #1,
        apply allE' _ ⦃ #1 ⦄,
        apply binary_union_def' (rfl),
        all_goals{ simp[set.image_insert_eq] } } },
    { -- assume `x = a`
      -- a x ⊢ x ∈ S(a)
      apply impE (#0 ∈' #1 ∨' #0 ∈' ⦃ #1 ⦄),
      { -- a x ⊢ x ∈ a ∨ x ∈ {a}
        apply orI₂,
        apply impE_insert,
        apply iffE_l,
        apply allE' _ #0,
        apply allE' _ #1,
        apply singleton_def' (rfl),
        all_goals{ simp[set.image_insert_eq] } },
      { -- a x ⊢ x ∈ a ∨ x ∈ {a} → x ∈ S(a)
        apply iffE_l,
        apply allE' _ #0,
        apply allE' _ #1,
        apply allE' _ ⦃ #1 ⦄,
        apply binary_union_def' (rfl),
        all_goals{ simp[set.image_insert_eq] } } } }
end

/-- Formal proof that ω is unique. -/
def omega_unique
  : ∅ ⊢ ∃! (#0 =' ω) :=
begin
  apply andI,
  { -- ∃ case is trivial
    apply exI ω,
    apply eqI },
  { -- uniqueness
    apply allsI 2,
    apply impI,
    apply eqE' ω #1 (#1 =' #0),
    { apply eqI_symm,
      apply andE₂,
      apply hypI1, },
    { apply andE₁,
      apply hypI1,},
    { refl, }, },
end

/--
  A formal proof that `ω` is a subset of all inductive sets,
  derived from the omega axiom.

  Informally: `{omega_ax} ⊢ ∀ w : (w is inductive) →  ω ⊆ w`.
-/
def omega_subset_all_inductive:
  {omega_ax} ⊢  ∀' (#0 is_inductive →' (ω ⊆' #0))   :=
begin
  apply allI, -- w
  apply impI, -- assume `w is inductive`
  apply allI, -- x
  apply impI, -- assume `x ∈ ω`
  apply impE (#1 is_inductive),
  { -- w x ⊢ w is inductive
    apply hypI,
    simp [set.image_insert_eq] },
  { -- w x ⊢ (w is inductive) → x ∈ w
    apply allE' (#0 is_inductive →' #1 ∈' (#0)) #1,
    apply iffE₂ (#0 ∈' ω),
    { -- w x ⊢ x ∈ ω
      apply hypI1 },
    { -- w x ⊢ x ∈ ω ↔ ∀ w ((w is inductive) → x ∈ w)
      apply allE_var0,
      apply hypI,
      apply omega_ax_mem,
      all_goals {simp[set.image_insert_eq] } },
    { refl } }
end

/--
  Informally: `Γ ⊢ ∀ w : (w is inductive) →  ω ⊆ w`, provided `omega_ax ∈ Γ`.
-/
def omega_subset_all_inductive' {Γ} (h: omega_ax ∈ Γ) :
  Γ ⊢  ∀' (#0 is_inductive →' (ω ⊆' #0))   :=
begin
  apply weak {omega_ax},
  exact omega_subset_all_inductive,
  exact set.singleton_subset_iff.mpr h,
end

/--
  A formal proof of `ω is inductive`, derived from the omega axiom.
-/
def omega_inductive : {omega_ax} ⊢ ω is_inductive :=
begin
  apply andI,
  { -- ⊢ ⌀ ∈ ω
    apply impE ∀'(#0 is_inductive →' ⌀ ∈' #0),
    { -- ⊢ ∀ w (w is inductive → ⌀ ∈ w)
      apply allI,
      apply impI,
      apply andE₁,
      apply hypI,
      simp },
    { -- ⊢ ∀ w (w is inductive → ⌀ ∈ w) → ⌀ ∈ ω
      apply iffE_l,
      apply allE' _ ⌀,
      apply hypI,
      apply omega_ax_mem (rfl),
      all_goals { simp } } },
  { -- ⊢ ∀ x (x ∈ ω → S(x) ∈ ω)
    apply allI, -- x
    apply impI, -- assume `x ∈ ω`
    apply impE (∀'(#0 is_inductive →' S#1 ∈' #0)),
    { -- x  ⊢ ∀ w ((w is inductive) → S(x) ∈ w)
      apply allI, -- w
      apply impI, -- assume `w is inductive`
      apply impE (#1 ∈' #0),
      { -- x w ⊢ x ∈ w
        apply impE (#1 ∈' ω),
        { -- x w ⊢ x ∈ ω
          apply hypI,
          simp[set.image_insert_eq] },
        { -- x w ⊢ x ∈ ω → x ∈ w
          apply allE' (#0 ∈' ω →' #0 ∈' #1) #1,
          apply impE_insert,
          apply allE_var0,
          apply omega_subset_all_inductive',
          { simp [set.image_insert_eq] },
          { refl } } },
      { -- (x ∈ ω) (w is inductive) ⊢  x ∈ w → S(x) ∈ w
        apply allE' (#0 ∈' #1 →' S #0 ∈' #1) #1 _ (rfl),
        apply andE₂ _ ,
        apply hypI1 } },
    { -- x ⊢ ∀ w ((w is inductive) → S(x) ∈ w) → S(x) ∈ ω
      apply iffE_l,
      apply allE' _ S#0,
      apply hypI,
      { simp [set.image_insert_eq] },
      { simp, } } }
end

/--
  Informally:  `Γ ⊢ ω is inductive`, provided `omega_ax ∈ Γ`.
-/
def omega_inductive' {Γ} (h: omega_ax ∈ Γ) : Γ  ⊢ ω is_inductive :=
begin
  apply weak_singleton omega_ax,
  exact omega_inductive,
  exact h,
end

/--
  A formal proof that `ω` is the smallest inductive set derived from the axioms of IZF.

  Informally : `izf_ax ⊢ (ω is inductive) ∧ ∀ w ((w is inductive) → ω ⊆ w)`
-/
def omega_smallest_inductive : izf_ax ⊢
  (ω is_inductive) ∧' ∀'((#0 is_inductive) →' ω ⊆' #0) :=
begin
  apply andI,
  { apply omega_inductive', simp[izf_ax] },
  { apply omega_subset_all_inductive', simp[izf_ax], }
end

end izf_proofs

/--  Main Theorem: IZF proves that ω is the smallest inductive set. -/
theorem omega_smallest_inductive_provable:
  ((ω is_inductive) ∧' ∀'((#0 is_inductive) →' ω ⊆' #0))
  is_provable_within izf_ax :=
begin use omega_smallest_inductive end

end izf


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import data.set.finite group_theory.coset
open set function

variables {α : Type*} {s : set α} {a a₁ a₂ b c: α}

-- TODO this lemma isn't used anywhere in this file, and should be moved elsewhere.
namespace finset
open finset

lemma mem_range_iff_mem_finset_range_of_mod_eq [decidable_eq α] {f : ℤ → α} {a : α} {n : ℕ}
  (hn : 0 < n) (h : ∀i, f (i % n) = f i) :
  a ∈ set.range f ↔ a ∈ (finset.range n).image (λi, f i) :=
suffices (∃i, f (i % n) = a) ↔ ∃i, i < n ∧ f ↑i = a, by simpa [h],
have hn' : 0 < (n : ℤ), from int.coe_nat_lt.mpr hn,
iff.intro
  (assume ⟨i, hi⟩,
    have 0 ≤ i % ↑n, from int.mod_nonneg _ (ne_of_gt hn'),
    ⟨int.to_nat (i % n),
      by rw [←int.coe_nat_lt, int.to_nat_of_nonneg this]; exact ⟨int.mod_lt_of_pos i hn', hi⟩⟩)
  (assume ⟨i, hi, ha⟩,
    ⟨i, by rw [int.mod_eq_of_lt (int.coe_zero_le _) (int.coe_nat_lt_coe_nat_of_lt hi), ha]⟩)

end finset

section order_of
variables [group α] [fintype α] [decidable_eq α]

lemma exists_gpow_eq_one (a : α) : ∃i≠0, a ^ (i:ℤ) = 1 :=
have ¬ injective (λi, a ^ i),
  from not_injective_int_fintype,
let ⟨i, j, a_eq, ne⟩ := show ∃(i j : ℤ), a ^ i = a ^ j ∧ i ≠ j,
  by rw [injective] at this; simpa [classical.not_forall] in
have a ^ (i - j) = 1,
  by simp [gpow_add, gpow_neg, a_eq],
⟨i - j, sub_ne_zero.mpr ne, this⟩

lemma exists_pow_eq_one (a : α) : ∃i > 0, a ^ i = 1 :=
let ⟨i, hi, eq⟩ := exists_gpow_eq_one a in
begin
  cases i,
  { exact ⟨i, nat.pos_of_ne_zero (by simp [int.of_nat_eq_coe, *] at *), eq⟩ },
  { exact ⟨i + 1, dec_trivial, inv_eq_one.1 eq⟩ }
end

/-- `order_of a` is the order of the element `a`, i.e. the `n ≥ 1`, s.t. `a ^ n = 1` -/
def order_of (a : α) : ℕ := nat.find (exists_pow_eq_one a)

lemma pow_order_of_eq_one (a : α) : a ^ order_of a = 1 :=
let ⟨h₁, h₂⟩ := nat.find_spec (exists_pow_eq_one a) in h₂

lemma order_of_pos (a : α) : order_of a > 0 :=
let ⟨h₁, h₂⟩ := nat.find_spec (exists_pow_eq_one a) in h₁

private lemma pow_injective_aux {n m : ℕ} (a : α) (h : n ≤ m)
  (hn : n < order_of a) (hm : m < order_of a) (eq : a ^ n = a ^ m) : n = m :=
decidable.by_contradiction $ assume ne : n ≠ m,
  have h₁ : m - n > 0, from nat.pos_of_ne_zero (by simp [nat.sub_eq_iff_eq_add h, ne.symm]),
  have h₂ : a ^ (m - n) = 1, by simp [pow_sub _ h, eq],
  have le : order_of a ≤ m - n, from nat.find_min' (exists_pow_eq_one a) ⟨h₁, h₂⟩,
  have lt : m - n < order_of a,
    from (nat.sub_lt_left_iff_lt_add h).mpr $ nat.lt_add_left _ _ _ hm,
  lt_irrefl _ (lt_of_le_of_lt le lt)

lemma pow_injective_of_lt_order_of {n m : ℕ} (a : α)
  (hn : n < order_of a) (hm : m < order_of a) (eq : a ^ n = a ^ m) : n = m :=
(le_total n m).elim
  (assume h, pow_injective_aux a h hn hm eq)
  (assume h, (pow_injective_aux a h hm hn eq.symm).symm)

lemma order_of_le_card_univ : order_of a ≤ fintype.card α :=
finset.card_le_of_inj_on ((^) a)
  (assume n _, fintype.complete _)
  (assume i j, pow_injective_of_lt_order_of a)

lemma pow_eq_mod_order_of {n : ℕ} : a ^ n = a ^ (n % order_of a) :=
calc a ^ n = a ^ (n % order_of a + order_of a * (n / order_of a)) :
    by rw [nat.mod_add_div]
  ... = a ^ (n % order_of a) :
    by simp [pow_add, pow_mul, pow_order_of_eq_one]

lemma gpow_eq_mod_order_of {i : ℤ} : a ^ i = a ^ (i % order_of a) :=
calc a ^ i = a ^ (i % order_of a + order_of a * (i / order_of a)) :
    by rw [int.mod_add_div]
  ... = a ^ (i % order_of a) :
    by simp [gpow_add, gpow_mul, pow_order_of_eq_one]

lemma mem_gpowers_iff_mem_range_order_of {a a' : α} :
  a' ∈ gpowers a ↔ a' ∈ (finset.range (order_of a)).image ((^) a : ℕ → α) :=
finset.mem_range_iff_mem_finset_range_of_mod_eq
  (order_of_pos a)
  (assume i, gpow_eq_mod_order_of.symm)

instance decidable_gpowers : decidable_pred (gpowers a) :=
assume a', decidable_of_iff'
  (a' ∈ (finset.range (order_of a)).image ((^) a))
  mem_gpowers_iff_mem_range_order_of

section
local attribute [instance] set_fintype

lemma order_eq_card_gpowers : order_of a = fintype.card (gpowers a) :=
begin
  refine (finset.card_eq_of_bijective _ _ _ _).symm,
  { exact λn hn, ⟨gpow a n, ⟨n, rfl⟩⟩ },
  { exact assume ⟨_, i, rfl⟩ _,
    have pos: (0:int) < order_of a,
      from int.coe_nat_lt.mpr $ order_of_pos a,
    have 0 ≤ i % (order_of a),
      from int.mod_nonneg _ $ ne_of_gt pos,
    ⟨int.to_nat (i % order_of a),
      by rw [← int.coe_nat_lt, int.to_nat_of_nonneg this];
        exact ⟨int.mod_lt_of_pos _ pos, subtype.eq gpow_eq_mod_order_of.symm⟩⟩ },
  { intros, exact finset.mem_univ _ },
  { exact assume i j hi hj eq, pow_injective_of_lt_order_of a hi hj $ by simpa using eq }
end

section classical
local attribute [instance] classical.prop_decidable
open quotient_group

/- TODO: use cardinal theory, introduce `card : set α → ℕ`, or setup decidability for cosets -/
lemma order_of_dvd_card_univ : order_of a ∣ fintype.card α :=
have ft_prod : fintype (quotient (gpowers a) × (gpowers a)),
  from fintype.of_equiv α (gpowers.is_subgroup a).group_equiv_quotient_times_subgroup,
have ft_s : fintype (gpowers a),
  from @fintype.fintype_prod_right _ _ _ ft_prod _,
have ft_cosets : fintype (quotient (gpowers a)),
  from @fintype.fintype_prod_left _ _ _ ft_prod ⟨⟨1, is_submonoid.one_mem (gpowers a)⟩⟩,
have ft : fintype (quotient (gpowers a) × (gpowers a)),
  from @prod.fintype _ _ ft_cosets ft_s,
have eq₁ : fintype.card α = @fintype.card _ ft_cosets * @fintype.card _ ft_s,
  from calc fintype.card α = @fintype.card _ ft_prod :
      @fintype.card_congr _ _ _ ft_prod (gpowers.is_subgroup a).group_equiv_quotient_times_subgroup
    ... = @fintype.card _ (@prod.fintype _ _ ft_cosets ft_s) :
      congr_arg (@fintype.card _) $ subsingleton.elim _ _
    ... = @fintype.card _ ft_cosets * @fintype.card _ ft_s :
      @fintype.card_prod _ _ ft_cosets ft_s,
have eq₂ : order_of a = @fintype.card _ ft_s,
  from calc order_of a = _ : order_eq_card_gpowers
    ... = _ : congr_arg (@fintype.card _) $ subsingleton.elim _ _,
dvd.intro (@fintype.card (quotient (gpowers a)) ft_cosets) $
  by rw [eq₁, eq₂, mul_comm]

end classical

end

end order_of