lean: apportion's parts sum to the whole for any number of parts

The ranks of n parts are a permutation of 0..n-1 (being ahead is a strict
total order; pigeonhole by hand, core Lean has no subperm), so exactly
u parts get a unit and one gets the fraction. apportion_sum and
apportion_sum_of_shortfall; the audit shows only the standard axioms.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01GWVo7x3UHw5kwCUaWxiejX

docs/testing.md

@@ -109,7 +109,7 @@ B-14) are the first.
 | End-to-end | SKIP for the core (a library) | MCP stdio tests cover the journeys |
 | Security properties | SKIP for the core (no roles, no secrets) | the first permission concept, or a secret-bearing field |
 | Concurrency stress | SKIP for the core (no shared state); DONE for the store's writer + viewer (found the false "differs") | the first `Arc`, atomic, or lock in the core; the MCP server's HTTP transport shares one store across sessions (next) |
-| Lean: apportion's sum law for any n | OPEN | Kani covers n <= 3, properties n <= 5; needs a permutation lemma |
+| Lean: apportion's sum law for any n | DONE (2026-10-14) | verify/lean/Wanderbooks/Apportion.lean: ranks are a permutation of 0..n-1 (strict total order + pigeonhole, core Lean only), so exactly u parts get a unit and one the fraction; `apportion_sum` and `apportion_sum_of_shortfall`, standard axioms only |
 | ASC paragraphs not yet read | OPEN | ASC 360-10-35-4, 340-10, 230-10-45-10, 606-10-55-37B, 210: needs a FASB basic-view login |
 | GnuCash's own close | OPEN | the oracle books closes as ordinary entries; comparing GnuCash's Close Book needs its Scheme API |
 | Import: spec-blind suite, footing properties, mutation | DONE | sources vendored (Intuit bank CSV and IIF, ECMA-376/Excel numbers, IRS form lines); specs on every module; tests/spec_import.rs (spec-blind, footing and round-trip properties, XLSX read back from its XML, layout and styles); fuzz_import_csv; templates checked against the engine's control accounts; mutation one equivalent left |

verify/lean/Audit.lean

@@ -32,3 +32,6 @@ open Wanderbooks
 #print axioms close_zeroes
 #print axioms close_credits_net_income
 #print axioms statements_add_up
+#print axioms Apportion.ranks_perm
+#print axioms Apportion.apportion_sum
+#print axioms Apportion.apportion_sum_of_shortfall

verify/lean/Wanderbooks.lean

@@ -3,3 +3,4 @@ import Wanderbooks.Entry
 import Wanderbooks.Statements
 import Wanderbooks.Closing
 import Wanderbooks.Ledger
+import Wanderbooks.Apportion

verify/lean/Wanderbooks/Apportion.lean

@@ -0,0 +1,241 @@
+/-!
+# Apportioning: the parts sum to the whole, for any number of parts
+
+Mirrors `crates/ledger-core/src/kernel.rs` `apportion`: each part is
+first rounded down; the shortfall `s = whole - Σ parts` (not negative) is
+`u` whole units plus a fraction `f` (`s = u * unit + f`, `u` below the
+number of parts, else the function refuses). A part's *rank* is how many
+parts are ahead of it: a strictly larger remainder, or an equal one at an
+earlier index. A part of rank below `u` gets one unit; the part of rank 0
+also gets the fraction.
+
+Kani proves INVARIANT 1 for up to three parts. Here it holds for every
+number of parts: the ranks are exactly `0, …, n-1` in some order (a strict
+total order ranks a finite set without gaps or ties), so exactly `u` parts
+get a unit and exactly one gets the fraction.
+-/
+
+namespace Wanderbooks.Apportion
+
+/-- Part `j` is ahead of part `i` (the closure in `kernel::apportion`). -/
+def ahead (r : Nat → Int) (j i : Nat) : Bool :=
+  decide (r j > r i) || (decide (r j = r i) && decide (j < i))
+
+/-- A part's rank among `n` parts: the parts ahead of it. -/
+def rank (r : Nat → Int) (n i : Nat) : Nat :=
+  ((List.range n).filter (fun j => ahead r j i)).length
+
+/-- What part `i` gets added: a unit if its rank is below `u`, and the
+fraction too if its rank is 0. -/
+def add (r : Nat → Int) (n u : Nat) (unit f : Int) (i : Nat) : Int :=
+  (if rank r n i < u then unit else 0) + (if rank r n i = 0 then f else 0)
+
+theorem ahead_irrefl (r : Nat → Int) (i : Nat) : ahead r i i = false := by
+  simp [ahead]
+
+theorem ahead_trans (r : Nat → Int) {a b c : Nat}
+    (h1 : ahead r a b = true) (h2 : ahead r b c = true) : ahead r a c = true := by
+  simp only [ahead, Bool.or_eq_true, Bool.and_eq_true, decide_eq_true_eq] at *
+  omega
+
+theorem ahead_total (r : Nat → Int) {a b : Nat} (h : a ≠ b) :
+    ahead r a b = true ∨ ahead r b a = true := by
+  simp only [ahead, Bool.or_eq_true, Bool.and_eq_true, decide_eq_true_eq]
+  omega
+
+theorem ahead_asymm (r : Nat → Int) {a b : Nat} (h : ahead r a b = true) :
+    ahead r b a = false := by
+  simp only [ahead, Bool.or_eq_true, Bool.and_eq_true, decide_eq_true_eq] at h
+  simp only [ahead, Bool.or_eq_false_iff, Bool.and_eq_false_imp, decide_eq_true_eq,
+    decide_eq_false_iff_not]
+  omega
+
+/-- A filter by a weaker predicate is no longer. -/
+theorem filter_length_le {p q : Nat → Bool} : ∀ (l : List Nat),
+    (∀ x ∈ l, p x = true → q x = true) → (l.filter p).length ≤ (l.filter q).length
+  | [], _ => by simp
+  | a :: t, sub => by
+    have ih := filter_length_le t (fun x hx => sub x (List.mem_cons_of_mem a hx))
+    have ha := sub a (List.mem_cons_self ..)
+    cases hpa : p a <;> cases hqa : q a <;> simp_all <;> omega
+
+/-- ... and strictly shorter when some element passes only the weaker one. -/
+theorem filter_length_lt {p q : Nat → Bool} : ∀ (l : List Nat),
+    (∀ x ∈ l, p x = true → q x = true) → (∃ x ∈ l, q x = true ∧ p x = false) →
+    (l.filter p).length < (l.filter q).length
+  | [], _, w => by simp at w
+  | a :: t, sub, w => by
+    have sub' : ∀ x ∈ t, p x = true → q x = true :=
+      fun x hx => sub x (List.mem_cons_of_mem a hx)
+    have le := filter_length_le t sub'
+    have ha := sub a (List.mem_cons_self ..)
+    obtain ⟨x, hx, hq, hp⟩ := w
+    rcases List.mem_cons.mp hx with rfl | hx'
+    · simp [hq, hp]
+      omega
+    · have := filter_length_lt t sub' ⟨x, hx', hq, hp⟩
+      cases hpa : p a <;> cases hqa : q a <;> simp_all <;> omega
+
+/-- Being ahead means a strictly smaller rank. -/
+theorem rank_lt_of_ahead (r : Nat → Int) {n a b : Nat} (ha : a < n)
+    (h : ahead r a b = true) : rank r n a < rank r n b := by
+  unfold rank
+  apply filter_length_lt
+  · intro x _ hx
+    exact ahead_trans r hx h
+  · exact ⟨a, List.mem_range.mpr ha, h, ahead_irrefl r a⟩
+
+/-- Distinct parts have distinct ranks. -/
+theorem rank_inj (r : Nat → Int) {n a b : Nat} (ha : a < n) (hb : b < n)
+    (h : rank r n a = rank r n b) : a = b := by
+  apply Classical.byContradiction
+  intro hne
+  rcases ahead_total r hne with h1 | h1
+  · have := rank_lt_of_ahead r ha h1; omega
+  · have := rank_lt_of_ahead r hb h1; omega
+
+/-- Every rank is below the number of parts (a part isn't ahead of itself). -/
+theorem rank_lt (r : Nat → Int) {n i : Nat} (hi : i < n) : rank r n i < n := by
+  unfold rank
+  have := (List.length_filter_lt_length_iff_exists (p := fun j => ahead r j i)
+    (l := List.range n)).mpr ⟨i, List.mem_range.mpr hi, by simp [ahead_irrefl]⟩
+  simpa using this
+
+/-- A duplicate-free list inside another is no longer. -/
+theorem nodup_length_le : ∀ (l m : List Nat), l.Nodup → (∀ x ∈ l, x ∈ m) →
+    l.length ≤ m.length
+  | [], _, _, _ => by simp
+  | a :: t, m, hn, hs => by
+    rw [List.nodup_cons] at hn
+    have ham : a ∈ m := hs a (by simp)
+    have ih := nodup_length_le t (m.erase a) hn.2 (fun x hx => by
+      have hxa : x ≠ a := fun e => hn.1 (e ▸ hx)
+      exact (List.mem_erase_of_ne hxa).mpr (hs x (by simp [hx])))
+    rw [List.length_erase_of_mem ham] at ih
+    have : 0 < m.length := List.length_pos_of_mem ham
+    simp
+    omega
+
+/-- Mapping a duplicate-free list by a function injective on it keeps it
+duplicate-free. -/
+theorem nodup_map_of_inj {f : Nat → Nat} : ∀ (l : List Nat), l.Nodup →
+    (∀ a ∈ l, ∀ b ∈ l, f a = f b → a = b) → (l.map f).Nodup
+  | [], _, _ => by simp
+  | a :: t, hn, hi => by
+    rw [List.nodup_cons] at hn
+    rw [List.map_cons, List.nodup_cons]
+    refine ⟨?_, nodup_map_of_inj t hn.2 (fun x hx y hy => hi x (by simp [hx]) y (by simp [hy]))⟩
+    intro hm
+    obtain ⟨b, hb, hfb⟩ := List.mem_map.mp hm
+    have := hi a (by simp) b (by simp [hb]) hfb.symm
+    exact hn.1 (this ▸ hb)
+
+/-- The ranks of `n` parts are `0, …, n-1` in some order. -/
+theorem ranks_perm (r : Nat → Int) (n : Nat) :
+    ((List.range n).map (rank r n)).Perm (List.range n) := by
+  let L := (List.range n).map (rank r n)
+  have nd : L.Nodup := nodup_map_of_inj _ List.nodup_range (fun a ha b hb h =>
+    rank_inj r (List.mem_range.mp ha) (List.mem_range.mp hb) h)
+  have sub : ∀ x ∈ L, x < n := by
+    intro x hx
+    obtain ⟨i, hi, rfl⟩ := List.mem_map.mp hx
+    exact rank_lt r (List.mem_range.mp hi)
+  have len : L.length = n := by simp [L]
+  -- Pigeonhole: n distinct values below n are all of them.
+  have all : ∀ v < n, v ∈ L := by
+    intro v hv
+    apply Classical.byContradiction
+    intro hnot
+    have := nodup_length_le L ((List.range n).erase v) nd (fun x hx => by
+      have hxv : x ≠ v := fun e => hnot (e ▸ hx)
+      exact (List.mem_erase_of_ne hxv).mpr (List.mem_range.mpr (sub x hx)))
+    rw [List.length_erase_of_mem (List.mem_range.mpr hv), List.length_range] at this
+    omega
+  rw [List.perm_iff_count]
+  intro a
+  rw [List.Nodup.count nd, List.Nodup.count List.nodup_range]
+  by_cases ha : a < n
+  · simp [all a ha, List.mem_range.mpr ha]
+  · have h1 : a ∉ L := fun h => ha (sub a h)
+    simp [h1, List.mem_range, ha]
+
+/-- Sums over permuted lists agree. -/
+theorem perm_sum {l₁ l₂ : List Int} (h : l₁.Perm l₂) : l₁.sum = l₂.sum := by
+  induction h with
+  | nil => rfl
+  | cons x _ ih => simp [ih]
+  | swap x y l => simp; omega
+  | trans _ _ ih1 ih2 => exact ih1.trans ih2
+
+/-- What the ranks `0, …, n-1` get, together: `u` units and the fraction. -/
+theorem sum_by_rank (u : Nat) (unit f : Int) : ∀ n, 0 < n → u ≤ n →
+    ((List.range n).map (fun v => (if v < u then unit else 0) + (if v = 0 then f else 0))).sum
+      = u * unit + f
+  | 0, h, _ => absurd h (by decide)
+  | 1, _, hu => by
+    rcases Nat.le_one_iff_eq_zero_or_eq_one.mp hu with rfl | rfl <;> simp
+  | n + 2, _, hu => by
+    rw [List.range_succ, List.map_append, List.sum_append]
+    by_cases h : u ≤ n + 1
+    · rw [sum_by_rank u unit f (n + 1) (by omega) h]
+      have : ¬ (n + 1 < u) := by omega
+      simp [this]
+    · have hu' : u = n + 2 := by omega
+      subst hu'
+      have ih := sum_by_rank (n + 1) unit f (n + 1) (by omega) (Nat.le_refl _)
+      have eq : ((List.range (n + 1)).map
+          (fun v => (if v < n + 2 then unit else 0) + (if v = 0 then f else 0))) =
+          ((List.range (n + 1)).map
+          (fun v => (if v < n + 1 then unit else 0) + (if v = 0 then f else 0))) := by
+        apply List.map_congr_left
+        intro v hv
+        have := List.mem_range.mp hv
+        simp [show v < n + 2 by omega, show v < n + 1 by omega]
+      rw [eq, ih]
+      have e : ((n + 2 : Nat) : Int) = ((n + 1 : Nat) : Int) + 1 := by omega
+      simp only [List.map_cons, List.map_nil, List.sum_cons, List.sum_nil]
+      rw [e, Int.add_mul, Int.one_mul]
+      simp
+      omega
+
+theorem sum_map_add (f g : Nat → Int) : ∀ (l : List Nat),
+    (l.map (fun i => f i + g i)).sum = (l.map f).sum + (l.map g).sum
+  | [] => by simp
+  | a :: t => by simp [sum_map_add f g t]; omega
+
+/-- **INVARIANT 1, for any number of parts.** When the shortfall
+`whole - Σ parts` is `u` units plus `f` (with `u` at most the number of
+parts, as `apportion` requires before it changes anything), the parts
+after apportioning sum to `whole` exactly. -/
+theorem apportion_sum (parts r : Nat → Int) (n u : Nat) (unit f whole : Int)
+    (hn : 0 < n) (hu : u ≤ n)
+    (hs : whole - ((List.range n).map parts).sum = u * unit + f) :
+    ((List.range n).map (fun i => parts i + add r n u unit f i)).sum = whole := by
+  rw [sum_map_add]
+  let g := fun v => (if v < u then unit else 0) + (if v = 0 then f else 0)
+  have h1 : (List.range n).map (add r n u unit f) = ((List.range n).map (rank r n)).map g := by
+    simp [List.map_map, add, g, Function.comp_def]
+  have h2 := perm_sum ((ranks_perm r n).map g)
+  have h3 := sum_by_rank u unit f n hn hu
+  show ((List.range n).map parts).sum + ((List.range n).map (add r n u unit f)).sum = whole
+  rw [h1, h2, h3]
+  omega
+
+/-- The same, from the shortfall as `apportion` computes it: `u` whole
+units by repeated subtraction (`s / unit`) and the rest (`s % unit`). -/
+theorem apportion_sum_of_shortfall (parts r : Nat → Int) (n : Nat) (unit whole : Int)
+    (hn : 0 < n) (hunit : 0 < unit)
+    (hs : 0 ≤ whole - ((List.range n).map parts).sum)
+    (hu : ((whole - ((List.range n).map parts).sum) / unit).toNat ≤ n) :
+    let s := whole - ((List.range n).map parts).sum
+    ((List.range n).map (fun i =>
+      parts i + add r n (s / unit).toNat unit (s % unit) i)).sum = whole := by
+  intro s
+  apply apportion_sum parts r n _ unit _ whole hn hu
+  have hq : 0 ≤ s / unit := Int.ediv_nonneg hs (Int.le_of_lt hunit)
+  rw [Int.toNat_of_nonneg hq]
+  have := Int.mul_ediv_add_emod s unit
+  rw [Int.mul_comm] at this
+  exact this.symm
+
+end Wanderbooks.Apportion