solar-conflux/lean/learning/Learning/Integers.lean

import Learning.Nat

macro "nat_ring_all"  : tactic => `(simp_all [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm, Nat.left_distrib, Nat.right_distrib])
macro "nat_ring"  : tactic => `(simp [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm, Nat.left_distrib, Nat.right_distrib])
macro "quotient_madness" : tactic => `(simp [Quotient.mk', Quotient.mk, Quotient.liftOn₂, Quotient.lift₂, Quotient.lift])

structure RawInt where
  pos : Nat
  neg : Nat
  deriving Repr

private def eqv : (x y: RawInt) → Prop
  | ⟨a, b⟩, ⟨c, d⟩ => a + d = c + b

infix:50 " ~ " => eqv

private theorem eqv.refl (x: RawInt) : x ~ x := rfl
private theorem eqv.symm {x y: RawInt} (xy: x ~ y):  y ~ x := Eq.symm xy
/-
a - b   c - d   e - f
a + d = c + b
c + f = e + d
 => a + f = e + b -- the target

a + d + c + f = c + b + e + d
a + f + e + b -- done
-/
private theorem eqv.trans {x y z: RawInt} (xy: x ~ y) (yz: y ~ z): x ~ z := by
  have summed: _ := Nat.add_equations xy yz
  apply @Nat.add_right_cancel _ (y.pos + y.neg) _
  nat_ring_all

private theorem is_equivalence: Equivalence eqv := 
  { refl := eqv.refl, symm := eqv.symm, trans := eqv.trans }

instance rawIntSetoid: Setoid RawInt where
  r := eqv
  iseqv := is_equivalence

def MyInt: Type := 
  Quotient rawIntSetoid

private theorem eqv.sound: x ~ y → Quotient.mk' x = Quotient.mk' y  := Quot.sound

@[simp]
def MyInt.mk (pos neg: Nat): MyInt := Quotient.mk' ⟨pos, neg⟩

notation "{ " a₁ ", " a₂ " }" => MyInt.mk a₁ a₂

@[simp, inline]
private def MyInt.ofRawInt(raw: RawInt) := MyInt.mk raw.pos raw.neg

@[simp, inline]
private def RawInt.ofNat(nat: Nat): RawInt := ⟨nat, 0⟩

@[simp, inline]
private def MyInt.ofNat(nat: Nat): MyInt := {nat, 0}

private instance rawIntOfNat: OfNat RawInt n where
  ofNat := RawInt.ofNat n

instance myIntOfNat: OfNat MyInt n where
  ofNat := MyInt.ofNat n

namespace MyInt
  private def negateRawInt: RawInt → MyInt
    | ⟨pos, neg⟩ => {neg, pos}

  /- 
  a - b = c - d 
  a + d = c + b

  b + c = d + a
  b - a = d - c
  -/
  private theorem negateRawInt.respects {x y: RawInt} (xy: x ~ y): negateRawInt x = negateRawInt y := by
    apply eqv.sound
    simp_all [eqv, Nat.add_comm] 

  def negate (τ: MyInt): MyInt :=
    Quotient.liftOn τ negateRawInt @negateRawInt.respects

  instance negMyInt: Neg MyInt where
    neg := negate

  private theorem double_neg_elim: ∀x, x = negate (negate x) := by
    intro x
    induction x using Quotient.ind
    rfl

  private def addRawInts: RawInt → RawInt → MyInt
    | ⟨a, b⟩, ⟨c, d⟩ => {a + c, b + d}

  private theorem addRawInts.respects 
    {a b c d: RawInt} 
    (ac: a ~ c)
    (bd: b ~ d): addRawInts a b = addRawInts c d := by
    have summed: _ := Nat.add_equations ac bd
    apply eqv.sound
    simp [eqv] at summed ⊢ 
    nat_ring_all 

  private theorem addRawInts.comm (a b: RawInt): addRawInts a b = addRawInts b a := by
    simp_all [addRawInts, Nat.add_comm]

  def add (τ β: MyInt): MyInt :=
    Quotient.liftOn₂ τ β addRawInts @addRawInts.respects

  private instance hAddRawInts: HAdd RawInt RawInt MyInt where
    hAdd := addRawInts
  instance addMyInts: Add MyInt where
    add := add

  def sub (a b: MyInt): MyInt := a + (-b)

  instance subMyInt: Sub MyInt where
    sub := sub

  @[simp]
  theorem sub.x_minus_x_is_zero (a: MyInt): a - a = 0 := by
    simp_all [HSub.hSub, sub, HAdd.hAdd, add, negate, Neg.neg, MyInt.ofNat] 
    induction a using Quotient.ind
    apply eqv.sound
    simp [eqv]
    apply Nat.add_comm

  theorem add.comm: ∀x y: MyInt, x + y = y + x := by
    intro x y
    simp_all [HAdd.hAdd, add] 
    induction x, y using Quotient.ind₂
    quotient_madness
    apply addRawInts.comm

  theorem add.assoc(x y z: MyInt): x + (y + z) = (x + y) + z := by
    simp_all [HAdd.hAdd, add] 

    induction x, y using Quotient.ind₂
    induction z using Quotient.ind 

    apply eqv.sound
    simp [eqv]
    nat_ring_all

  @[simp]
  theorem add.zero(x: MyInt): x + 0 = x := by
    simp_all [HAdd.hAdd, add]
    induction x using Quotient.ind
    apply eqv.sound
    simp [eqv]

  /-
  (a - b) * (c - d)
  ac - bc - ad + bd
  -/
  private def multiplyRawInts: RawInt → RawInt → MyInt
    | ⟨a, b⟩, ⟨c, d⟩ => {a * c + b * d, b * c + a * d}

  /-
  ac : c.neg + a.pos = a.neg + c.pos
  bd : d.neg + b.pos = b.neg + d.pos
  ⊢ a.neg * b.neg + (a.pos * b.pos + (c.pos * d.neg + c.neg * d.pos)) =
    c.neg * d.neg + (a.pos * b.neg + (a.neg * b.pos + c.pos * d.pos))

  a - b c - d e - f g - h

  f + a = b + e
  h + c = d + g

  bd + ac + eh + fg = fh + ad + bc + eg

  bd + ac + fc + eh + fg + ec = fh + ad + bc + ec + eg + fc
  + cf + ce
  bd + c(a + f) + eh + fg + ec = fh + ad + c(b + e) + eg + fc
  bd + eh + fg + ec = fh + ad + eg + fc
  bd + e(h + c) + fg = f(h + c) + ad + eg
  + bg + ag
  b(d + g) + e(h + c) + fg + ag = f(h + c) + a(d + g) + bg + eg
  (h + c)(b + e) + g(a + f) = (h + c)(f + a) + g(b + e)
  -/
  private theorem multiplyRawInts.respects: ∀
    {x y z w: RawInt} 
    (xz: x ~ z)
    (yw: y ~ w), (multiplyRawInts x y = multiplyRawInts z w)
  | ⟨a, b⟩, ⟨c, d⟩, ⟨e, f⟩, ⟨g, h⟩ => by
    intro xz yw
    apply eqv.sound
    simp_all [eqv] 

    have first: (c + h) * (b + e) + g * (a + f) + c * (a + f) 
      = (c + h) * (f + a) + g * (b + e) + c * (b + e) := by
      simp [Nat.add_comm, xz, yw]

    have second: b * (d + g) + e * (c + h) + c * (a + f) + f * g + a * g
      = f * (c + h) + a * (d + g) + c * (b + e) + b * g + e * g := by
      simp [yw, xz] at first ⊢ 
      conv at first in g * (e + b) => rw [<-xz]
      conv at first => tactic => nat_ring
      nat_ring
      exact first

    conv at second => tactic => nat_ring
    apply @Nat.subtract_to_equation_left _ _
      (a * g + b * g + c * f + c * e)

    nat_ring_all

  def multiply (τ β: MyInt): MyInt :=
    Quotient.liftOn₂ τ β multiplyRawInts @multiplyRawInts.respects

  private instance hMulRawInt: HMul RawInt RawInt MyInt where
    hMul := multiplyRawInts 
  instance mulMyInt: Mul MyInt where
    mul := multiply 

  private theorem multiplyRawInts.comm (a b: RawInt): a * b = b * a := by
    apply eqv.sound
    simp [eqv]
    simp_all [multiplyRawInts, Nat.mul_comm]
    nat_ring_all

  theorem multiply.comm (a b: MyInt): a * b = b * a := by
    simp_all [Mul.mul, multiply] 
    induction a, b using Quotient.ind₂
    quotient_madness
    apply multiplyRawInts.comm

  theorem multiply.assoc(x y z: MyInt): x * (y * z) = (x * y) * z := by
    simp_all [Mul.mul, multiply] 

    induction x, y using Quotient.ind₂
    induction z using Quotient.ind 

    apply eqv.sound
    simp [eqv]
    nat_ring_all

  @[simp]
  theorem multiply.one(x: MyInt): x * 1 = 1 * x := by
    simp_all [Mul.mul, multiply]
    induction x using Quotient.ind
    apply eqv.sound
    simp [eqv]

  @[simp]
  theorem multiply.zero(x: MyInt): x * 0 = 0 := by
    simp_all [Mul.mul, multiply]
    induction x using Quotient.ind
    apply eqv.sound
    simp [eqv]

  theorem left_distrib(x y z: MyInt): x * (y + z) = x * y + x * z := by
    simp_all [Mul.mul, Add.add, add, multiply] 

    induction x, y using Quotient.ind₂
    induction z using Quotient.ind 

    apply eqv.sound
    simp [eqv]
    nat_ring_all

  theorem right_distrib(x y z: MyInt): (x + y) * z = x * z + y * z := by
    simp_all [Mul.mul, Add.add, add, multiply] 

    induction x, y using Quotient.ind₂
    induction z using Quotient.ind 

    apply eqv.sound
    simp [eqv]
    nat_ring_all

  /-
  notes on division?
  t * (c - d) + r = a - b 
  t * c + b + r = a + t * d
  -/
  @[simp]
  def is_even(x: MyInt) := ∃h, h + h = x
  @[simp]
  def is_odd(x: MyInt) := ∃h, h + h + 1 = x

  theorem double_is_even(x: MyInt): is_even (2 * x) := by
    simp
    exists x
    induction x using Quotient.ind
    apply eqv.sound
    simp [eqv, Nat.double.addition_is_multiplication]

  theorem raw_int_induction 
    (P: MyInt → Prop) 
    (pz: P 0) 
    (pn: ∀k, P k ↔ P (k + 1)):
    (x: RawInt) → ∃k, k ~ x ∧ P (MyInt.ofRawInt k)
  | ⟨0, 0⟩ => ⟨0, ⟨rfl, pz⟩⟩
  | ⟨Nat.succ a, 0⟩ => by 
    have ⟨⟨kp, kn⟩, pk⟩ := raw_int_induction P pz pn ⟨a, 0⟩
    exists (⟨kp + 1, kn⟩ : RawInt)
    apply And.intro 
    . simp [eqv, Nat.succ_add]
      rw [<-pk.left]
      simp [Nat.add_zero]
    . apply (@pn {kp, kn}).mp
      exact pk.right
  | ⟨Nat.succ a, Nat.succ b⟩ => by 
    have ⟨k, pk⟩ := raw_int_induction P pz pn ⟨a, b⟩
    exists k
    apply And.intro
    . simp [eqv, Nat.succ_add]
      rw [<-pk.left]
      simp_arith
    . exact pk.right
  | ⟨0, Nat.succ a⟩ => by
    have ⟨⟨kp, kn⟩, pk⟩ := raw_int_induction P pz pn ⟨0, a⟩
    exists (⟨kp, kn + 1⟩ : RawInt)
    apply And.intro 
    . have pkl := pk.left
      simp [eqv, Nat.succ_add, Nat.add_zero] at pkl ⊢ 
      rw [<-pkl]
      simp_arith
    . have recurse := (@pn {kp, kn + 1}).mpr
      have rewriter: {kp, kn + 1} + 1 = {kp, kn} := by
        apply eqv.sound
        simp [eqv]
        simp_arith
      rw [rewriter] at recurse
      exact (recurse pk.right)

  theorem int_induction 
    (P: MyInt → Prop) 
    (zero: P 0) 
    (succ: ∀k, P k ↔ P (k + 1)):
      ∀k, P k := by
      intro k
      induction k using Quotient.ind 
      rename RawInt => kRaw
      have ⟨e, ⟨eIsK, proof⟩⟩ := raw_int_induction P zero succ kRaw
      have eIsKQuot : MyInt.ofRawInt e = MyInt.ofRawInt kRaw := by
        exact (eqv.sound eIsK)
      simp [Quotient.mk'] at eIsKQuot
      rw [<-eIsKQuot]
      exact proof 

  theorem add_left_cancel {a b c: MyInt}: a + b = a + c → b = c := by
    intro hip
    induction b, c using Quotient.ind₂ 
    induction a using Quotient.ind 
    rename RawInt => c
    simp_all [HAdd.hAdd, Add.add, add]
    conv at hip => tactic => quotient_madness
    /- apply eqv.sound  -/
    /- simp [eqv] -/
    /- nat_ring -/
    simp_all [MyInt.addRawInts, Quotient.mk', Quotient.mk]
    sorry

/-     induction a using int_induction with -/
/-     | zero =>  -/
/-       rw [add.comm 0 c, add.comm 0 b] -/
/-       simp_all -/
/-     | succ k =>  -/
/-       apply Iff.intro -/
/-       . intro win  -/
/-         intro previous -/
/-         have p: k + b = k + c := by  -/
/-           rw [add.comm k 1] at previous -/
/-           induction b, c using Quotient.ind₂  -/
/-           induction k using Quotient.ind  -/
/-           rename RawInt => c -/
/-           simp [HAdd.hAdd, Add.add, add] -/
/-           apply eqv.sound  -/
/-           simp [eqv] -/
/-           nat_ring -/
/-  -/
/-           sorry -/
/-         exact (win p) -/
/-       . sorry -/
/-  -/

  theorem odd_and_even_contradict(x: MyInt): ¬(is_odd x ∧ is_even x)
  | ⟨⟨h₁, oddProof⟩, ⟨h₂, evenProof⟩⟩ => by
    have wrong: (1: MyInt) = 0 := by 
      apply @add_left_cancel (h₁ + h₂)
      exact oddProof.trans evenProof.symm
      sorry
    contradiction
  
  theorem odds_not_even(x: MyInt): is_odd x ↔ ¬(is_even x) := by
    apply Iff.intro
    case mp =>
      intro oddProof
      intro evenProof
      apply odd_and_even_contradict x
      exact ⟨oddProof, evenProof⟩
    case mpr =>
      simp [is_even, is_odd]
      sorry

end MyInt