1
Fork 0
solar-conflux/lean/learning/Learning/Integers.lean
2023-10-29 00:07:15 +02:00

398 lines
11 KiB
Plaintext

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