@lapxo/obligations 0.4.4 → 0.4.6

package/proofs/m0-046-diagonal/M0Threshold046.lean

@@ -0,0 +1,278 @@
+import M0Lindeberg046
+open scoped BigOperators
+open Filter Topology MeasureTheory
+noncomputable section
+open Classical Obligations045.M0 Obligations046.Bridge Obligations046.Diagonal
+namespace Obligations046.Threshold
+
+/-- Threshold transfer, explicitly conditional on all fixed-cut distribution limits.
+This is not a construction of a CLT or an M0 diagonal theorem. -/
+theorem moving_cut_sandwich (C : ℕ → ℝ → ℝ) (F : ℝ → ℝ)
+    (t v : ℕ → ℝ) (hF : ContinuousAt F 0)
+    (hC : ∀ z, Tendsto (fun N => C N z) atTop (𝓝 (F z)))
+    (ht : Tendsto t atTop (𝓝 0))
+    (hl : ∀ᶠ N in atTop, ∀ z, z < t N → C N z ≤ v N)
+    (hu : ∀ᶠ N in atTop, ∀ z, t N < z → v N ≤ C N z) :
+    Tendsto v atTop (𝓝 (F 0)) := by
+  have hinv : Tendsto (fun j : ℕ => (1:ℝ)/((j:ℝ)+1)) atTop (𝓝 0) :=
+    tendsto_const_nhds.div_atTop (tendsto_atTop_mono
+      (fun j : ℕ => show (j:ℝ) ≤ (j:ℝ)+1 by linarith)
+      tendsto_natCast_atTop_atTop)
+  have hleft : Tendsto (fun j : ℕ => F (-((1:ℝ)/((j:ℝ)+1)))) atTop (𝓝 (F 0)) := by
+    exact hF.tendsto.comp (by simpa only [neg_zero] using hinv.neg)
+  have hright : Tendsto (fun j : ℕ => F ((1:ℝ)/((j:ℝ)+1))) atTop (𝓝 (F 0)) :=
+    hF.tendsto.comp hinv
+  apply tendsto_order.2
+  constructor
+  · intro b hb
+    obtain ⟨j,hj⟩ := (hleft.eventually (Ioi_mem_nhds hb)).exists
+    let δ : ℝ := (1:ℝ)/((j:ℝ)+1)
+    have hd : 0 < δ := by dsimp [δ]; positivity
+    have he := (hC (-δ)).eventually (Ioi_mem_nhds hj)
+    have hth := ht.eventually (Ioi_mem_nhds (show -δ < (0:ℝ) by linarith))
+    filter_upwards [he,hth,hl] with N hN htN hlN
+    exact lt_of_lt_of_le hN (hlN (-δ) htN)
+  · intro b hb
+    obtain ⟨j,hj⟩ := (hright.eventually (Iio_mem_nhds hb)).exists
+    let δ : ℝ := (1:ℝ)/((j:ℝ)+1)
+    have hd : 0 < δ := by dsimp [δ]; positivity
+    have he := (hC δ).eventually (Iio_mem_nhds hj)
+    have hth := ht.eventually (Iio_mem_nhds hd)
+    filter_upwards [he,hth,hu] with N hN htN huN
+    exact lt_of_le_of_lt (huN δ htN) hN
+
+def sigma (M : Domain) (a : Fin M.K → Bool) (N : ℕ) : ℝ :=
+  Real.sqrt (Obligations046.Diagonal.variance M a N)
+def threshold (M : Domain) (a : Fin M.K → Bool) (N : ℕ) : ℝ :=
+  ((N:ℝ)/2-mean M a N)/sigma M a N
+
+theorem sigma_pos (M : Domain) (a : Fin M.K → Bool) (N : ℕ) (hN : 0<N) :
+    0 < sigma M a N := by
+  apply Real.sqrt_pos.2
+  exact lt_of_lt_of_le (mul_pos (by exact_mod_cast hN) (variance_lower_pos M))
+    (finite_variance_lower M a N)
+
+theorem threshold_limit (M : Domain) (a : Fin M.K → Bool)
+    (hdiag : score M a = (1:ℝ)/2) :
+    Tendsto (threshold M a) atTop (𝓝 0) := by
+  have h := Obligations046.Lindeberg.actual_mean_standardized_drift M a hdiag
+  apply (tendsto_zero_iff_norm_tendsto_zero).mpr
+  simpa only [threshold, sigma, Real.norm_eq_abs, abs_div,
+    abs_of_nonneg (Real.sqrt_nonneg _), abs_sub_comm,
+    Obligations046.Moments.model_mean, Obligations046.Moments.model_variance] using h
+
+/-- This CDF uses the actual joint member law; the cut is in standard-deviation units. -/
+def cdf (M : Domain) (a : Fin M.K → Bool) (N : ℕ) (z : ℝ) : ℝ :=
+  ∫ x, (if ((correctCount x:ℝ)-mean M a N)/sigma M a N ≤ z then (1:ℝ) else 0)
+    ∂(modelLaw M N a).toMeasure
+
+theorem fair_loss_bounds (b N : ℕ) : 0 ≤ fairLoss b N ∧ fairLoss b N ≤ 1 := by
+  unfold fairLoss
+  split_ifs <;> norm_num
+
+theorem lower_cut_pointwise (b N : ℕ) (μ σ z : ℝ) (hσ : 0<σ)
+    (hz : z < ((N:ℝ)/2-μ)/σ) :
+    (if ((b:ℝ)-μ)/σ ≤ z then (1:ℝ) else 0) ≤ fairLoss b N := by
+  split_ifs with hb
+  · have hreal : (b:ℝ)<(N:ℝ)/2 := by
+      have := (div_le_iff₀ hσ).mp hb
+      have := (lt_div_iff₀ hσ).mp hz
+      nlinarith
+    have hn : 2*b<N := by exact_mod_cast (show (2:ℝ)*(b:ℝ)<(N:ℝ) by linarith)
+    simp [fairLoss, hn]
+  · exact (fair_loss_bounds b N).1
+
+theorem upper_cut_pointwise (b N : ℕ) (μ σ z : ℝ) (hσ : 0<σ)
+    (hz : ((N:ℝ)/2-μ)/σ < z) :
+    fairLoss b N ≤ (if ((b:ℝ)-μ)/σ ≤ z then (1:ℝ) else 0) := by
+  split_ifs with hb
+  · exact (fair_loss_bounds b N).2
+  · have hreal : (N:ℝ)/2 < (b:ℝ) := by
+      have := (div_lt_iff₀ hσ).mp hz
+      have := (lt_div_iff₀ hσ).mp (lt_of_not_ge hb)
+      nlinarith
+    have hn : N<2*b := by exact_mod_cast (show (N:ℝ)<(2:ℝ)*(b:ℝ) by linarith)
+    simp [fairLoss, not_lt.mpr hn.le, Ne.symm hn.ne]
+
+theorem cdf_finite (M : Domain) (a : Fin M.K → Bool) (N : ℕ) (z : ℝ) :
+    cdf M a N z = ∑ x : World (sizes M N), jointMass (sizes M N)
+      (fun i => q M (a i)) x *
+      (if ((correctCount x:ℝ)-mean M a N)/sigma M a N ≤ z then (1:ℝ) else 0) := by
+  rw [cdf, modelLaw, memberLaw_expectation]
+
+theorem error_finite (M : Domain) (a : Fin M.K → Bool) (N : ℕ) :
+    conditionalError M N a = ∑ x : World (sizes M N), jointMass (sizes M N)
+      (fun i => q M (a i)) x * fairLoss (correctCount x) N := by
+  rw [← conditional_error_representation, modelLaw, memberLaw_expectation]
+
+theorem joint_nonneg (M : Domain) (a : Fin M.K → Bool) (N : ℕ) (x : World (sizes M N)) :
+    0 ≤ jointMass (sizes M N) (fun i => q M (a i)) x :=
+  Finset.prod_nonneg (fun i _ => mass_nonneg _ (q_pos M (a i)).le (q_lt_one M (a i)).le _)
+
+theorem lower_cut (M : Domain) (a : Fin M.K → Bool) (N : ℕ) (hN : 0<N)
+    (z : ℝ) (hz : z < threshold M a N) : cdf M a N z ≤ conditionalError M N a := by
+  rw [cdf_finite, error_finite]
+  apply Finset.sum_le_sum
+  intro x _
+  exact mul_le_mul_of_nonneg_left
+    (lower_cut_pointwise _ _ _ _ _ (sigma_pos M a N hN) hz) (joint_nonneg M a N x)
+
+theorem upper_cut (M : Domain) (a : Fin M.K → Bool) (N : ℕ) (hN : 0<N)
+    (z : ℝ) (hz : threshold M a N < z) : conditionalError M N a ≤ cdf M a N z := by
+  rw [cdf_finite, error_finite]
+  apply Finset.sum_le_sum
+  intro x _
+  exact mul_le_mul_of_nonneg_left
+    (upper_cut_pointwise _ _ _ _ _ (sigma_pos M a N hN) hz) (joint_nonneg M a N x)
+
+/-- Actual finite M0 law, actual majority with fair ties, unchanged quota rule.
+The fixed-cut limit hCLT remains an explicit unpaid hypothesis, not a law claim. -/
+theorem diagonal_transfer_of_fixed_cut_limits (M : Domain) (a : Fin M.K → Bool)
+    (hdiag : score M a = (1:ℝ)/2) (F : ℝ → ℝ) (hF : ContinuousAt F 0)
+    (hCLT : ∀ z, Tendsto (fun N => cdf M a N z) atTop (𝓝 (F z))) :
+    Tendsto (fun N => conditionalError M N a) atTop (𝓝 (F 0)) := by
+  apply moving_cut_sandwich (cdf M a) F (threshold M a)
+    (fun N => conditionalError M N a) hF hCLT (threshold_limit M a hdiag)
+  · filter_upwards [eventually_ge_atTop 1] with N hN
+    exact lower_cut M a N (by omega)
+  · filter_upwards [eventually_ge_atTop 1] with N hN
+    exact upper_cut M a N (by omega)
+
+def strictCdf (M : Domain) (a : Fin M.K → Bool) (N : ℕ) (z : ℝ) : ℝ :=
+  ∑ x : World (sizes M N), jointMass (sizes M N) (fun i => q M (a i)) x *
+    (if ((correctCount x:ℝ)-mean M a N)/sigma M a N < z then (1:ℝ) else 0)
+
+theorem cdf_mono (M : Domain) (a : Fin M.K → Bool) (N : ℕ) :
+    Monotone (cdf M a N) := by
+  intro z y hzy
+  rw [cdf_finite, cdf_finite]
+  apply Finset.sum_le_sum
+  intro x _
+  apply mul_le_mul_of_nonneg_left _ (joint_nonneg M a N x)
+  split_ifs <;> norm_num
+  linarith
+
+theorem strict_lower_cut (M : Domain) (a : Fin M.K → Bool) (N : ℕ)
+    (z t : ℝ) (hzt : z<t) : cdf M a N z ≤ strictCdf M a N t := by
+  rw [cdf_finite, strictCdf]
+  apply Finset.sum_le_sum
+  intro x _
+  apply mul_le_mul_of_nonneg_left _ (joint_nonneg M a N x)
+  split_ifs <;> norm_num
+  linarith
+
+theorem strict_upper_cut (M : Domain) (a : Fin M.K → Bool) (N : ℕ)
+    (t z : ℝ) (htz : t<z) : strictCdf M a N t ≤ cdf M a N z := by
+  rw [cdf_finite, strictCdf]
+  apply Finset.sum_le_sum
+  intro x _
+  apply mul_le_mul_of_nonneg_left _ (joint_nonneg M a N x)
+  split_ifs <;> norm_num
+  linarith
+
+/-- Both versions at the moving threshold have the same limit, only IF fixed-cut
+convergence to a continuous distribution is supplied. No atomless-limit axiom. -/
+theorem threshold_cdf_limits_of_fixed_cut_limits (M : Domain) (a : Fin M.K → Bool)
+    (hdiag : score M a = (1:ℝ)/2) (F : ℝ → ℝ) (hF : ContinuousAt F 0)
+    (hCLT : ∀ z, Tendsto (fun N => cdf M a N z) atTop (𝓝 (F z))) :
+    Tendsto (fun N => cdf M a N (threshold M a N)) atTop (𝓝 (F 0)) ∧
+    Tendsto (fun N => strictCdf M a N (threshold M a N)) atTop (𝓝 (F 0)) := by
+  constructor
+  · apply moving_cut_sandwich (cdf M a) F (threshold M a)
+      (fun N => cdf M a N (threshold M a N)) hF hCLT (threshold_limit M a hdiag)
+    · filter_upwards [] with N
+      intro z hz
+      exact cdf_mono M a N hz.le
+    · filter_upwards [] with N
+      intro z hz
+      exact cdf_mono M a N hz.le
+  · apply moving_cut_sandwich (cdf M a) F (threshold M a)
+      (fun N => strictCdf M a N (threshold M a N)) hF hCLT (threshold_limit M a hdiag)
+    · filter_upwards [] with N
+      exact fun z hz => strict_lower_cut M a N z _ hz
+    · filter_upwards [] with N
+      exact fun z hz => strict_upper_cut M a N _ z hz
+
+def tieMass (M : Domain) (a : Fin M.K → Bool) (N : ℕ) : ℝ :=
+  ∑ x : World (sizes M N), jointMass (sizes M N) (fun i => q M (a i)) x *
+    (if 2*correctCount x=N then (1:ℝ) else 0)
+
+theorem standardized_eq_threshold (b N : ℕ) (μ σ : ℝ) (hσ : 0<σ) :
+    ((b:ℝ)-μ)/σ = ((N:ℝ)/2-μ)/σ ↔ 2*b=N := by
+  constructor
+  · intro h
+    have hm := congrArg (fun y : ℝ => y*σ) h
+    simp only [div_mul_cancel₀ _ hσ.ne'] at hm
+    exact_mod_cast (show (2:ℝ)*(b:ℝ)=(N:ℝ) by linarith)
+  · intro h
+    have hn : (2:ℝ)*(b:ℝ)=(N:ℝ) := by exact_mod_cast h
+    congr 1
+    linarith
+
+theorem weak_strict_indicator_difference (r t : ℝ) :
+    (if r≤t then (1:ℝ) else 0) - (if r<t then (1:ℝ) else 0) =
+      if r=t then (1:ℝ) else 0 := by
+  rcases lt_trichotomy r t with h | h | h
+  · simp [h, h.le, h.ne]
+  · subst t; simp
+  · simp [not_le.mpr h, not_lt.mpr h.le, Ne.symm h.ne]
+
+theorem tie_mass_difference (M : Domain) (a : Fin M.K → Bool) (N : ℕ) (hN : 0<N) :
+    tieMass M a N = cdf M a N (threshold M a N) -
+      strictCdf M a N (threshold M a N) := by
+  rw [cdf_finite, strictCdf, ← Finset.sum_sub_distrib]
+  unfold tieMass
+  apply Finset.sum_congr rfl
+  intro x _
+  rw [← mul_sub, weak_strict_indicator_difference]
+  simp only [show (((correctCount x:ℝ)-mean M a N)/sigma M a N = threshold M a N) ↔
+    2*correctCount x=N from
+      standardized_eq_threshold _ _ _ _ (sigma_pos M a N hN)]
+
+/-- The tie atom vanishes as a CONSEQUENCE of the explicit fixed-cut CLT hypothesis. -/
+theorem tie_limit_of_fixed_cut_limits (M : Domain) (a : Fin M.K → Bool)
+    (hdiag : score M a = (1:ℝ)/2) (F : ℝ → ℝ) (hF : ContinuousAt F 0)
+    (hCLT : ∀ z, Tendsto (fun N => cdf M a N z) atTop (𝓝 (F z))) :
+    Tendsto (tieMass M a) atTop (𝓝 0) := by
+  have h := threshold_cdf_limits_of_fixed_cut_limits M a hdiag F hF hCLT
+  have hd := h.1.sub h.2
+  have he : (fun N => tieMass M a N) =ᶠ[atTop]
+      (fun N => cdf M a N (threshold M a N)-strictCdf M a N (threshold M a N)) := by
+    filter_upwards [eventually_ge_atTop 1] with N hN
+    exact tie_mass_difference M a N (by omega)
+  simpa only [sub_self] using hd.congr' he.symm
+
+/-- The final value 1/2 requires F(0)=1/2 in addition to continuity and the unpaid CLT. -/
+theorem floor_limit_diag_of_fixed_cut_limits (M : Domain) (a : Fin M.K → Bool)
+    (hdiag : score M a = (1:ℝ)/2) (F : ℝ → ℝ) (hF : ContinuousAt F 0)
+    (hF0 : F 0 = (1:ℝ)/2)
+    (hCLT : ∀ z, Tendsto (fun N => cdf M a N z) atTop (𝓝 (F z))) :
+    Tendsto (fun N => conditionalError M N a) atTop (𝓝 ((1:ℝ)/2)) := by
+  simpa only [hF0] using diagonal_transfer_of_fixed_cut_limits M a hdiag F hF hCLT
+
+/-- A scalar regression outside the independent M0 law: LLN convergence alone does
+not determine a discontinuous majority limit at the diagonal. -/
+def above (N : ℕ) : ℝ := (1:ℝ)/2 + 1/((N:ℝ)+1)
+
+theorem above_limit : Tendsto above atTop (𝓝 ((1:ℝ)/2)) := by
+  have hinv : Tendsto (fun N : ℕ => (1:ℝ)/((N:ℝ)+1)) atTop (𝓝 0) :=
+    tendsto_const_nhds.div_atTop (tendsto_atTop_mono
+      (fun N : ℕ => show (N:ℝ) ≤ (N:ℝ)+1 by linarith)
+      tendsto_natCast_atTop_atTop)
+  simpa only [above, add_zero] using tendsto_const_nhds.add hinv
+
+theorem above_loss_zero (N : ℕ) : limitingLoss (above N) = 0 := by
+  have hp : 0 < (1:ℝ)/((N:ℝ)+1) := by positivity
+  have hg : (1:ℝ)/2 < above N := by dsimp [above]; linarith
+  simp only [limitingLoss, if_neg (not_lt.mpr hg.le), if_neg (Ne.symm hg.ne)]
+
+theorem lgn_alone_does_not_give_half :
+    ¬ Tendsto (fun N => limitingLoss (above N)) atTop (𝓝 ((1:ℝ)/2)) := by
+  intro h
+  have hz : Tendsto (fun N => limitingLoss (above N)) atTop (𝓝 0) := by
+    simpa only [above_loss_zero] using
+      (tendsto_const_nhds : Tendsto (fun _ : ℕ => (0:ℝ)) atTop (𝓝 0))
+  have hbad := tendsto_nhds_unique hz h
+  norm_num at hbad
+
+end Obligations046.Threshold

package/proofs/m0-046-diagonal/Obligations045/ConsensusGrid.lean

@@ -0,0 +1,72 @@
+import Std
+set_option maxRecDepth 10000
+set_option maxHeartbeats 8000000
+namespace Obligations045
+-- Finite closed-form calculation only. This file does not assert a limit theorem.
+def binom : Nat → Nat → Nat
+  | 0, 0 => 1
+  | 0, _ + 1 => 0
+  | _ + 1, 0 => 1
+  | n + 1, k + 1 => binom n k + binom n (k + 1)
+def configs : Nat → List (List Bool)
+  | 0 => [[]]
+  | k + 1 => (configs k).flatMap (fun xs => [false :: xs, true :: xs])
+def ones (xs : List Bool) : Nat := (xs.filter id).length
+-- p=P/20, c=C/20. Below/equal/above 1/2 encoded as 2/1/0.
+def loss2 (K P C m : Nat) : Nat :=
+  let lhs := 2 * (20 * C * m + (20-C) * P * K)
+  let rhs := 400 * K
+  if lhs < rhs then 2 else if lhs == rhs then 1 else 0
+def grouped (K P C : Nat) : Nat :=
+  ((List.range (K+1)).map (fun m =>
+    binom K m * P^m * (20-P)^(K-m) * loss2 K P C m)).sum
+def enumerated (K P C : Nat) : Nat :=
+  ((configs K).map (fun xs =>
+    P^(ones xs) * (20-P)^(K-ones xs) * loss2 K P C (ones xs))).sum
+def grid : List (Nat × Nat × Nat) :=
+  ([1,2,3,4] : List Nat).flatMap (fun K =>
+    (List.range 9).flatMap (fun i =>
+      (List.range 20).map (fun j => (K,11+i,1+j))))
+theorem grid_has_720_cases : grid.length = 720 := by decide
+theorem closed_form_matches_full_configurations :
+    ∀ x ∈ grid, grouped x.1 x.2.1 x.2.2 = enumerated x.1 x.2.1 x.2.2 := by decide
+theorem grid_probability_range :
+    ∀ x ∈ grid, grouped x.1 x.2.1 x.2.2 ≤ 2*20^x.1 := by decide
+-- p=3/4, c=1/2: two distinct K have the same 1/64 floor.
+theorem inverse_alias :
+    grouped 3 15 10 * (2*20^5) = grouped 5 15 10 * (2*20^3) := by decide
+-- For p=3/4,c=9/10 and counts summing to N, compare score with 17*N/36.
+def score (counts : List Nat) (zs : List Bool) : Nat :=
+  ((counts.zip zs).map (fun x => if x.2 then x.1 else 0)).sum
+def floorNumerator (counts : List Nat) : Nat :=
+  ((configs counts.length).map (fun zs =>
+    let lhs := 36 * score counts zs
+    let rhs := 17 * counts.sum
+    let factor := if lhs < rhs then 2 else if lhs == rhs then 1 else 0
+    3^(ones zs) * factor)).sum
+-- Denominator is 2*4^3=128 in each three-lineage case.
+theorem same_effective_participation_different_floor :
+    (1*1+4*4+4*4 : Nat) = 2*2+2*2+5*5 ∧
+    floorNumerator [1,4,4] = 20 ∧ floorNumerator [2,2,5] = 32 := by decide
+-- WF population N=5, initial counts [3,1,1]; all 21 descendant count states.
+def wfNumerator : Nat :=
+  ((List.range 6).map (fun a =>
+    ((List.range (6-a)).map (fun b =>
+      binom 5 a * binom (5-a) b * 3^a *
+        floorNumerator [a,b,5-a-b])).sum)).sum
+theorem wf_transition_normalized :
+    ((List.range 6).map (fun a =>
+      ((List.range (6-a)).map (fun b =>
+        binom 5 a * binom (5-a) b * 3^a)).sum)).sum = 5^5 := by decide
+theorem wf_floor_decreases_in_expectation :
+    floorNumerator [3,1,1] = 32 ∧ wfNumerator = 92440 ∧
+    wfNumerator < floorNumerator [3,1,1] * 5^5 := by decide
+end Obligations045
+#print axioms Obligations045.grid_has_720_cases
+#print axioms Obligations045.closed_form_matches_full_configurations
+#print axioms Obligations045.grid_probability_range
+#print axioms Obligations045.inverse_alias
+
+#print axioms Obligations045.same_effective_participation_different_floor
+#print axioms Obligations045.wf_transition_normalized
+#print axioms Obligations045.wf_floor_decreases_in_expectation

package/proofs/m0-046-diagonal/Obligations045/M0Coincidence.lean

@@ -0,0 +1,39 @@
+import Mathlib.Data.Real.Basic
+import Mathlib.Tactic.Ring
+namespace Obligations045.M0Coincidence
+/-- Exact expectation over independent Bernoulli(p) latent lineages.
+    The recurrence keeps both branches and their actual probabilities. -/
+def expect (p : ℝ) : List ℝ → (ℝ → ℝ) → ℝ
+  | [], f => f 0
+  | w :: ws, f => (1-p)*expect p ws f + p*expect p ws (fun x => f (w+x))
+def squares (ws : List ℝ) : ℝ := (ws.map (fun w => w^2)).sum
+
+theorem expect_quadratic (p : ℝ) (ws : List ℝ) (a b d : ℝ) :
+    expect p ws (fun x => a*x^2+b*x+d) =
+    a*(p^2*ws.sum^2+p*(1-p)*squares ws)+b*p*ws.sum+d := by
+  induction ws generalizing a b d with
+  | nil => simp [expect, squares]
+  | cons w ws ih =>
+    have hf : (fun x : ℝ => a*(w+x)^2+b*(w+x)+d) =
+        (fun x => a*x^2+(2*a*w+b)*x+(a*w^2+b*w+d)) := by
+      funext x
+      ring
+    simp only [expect, hf]
+    rw [ih, ih]
+    simp only [List.sum_cons, squares, List.map_cons]
+    ring
+
+theorem pair_coincidence (p c : ℝ) (ws : List ℝ) (hw : ws.sum = 1) :
+    expect p ws (fun x => ((1-c)*p+c*x)^2+(1-((1-c)*p+c*x))^2) =
+    p^2+(1-p)^2+2*c^2*p*(1-p)*squares ws := by
+  have hf : (fun x : ℝ => ((1-c)*p+c*x)^2+(1-((1-c)*p+c*x))^2) =
+      (fun x => (2*c^2)*x^2+(2*c*(2*(1-c)*p-1))*x+
+        (((1-c)*p)^2+(1-(1-c)*p)^2)) := by
+    funext x
+    ring
+  rw [hf, expect_quadratic, hw]
+  ring
+
+theorem triple_redundant (q : ℝ) :
+    q^3+(1-q)^3 = (3*(q^2+(1-q)^2)-1)/2 := by ring
+end Obligations045.M0Coincidence

package/proofs/m0-046-diagonal/Obligations045/M0Diagonal.lean

@@ -0,0 +1,18 @@
+import Obligations045.ConsensusGrid
+set_option maxRecDepth 10000
+set_option maxHeartbeats 8000000
+namespace Obligations045.Diagonal
+/-- Finite diagonal vector only: K=1,p=3/4,c=1/3,w=[1].
+    A=false gives q=1/2, A=true gives q=5/6.
+    No general CLT or diagonal-limit theorem is declared in this file. -/
+def loss2 (b N : Nat) : Nat := if 2*b < N then 2 else if 2*b == N then 1 else 0
+def unbiasedNumerator (N : Nat) : Nat :=
+  ((List.range (N+1)).map (fun b => Obligations045.binom N b * loss2 b N)).sum
+def cases : List Nat := [1,2,3,4,5,6,7,8,9,10,11,12]
+theorem unbiased_diagonal_vector : ∀ N ∈ cases, unbiasedNumerator N = 2^N := by decide
+-- Total error numerator has denominator 8*6^N; the target floor is 1/8.
+def errorNumerator (N : Nat) : Nat :=
+  6^N+3*((List.range (N+1)).map (fun b =>
+    Obligations045.binom N b * 5^b * loss2 b N)).sum
+#eval cases.map (fun N => (N,errorNumerator N,8*6^N))
+end Obligations045.Diagonal

package/proofs/m0-046-diagonal/Obligations045/M0Limit.lean

@@ -0,0 +1,134 @@
+import Mathlib.Topology.Instances.Real.Lemmas
+import Mathlib.Data.Real.Archimedean
+import Mathlib.Topology.Algebra.Order.Field
+import Mathlib.Algebra.Order.Floor.Ring
+import Mathlib.Tactic.Linarith
+import Mathlib.Tactic.Ring
+import Mathlib.Tactic.NormNum
+import Mathlib.Tactic.Positivity
+
+open scoped BigOperators
+open Filter Topology
+noncomputable section
+open Classical
+namespace Obligations045.M0
+
+/-- Declared binary M0 domain. This structure contains no limiting-probability axiom. -/
+structure Domain where
+  K : ℕ
+  K_pos : 0 < K
+  p : ℝ
+  c : ℝ
+  p_half : (1:ℝ)/2 < p
+  p_lt_one : p < 1
+  c_nonneg : 0 ≤ c
+  c_lt_one : c < 1
+  w : ℕ → ℝ
+  w_nonneg : ∀ i, 0 ≤ w i
+  weights_sum : ∑ i ∈ Finset.range K, w i = 1
+
+def cumulative (w : ℕ → ℝ) (i : ℕ) : ℝ := ∑ j ∈ Finset.range i, w j
+
+def allocation (w : ℕ → ℝ) (N i : ℕ) : ℕ :=
+  ⌊(N:ℝ) * cumulative w (i+1)⌋₊ - ⌊(N:ℝ) * cumulative w i⌋₊
+
+theorem prefix_succ (w : ℕ → ℝ) (i : ℕ) :
+    cumulative w (i+1) = cumulative w i + w i := by simp [cumulative, Finset.sum_range_succ]
+
+theorem prefix_monotone (w : ℕ → ℝ) (hw : ∀ i, 0 ≤ w i) : Monotone (cumulative w) := by
+  apply monotone_nat_of_le_succ
+  intro i
+  rw [prefix_succ]
+  exact le_add_of_nonneg_right (hw i)
+
+theorem allocation_sum (M : Domain) (N : ℕ) :
+    ∑ i ∈ Finset.range M.K, allocation M.w N i = N := by
+  let f : ℕ → ℕ := fun i => ⌊(N:ℝ) * cumulative M.w i⌋₊
+  have hf : Monotone f := fun i j hij =>
+    Nat.floor_mono (mul_le_mul_of_nonneg_left (prefix_monotone M.w M.w_nonneg hij) (by positivity))
+  change ∑ i ∈ Finset.range M.K, (f (i+1) - f i) = N
+  rw [Finset.sum_range_tsub hf]
+  simp [f, cumulative, M.weights_sum]
+
+theorem allocation_discrepancy (M : Domain) (N i : ℕ) :
+    -1 < (allocation M.w N i : ℝ) - (N:ℝ)*M.w i ∧
+    (allocation M.w N i : ℝ) - (N:ℝ)*M.w i < 1 := by
+  have hpre : 0 ≤ cumulative M.w i := Finset.sum_nonneg (fun j _ => M.w_nonneg j)
+  have hnext : 0 ≤ cumulative M.w (i+1) := Finset.sum_nonneg (fun j _ => M.w_nonneg j)
+  have hm : ⌊(N:ℝ)*cumulative M.w i⌋₊ ≤ ⌊(N:ℝ)*cumulative M.w (i+1)⌋₊ :=
+    Nat.floor_mono (mul_le_mul_of_nonneg_left (prefix_monotone M.w M.w_nonneg (Nat.le_succ i)) (by positivity))
+  have a := Nat.floor_le (mul_nonneg (Nat.cast_nonneg N) hpre)
+  have b := Nat.lt_floor_add_one ((N:ℝ)*cumulative M.w i)
+  have c := Nat.floor_le (mul_nonneg (Nat.cast_nonneg N) hnext)
+  have d := Nat.lt_floor_add_one ((N:ℝ)*cumulative M.w (i+1))
+  have hs := prefix_succ M.w i
+  simp only [allocation, Nat.cast_sub hm]
+  constructor <;> nlinarith
+
+def q (M : Domain) (a : Bool) : ℝ := (1-M.c)*M.p + if a then M.c else 0
+
+theorem q_pos (M : Domain) (a : Bool) : 0 < q M a := by
+  have hp : 0 < M.p := by linarith [M.p_half]
+  cases a <;> simp only [q, Bool.false_eq_true, ite_false, add_zero, ite_true] <;>
+    nlinarith [M.c_nonneg, M.c_lt_one]
+
+theorem q_lt_one (M : Domain) (a : Bool) : q M a < 1 := by
+  have hp : 0 < M.p := by linarith [M.p_half]
+  cases a <;> simp only [q, Bool.false_eq_true, ite_false, add_zero, ite_true] <;>
+    nlinarith [M.c_nonneg, M.c_lt_one, M.p_lt_one]
+
+def score (M : Domain) (a : Fin M.K → Bool) : ℝ :=
+  ∑ i : Fin M.K, M.w i * q M (a i)
+
+def latentMass (M : Domain) (a : Fin M.K → Bool) : ℝ :=
+  ∏ i : Fin M.K, if a i then M.p else 1-M.p
+
+def fairLoss (correct total : ℕ) : ℝ :=
+  if 2*correct < total then 1 else if 2*correct = total then 1/2 else 0
+
+/-- The exact finite conditional error, using independent binomial counts in each lineage. -/
+noncomputable def conditionalError (M : Domain) (N : ℕ) (a : Fin M.K → Bool) : ℝ :=
+  ∑ x : (i : Fin M.K) → Fin (allocation M.w N i + 1),
+    (∏ i : Fin M.K,
+      (Nat.choose (allocation M.w N i) (x i) : ℝ) *
+      q M (a i) ^ (x i : ℕ) *
+      (1-q M (a i)) ^ (allocation M.w N i - (x i : ℕ))) *
+    fairLoss (∑ i : Fin M.K, (x i : ℕ)) N
+
+noncomputable def error (M : Domain) (N : ℕ) : ℝ :=
+  ∑ a : Fin M.K → Bool, latentMass M a * conditionalError M N a
+
+noncomputable def limitingLoss (s : ℝ) : ℝ :=
+  if s < 1/2 then 1 else if s = 1/2 then 1/2 else 0
+
+noncomputable def floor (M : Domain) : ℝ :=
+  ∑ a : Fin M.K → Bool, latentMass M a * limitingLoss (score M a)
+
+/-- Explicit proof obligations, NOT assumptions hidden inside the generative model.
+    The strict branches require concentration. The equality branch requires a CLT.
+    This certificate has no constructed instance in this project. -/
+def ConditionalTailLimits (M : Domain) : Prop :=
+  (∀ a, score M a < 1/2 → Tendsto (fun N => conditionalError M N a) atTop (𝓝 1)) ∧
+  (∀ a, 1/2 < score M a → Tendsto (fun N => conditionalError M N a) atTop (𝓝 0)) ∧
+  (∀ a, score M a = 1/2 → Tendsto (fun N => conditionalError M N a) atTop (𝓝 (1/2)))
+
+/-- Kernel checked finite-mixture transfer. This is intentionally conditional;
+    it does not claim that ConditionalTailLimits follows from Domain. -/
+theorem limit_of_conditional_tail_limits (M : Domain) (h : ConditionalTailLimits M) :
+    Tendsto (error M) atTop (𝓝 (floor M)) := by
+  have hcase : ∀ a, Tendsto (fun N => conditionalError M N a) atTop
+      (𝓝 (limitingLoss (score M a))) := by
+    intro a
+    by_cases hl : score M a < 1/2
+    · rw [limitingLoss, if_pos hl]
+      exact h.1 a hl
+    · by_cases he : score M a = 1/2
+      · rw [limitingLoss, if_neg hl, if_pos he]
+        exact h.2.2 a he
+      · have hg : 1/2 < score M a := lt_of_le_of_ne (le_of_not_gt hl) (Ne.symm he)
+        rw [limitingLoss, if_neg hl, if_neg he]
+        exact h.2.1 a hg
+  unfold error floor
+  exact tendsto_finset_sum _ (fun a _ => tendsto_const_nhds.mul (hcase a))
+
+end Obligations045.M0