diff --git a/LeanPool.lean b/LeanPool.lean index aa0c8e656..9dfa736f7 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -3040,6 +3040,11 @@ import LeanPool.MulticolorTriangleRamsey import LeanPool.Neukirch import LeanPool.Neukirch.ExtensionOfDedekindDomains import LeanPool.Neukirch.HilbertRamificationTheory +import LeanPool.NonSoficGroup +import LeanPool.NonSoficGroup.Compression +import LeanPool.NonSoficGroup.Conclusion +import LeanPool.NonSoficGroup.Foundations +import LeanPool.NonSoficGroup.Spectral import LeanPool.OSforGFF import LeanPool.OSforGFF.Bochner import LeanPool.OSforGFF.Bochner.FejerPD diff --git a/LeanPool/NonSoficGroup.lean b/LeanPool/NonSoficGroup.lean new file mode 100644 index 000000000..8bf4e9e1d --- /dev/null +++ b/LeanPool/NonSoficGroup.lean @@ -0,0 +1,21 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +module + +public import LeanPool.NonSoficGroup.Foundations +public import LeanPool.NonSoficGroup.Conclusion + +/-! +# Existence of a finitely presented non-sofic group + +Source: url:https://github.com/openai/ten-proofs +Authors: OpenAI, Dean Cureton +Status: verified +Main declarations: `SoficGroups.exists_finitelyPresented_nonsofic_group` +Tags: group-theory, sofic-groups, property-t, finite-approximations +MSC: 20F65, 20E22 +-/ diff --git a/LeanPool/NonSoficGroup/Compression.lean b/LeanPool/NonSoficGroup/Compression.lean new file mode 100644 index 000000000..a72e7b604 --- /dev/null +++ b/LeanPool/NonSoficGroup/Compression.lean @@ -0,0 +1,9536 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +module + +public import LeanPool.NonSoficGroup.Spectral +import all LeanPool.NonSoficGroup.Spectral +import Mathlib.Algebra.Order.Field.GeomSum +import Mathlib.Geometry.Group.Growth.LinearLowerBound +import Mathlib.Tactic.Monotonicity.Lemmas + +/-! +# Compression arguments for the non-sofic group construction + +This file assembles the rooted finite-model and component-compression +arguments used by the final contradiction. +-/ + +noncomputable section + +namespace SoficGroups + +open MatchedComponentCompletion + +namespace KunRootedWordPower + +section + +open Filter Topology +open KunRootedIndicatorCrossing +open KunThomInvariantOrthogonal +open scoped BigOperators ComplexConjugate ComplexOrder InnerProductSpace Pointwise + +universe u v + +private theorem RootedIndicatorMarkovModel.IsRootedAtRadius.mono + {G ι : Type u} [Group G] + {X : RootedIndicatorMarkovModel G ι} + {w : G → List ι} {r R : ℕ} + (h : X.IsRootedAtRadius w R) (hr : r ≤ R) : + X.IsRootedAtRadius w r := + ⟨fun a g hword => h.out a g (hword.trans hr)⟩ + +private theorem exists_rooted_word_radius_all_markov_iterate_contractions + {G : Type u} [Group G] + (P : KazhdanPair.{u, u} G) + (S : Finset G) (honeS : 1 ∈ S) + (hcover : P.generators ⊆ S) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (w : G → List ↥S) + (k : ℕ) (ε : ℝ) (hε : 0 < ε) : + ∃ r : ℕ, ∀ X : RootedIndicatorMarkovModel G ↥S, + X.IsGenerated (fun i : ↥S => (i : G)) w → + X.IsRootedAtRadius w r → + ∀ j ≤ k, + ‖((permutationMarkov X.generator)^[j + 1]) + (indicatorVector X.indicator) - + ((permutationMarkov X.generator)^[j]) + (indicatorVector X.indicator)‖ ≤ + (kazhdanMarkovContractionFactor P S ^ j + ε) * + ‖permutationMarkov X.generator + (indicatorVector X.indicator) - + indicatorVector X.indicator‖ := by + classical + have hexists : ∀ j : ℕ, ∃ r : ℕ, + ∀ X : RootedIndicatorMarkovModel G ↥S, + X.IsGenerated (fun i : ↥S => (i : G)) w → + X.IsRootedAtRadius w r → + ‖((permutationMarkov X.generator)^[j + 1]) + (indicatorVector X.indicator) - + ((permutationMarkov X.generator)^[j]) + (indicatorVector X.indicator)‖ ≤ + (kazhdanMarkovContractionFactor P S ^ j + ε) * + ‖permutationMarkov X.generator + (indicatorVector X.indicator) - + indicatorVector X.indicator‖ := + fun j => exists_rooted_word_radius_markov_iterate_contraction + P S honeS hcover hsymmetric w j ε hε + choose r hr using hexists + let R := ∑ j ∈ Finset.range (k + 1), r j + refine ⟨R, ?_⟩ + intro X hgenerated hroot j hj + have hjmem : j ∈ Finset.range (k + 1) := + Finset.mem_range.mpr (Nat.lt_succ_iff.mpr hj) + have hrj : r j ≤ R := by + exact Finset.single_le_sum + (f := r) (fun i _ => Nat.zero_le _) hjmem + exact hr j X hgenerated (hroot.mono hrj) + +/-- The displacement of an iterate is bounded by its successive displacements. -/ +public +theorem norm_iterate_sub_le_sum_successive + {E : Type*} [NormedAddCommGroup E] + (F : E → E) (x : E) (k : ℕ) : + ‖(F^[k]) x - x‖ ≤ + ∑ j ∈ Finset.range k, + ‖(F^[j + 1]) x - (F^[j]) x‖ := by + induction k with + | zero => simp only [Function.iterate_zero, id_eq, sub_self, norm_zero, Finset.range_zero, + Function.iterate_succ, + Function.comp_apply, Finset.sum_empty, Std.le_refl] + | succ k ih => + rw [Finset.sum_range_succ] + calc + ‖(F^[k + 1]) x - x‖ = + ‖((F^[k]) x - x) + + ((F^[k + 1]) x - (F^[k]) x)‖ := by + congr 1 + abel + _ ≤ ‖(F^[k]) x - x‖ + + ‖(F^[k + 1]) x - (F^[k]) x‖ := + norm_add_le _ _ + _ ≤ (∑ j ∈ Finset.range k, + ‖(F^[j + 1]) x - (F^[j]) x‖) + + ‖(F^[k + 1]) x - (F^[k]) x‖ := + add_le_add ih (le_refl _) + +private theorem sum_geometric_budget_le + (q : ℝ) (hqzero : 0 ≤ q) (hqone : q < 1) (k : ℕ) : + (∑ j ∈ Finset.range k, + (q ^ j + + (((k + 1 : ℕ) : ℝ) * (1 - q))⁻¹)) ≤ + 2 / (1 - q) := by + have hgap : 0 < 1 - q := sub_pos.mpr hqone + have hkpos : 0 < ((k + 1 : ℕ) : ℝ) := by positivity + have hgeom : + (∑ j ∈ Finset.range k, q ^ j) ≤ (1 - q)⁻¹ := by + simpa only [Nat.Ico_zero_eq_range, pow_zero, one_div] using + (geom_sum_Ico_le_of_lt_one (m := 0) (n := k) hqzero hqone) + have hratio : + (k : ℝ) / ((k + 1 : ℕ) : ℝ) ≤ 1 := by + apply (div_le_iff₀ hkpos).2 + rw [one_mul] + exact_mod_cast Nat.le_succ k + have hnoise : + (k : ℝ) * + (((k + 1 : ℕ) : ℝ) * (1 - q))⁻¹ ≤ + (1 - q)⁻¹ := by + calc + (k : ℝ) * + (((k + 1 : ℕ) : ℝ) * (1 - q))⁻¹ = + ((k : ℝ) / ((k + 1 : ℕ) : ℝ)) * + (1 - q)⁻¹ := by + field_simp + _ ≤ 1 * (1 - q)⁻¹ := + mul_le_mul_of_nonneg_right hratio + (inv_nonneg.mpr hgap.le) + _ = (1 - q)⁻¹ := one_mul _ + calc + (∑ j ∈ Finset.range k, + (q ^ j + (((k + 1 : ℕ) : ℝ) * (1 - q))⁻¹)) = + (∑ j ∈ Finset.range k, q ^ j) + + (k : ℝ) * + (((k + 1 : ℕ) : ℝ) * (1 - q))⁻¹ := by + rw [Finset.sum_add_distrib] + simp only [Nat.cast_add, Nat.cast_one, mul_inv_rev, Finset.sum_const, + Finset.card_range, nsmul_eq_mul] + _ ≤ (1 - q)⁻¹ + (1 - q)⁻¹ := + add_le_add hgeom hnoise + _ = 2 / (1 - q) := by ring + +private theorem exists_rooted_word_radius_geometric_markov_displacement + {G : Type u} [Group G] + (P : KazhdanPair.{u, u} G) + (S : Finset G) (honeS : 1 ∈ S) + (hcover : P.generators ⊆ S) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (w : G → List ↥S) + (k : ℕ) : + ∃ r : ℕ, ∀ X : RootedIndicatorMarkovModel G ↥S, + X.IsGenerated (fun i : ↥S => (i : G)) w → + X.IsRootedAtRadius w r → + ‖((permutationMarkov X.generator)^[k]) + (indicatorVector X.indicator) - + indicatorVector X.indicator‖ ≤ + (2 / (1 - kazhdanMarkovContractionFactor P S)) * + ‖permutationMarkov X.generator + (indicatorVector X.indicator) - + indicatorVector X.indicator‖ := by + let q := kazhdanMarkovContractionFactor P S + have hqzero : 0 ≤ q := + kazhdanMarkovContractionFactor_nonneg P S + have hqone : q < 1 := + kazhdanMarkovContractionFactor_lt_one P S ⟨1, honeS⟩ + let ε : ℝ := (((k + 1 : ℕ) : ℝ) * (1 - q))⁻¹ + have hε : 0 < ε := + inv_pos.mpr (mul_pos (by positivity) (sub_pos.mpr hqone)) + obtain ⟨r, hr⟩ := + exists_rooted_word_radius_all_markov_iterate_contractions + P S honeS hcover hsymmetric w k ε hε + refine ⟨r, ?_⟩ + intro X hgenerated hroot + let d : ℝ := + ‖permutationMarkov X.generator + (indicatorVector X.indicator) - + indicatorVector X.indicator‖ + have hsteps : ∀ j ∈ Finset.range k, + ‖((permutationMarkov X.generator)^[j + 1]) + (indicatorVector X.indicator) - + ((permutationMarkov X.generator)^[j]) + (indicatorVector X.indicator)‖ ≤ + (q ^ j + ε) * d := by + intro j hj + exact hr X hgenerated hroot j + (Nat.le_of_lt (Finset.mem_range.mp hj)) + calc + ‖((permutationMarkov X.generator)^[k]) + (indicatorVector X.indicator) - + indicatorVector X.indicator‖ ≤ + ∑ j ∈ Finset.range k, + ‖((permutationMarkov X.generator)^[j + 1]) + (indicatorVector X.indicator) - + ((permutationMarkov X.generator)^[j]) + (indicatorVector X.indicator)‖ := + norm_iterate_sub_le_sum_successive + (permutationMarkov X.generator) + (indicatorVector X.indicator) k + _ ≤ ∑ j ∈ Finset.range k, (q ^ j + ε) * d := + Finset.sum_le_sum hsteps + _ = (∑ j ∈ Finset.range k, (q ^ j + ε)) * d := by + rw [Finset.sum_mul] + _ ≤ (2 / (1 - q)) * d := + mul_le_mul_of_nonneg_right + (sum_geometric_budget_le q hqzero hqone k) + (norm_nonneg _) + _ = (2 / (1 - kazhdanMarkovContractionFactor P S)) * + ‖permutationMarkov X.generator + (indicatorVector X.indicator) - + indicatorVector X.indicator‖ := by + rfl + +end + +section + +open Filter Topology +open KunRootedIndicatorCrossing +open KunThomInvariantOrthogonal +open scoped BigOperators ComplexConjugate ComplexOrder InnerProductSpace Pointwise + +universe u + +private theorem rooted_realMarkov_eq_mass_realPermutationMarkov + {ι V : Type*} [Fintype ι] + (p : ι → Equiv.Perm V) : + KunRealComplexMarkovBridge.realMarkov p = + KunFinitePermutationMarkovMass.realPermutationMarkov p := by + funext f x + simp only [KunRealComplexMarkovBridge.realMarkov, div_eq_mul_inv, mul_comm, + KunFinitePermutationMarkovMass.realPermutationMarkov] + +private theorem rooted_markov_real_iterate_sq_error + {ι V : Type*} [Fintype ι] [Fintype V] [DecidableEq V] + (p : ι → Equiv.Perm V) (T : Finset V) (k : ℕ) : + ‖((permutationMarkov p)^[k]) + (indicatorVector + (KunFinitePermutationMarkovMass.realIndicator T)) - + indicatorVector + (KunFinitePermutationMarkovMass.realIndicator T)‖ ^ 2 = + ∑ x : V, + ((((KunFinitePermutationMarkovMass.realPermutationMarkov p)^[k]) + (KunFinitePermutationMarkovMass.realIndicator T)) x - + if x ∈ T then (1 : ℝ) else 0) ^ 2 := by + have h := + KunRealComplexMarkovBridge.norm_iterate_permutationMarkov_indicator_sub_sq + p (KunFinitePermutationMarkovMass.realIndicator T) k + have hcomplex : + KunRealComplexMarkovBridge.permutationMarkov p = + KunRootedIndicatorCrossing.permutationMarkov p := rfl + have hvector : + KunRealComplexMarkovBridge.indicatorVector + (KunFinitePermutationMarkovMass.realIndicator T) = + KunRootedIndicatorCrossing.indicatorVector + (KunFinitePermutationMarkovMass.realIndicator T) := rfl + rw [rooted_realMarkov_eq_mass_realPermutationMarkov] at h + rw [hcomplex, hvector] at h + simpa only [KunFinitePermutationMarkovMass.realIndicator] using h + +private theorem rooted_indicator_defect_sq_le_boundary + {ι V : Type*} [Fintype ι] [Nonempty ι] + [Fintype V] [DecidableEq V] + (p : ι → Equiv.Perm V) (T : Finset V) : + ‖permutationMarkov p + (indicatorVector + (KunFinitePermutationMarkovMass.realIndicator T)) - + indicatorVector + (KunFinitePermutationMarkovMass.realIndicator T)‖ ^ 2 ≤ + 2 * (boundary p T : ℝ) / + (Fintype.card ι : ℝ) := by + have hcomplex : + KunRealComplexMarkovBridge.permutationMarkov p = + KunRootedIndicatorCrossing.permutationMarkov p := rfl + have hvector : + KunRealComplexMarkovBridge.indicatorVector + (KunDirectedIndicatorJensen.realIndicator T) = + KunRootedIndicatorCrossing.indicatorVector + (KunDirectedIndicatorJensen.realIndicator T) := rfl + have hreal : + KunRealComplexMarkovBridge.realMarkov p + (KunDirectedIndicatorJensen.realIndicator T) = + KunDirectedIndicatorJensen.realPermutationMarkov p + (KunDirectedIndicatorJensen.realIndicator T) := rfl + have henergy := + KunRealComplexMarkovBridge.norm_permutationMarkov_indicator_sub_sq + p (KunDirectedIndicatorJensen.realIndicator T) + rw [hcomplex, hvector, hreal] at henergy + have hindicator : + KunFinitePermutationMarkovMass.realIndicator T = + KunDirectedIndicatorJensen.realIndicator T := by + funext x + simp only [KunFinitePermutationMarkovMass.realIndicator, + KunDirectedIndicatorJensen.realIndicator] + rw [hindicator] + calc + ‖permutationMarkov p + (indicatorVector + (KunDirectedIndicatorJensen.realIndicator T)) - + indicatorVector + (KunDirectedIndicatorJensen.realIndicator T)‖ ^ 2 = + ∑ x, + (KunDirectedIndicatorJensen.realPermutationMarkov p + (KunDirectedIndicatorJensen.realIndicator T) x - + KunDirectedIndicatorJensen.realIndicator T x) ^ 2 := by + exact henergy + _ ≤ 2 * (boundary p T : ℝ) / + (Fintype.card ι : ℝ) := + KunDirectedIndicatorJensen.realPermutationMarkov_indicator_defect_sq_le_boundary + p T + +end + +end KunRootedWordPower + +namespace KunActualRootedModelBridge + +open KunActualSoficRootRadius +open KunRootedIndicatorCrossing +open KunRootedWordPower +open KunThomInvariantOrthogonal +open scoped BigOperators + +universe u + +private def sourceFiniteIndicator + {V : Type*} [DecidableEq V] (T : Finset V) (x : V) : ℝ := + if x ∈ T then 1 else 0 + +private def sourceRootedIndicatorMarkovModel + {G : Type} [Group G] [DecidableEq G] + (A : SoficApproximation G) + (S : Finset G) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) + (n : ℕ) (T : Finset (Fin (A.model n).size)) : + RootedIndicatorMarkovModel G ↥S where + carrier := Fin (A.model n).size + fintype := inferInstance + generator i := (A.model n).action (i : G) + indicator := sourceFiniteIndicator T + evaluation := + chosenWordEvaluation A (fun i : ↥S => (i : G)) + (symmetricGeneratorWord S hsymmetric hgenerates) n + +private theorem sourceRootedIndicatorMarkovModel_isGenerated + {G : Type} [Group G] [DecidableEq G] + (A : SoficApproximation G) + (S : Finset G) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) + (n : ℕ) (T : Finset (Fin (A.model n).size)) : + (sourceRootedIndicatorMarkovModel + A S hsymmetric hgenerates n T).IsGenerated + (fun i : ↥S => (i : G)) + (symmetricGeneratorWord S hsymmetric hgenerates) := by + refine ⟨?_, ?_, ?_, ?_⟩ + · intro x + change sourceFiniteIndicator T x = 0 ∨ + sourceFiniteIndicator T x = 1 + by_cases hx : x ∈ T + · right + unfold sourceFiniteIndicator + split + · rfl + · rename_i hnot + exact (hnot hx).elim + · left + unfold sourceFiniteIndicator + split + · rename_i hmem + exact (hx hmem).elim + · rfl + · intro g + rfl + · exact chosen_symmetric_wordEvaluation_one + A S hsymmetric hgenerates n + · intro i + exact chosen_symmetric_wordEvaluation_generator + A S hsymmetric hgenerates n i + +private theorem sourceRootedIndicatorMarkovModel_isRootedAtRadius + {G : Type} [Group G] [DecidableEq G] + (A : SoficApproximation G) + (S : Finset G) (hone : 1 ∈ S) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) + (n r : ℕ) (T : Finset (Fin (A.model n).size)) + (hgood : Disjoint T + (chosenCayleyRadiusBad A S + (symmetricGeneratorWord S hsymmetric hgenerates) n r)) : + (sourceRootedIndicatorMarkovModel + A S hsymmetric hgenerates n T).IsRootedAtRadius + (symmetricGeneratorWord S hsymmetric hgenerates) r := by + refine ⟨?_⟩ + intro a g hword x hx + have hxreal : sourceFiniteIndicator T x ≠ 0 := by + intro hzero + apply hx + change (sourceFiniteIndicator T x : ℂ) = 0 + exact_mod_cast hzero + have hxT : x ∈ T := by + by_contra hnot + apply hxreal + unfold sourceFiniteIndicator + split + · rename_i hmem + exact (hnot hmem).elim + · rfl + have hxgood := Finset.disjoint_left.mp hgood hxT + exact chosenCayleyRadiusBad_rooted + A S hone (symmetricGeneratorWord S hsymmetric hgenerates) + (symmetricGeneratorWord_prod S hsymmetric hgenerates) + n r a g hword hxgood + +end KunActualRootedModelBridge + +namespace KunSharpThresholdCut + +open MeasureTheory Set +open scoped BigOperators ENNReal symmDiff + +private def upperLevel {V : Type*} [Fintype V] + (f : V → ℝ) (t : ℝ) : Finset V := + Finset.univ.filter (fun x => t < f x) + +private def highCrossingProfile {V ι : Type*} [Fintype V] [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) (a t : ℝ) : ℝ := + Finset.univ.sum (fun i : ι => + (Finset.univ.filter (fun x : V => a < f x)).sum (fun x => + (Ico (f (σ i x)) (f x)).indicator (fun _ => (1 : ℝ)) t)) + +private theorem highCrossingProfile_eq_boundary {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (f : V → ℝ) (a t : ℝ) + (hat : a < t) : + highCrossingProfile σ f a t = + (boundary σ (upperLevel f t) : ℝ) := by + classical + unfold highCrossingProfile boundary upperLevel + push_cast + apply Finset.sum_congr rfl + intro i _ + rw [Finset.card_eq_sum_ones] + push_cast + rw [Finset.sum_filter, Finset.sum_filter, Finset.sum_filter] + apply Finset.sum_congr rfl + intro x _ + simp only [mem_Ico, indicator, + Finset.mem_filter, Finset.mem_univ, true_and] + split_ifs + all_goals grind + +private theorem integrableOn_crossingIndicator + (a b c d : ℝ) : + IntegrableOn ((Ico a b).indicator (fun _ => (1 : ℝ))) + (Ioo c d) := by + exact (integrableOn_const (μ := volume) + (C := (1 : ℝ)) (s := Ioo c d) + (by simp only [Real.volume_Ioo, ne_eq, ENNReal.ofReal_ne_top, not_false_eq_true])).indicator + measurableSet_Ico + +private theorem integrableOn_highCrossingProfile {V ι : Type*} + [Fintype V] [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) (a c d : ℝ) : + IntegrableOn (highCrossingProfile σ f a) (Ioo c d) := by + unfold highCrossingProfile + exact integrable_finsetSum _ fun i _ => + integrable_finsetSum _ fun x _ => + integrableOn_crossingIndicator (f (σ i x)) (f x) c d + +private theorem setIntegral_crossingIndicator_le_abs + (a b c d : ℝ) : + (∫ t in Ioo c d, + (Ico a b).indicator (fun _ => (1 : ℝ)) t) ≤ |b - a| := by + calc + (∫ t in Ioo c d, + (Ico a b).indicator (fun _ => (1 : ℝ)) t) = + (volume.restrict (Ioo c d)).real (Ico a b) := by + exact integral_indicator_one (μ := volume.restrict (Ioo c d)) + measurableSet_Ico + _ = volume.real (Ico a b ∩ Ioo c d) := + measureReal_restrict_apply measurableSet_Ico + _ ≤ volume.real (Ico a b) := + measureReal_mono inter_subset_left + (by simp only [Real.volume_Ico, ne_eq, ENNReal.ofReal_ne_top, not_false_eq_true]) + _ = max (b - a) 0 := Real.volume_real_Ico + _ ≤ |b - a| := max_le (le_abs_self _) (abs_nonneg _) + +private theorem setIntegral_highCrossingProfile_le_variation {V ι : Type*} + [Fintype V] [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) (a c d : ℝ) : + (∫ t in Ioo c d, highCrossingProfile σ f a t) ≤ + ∑ i : ι, ∑ x ∈ Finset.univ.filter (fun x : V => a < f x), + |f (σ i x) - f x| := by + classical + let H : Finset V := Finset.univ.filter fun x : V => a < f x + have hint (i : ι) (x : V) : + Integrable + ((Ico (f (σ i x)) (f x)).indicator (fun _ => (1 : ℝ))) + (volume.restrict (Ioo c d)) := + integrableOn_crossingIndicator (f (σ i x)) (f x) c d + calc + (∫ t in Ioo c d, highCrossingProfile σ f a t) = + ∑ i : ι, ∑ x ∈ H, (∫ t in Ioo c d, + (Ico (f (σ i x)) (f x)).indicator (fun _ => (1 : ℝ)) t) := by + unfold highCrossingProfile + change (∫ t in Ioo c d, ∑ i : ι, ∑ x ∈ H, + (Ico (f (σ i x)) (f x)).indicator (fun _ => (1 : ℝ)) t) = _ + rw [integral_finsetSum Finset.univ + (fun i _ => integrable_finsetSum H + (fun x _ => hint i x))] + apply Finset.sum_congr rfl + intro i _ + rw [integral_finsetSum H (fun x _ => hint i x)] + _ ≤ ∑ i : ι, ∑ x ∈ H, |f (σ i x) - f x| := by + apply Finset.sum_le_sum + intro i _ + apply Finset.sum_le_sum + intro x _ + calc + (∫ t in Ioo c d, + (Ico (f (σ i x)) (f x)).indicator (fun _ => (1 : ℝ)) t) ≤ + |f x - f (σ i x)| := + setIntegral_crossingIndicator_le_abs + (f (σ i x)) (f x) c d + _ = |f (σ i x) - f x| := abs_sub_comm _ _ + _ = ∑ i : ι, ∑ x ∈ Finset.univ.filter + (fun x : V => a < f x), |f (σ i x) - f x| := by + rfl + +private theorem card_symmDiff_upperLevel_le_nine_sq_error {V : Type*} + [Fintype V] [DecidableEq V] + (T : Finset V) (f : V → ℝ) (t : ℝ) + (hlow : (1 / 3 : ℝ) ≤ t) (hhigh : t ≤ (2 / 3 : ℝ)) : + (((upperLevel f t ∆ T).card : ℝ)) ≤ + 9 * ∑ x : V, (f x - if x ∈ T then (1 : ℝ) else 0) ^ 2 := by + classical + let D : Finset V := upperLevel f t ∆ T + have hpoint (x : V) (hx : x ∈ D) : + (1 : ℝ) ≤ + 9 * (f x - if x ∈ T then (1 : ℝ) else 0) ^ 2 := by + rcases (Finset.mem_symmDiff.mp hx) with hx | hx + · obtain ⟨hxlevel, hxT⟩ := hx + have hfx : t < f x := (Finset.mem_filter.mp hxlevel).2 + simp only [ite_eq_right hxT] + nlinarith [sq_nonneg (3 * f x - 1)] + · obtain ⟨hxT, hxlevel⟩ := hx + have hfx : f x ≤ t := by + apply le_of_not_gt + intro h + exact hxlevel + (Finset.mem_filter.mpr ⟨Finset.mem_univ x, h⟩) + simp only [ite_eq_left hxT] + nlinarith [sq_nonneg (3 * f x - 2)] + have hcard : + (D.card : ℝ) = ∑ x : V, if x ∈ D then (1 : ℝ) else 0 := by + simp only [Finset.sum_ite_mem, Finset.univ_inter, Finset.sum_const, nsmul_eq_mul, mul_one] + change (D.card : ℝ) ≤ _ + rw [hcard] + calc + (∑ x : V, if x ∈ D then (1 : ℝ) else 0) ≤ + ∑ x : V, + 9 * (f x - if x ∈ T then (1 : ℝ) else 0) ^ 2 := by + apply Finset.sum_le_sum + intro x _ + by_cases hx : x ∈ D + · simpa only [ite_eq_left hx] using hpoint x hx + · simp only [ite_eq_right hx] + positivity + _ = 9 * ∑ x : V, + (f x - if x ∈ T then (1 : ℝ) else 0) ^ 2 := by + rw [Finset.mul_sum] + +private theorem exists_upperLevel_boundary_and_symmDiff_le {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (T : Finset V) (f : V → ℝ) : + ∃ t ∈ Ioo (1 / 3 : ℝ) (2 / 3 : ℝ), + (boundary σ (upperLevel f t) : ℝ) ≤ + 3 * ∑ i : ι, + ∑ x ∈ Finset.univ.filter + (fun x : V => (1 / 3 : ℝ) < f x), + |f (σ i x) - f x| ∧ + (((upperLevel f t ∆ T).card : ℝ)) ≤ + 9 * ∑ x : V, + (f x - if x ∈ T then (1 : ℝ) else 0) ^ 2 := by + have hpos : volume (Ioo (1 / 3 : ℝ) (2 / 3 : ℝ)) ≠ 0 := by + norm_num [Real.volume_Ioo] + have hfin : volume (Ioo (1 / 3 : ℝ) (2 / 3 : ℝ)) ≠ ∞ := by + simp only [one_div, Real.volume_Ioo, ne_eq, ENNReal.ofReal_ne_top, not_false_eq_true] + obtain ⟨t, ht, hmean⟩ := + exists_le_setAverage (μ := volume) + (s := Ioo (1 / 3 : ℝ) (2 / 3 : ℝ)) + hpos hfin + (integrableOn_highCrossingProfile σ f (1 / 3) _ _) + refine ⟨t, ht, ?_, ?_⟩ + · rw [← highCrossingProfile_eq_boundary σ f (1 / 3) t ht.1] + calc + highCrossingProfile σ f (1 / 3) t ≤ + ⨍ u in Ioo (1 / 3 : ℝ) (2 / 3 : ℝ), + highCrossingProfile σ f (1 / 3) u := hmean + _ = 3 * (∫ u in Ioo (1 / 3 : ℝ) (2 / 3 : ℝ), + highCrossingProfile σ f (1 / 3) u) := by + rw [setAverage_eq, Real.volume_real_Ioo] + norm_num + _ ≤ 3 * ∑ i : ι, + ∑ x ∈ Finset.univ.filter + (fun x : V => (1 / 3 : ℝ) < f x), + |f (σ i x) - f x| := + mul_le_mul_of_nonneg_left + (setIntegral_highCrossingProfile_le_variation + σ f (1 / 3) (1 / 3) (2 / 3)) (by norm_num) + · exact card_symmDiff_upperLevel_le_nine_sq_error + T f t ht.1.le ht.2.le + +end KunSharpThresholdCut + +namespace KunActualFinalRestrictedVariation + +open scoped BigOperators + +private def realMarkov {V ι : Type*} [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) (x : V) : ℝ := + (∑ i : ι, f ((σ i).symm x)) / (Fintype.card ι : ℝ) + +private theorem sum_permutation_mul_eq_sum_inverse_mul + {V : Type*} [Fintype V] + (p : Equiv.Perm V) (f : V → ℝ) : + (∑ x : V, f (p x) * f x) = + ∑ x : V, f x * f (p.symm x) := by + calc + (∑ x : V, f (p x) * f x) = + ∑ x : V, f (p (p.symm x)) * f (p.symm x) := + (Equiv.sum_comp p.symm + (fun x : V => f (p x) * f x)).symm + _ = ∑ x : V, f x * f (p.symm x) := by + apply Finset.sum_congr rfl + intro x _ + rw [p.apply_symm_apply] + +private theorem sum_sq_displacement_eq_twice_inverse_residual + {V : Type*} [Fintype V] + (p : Equiv.Perm V) (f : V → ℝ) : + (∑ x : V, (f (p x) - f x) ^ 2) = + 2 * ∑ x : V, f x * (f x - f (p.symm x)) := by + have hsquare : + (∑ x : V, f (p x) ^ 2) = ∑ x : V, f x ^ 2 := + Equiv.sum_comp p (fun x : V => f x ^ 2) + have hcross := sum_permutation_mul_eq_sum_inverse_mul p f + calc + (∑ x : V, (f (p x) - f x) ^ 2) = + (∑ x : V, f (p x) ^ 2) + + (∑ x : V, f x ^ 2) - + 2 * ∑ x : V, f (p x) * f x := by + calc + (∑ x : V, (f (p x) - f x) ^ 2) = + ∑ x : V, + (f (p x) ^ 2 + f x ^ 2 - + 2 * (f (p x) * f x)) := by + apply Finset.sum_congr rfl + intro x _ + ring + _ = _ := by + rw [Finset.sum_sub_distrib, Finset.sum_add_distrib, + ← Finset.mul_sum] + _ = 2 * ∑ x : V, f x * (f x - f (p.symm x)) := by + rw [hsquare, hcross] + simp_rw [mul_sub] + rw [Finset.sum_sub_distrib] + ring_nf + +private theorem sum_sum_sq_displacement_eq_twice_card_mul_realMarkov_residual + {V ι : Type*} [Fintype V] [Fintype ι] [Nonempty ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) : + (∑ i : ι, ∑ x : V, (f (σ i x) - f x) ^ 2) = + 2 * (Fintype.card ι : ℝ) * + ∑ x : V, f x * (f x - realMarkov σ f x) := by + classical + have hd : 0 < (Fintype.card ι : ℝ) := by + exact_mod_cast Fintype.card_pos_iff.mpr + (inferInstance : Nonempty ι) + calc + (∑ i : ι, ∑ x : V, (f (σ i x) - f x) ^ 2) = + 2 * ∑ x : V, ∑ i : ι, + f x * (f x - f ((σ i).symm x)) := by + simp_rw [sum_sq_displacement_eq_twice_inverse_residual] + rw [← Finset.mul_sum, Finset.sum_comm] + _ = 2 * (Fintype.card ι : ℝ) * + ∑ x : V, f x * (f x - realMarkov σ f x) := by + rw [mul_assoc] + congr 1 + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro x _ + unfold realMarkov + simp_rw [mul_sub] + rw [Finset.sum_sub_distrib, Finset.sum_const, + Finset.card_univ, nsmul_eq_mul] + rw [← Finset.mul_sum] + field_simp + +private theorem sum_sq_le_card_of_unit_interval_mass + {V : Type*} [Fintype V] + (T : Finset V) (f : V → ℝ) + (hfzero : ∀ x, 0 ≤ f x) (hfone : ∀ x, f x ≤ 1) + (hmass : (∑ x : V, f x) = (T.card : ℝ)) : + (∑ x : V, f x ^ 2) ≤ (T.card : ℝ) := by + calc + (∑ x : V, f x ^ 2) ≤ ∑ x : V, f x := by + apply Finset.sum_le_sum + intro x _ + nlinarith [mul_nonneg (hfzero x) + (sub_nonneg.mpr (hfone x))] + _ = (T.card : ℝ) := hmass + +private theorem realMarkov_residual_pairing_le_sqrt_card_mul_residual + {V ι : Type*} [Fintype V] [Fintype ι] + (σ : ι → Equiv.Perm V) (T : Finset V) (f : V → ℝ) + (hfzero : ∀ x, 0 ≤ f x) (hfone : ∀ x, f x ≤ 1) + (hmass : (∑ x : V, f x) = (T.card : ℝ)) : + (∑ x : V, f x * (f x - realMarkov σ f x)) ≤ + Real.sqrt (T.card : ℝ) * + Real.sqrt (∑ x : V, + (realMarkov σ f x - f x) ^ 2) := by + have hsquare := sum_sq_le_card_of_unit_interval_mass + T f hfzero hfone hmass + calc + (∑ x : V, f x * (f x - realMarkov σ f x)) ≤ + Real.sqrt (∑ x : V, f x ^ 2) * + Real.sqrt (∑ x : V, + (f x - realMarkov σ f x) ^ 2) := + Real.sum_mul_le_sqrt_mul_sqrt Finset.univ f + (fun x => f x - realMarkov σ f x) + _ ≤ Real.sqrt (T.card : ℝ) * + Real.sqrt (∑ x : V, + (f x - realMarkov σ f x) ^ 2) := + mul_le_mul_of_nonneg_right (Real.sqrt_le_sqrt hsquare) + (Real.sqrt_nonneg _) + _ = Real.sqrt (T.card : ℝ) * + Real.sqrt (∑ x : V, + (realMarkov σ f x - f x) ^ 2) := by + congr 2 + apply Finset.sum_congr rfl + intro x _ + ring + +private theorem sum_sum_sq_displacement_le_twice_card_mul_sqrt_card_mul_residual + {V ι : Type*} [Fintype V] + [Fintype ι] [Nonempty ι] + (σ : ι → Equiv.Perm V) (T : Finset V) (f : V → ℝ) + (hfzero : ∀ x, 0 ≤ f x) (hfone : ∀ x, f x ≤ 1) + (hmass : (∑ x : V, f x) = (T.card : ℝ)) : + (∑ i : ι, ∑ x : V, (f (σ i x) - f x) ^ 2) ≤ + 2 * (Fintype.card ι : ℝ) * Real.sqrt (T.card : ℝ) * + Real.sqrt (∑ x : V, + (realMarkov σ f x - f x) ^ 2) := by + rw [sum_sum_sq_displacement_eq_twice_card_mul_realMarkov_residual] + have hpair := realMarkov_residual_pairing_le_sqrt_card_mul_residual + σ T f hfzero hfone hmass + have hfactor : 0 ≤ 2 * (Fintype.card ι : ℝ) := by positivity + nlinarith [mul_nonneg hfactor + (sub_nonneg.mpr hpair)] + +private theorem card_highSupport_le_three_card + {V : Type*} [Fintype V] + (T : Finset V) (f : V → ℝ) + (hfzero : ∀ x, 0 ≤ f x) + (hmass : (∑ x : V, f x) = (T.card : ℝ)) : + (((Finset.univ.filter fun x : V => + (1 / 3 : ℝ) < f x).card : ℝ)) ≤ 3 * (T.card : ℝ) := by + classical + let H : Finset V := + Finset.univ.filter fun x : V => (1 / 3 : ℝ) < f x + have hpoint (x : V) (hx : x ∈ H) : + (1 : ℝ) ≤ 3 * f x := by + have hx' : (1 / 3 : ℝ) < f x := + (Finset.mem_filter.mp hx).2 + linarith + have hhigh : (H.card : ℝ) ≤ 3 * ∑ x ∈ H, f x := by + calc + (H.card : ℝ) = ∑ _x ∈ H, (1 : ℝ) := by simp only [Finset.sum_const, nsmul_eq_mul, mul_one] + _ ≤ ∑ x ∈ H, 3 * f x := + Finset.sum_le_sum fun x hx => hpoint x hx + _ = 3 * ∑ x ∈ H, f x := by rw [Finset.mul_sum] + have hsum : (∑ x ∈ H, f x) ≤ ∑ x : V, f x := by + apply Finset.sum_le_sum_of_subset_of_nonneg + (Finset.subset_univ H) + intro x _ _ + exact hfzero x + change (H.card : ℝ) ≤ 3 * (T.card : ℝ) + calc + (H.card : ℝ) ≤ 3 * ∑ x ∈ H, f x := hhigh + _ ≤ 3 * ∑ x : V, f x := + mul_le_mul_of_nonneg_left hsum (by norm_num) + _ = 3 * (T.card : ℝ) := by rw [hmass] + +private theorem filtered_variation_sq_le_card_mul_filtered_energy + {V ι : Type*} [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) (H : Finset V) : + (∑ i : ι, ∑ x ∈ H, |f (σ i x) - f x|) ^ 2 ≤ + (Fintype.card ι : ℝ) * (H.card : ℝ) * + ∑ i : ι, ∑ x ∈ H, (f (σ i x) - f x) ^ 2 := by + classical + have hcs := Finset.sum_mul_sq_le_sq_mul_sq + (Finset.univ.product H) + (fun _ : ι × V => (1 : ℝ)) + (fun z : ι × V => |f (σ z.1 z.2) - f z.2|) + simpa only [mul_assoc, ge_iff_le, Finset.product_eq_sprod, one_mul, Finset.sum_product, one_pow, + Finset.sum_const, Finset.card_product, Finset.card_univ, nsmul_eq_mul, Nat.cast_mul, mul_one, + sq_abs] using hcs + +private theorem filtered_variation_sq_le_card_mul_energy + {V ι : Type*} [Fintype V] [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) (H : Finset V) : + (∑ i : ι, ∑ x ∈ H, |f (σ i x) - f x|) ^ 2 ≤ + (Fintype.card ι : ℝ) * (H.card : ℝ) * + ∑ i : ι, ∑ x : V, (f (σ i x) - f x) ^ 2 := by + classical + have henergy : + (∑ i : ι, ∑ x ∈ H, (f (σ i x) - f x) ^ 2) ≤ + ∑ i : ι, ∑ x : V, (f (σ i x) - f x) ^ 2 := by + apply Finset.sum_le_sum + intro i _ + apply Finset.sum_le_sum_of_subset_of_nonneg + (Finset.subset_univ H) + intro x _ _ + exact sq_nonneg _ + calc + (∑ i : ι, ∑ x ∈ H, |f (σ i x) - f x|) ^ 2 ≤ + (Fintype.card ι : ℝ) * (H.card : ℝ) * + ∑ i : ι, ∑ x ∈ H, (f (σ i x) - f x) ^ 2 := + filtered_variation_sq_le_card_mul_filtered_energy σ f H + _ ≤ (Fintype.card ι : ℝ) * (H.card : ℝ) * + ∑ i : ι, ∑ x : V, (f (σ i x) - f x) ^ 2 := + mul_le_mul_of_nonneg_left henergy + (mul_nonneg (Nat.cast_nonneg _) (Nat.cast_nonneg _)) + +private theorem highSupport_variation_sq_le_three_mul_reference_energy + {V ι : Type*} [Fintype V] [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) (T : Finset V) + (hhigh : + ((Finset.univ.filter + (fun x : V => (1 / 3 : ℝ) < f x)).card : ℝ) ≤ + 3 * (T.card : ℝ)) : + (∑ i : ι, + ∑ x ∈ Finset.univ.filter + (fun x : V => (1 / 3 : ℝ) < f x), + |f (σ i x) - f x|) ^ 2 ≤ + 3 * (Fintype.card ι : ℝ) * (T.card : ℝ) * + ∑ i : ι, ∑ x : V, (f (σ i x) - f x) ^ 2 := by + have henergy : + 0 ≤ ∑ i : ι, ∑ x : V, (f (σ i x) - f x) ^ 2 := + Finset.sum_nonneg fun i _ => + Finset.sum_nonneg fun x _ => sq_nonneg _ + calc + (∑ i : ι, + ∑ x ∈ Finset.univ.filter + (fun x : V => (1 / 3 : ℝ) < f x), + |f (σ i x) - f x|) ^ 2 ≤ + (Fintype.card ι : ℝ) * + ((Finset.univ.filter + (fun x : V => (1 / 3 : ℝ) < f x)).card : ℝ) * + ∑ i : ι, ∑ x : V, (f (σ i x) - f x) ^ 2 := + filtered_variation_sq_le_card_mul_energy σ f + (Finset.univ.filter fun x : V => (1 / 3 : ℝ) < f x) + _ ≤ (Fintype.card ι : ℝ) * (3 * (T.card : ℝ)) * + ∑ i : ι, ∑ x : V, (f (σ i x) - f x) ^ 2 := + mul_le_mul_of_nonneg_right + (mul_le_mul_of_nonneg_left hhigh (Nat.cast_nonneg _)) henergy + _ = 3 * (Fintype.card ι : ℝ) * (T.card : ℝ) * + ∑ i : ι, ∑ x : V, (f (σ i x) - f x) ^ 2 := by + ring + +private theorem high_variation_le_of_markov_square_bounds + {d t α η b r E H : ℝ} + (hd : 0 ≤ d) (ht : 0 ≤ t) (hα : 0 ≤ α) (hη : 0 ≤ η) + (hbase : b ^ 2 ≤ t) + (hresidual : r ≤ η * b) + (henergy : E ≤ 2 * d * Real.sqrt t * r) + (hcauchy : H ^ 2 ≤ 3 * d * t * E) + (hsmall : 486 * d ^ 2 * η ≤ 4 * α ^ 2) : + 9 * H ≤ 2 * α * t := by + have hsqrt : 0 ≤ Real.sqrt t := Real.sqrt_nonneg t + have hsqrt_sq : (Real.sqrt t) ^ 2 = t := Real.sq_sqrt ht + have hb_sqrt : b ≤ Real.sqrt t := Real.le_sqrt_of_sq_le hbase + have hr_sqrt : r ≤ η * Real.sqrt t := + hresidual.trans (mul_le_mul_of_nonneg_left hb_sqrt hη) + have henergy' : E ≤ 2 * d * η * t := by + calc + E ≤ 2 * d * Real.sqrt t * r := henergy + _ ≤ 2 * d * Real.sqrt t * (η * Real.sqrt t) := + mul_le_mul_of_nonneg_left hr_sqrt + (mul_nonneg (mul_nonneg (by norm_num) hd) hsqrt) + _ = 2 * d * η * (Real.sqrt t) ^ 2 := by ring + _ = 2 * d * η * t := by rw [hsqrt_sq] + have hcauchy' : H ^ 2 ≤ 6 * d ^ 2 * η * t ^ 2 := by + calc + H ^ 2 ≤ 3 * d * t * E := hcauchy + _ ≤ 3 * d * t * (2 * d * η * t) := + mul_le_mul_of_nonneg_left henergy' + (mul_nonneg (mul_nonneg (by norm_num) hd) ht) + _ = 6 * d ^ 2 * η * t ^ 2 := by ring + have hsquare : (9 * H) ^ 2 ≤ (2 * α * t) ^ 2 := by + have hsmall' := mul_le_mul_of_nonneg_right hsmall (sq_nonneg t) + linarith only [hcauchy', hsmall'] + nlinarith only [hsquare, mul_nonneg hα ht] + +private theorem highSupport_variation_le_of_realMarkov_residual_and_highSupport + {V ι : Type*} [Fintype V] + [Fintype ι] [Nonempty ι] + (σ : ι → Equiv.Perm V) (T : Finset V) (f : V → ℝ) + (α η b : ℝ) + (hfzero : ∀ x, 0 ≤ f x) (hfone : ∀ x, f x ≤ 1) + (hmass : (∑ x : V, f x) = (T.card : ℝ)) + (hhigh : + ((Finset.univ.filter + (fun x : V => (1 / 3 : ℝ) < f x)).card : ℝ) ≤ + 3 * (T.card : ℝ)) + (hα : 0 ≤ α) (hη : 0 ≤ η) + (hbase : b ^ 2 ≤ (T.card : ℝ)) + (hresidual : + Real.sqrt (∑ x : V, + (realMarkov σ f x - f x) ^ 2) ≤ η * b) + (hsmall : + 486 * (Fintype.card ι : ℝ) ^ 2 * η ≤ 4 * α ^ 2) : + 9 * (∑ i : ι, + ∑ x ∈ Finset.univ.filter + (fun x : V => (1 / 3 : ℝ) < f x), + |f (σ i x) - f x|) ≤ 2 * α * (T.card : ℝ) := by + exact high_variation_le_of_markov_square_bounds + (d := (Fintype.card ι : ℝ)) + (t := (T.card : ℝ)) + (α := α) (η := η) (b := b) + (r := Real.sqrt (∑ x : V, + (realMarkov σ f x - f x) ^ 2)) + (E := ∑ i : ι, ∑ x : V, (f (σ i x) - f x) ^ 2) + (H := ∑ i : ι, + ∑ x ∈ Finset.univ.filter + (fun x : V => (1 / 3 : ℝ) < f x), + |f (σ i x) - f x|) + (Nat.cast_nonneg _) (Nat.cast_nonneg _) + hα hη hbase hresidual + (sum_sum_sq_displacement_le_twice_card_mul_sqrt_card_mul_residual + σ T f hfzero hfone hmass) + (highSupport_variation_sq_le_three_mul_reference_energy + σ f T hhigh) + hsmall + +private theorem highSupport_variation_le_of_realMarkov_residual + {V ι : Type*} [Fintype V] + [Fintype ι] [Nonempty ι] + (σ : ι → Equiv.Perm V) (T : Finset V) (f : V → ℝ) + (α η b : ℝ) + (hfzero : ∀ x, 0 ≤ f x) (hfone : ∀ x, f x ≤ 1) + (hmass : (∑ x : V, f x) = (T.card : ℝ)) + (hα : 0 ≤ α) (hη : 0 ≤ η) + (hbase : b ^ 2 ≤ (T.card : ℝ)) + (hresidual : + Real.sqrt (∑ x : V, + (realMarkov σ f x - f x) ^ 2) ≤ η * b) + (hsmall : + 486 * (Fintype.card ι : ℝ) ^ 2 * η ≤ 4 * α ^ 2) : + 9 * (∑ i : ι, + ∑ x ∈ Finset.univ.filter + (fun x : V => (1 / 3 : ℝ) < f x), + |f (σ i x) - f x|) ≤ 2 * α * (T.card : ℝ) := by + exact highSupport_variation_le_of_realMarkov_residual_and_highSupport + σ T f α η b hfzero hfone hmass + (card_highSupport_le_three_card T f hfzero hmass) + hα hη hbase hresidual hsmall + +end KunActualFinalRestrictedVariation + +namespace MatchedFirstStageWordRadiusTransfer + +open Filter Topology +open scoped BigOperators + +private theorem card_completed_sourceWordTestBad_le_sourceCompletionBad + {V ι J : Type*} [Fintype V] [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) (p : J → Equiv.Perm V) + (F : Finset J) (P : Finset V) : + (MatchedComponentExitBudget.sourceWordTestBad + (fun i => MatchedComponentCompletion.completedRestriction + (σ i) P) + (fun j => MatchedComponentCompletion.completedRestriction + (p j) P) + F).card ≤ + (MatchedComponentCompletion.sourceCompletionBad + σ p F P).card := by + classical + let σP : ι → Equiv.Perm {x : V // x ∈ P} := fun i => + MatchedComponentCompletion.completedRestriction (σ i) P + let pP : J → Equiv.Perm {x : V // x ∈ P} := fun j => + MatchedComponentCompletion.completedRestriction (p j) P + let W : Finset {x : V // x ∈ P} := + MatchedComponentExitBudget.sourceWordTestBad σP pP F + have hσP : + ∀ i (x : V) (hx : x ∈ P) (_hi : σ i x ∈ P), + ((σP i ⟨x, hx⟩ : {x : V // x ∈ P}) : V) = σ i x := by + intro i x hx hi + exact MatchedComponentCompletion.completedRestriction_apply_of_mem + (σ i) P x hx hi + have hinject : + W.map (Function.Embedding.subtype (fun x : V => x ∈ P)) ⊆ + MatchedComponentCompletion.sourceCompletionBad + σ p F P := by + intro x hx + obtain ⟨z, hz, rfl⟩ := Finset.mem_map.mp hx + by_contra hnot + have hwords : z ∈ W := hz + simp only [MatchedComponentExitBudget.sourceWordTestBad, ne_eq, Finset.univ_eq_attach, + Finset.union_assoc, + Finset.mem_union, Finset.mem_biUnion, Finset.mem_univ, Finset.mem_filter, Finset.mem_attach, + true_and, W, pP, + σP] at hwords + rcases hwords with hcomm | hmul | hsep + · obtain ⟨i, j, hj, hfailure⟩ := hcomm + exact hfailure + (MatchedComponentCompletion.completedRestriction_commute_of_not_mem_sourceCompletionBad + σ p F P σP hσP hj i z hnot) + · obtain ⟨j, hj, k, hk, hfailure⟩ := hmul + apply hfailure + simpa only [Equiv.Perm.mul_apply] using + completedRestriction_mul_of_not_mem_sourceCompletionBad σ p F P hj hk z hnot + · obtain ⟨j, hj, k, hk, hne, heq⟩ := hsep + exact + (MatchedComponentCompletion.completedRestriction_ne_of_not_mem_sourceCompletionBad + σ p F P hj hk hne z hnot) heq + change W.card ≤ _ + calc + W.card = + (W.map (Function.Embedding.subtype (fun x : V => x ∈ P))).card := + (Finset.card_map _).symm + _ ≤ (MatchedComponentCompletion.sourceCompletionBad + σ p F P).card := Finset.card_le_card hinject + +private theorem completed_sourceWordTestBad_density_tendsto_zero + (V : ℕ → Type*) [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + {ι J : Type*} [Fintype ι] [Group J] + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (p : (n : ℕ) → J → Equiv.Perm (V n)) + (F : Finset J) + (P E : (n : ℕ) → Finset (V n)) + (hcapture : ∀ n, + MatchedComponentCompletion.sourceCompletionBad + (σ n) (p n) F (P n) ⊆ P n ∩ E n) + (hradius : Tendsto + (fun n => (((P n ∩ E n).card : ℝ) / (P n).card)) + atTop (nhds 0)) : + Tendsto + (fun n => + ((MatchedComponentExitBudget.sourceWordTestBad + (fun i => MatchedComponentCompletion.completedRestriction + (σ n i) (P n)) + (fun j => MatchedComponentCompletion.completedRestriction + (p n j) (P n)) + F).card : ℝ) / (P n).card) + atTop (nhds 0) := by + have hupper (n : ℕ) : + ((MatchedComponentExitBudget.sourceWordTestBad + (fun i => MatchedComponentCompletion.completedRestriction + (σ n i) (P n)) + (fun j => MatchedComponentCompletion.completedRestriction + (p n j) (P n)) + F).card : ℝ) / (P n).card ≤ + (((P n ∩ E n).card : ℝ) / (P n).card) := by + have hfirst := card_completed_sourceWordTestBad_le_sourceCompletionBad + (σ n) (p n) F (P n) + have hsecond := Finset.card_le_card (hcapture n) + have hcard : + (MatchedComponentExitBudget.sourceWordTestBad + (fun i => MatchedComponentCompletion.completedRestriction + (σ n i) (P n)) + (fun j => MatchedComponentCompletion.completedRestriction + (p n j) (P n)) + F).card ≤ (P n ∩ E n).card := hfirst.trans hsecond + apply div_le_div_of_nonneg_right _ (by positivity) + exact_mod_cast hcard + exact squeeze_zero' + (Filter.Eventually.of_forall fun n => by positivity) + (Filter.Eventually.of_forall hupper) + hradius + +private theorem completed_sourceWordTestBad_density_tendsto_zero_of_matchedRadius + (V : ℕ → Type*) [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + {ι κ J : Type*} [Fintype ι] [Group J] + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (p : (n : ℕ) → J → Equiv.Perm (V n)) + (F : Finset J) + (U P : (n : ℕ) → Finset (V n)) + (Q : (n : ℕ) → Finpartition (U n)) + (I : ℕ → Finset κ) + (w : (n : ℕ) → κ → Equiv.Perm (V n)) + (r : ℕ → ℕ) + (B : (n : ℕ) → ℕ → Finset (V n)) + (hcapture : ∀ n, + MatchedComponentCompletion.sourceCompletionBad + (σ n) (p n) F (P n) ⊆ + P n ∩ matchedRadiusBad + (Q n) (I (r n)) (w n) (B n (r n))) + (hradius : Tendsto + (fun n => + (((P n ∩ matchedRadiusBad + (Q n) (I (r n)) (w n) (B n (r n))).card : ℝ) / (P n).card)) + atTop (nhds 0)) : + Tendsto + (fun n => + ((MatchedComponentExitBudget.sourceWordTestBad + (fun i => MatchedComponentCompletion.completedRestriction + (σ n i) (P n)) + (fun j => MatchedComponentCompletion.completedRestriction + (p n j) (P n)) + F).card : ℝ) / (P n).card) + atTop (nhds 0) := by + exact completed_sourceWordTestBad_density_tendsto_zero + V σ p F P + (fun n => matchedRadiusBad + (Q n) (I (r n)) (w n) (B n (r n))) + hcapture hradius + +public +theorem pruned_sourceCompletionBad_density_tendsto_zero_of_matchedRadius + (V : ℕ → Type*) [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + {ι κ J : Type*} [Fintype ι] [Group J] + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (p : (n : ℕ) → J → Equiv.Perm (V n)) + (F : Finset J) + (U P : (n : ℕ) → Finset (V n)) + (Q : (n : ℕ) → Finpartition (U n)) + (I : ℕ → Finset κ) + (w : (n : ℕ) → κ → Equiv.Perm (V n)) + (r : ℕ → ℕ) + (B : (n : ℕ) → ℕ → Finset (V n)) + (D : (n : ℕ) → Finset {x : V n // x ∈ P n}) + (hcapture : ∀ n, + MatchedComponentCompletion.sourceCompletionBad + (σ n) (p n) F (P n) ⊆ + P n ∩ matchedRadiusBad + (Q n) (I (r n)) (w n) (B n (r n))) + (hradius : Tendsto + (fun n => + (((P n ∩ matchedRadiusBad + (Q n) (I (r n)) (w n) (B n (r n))).card : ℝ) / (P n).card)) + atTop (nhds 0)) + (hZ : ∀ n, + (Finset.univ \ D n : + Finset {x : V n // x ∈ P n}).Nonempty) + (hdeleted : Tendsto + (fun n => ((D n).card : ℝ) / (P n).card) + atTop (nhds 0)) : + Tendsto + (fun n => + ((MatchedComponentCompletion.sourceCompletionBad + (fun i => MatchedComponentCompletion.completedRestriction + (σ n i) (P n)) + (fun j => MatchedComponentCompletion.completedRestriction + (p n j) (P n)) + F (Finset.univ \ D n)).card : ℝ) / + (Finset.univ \ D n : + Finset {x : V n // x ∈ P n}).card) + atTop (nhds 0) := by + have hword := + completed_sourceWordTestBad_density_tendsto_zero_of_matchedRadius + V σ p F U P Q I w r B hcapture hradius + apply MatchedComponentExitBudget.sourceCompletionBad_surviving_density_tendsto_zero + (fun n => {x : V n // x ∈ P n}) + (fun n i => + MatchedComponentCompletion.completedRestriction + (σ n i) (P n)) + (fun n j => + MatchedComponentCompletion.completedRestriction + (p n j) (P n)) + F D hZ + · simpa only [Fintype.card_coe] using hdeleted + · simpa only [Fintype.card_coe] using hword + +end MatchedFirstStageWordRadiusTransfer + +namespace SourceCompressionMatching + +open Filter Topology +open scoped BigOperators symmDiff + +private theorem lt_exp_mul_of_equal_log_floor + {x y H r : ℝ} (hx : 0 < x) (hy : 0 < y) (hH : 0 < H) + (hrank : + ⌊(Real.log x + r) / H⌋ = ⌊(Real.log y + r) / H⌋) : + y < Real.exp H * x := by + have hyfloor := Int.lt_floor_add_one ((Real.log y + r) / H) + rw [← hrank] at hyfloor + have hxloor := Int.floor_le ((Real.log x + r) / H) + have hratio : + (Real.log y + r) / H < (Real.log x + r) / H + 1 := + hyfloor.trans_le (by + simpa only [add_comm, add_le_add_iff_left] using (add_le_add_right hxloor 1)) + have hscaled := mul_lt_mul_of_pos_right hratio hH + have hcancel : + ((Real.log x + r) / H + 1) * H = + Real.log x + r + H := by + rw [add_mul, div_mul_cancel₀ _ hH.ne', one_mul] + have hlog : Real.log y < Real.log x + H := by + rw [div_mul_cancel₀ _ hH.ne', hcancel] at hscaled + linarith + have hexp := (Real.exp_lt_exp).2 hlog + rw [Real.exp_log hy, Real.exp_add, Real.exp_log hx] at hexp + simpa only [mul_comm, gt_iff_lt] using hexp + +public +theorem transported_maximumOverlapPart_card_lt_exp_mul + {V : Type*} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) (C : Finset V) (hC : C ∈ Q.parts) + (H r : ℝ) (hH : 0 < H) (x : V) (hx : x ∈ C) + (hTx : T x ∈ maximumOverlapPart Q + (C.map T.toEmbedding)) + (hrank : + MidrankPermutationEnergy.offsetFloorRank + (fun z : V => + Real.log (partitionComponentSize Q z : ℝ)) + H r (T x) = + MidrankPermutationEnergy.offsetFloorRank + (fun z : V => + Real.log (partitionComponentSize Q z : ℝ)) + H r x) : + ((maximumOverlapPart Q + (C.map T.toEmbedding)).card : ℝ) < + Real.exp H * (C.card : ℝ) := by + let D := maximumOverlapPart Q (C.map T.toEmbedding) + have hCne : C.Nonempty := Q.nonempty_of_mem_parts hC + have hD : D ∈ Q.parts := + maximumOverlapPart_mem Q (C.map T.toEmbedding) + ((Finset.map_nonempty).2 hCne) (Finset.subset_univ _) + have hsource : partitionComponentSize Q x = C.card := + partitionComponentSize_eq_card_of_mem Q C hC x hx + have htarget : partitionComponentSize Q (T x) = D.card := + partitionComponentSize_eq_card_of_mem + Q D hD (T x) hTx + have hfloor : + ⌊(Real.log (C.card : ℝ) + r) / H⌋ = + ⌊(Real.log (D.card : ℝ) + r) / H⌋ := by + simpa only [MidrankPermutationEnergy.offsetFloorRank, hsource, htarget] using hrank.symm + have hxpos : (0 : ℝ) < C.card := by + exact_mod_cast hCne.card_pos + have hypos : (0 : ℝ) < D.card := by + exact_mod_cast (Q.nonempty_of_mem_parts hD).card_pos + exact lt_exp_mul_of_equal_log_floor hxpos hypos hH hfloor + +private theorem card_symmDiff_add_twice_inter + {V : Type*} [DecidableEq V] (C D : Finset V) : + (C ∆ D).card + 2 * (C ∩ D).card = C.card + D.card := by + have hdis : Disjoint (C \ D) (D \ C) := by + apply Finset.disjoint_left.mpr + intro x hx hy + exact (Finset.mem_sdiff.mp hx).2 (Finset.mem_sdiff.mp hy).1 + have hsym : (C ∆ D).card = (C \ D).card + (D \ C).card := by + rw [Finset.symmDiff_def, Finset.card_union_of_disjoint hdis] + have hC := Finset.card_sdiff_add_card_inter C D + have hD := Finset.card_sdiff_add_card_inter D C + rw [Finset.inter_comm D C] at hD + omega + +public +theorem symmDiff_card_lt_of_overlap_and_exp_card + {V : Type*} [DecidableEq V] + (C D : Finset V) (H eta : ℝ) + (hoverlap : + (1 - eta) * (C.card : ℝ) ≤ ((C ∩ D).card : ℝ)) + (hcard : (D.card : ℝ) < Real.exp H * (C.card : ℝ)) : + ((C ∆ D).card : ℝ) < + (Real.exp H - 1 + 2 * eta) * (C.card : ℝ) := by + have hexact : + ((C ∆ D).card : ℝ) + 2 * ((C ∩ D).card : ℝ) = + (C.card : ℝ) + (D.card : ℝ) := by + exact_mod_cast card_symmDiff_add_twice_inter C D + nlinarith + +public +theorem target_majority_of_overlap_and_exp_card + {V : Type*} [DecidableEq V] + (C D : Finset V) (hC : C.Nonempty) (H eta : ℝ) + (hoverlap : + (1 - eta) * (C.card : ℝ) ≤ ((C ∩ D).card : ℝ)) + (hcard : (D.card : ℝ) < Real.exp H * (C.card : ℝ)) + (hsmall : 2 * (Real.exp H - 1 + 2 * eta) < 1) : + D.card < 2 * (C ∩ D).card := by + have hbound := + symmDiff_card_lt_of_overlap_and_exp_card C D H eta hoverlap hcard + have hpositive : (0 : ℝ) < C.card := by + exact_mod_cast hC.card_pos + have hreal : + (2 : ℝ) * ((C ∆ D).card : ℝ) < (C.card : ℝ) := by + calc + (2 : ℝ) * ((C ∆ D).card : ℝ) < + 2 * ((Real.exp H - 1 + 2 * eta) * (C.card : ℝ)) := + mul_lt_mul_of_pos_left hbound (by norm_num) + _ = (2 * (Real.exp H - 1 + 2 * eta)) * (C.card : ℝ) := by + ring + _ < 1 * (C.card : ℝ) := + mul_lt_mul_of_pos_right hsmall hpositive + _ = (C.card : ℝ) := one_mul _ + have hnat : 2 * (C ∆ D).card < C.card := by + exact_mod_cast hreal + exact target_majority_of_small_symmDiff C D hnat + +public +theorem symmDiff_density_tendsto_zero_of_log_rank_bounds + {V : ℕ → Type*} [∀ n, DecidableEq (V n)] + (U : ∀ n, Finset (V n)) (hU : ∀ n, (U n).Nonempty) + (P : ∀ n, Finpartition (U n)) + (R : ∀ n, Finset (Finset (V n))) + (hR : ∀ n, R n ⊆ (P n).parts) + (D : ∀ n, Finset (V n) → Finset (V n)) + (H eta : ℕ → ℝ) + (hH : ∀ n, 0 ≤ H n) (heta : ∀ n, 0 ≤ eta n) + (hHzero : Tendsto H atTop (nhds 0)) + (hetazero : Tendsto eta atTop (nhds 0)) + (hbound : ∀ n C, C ∈ R n → + ((C ∆ D n C).card : ℝ) ≤ + (Real.exp (H n) - 1 + 2 * eta n) * (C.card : ℝ)) : + Tendsto + (fun n => + ((∑ C ∈ R n, (C ∆ D n C).card : ℕ) : ℝ) / (U n).card) + atTop (nhds 0) := by + have hcoeff : Tendsto + (fun n => Real.exp (H n) - 1 + 2 * eta n) + atTop (nhds 0) := by + have hexp : Tendsto (fun n => Real.exp (H n)) atTop (nhds 1) := by + simpa only [Function.comp_def, Real.exp_zero] using (Real.continuous_exp.tendsto (0 : ℝ)).comp + hHzero + have hfirst : Tendsto + (fun n => Real.exp (H n) - 1) atTop (nhds 0) := by + simpa only [sub_self] using hexp.sub_const 1 + have hsecond : Tendsto + (fun n => (2 : ℝ) * eta n) atTop (nhds 0) := by + simpa only [mul_zero] using hetazero.const_mul 2 + simpa only [zero_add] using hfirst.add hsecond + refine squeeze_zero (fun n => by positivity) ?_ hcoeff + intro n + have hpos : (0 : ℝ) < (U n).card := by + exact_mod_cast (hU n).card_pos + have hexp : 1 ≤ Real.exp (H n) := by + simpa only [Real.one_le_exp_iff, Real.exp_zero] using (Real.exp_le_exp.mpr (hH n)) + have hnonneg : 0 ≤ Real.exp (H n) - 1 + 2 * eta n := by + nlinarith [heta n] + have hmassnat : + (∑ C ∈ R n, C.card) ≤ (U n).card := by + calc + (∑ C ∈ R n, C.card) = + (matchedRetainedSupport (R n)).card := + (matchedRetainedSupport_card + (P n) (R n) (hR n)).symm + _ ≤ (U n).card := + Finset.card_le_card + (matchedRetainedSupport_subset + (P n) (R n) (hR n)) + have hmass : + (∑ C ∈ R n, (C.card : ℝ)) ≤ (U n).card := by + exact_mod_cast hmassnat + have hsum : + ((∑ C ∈ R n, (C ∆ D n C).card : ℕ) : ℝ) ≤ + (Real.exp (H n) - 1 + 2 * eta n) * + (∑ C ∈ R n, (C.card : ℝ)) := by + calc + ((∑ C ∈ R n, (C ∆ D n C).card : ℕ) : ℝ) = + ∑ C ∈ R n, ((C ∆ D n C).card : ℝ) := by + simp only [Nat.cast_sum] + _ ≤ ∑ C ∈ R n, + (Real.exp (H n) - 1 + 2 * eta n) * (C.card : ℝ) := by + exact Finset.sum_le_sum fun C hC => hbound n C hC + _ = (Real.exp (H n) - 1 + 2 * eta n) * + (∑ C ∈ R n, (C.card : ℝ)) := by + rw [Finset.mul_sum] + calc + ((∑ C ∈ R n, (C ∆ D n C).card : ℕ) : ℝ) / (U n).card ≤ + ((Real.exp (H n) - 1 + 2 * eta n) * + (∑ C ∈ R n, (C.card : ℝ))) / (U n).card := + (div_le_div_iff_of_pos_right hpos).2 hsum + _ ≤ ((Real.exp (H n) - 1 + 2 * eta n) * + (U n).card) / (U n).card := by + apply (div_le_div_iff_of_pos_right hpos).2 + exact mul_le_mul_of_nonneg_left hmass hnonneg + _ = Real.exp (H n) - 1 + 2 * eta n := by + field_simp + +end SourceCompressionMatching + +namespace SourceCompressionTransportCrossing + +open Filter Topology +open scoped BigOperators + +private theorem mem_partitionWordCrossing_univ + {V : Type*} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) + (p : Equiv.Perm V) (x : V) : + x ∈ partitionWordCrossing Q p ↔ + Q.part x ≠ Q.part (p x) := by + simp only [partitionWordCrossing, Finset.mem_filter, + Finset.mem_univ, true_and] + rw [Q.mem_part_iff_part_eq_part (Finset.mem_univ _) + (Finset.mem_univ _)] + simp only [eq_comm, ne_eq] + +private theorem card_partitionWordCrossing_le_add_distance + {V : Type*} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) + (p q : Equiv.Perm V) : + (partitionWordCrossing Q p).card ≤ + (partitionWordCrossing Q q).card + + permutationDistance p q := by + classical + have hsub : + partitionWordCrossing Q p ⊆ + partitionWordCrossing Q q ∪ + Finset.univ.filter (fun x : V => p x ≠ q x) := by + intro x hx + by_cases heq : p x = q x + · apply Finset.mem_union_left + apply (mem_partitionWordCrossing_univ Q q x).2 + have hp := (mem_partitionWordCrossing_univ Q p x).1 hx + simpa only [ne_eq, heq] using hp + · apply Finset.mem_union_right + exact Finset.mem_filter.2 ⟨Finset.mem_univ x, heq⟩ + calc + (partitionWordCrossing Q p).card ≤ + (partitionWordCrossing Q q ∪ + Finset.univ.filter (fun x : V => p x ≠ q x)).card := + Finset.card_le_card hsub + _ ≤ (partitionWordCrossing Q q).card + + (Finset.univ.filter (fun x : V => p x ≠ q x)).card := + Finset.card_union_le _ _ + _ = (partitionWordCrossing Q q).card + + permutationDistance p q := by + simp only [ne_eq, permutationDistance, hammingDist] + +private theorem tendsto_action_inverse + {G : Type*} [Group G] (A : SoficApproximation G) + (u : G) : + Tendsto + (fun n => normalizedHamming + (((A.model n).action u)⁻¹) + ((A.model n).action (u⁻¹))) + atTop (nhds 0) := by + have heq : + (fun n => normalizedHamming + (((A.model n).action u)⁻¹) + ((A.model n).action (u⁻¹))) = + (fun n => normalizedHamming + ((A.model n).action (u * u⁻¹)) + ((A.model n).action u * (A.model n).action (u⁻¹))) := by + funext n + calc + normalizedHamming + (((A.model n).action u)⁻¹) + ((A.model n).action (u⁻¹)) = + normalizedHamming + ((A.model n).action u * ((A.model n).action u)⁻¹) + ((A.model n).action u * (A.model n).action (u⁻¹)) := + (normalizedHamming_mul_left + ((A.model n).action u) + (((A.model n).action u)⁻¹) + ((A.model n).action (u⁻¹))).symm + _ = normalizedHamming + ((A.model n).action (u * u⁻¹)) + ((A.model n).action u * (A.model n).action (u⁻¹)) := by + simp only [mul_inv_cancel, (A.model n).map_one] + rw [heq] + exact A.multiplicative u (u⁻¹) + +public +theorem tendsto_action_conjugate + {G : Type*} [Group G] (A : SoficApproximation G) + (u g : G) : + Tendsto + (fun n => normalizedHamming + ((A.model n).action (u * g * u⁻¹)) + ((A.model n).action u * (A.model n).action g * + ((A.model n).action u)⁻¹)) + atTop (nhds 0) := by + have hbound : ∀ n, + normalizedHamming + ((A.model n).action (u * g * u⁻¹)) + ((A.model n).action u * (A.model n).action g * + ((A.model n).action u)⁻¹) ≤ + normalizedHamming + ((A.model n).action (u * g * u⁻¹)) + ((A.model n).action (u * g) * (A.model n).action (u⁻¹)) + + (normalizedHamming + ((A.model n).action (u * g)) + ((A.model n).action u * (A.model n).action g) + + normalizedHamming + ((A.model n).action (u⁻¹)) + (((A.model n).action u)⁻¹)) := by + intro n + calc + normalizedHamming + ((A.model n).action (u * g * u⁻¹)) + ((A.model n).action u * (A.model n).action g * + ((A.model n).action u)⁻¹) ≤ + normalizedHamming + ((A.model n).action (u * g * u⁻¹)) + ((A.model n).action (u * g) * (A.model n).action (u⁻¹)) + + normalizedHamming + ((A.model n).action (u * g) * (A.model n).action (u⁻¹)) + ((A.model n).action u * (A.model n).action g * + ((A.model n).action u)⁻¹) := + normalizedHamming_triangle _ _ _ + _ ≤ normalizedHamming + ((A.model n).action (u * g * u⁻¹)) + ((A.model n).action (u * g) * (A.model n).action (u⁻¹)) + + (normalizedHamming + ((A.model n).action (u * g) * (A.model n).action (u⁻¹)) + (((A.model n).action u * (A.model n).action g) * + (A.model n).action (u⁻¹)) + + normalizedHamming + (((A.model n).action u * (A.model n).action g) * + (A.model n).action (u⁻¹)) + (((A.model n).action u * (A.model n).action g) * + ((A.model n).action u)⁻¹)) := by + gcongr + exact normalizedHamming_triangle _ _ _ + _ = normalizedHamming + ((A.model n).action (u * g * u⁻¹)) + ((A.model n).action (u * g) * (A.model n).action (u⁻¹)) + + (normalizedHamming + ((A.model n).action (u * g)) + ((A.model n).action u * (A.model n).action g) + + normalizedHamming + ((A.model n).action (u⁻¹)) + (((A.model n).action u)⁻¹)) := by + rw [normalizedHamming_mul_right, + normalizedHamming_mul_left] + apply squeeze_zero + (fun n => normalizedHamming_nonneg _ _) hbound + convert (A.multiplicative (u * g) (u⁻¹)).add + ((A.multiplicative u g).add + (tendsto_action_inverse A u)) using 1 + · funext n + rw [normalizedHamming_comm + ((A.model n).action (u⁻¹)) + (((A.model n).action u)⁻¹)] + · norm_num + +public +theorem conjugated_word_crossing_density_tendsto_zero + {G : Type*} [Group G] (A : SoficApproximation G) + (u g : G) + (Q : ∀ n, Finpartition + (Finset.univ : Finset (Fin (A.model n).size))) + (hword : Tendsto + (fun n => + ((partitionWordCrossing (Q n) + ((A.model n).action (u * g * u⁻¹))).card : ℝ) / + (A.model n).size) + atTop (nhds 0)) : + Tendsto + (fun n => + ((partitionWordCrossing (Q n) + ((A.model n).action u * (A.model n).action g * + ((A.model n).action u)⁻¹)).card : ℝ) / + (A.model n).size) + atTop (nhds 0) := by + have hdist : Tendsto + (fun n => normalizedHamming + ((A.model n).action u * (A.model n).action g * + ((A.model n).action u)⁻¹) + ((A.model n).action (u * g * u⁻¹))) + atTop (nhds 0) := by + have heq : + (fun n => normalizedHamming + ((A.model n).action u * (A.model n).action g * + ((A.model n).action u)⁻¹) + ((A.model n).action (u * g * u⁻¹))) = + (fun n => normalizedHamming + ((A.model n).action (u * g * u⁻¹)) + ((A.model n).action u * (A.model n).action g * + ((A.model n).action u)⁻¹)) := by + funext n + exact normalizedHamming_comm _ _ + rw [heq] + exact tendsto_action_conjugate A u g + have hupper : Tendsto + (fun n => + ((partitionWordCrossing (Q n) + ((A.model n).action (u * g * u⁻¹))).card : ℝ) / + (A.model n).size + + normalizedHamming + ((A.model n).action u * (A.model n).action g * + ((A.model n).action u)⁻¹) + ((A.model n).action (u * g * u⁻¹))) + atTop (nhds 0) := by + simpa only [add_zero] using hword.add hdist + refine squeeze_zero (fun n => by positivity) ?_ hupper + intro n + have hnat := card_partitionWordCrossing_le_add_distance (Q n) + ((A.model n).action u * (A.model n).action g * + ((A.model n).action u)⁻¹) + ((A.model n).action (u * g * u⁻¹)) + have hreal : + ((partitionWordCrossing (Q n) + ((A.model n).action u * (A.model n).action g * + ((A.model n).action u)⁻¹)).card : ℝ) ≤ + ((partitionWordCrossing (Q n) + ((A.model n).action (u * g * u⁻¹))).card : ℝ) + + (permutationDistance + ((A.model n).action u * (A.model n).action g * + ((A.model n).action u)⁻¹) + ((A.model n).action (u * g * u⁻¹)) : ℝ) := by + exact_mod_cast hnat + calc + ((partitionWordCrossing (Q n) + ((A.model n).action u * (A.model n).action g * + ((A.model n).action u)⁻¹)).card : ℝ) / + (A.model n).size ≤ + (((partitionWordCrossing (Q n) + ((A.model n).action (u * g * u⁻¹))).card : ℝ) + + (permutationDistance + ((A.model n).action u * (A.model n).action g * + ((A.model n).action u)⁻¹) + ((A.model n).action (u * g * u⁻¹)) : ℝ)) / + (A.model n).size := + div_le_div_of_nonneg_right hreal (by positivity) + _ = ((partitionWordCrossing (Q n) + ((A.model n).action (u * g * u⁻¹))).card : ℝ) / + (A.model n).size + + normalizedHamming + ((A.model n).action u * (A.model n).action g * + ((A.model n).action u)⁻¹) + ((A.model n).action (u * g * u⁻¹)) := by + simp only [permutationDistance, Equiv.Perm.coe_mul, Equiv.Perm.coe_inv, Function.comp_apply, + add_div, + normalizedHamming, Fintype.card_fin] + +end SourceCompressionTransportCrossing + +namespace KunResidualRetainedSelection + +open Filter Topology +open scoped BigOperators Pointwise symmDiff + +private theorem exists_matchedRetained_part_boundary_and_bad_density_le + {V ι : Type*} [DecidableEq V] [Fintype ι] + (σ : ι → Equiv.Perm V) {U : Finset V} + (P : Finpartition U) (R : Finset (Finset V)) + (hR : R ⊆ P.parts) (hRne : R.Nonempty) (B : Finset V) : + ∃ C ∈ R, + (boundary σ C : ℝ) / C.card ≤ + ((∑ D ∈ R, (boundary σ D : ℝ)) + + ((matchedRetainedSupport R ∩ B).card : ℝ)) / + (matchedRetainedSupport R).card ∧ + ((C ∩ B).card : ℝ) / C.card ≤ + ((∑ D ∈ R, (boundary σ D : ℝ)) + + ((matchedRetainedSupport R ∩ B).card : ℝ)) / + (matchedRetainedSupport R).card := by + let PR := matchedRetainedFinpartition P R hR + have hweight : ∀ C ∈ R, 0 < (C.card : ℝ) := by + intro C hC + exact_mod_cast (P.nonempty_of_mem_parts (hR hC)).card_pos + obtain ⟨C, hC, haverage⟩ := + matched_exists_le_weighted_average R hRne + (fun C : Finset V => (C.card : ℝ)) + (fun C : Finset V => (boundary σ C : ℝ) + + ((C ∩ B).card : ℝ)) hweight + have hbad : + (∑ D ∈ R, ((D ∩ B).card : ℝ)) = + ((matchedRetainedSupport R ∩ B).card : ℝ) := by + have h := matched_sum_card_inter_partition PR B + exact_mod_cast h + have hmass : + (∑ D ∈ R, (D.card : ℝ)) = + ((matchedRetainedSupport R).card : ℝ) := by + exact_mod_cast (matchedRetainedSupport_card P R hR).symm + have haverage' : + ((boundary σ C : ℝ) + ((C ∩ B).card : ℝ)) / + C.card ≤ + ((∑ D ∈ R, (boundary σ D : ℝ)) + + ((matchedRetainedSupport R ∩ B).card : ℝ)) / + (matchedRetainedSupport R).card := by + simpa only [Finset.sum_add_distrib, hbad, hmass] using haverage + have hden : (0 : ℝ) ≤ C.card := Nat.cast_nonneg _ + refine ⟨C, hC, ?_, ?_⟩ + · exact (div_le_div_of_nonneg_right + (le_add_of_nonneg_right (Nat.cast_nonneg (C ∩ B).card)) hden).trans + haverage' + · exact (div_le_div_of_nonneg_right + (le_add_of_nonneg_left + (Nat.cast_nonneg (boundary σ C))) hden).trans + haverage' + +private theorem matchedRetained_boundary_density_tendsto_zero + {V : ℕ → Type*} [∀ n, DecidableEq (V n)] + {ι : Type*} [Fintype ι] + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (U : ∀ n, Finset (V n)) (hU : ∀ n, (U n).Nonempty) + (P : ∀ n, Finpartition (U n)) + (R : ∀ n, Finset (Finset (V n))) + (hR : ∀ n, R n ⊆ (P n).parts) + (hRne : ∀ n, (R n).Nonempty) + (hdiscard : Tendsto + (fun n => (((U n \ matchedRetainedSupport (R n)).card : ℝ) / + (U n).card)) atTop (𝓝 0)) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (P n).parts, (boundary (σ n) C : ℝ)) / + (U n).card) atTop (𝓝 0)) : + Tendsto + (fun n => + (∑ C ∈ R n, (boundary (σ n) C : ℝ)) / + (matchedRetainedSupport (R n)).card) + atTop (𝓝 0) := by + have hcover := matchedRetainedSupport_cover_density_tendsto_one + U hU P R hR hdiscard + have hhalf : ∀ᶠ n in atTop, + (1 / 2 : ℝ) ≤ + ((matchedRetainedSupport (R n)).card : ℝ) / + (U n).card := + (hcover.eventually (lt_mem_nhds (by norm_num : (1 / 2 : ℝ) < 1))).mono + fun _ h => h.le + have htwice : Tendsto + (fun n => + (2 : ℝ) * + ((∑ C ∈ (P n).parts, + (boundary (σ n) C : ℝ)) / (U n).card)) + atTop (𝓝 0) := by + simpa only [mul_zero] using + (tendsto_const_nhds.mul hboundary : + Tendsto + (fun n => + (2 : ℝ) * + ((∑ C ∈ (P n).parts, + (boundary (σ n) C : ℝ)) / (U n).card)) + atTop (𝓝 ((2 : ℝ) * 0))) + refine squeeze_zero' + (Eventually.of_forall fun n => by positivity) ?_ htwice + filter_upwards [hhalf] with n hn + have hucard : (0 : ℝ) < (U n).card := by + exact_mod_cast (hU n).card_pos + have hrcard : + (0 : ℝ) < (matchedRetainedSupport (R n)).card := by + exact_mod_cast + (matchedRetainedSupport_nonempty + (P n) (R n) (hR n) (hRne n)).card_pos + have hmass : + ((U n).card : ℝ) ≤ + 2 * (matchedRetainedSupport (R n)).card := by + have h := (le_div_iff₀ hucard).1 hn + linarith + have hsum : + (∑ C ∈ R n, (boundary (σ n) C : ℝ)) ≤ + ∑ C ∈ (P n).parts, (boundary (σ n) C : ℝ) := by + apply Finset.sum_le_sum_of_subset_of_nonneg (hR n) + intro C _ _ + positivity + calc + (∑ C ∈ R n, (boundary (σ n) C : ℝ)) / + (matchedRetainedSupport (R n)).card ≤ + (∑ C ∈ (P n).parts, (boundary (σ n) C : ℝ)) / + (matchedRetainedSupport (R n)).card := + div_le_div_of_nonneg_right hsum hrcard.le + _ ≤ 2 * + ((∑ C ∈ (P n).parts, (boundary (σ n) C : ℝ)) / + (U n).card) := by + rw [← mul_div_assoc] + apply (div_le_div_iff₀ hrcard hucard).2 + simpa only [mul_comm, mul_left_comm, mul_assoc] using + (mul_le_mul_of_nonneg_left hmass (Finset.sum_nonneg fun C _ => Nat.cast_nonneg + (boundary (σ n) C))) + +private theorem exists_matchedRetained_parts_with_vanishing_boundary_and_bad_density + {V : ℕ → Type*} [∀ n, DecidableEq (V n)] + {ι : Type*} [Fintype ι] + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (U : ∀ n, Finset (V n)) (hU : ∀ n, (U n).Nonempty) + (P : ∀ n, Finpartition (U n)) + (R : ∀ n, Finset (Finset (V n))) + (hR : ∀ n, R n ⊆ (P n).parts) + (hRne : ∀ n, (R n).Nonempty) + (hdiscard : Tendsto + (fun n => (((U n \ matchedRetainedSupport (R n)).card : ℝ) / + (U n).card)) atTop (𝓝 0)) + (B : ∀ n, Finset (V n)) + (hbad : Tendsto + (fun n => (((U n ∩ B n).card : ℝ) / (U n).card)) + atTop (𝓝 0)) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (P n).parts, (boundary (σ n) C : ℝ)) / + (U n).card) atTop (𝓝 0)) : + ∃ C : ∀ n, Finset (V n), + (∀ n, C n ∈ R n) ∧ + Tendsto + (fun n => (boundary (σ n) (C n) : ℝ) / (C n).card) + atTop (𝓝 0) ∧ + Tendsto + (fun n => (((C n ∩ B n).card : ℝ) / (C n).card)) + atTop (𝓝 0) := by + have hretboundary := matchedRetained_boundary_density_tendsto_zero + σ U hU P R hR hRne hdiscard hboundary + have hretbad := matchedRetained_bad_density_tendsto_zero + U hU P R hR hRne hdiscard B hbad + have hcombined : Tendsto + (fun n => + ((∑ D ∈ R n, (boundary (σ n) D : ℝ)) + + ((matchedRetainedSupport (R n) ∩ B n).card : ℝ)) / + (matchedRetainedSupport (R n)).card) + atTop (𝓝 0) := by + simpa only [add_div, add_zero] using hretboundary.add hretbad + have hchoose (n : ℕ) := + exists_matchedRetained_part_boundary_and_bad_density_le + (σ n) (P n) (R n) (hR n) (hRne n) (B n) + let C : ∀ n, Finset (V n) := fun n => (hchoose n).choose + have hC (n : ℕ) : C n ∈ R n := (hchoose n).choose_spec.1 + have hCb (n : ℕ) : + (boundary (σ n) (C n) : ℝ) / (C n).card ≤ + ((∑ D ∈ R n, (boundary (σ n) D : ℝ)) + + ((matchedRetainedSupport (R n) ∩ B n).card : ℝ)) / + (matchedRetainedSupport (R n)).card := + (hchoose n).choose_spec.2.1 + have hCe (n : ℕ) : + ((C n ∩ B n).card : ℝ) / (C n).card ≤ + ((∑ D ∈ R n, (boundary (σ n) D : ℝ)) + + ((matchedRetainedSupport (R n) ∩ B n).card : ℝ)) / + (matchedRetainedSupport (R n)).card := + (hchoose n).choose_spec.2.2 + exact ⟨C, hC, + squeeze_zero (fun n => by positivity) hCb hcombined, + squeeze_zero (fun n => by positivity) hCe hcombined⟩ + +private theorem exists_matched_slow_diagonal_large_components_with_vanishing_boundary + {K : Type*} [Group K] [Infinite K] [DecidableEq K] + (S : Finset K) (hS : 1 ∈ S) + (hgen : Subgroup.closure (S : Set K) = ⊤) + {V : ℕ → Type*} [∀ n, DecidableEq (V n)] + {ι κ : Type*} [Fintype κ] + (σ : (n : ℕ) → κ → Equiv.Perm (V n)) + (U : ∀ n, Finset (V n)) (hU : ∀ n, (U n).Nonempty) + (P Q : ∀ n, Finpartition (U n)) + (R : ∀ n, Finset (Finset (V n))) + (hR : ∀ n, R n ⊆ (P n).parts) + (hRne : ∀ n, (R n).Nonempty) + (D : ∀ n, Finset (V n) → Finset (V n)) + (hD : ∀ n C, C ∈ R n → D n C ∈ (Q n).parts) + (hmajor : ∀ n C, C ∈ R n → + (D n C).card < 2 * (C ∩ D n C).card) + (hdiscard : Tendsto + (fun n => + (((U n \ matchedRetainedSupport (R n)).card : ℝ) / + (U n).card)) atTop (𝓝 0)) + (hsymm : Tendsto + (fun n => + ((∑ C ∈ R n, (C ∆ D n C).card : ℕ) : ℝ) / (U n).card) + atTop (𝓝 0)) + (I : ℕ → Finset ι) + (w : ∀ n, ι → Equiv.Perm (V n)) + (hword : ∀ k, Tendsto + (fun n => + ((∑ i ∈ I k, + (partitionWordCrossing (Q n) (w n i)).card : ℕ) : + ℝ) / (U n).card) + atTop (𝓝 0)) + (B : ∀ n, ℕ → Finset (V n)) + (hbad : ∀ k, Tendsto + (fun n => (((U n ∩ B n k).card : ℝ) / (U n).card)) + atTop (𝓝 0)) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (P n).parts, (boundary (σ n) C : ℝ)) / + (U n).card) atTop (𝓝 0)) + (hrealize : ∀ n k (C : Finset (V n)), C ∈ R n → + ∀ x ∈ C, + x ∉ matchedRadiusBad + (P n) (I k) (w n) (B n k) → + ∃ f : K → V n, + Set.MapsTo f (↑(S ^ (k / 2)) : Set K) (↑C : Set (V n)) ∧ + Set.InjOn f (↑(S ^ (k / 2)) : Set K)) : + ∃ (r : ℕ → ℕ) (C : ∀ n, Finset (V n)), + Tendsto r atTop atTop ∧ + (∀ n, C n ∈ R n) ∧ + Tendsto + (fun n => + (boundary (σ n) (C n) : ℝ) / (C n).card) + atTop (𝓝 0) ∧ + Tendsto + (fun n => + (((C n ∩ + matchedRadiusBad + (P n) (I (r n)) (w n) (B n (r n))).card : ℝ) / + (C n).card)) + atTop (𝓝 0) ∧ + Tendsto (fun n => (C n).card) atTop atTop := by + obtain ⟨r, hr, herror⟩ := + exists_matched_slow_diagonal_word_errors + U P Q R hR D hD hmajor hdiscard hsymm I w hword B hbad + let B' : ∀ n, Finset (V n) := fun n => + matchedRadiusBad (P n) (I (r n)) (w n) (B n (r n)) + have hB' : Tendsto + (fun n => (((U n ∩ B' n).card : ℝ) / (U n).card)) + atTop (𝓝 0) := by + refine squeeze_zero (fun n => by positivity) ?_ herror + intro n + have hcard : + ((U n ∩ B' n).card : ℝ) ≤ + ((∑ i ∈ I (r n), + (partitionWordCrossing + (P n) (w n i)).card : ℕ) : ℝ) + + ((U n ∩ B n (r n)).card : ℝ) := by + have h := matchedRadiusBad_card_le + (P n) (I (r n)) (w n) (B n (r n)) + have h' : + (U n ∩ + matchedRadiusBad + (P n) (I (r n)) (w n) (B n (r n))).card ≤ + (∑ i ∈ I (r n), + (partitionWordCrossing + (P n) (w n i)).card) + + (U n ∩ B n (r n)).card := by + omega + dsimp [B'] + exact_mod_cast h' + exact div_le_div_of_nonneg_right hcard (by positivity) + obtain ⟨C, hC, hCboundary, hCerror⟩ := + exists_matchedRetained_parts_with_vanishing_boundary_and_bad_density + σ U hU P R hR hRne hdiscard B' hB' hboundary + have hCnonempty (n : ℕ) : (C n).Nonempty := + (P n).nonempty_of_mem_parts (hR n (hC n)) + have hgood : ∀ᶠ n in atTop, ∃ x ∈ C n, x ∉ B' n := + matched_eventually_exists_good_vertex + C B' hCnonempty hCerror + have hhalf : Tendsto (fun n => r n / 2) atTop atTop := + (Nat.tendsto_div_const_atTop (by norm_num : (2 : ℕ) ≠ 0)).comp hr + have hclosure : + (Subgroup.closure (S : Set K) : Set K).Infinite := by + simpa only [hgen, Subgroup.coe_top] using (Set.infinite_univ (α := K)) + have hlarge : Tendsto (fun n => (C n).card) atTop atTop := by + refine tendsto_atTop_mono' atTop ?_ hhalf + filter_upwards [hgood] with n hn + obtain ⟨x, hx, hx'⟩ := hn + obtain ⟨f, hf, hfinj⟩ := + hrealize n (r n) (C n) (hC n) x hx hx' + exact (Nat.le_succ (r n / 2)).trans + ((Finset.add_one_le_card_pow hS hclosure (r n / 2)).trans + (Finset.card_le_card_of_injOn f hf hfinj)) + exact ⟨r, C, hr, hC, hCboundary, hCerror, hlarge⟩ + +private theorem matchedRetained_parts_eventually_nonempty_of_discard + {V : ℕ → Type*} [∀ n, DecidableEq (V n)] + (U : ∀ n, Finset (V n)) (hU : ∀ n, (U n).Nonempty) + (R : ∀ n, Finset (Finset (V n))) + (hdiscard : Tendsto + (fun n => + (((U n \ matchedRetainedSupport (R n)).card : ℝ) / + (U n).card)) atTop (𝓝 0)) : + ∀ᶠ n in atTop, (R n).Nonempty := by + filter_upwards [hdiscard.eventually (gt_mem_nhds zero_lt_one)] with n hn + by_contra hR + have hrempty : R n = ∅ := Finset.not_nonempty_iff_eq_empty.mp hR + have hucard : ((U n).card : ℝ) ≠ 0 := by + exact_mod_cast (hU n).card_pos.ne' + have hsupport : matchedRetainedSupport (R n) = ∅ := by + simp only [matchedRetainedSupport, hrempty, Finset.biUnion_empty] + simp only [hsupport, Finset.sdiff_empty] at hn + rw [div_self hucard] at hn + exact (lt_irrefl (1 : ℝ)) hn + +private theorem exists_matched_slow_diagonal_large_components_on_guarded_tail + {K : Type*} [Group K] [Infinite K] [DecidableEq K] + (S : Finset K) (hS : 1 ∈ S) + (hgen : Subgroup.closure (S : Set K) = ⊤) + {V : ℕ → Type*} [∀ n, DecidableEq (V n)] + {ι κ : Type*} [Fintype κ] + (σ : (n : ℕ) → κ → Equiv.Perm (V n)) + (U : ∀ n, Finset (V n)) (hU : ∀ n, (U n).Nonempty) + (P Q : ∀ n, Finpartition (U n)) + (R : ∀ n, Finset (Finset (V n))) + (hR : ∀ n, R n ⊆ (P n).parts) + (D : ∀ n, Finset (V n) → Finset (V n)) + (hD : ∀ n C, C ∈ R n → D n C ∈ (Q n).parts) + (guard : ℕ → Prop) + (hguard : ∀ᶠ n in atTop, guard n) + (hmajor : ∀ n, guard n → ∀ C, C ∈ R n → + (D n C).card < 2 * (C ∩ D n C).card) + (hdiscard : Tendsto + (fun n => + (((U n \ matchedRetainedSupport (R n)).card : ℝ) / + (U n).card)) atTop (𝓝 0)) + (hsymm : Tendsto + (fun n => + ((∑ C ∈ R n, (C ∆ D n C).card : ℕ) : ℝ) / + (U n).card) + atTop (𝓝 0)) + (I : ℕ → Finset ι) + (w : ∀ n, ι → Equiv.Perm (V n)) + (hword : ∀ k, Tendsto + (fun n => + ((∑ i ∈ I k, + (partitionWordCrossing (Q n) (w n i)).card : + ℕ) : ℝ) / (U n).card) + atTop (𝓝 0)) + (B : ∀ n, ℕ → Finset (V n)) + (hbad : ∀ k, Tendsto + (fun n => (((U n ∩ B n k).card : ℝ) / (U n).card)) + atTop (𝓝 0)) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (P n).parts, (boundary (σ n) C : ℝ)) / + (U n).card) atTop (𝓝 0)) + (hrealize : ∀ n k (C : Finset (V n)), C ∈ R n → + ∀ x ∈ C, + x ∉ matchedRadiusBad + (P n) (I k) (w n) (B n k) → + ∃ f : K → V n, + Set.MapsTo f (↑(S ^ (k / 2)) : Set K) + (↑C : Set (V n)) ∧ + Set.InjOn f (↑(S ^ (k / 2)) : Set K)) + (N₀ : ℕ) : + ∃ (N : ℕ) (r : ℕ → ℕ) + (C : (n : ℕ) → Finset (V (n + N))), + N₀ ≤ N ∧ + (∀ n, guard (n + N)) ∧ + Tendsto r atTop atTop ∧ + (∀ n, C n ∈ R (n + N)) ∧ + Tendsto + (fun n => + (boundary (σ (n + N)) (C n) : ℝ) / + (C n).card) + atTop (𝓝 0) ∧ + Tendsto + (fun n => + (((C n ∩ + matchedRadiusBad + (P (n + N)) (I (r n)) (w (n + N)) + (B (n + N) (r n))).card : ℝ) / + (C n).card)) + atTop (𝓝 0) ∧ + Tendsto (fun n => (C n).card) atTop atTop := by + have hretained := + matchedRetained_parts_eventually_nonempty_of_discard + U hU R hdiscard + obtain ⟨N₁, hN₁⟩ := + eventually_atTop.1 (hretained.and hguard) + let N : ℕ := max N₀ N₁ + have htail (n : ℕ) : + (R (n + N)).Nonempty ∧ guard (n + N) := + hN₁ (n + N) (by dsimp [N]; omega) + have hshift : Tendsto (fun n : ℕ => n + N) atTop atTop := + tendsto_add_atTop_nat N + have hdiscard' : Tendsto + (fun n => + (((U (n + N) \ + matchedRetainedSupport (R (n + N))).card : ℝ) / + (U (n + N)).card)) + atTop (𝓝 0) := by + simpa only [Function.comp_def] using hdiscard.comp hshift + have hsymm' : Tendsto + (fun n => + ((∑ C ∈ R (n + N), + (C ∆ D (n + N) C).card : ℕ) : ℝ) / + (U (n + N)).card) + atTop (𝓝 0) := by + simpa only [Function.comp_def] using hsymm.comp hshift + have hword' (k : ℕ) : Tendsto + (fun n => + ((∑ i ∈ I k, + (partitionWordCrossing + (Q (n + N)) (w (n + N) i)).card : ℕ) : ℝ) / + (U (n + N)).card) + atTop (𝓝 0) := by + simpa only [Function.comp_def] using (hword k).comp hshift + have hbad' (k : ℕ) : Tendsto + (fun n => + (((U (n + N) ∩ B (n + N) k).card : ℝ) / + (U (n + N)).card)) + atTop (𝓝 0) := by + simpa only [Function.comp_def] using (hbad k).comp hshift + have hboundary' : Tendsto + (fun n => + (∑ C ∈ (P (n + N)).parts, + (boundary (σ (n + N)) C : ℝ)) / + (U (n + N)).card) + atTop (𝓝 0) := by + simpa only [Function.comp_def] using hboundary.comp hshift + obtain ⟨r, C, hr, hC, hCboundary, hCbad, hClarge⟩ := + exists_matched_slow_diagonal_large_components_with_vanishing_boundary + S hS hgen + (fun n => σ (n + N)) + (fun n => U (n + N)) + (fun n => hU (n + N)) + (fun n => P (n + N)) + (fun n => Q (n + N)) + (fun n => R (n + N)) + (fun n => hR (n + N)) + (fun n => (htail n).1) + (fun n C => D (n + N) C) + (fun n C hC => hD (n + N) C hC) + (fun n C hC => hmajor (n + N) (htail n).2 C hC) + hdiscard' hsymm' I + (fun n => w (n + N)) + hword' + (fun n k => B (n + N) k) + hbad' hboundary' + (fun n k C hC x hx hx' => + hrealize (n + N) k C hC x hx hx') + refine ⟨N, r, C, ?_, (fun n => (htail n).2), hr, hC, + hCboundary, hCbad, hClarge⟩ + exact le_max_left _ _ + +private theorem source_compression_scale_guard_eventually + (H eta : ℕ → ℝ) + (hH : Tendsto H atTop (𝓝 0)) + (heta : Tendsto eta atTop (𝓝 0)) : + ∀ᶠ n in atTop, + eta n ≤ (1 : ℝ) / 2 ∧ + 2 * (Real.exp (H n) - 1 + 2 * eta n) < 1 := by + have hhalf : ∀ᶠ n in atTop, eta n ≤ (1 : ℝ) / 2 := + (heta.eventually (gt_mem_nhds (by norm_num : + (0 : ℝ) < (1 : ℝ) / 2))).mono fun _ h => h.le + have hexp : Tendsto + (fun n => Real.exp (H n)) atTop (𝓝 1) := by + simpa only [Function.comp_def, Real.exp_zero] using + (Real.continuous_exp.tendsto (0 : ℝ)).comp hH + have hinner : Tendsto + (fun n => Real.exp (H n) - 1 + 2 * eta n) + atTop (𝓝 0) := by + have htwo : Tendsto + (fun n => (2 : ℝ) * eta n) atTop (𝓝 0) := by + simpa only [mul_zero] using + ((tendsto_const_nhds : + Tendsto (fun _ : ℕ => (2 : ℝ)) atTop (𝓝 2)).mul heta) + have hone : Tendsto + (fun _ : ℕ => (1 : ℝ)) atTop (𝓝 1) := + tendsto_const_nhds + simpa only [sub_self, add_zero] using (hexp.sub hone).add htwo + have hsmallLimit : Tendsto + (fun n => (2 : ℝ) * (Real.exp (H n) - 1 + 2 * eta n)) + atTop (𝓝 0) := by + simpa only [mul_zero] using + ((tendsto_const_nhds : + Tendsto (fun _ : ℕ => (2 : ℝ)) atTop (𝓝 2)).mul hinner) + exact hhalf.and + (hsmallLimit.eventually (gt_mem_nhds zero_lt_one)) + +public +theorem exists_matched_slow_diagonal_large_components_on_source_scale_tail + {K : Type*} [Group K] [Infinite K] [DecidableEq K] + (S : Finset K) (hS : 1 ∈ S) + (hgen : Subgroup.closure (S : Set K) = ⊤) + {V : ℕ → Type*} [∀ n, DecidableEq (V n)] + {ι κ : Type*} [Fintype κ] + (σ : (n : ℕ) → κ → Equiv.Perm (V n)) + (U : ∀ n, Finset (V n)) (hU : ∀ n, (U n).Nonempty) + (P Q : ∀ n, Finpartition (U n)) + (R : ∀ n, Finset (Finset (V n))) + (hR : ∀ n, R n ⊆ (P n).parts) + (D : ∀ n, Finset (V n) → Finset (V n)) + (hD : ∀ n C, C ∈ R n → D n C ∈ (Q n).parts) + (H eta : ℕ → ℝ) + (hH : Tendsto H atTop (𝓝 0)) + (heta : Tendsto eta atTop (𝓝 0)) + (hmajor : ∀ n, + eta n ≤ (1 : ℝ) / 2 → + 2 * (Real.exp (H n) - 1 + 2 * eta n) < 1 → + ∀ C, C ∈ R n → + (D n C).card < 2 * (C ∩ D n C).card) + (hdiscard : Tendsto + (fun n => + (((U n \ matchedRetainedSupport (R n)).card : ℝ) / + (U n).card)) atTop (𝓝 0)) + (hsymm : Tendsto + (fun n => + ((∑ C ∈ R n, (C ∆ D n C).card : ℕ) : ℝ) / + (U n).card) + atTop (𝓝 0)) + (I : ℕ → Finset ι) + (w : ∀ n, ι → Equiv.Perm (V n)) + (hword : ∀ k, Tendsto + (fun n => + ((∑ i ∈ I k, + (partitionWordCrossing (Q n) (w n i)).card : + ℕ) : ℝ) / (U n).card) + atTop (𝓝 0)) + (B : ∀ n, ℕ → Finset (V n)) + (hbad : ∀ k, Tendsto + (fun n => (((U n ∩ B n k).card : ℝ) / (U n).card)) + atTop (𝓝 0)) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (P n).parts, (boundary (σ n) C : ℝ)) / + (U n).card) atTop (𝓝 0)) + (hrealize : ∀ n k (C : Finset (V n)), C ∈ R n → + ∀ x ∈ C, + x ∉ matchedRadiusBad + (P n) (I k) (w n) (B n k) → + ∃ f : K → V n, + Set.MapsTo f (↑(S ^ (k / 2)) : Set K) + (↑C : Set (V n)) ∧ + Set.InjOn f (↑(S ^ (k / 2)) : Set K)) + (N₀ : ℕ) : + ∃ (N : ℕ) (r : ℕ → ℕ) + (C : (n : ℕ) → Finset (V (n + N))), + N₀ ≤ N ∧ + (∀ n, eta (n + N) ≤ (1 : ℝ) / 2) ∧ + (∀ n, + 2 * (Real.exp (H (n + N)) - 1 + + 2 * eta (n + N)) < 1) ∧ + Tendsto r atTop atTop ∧ + (∀ n, C n ∈ R (n + N)) ∧ + Tendsto + (fun n => + (boundary (σ (n + N)) (C n) : ℝ) / + (C n).card) + atTop (𝓝 0) ∧ + Tendsto + (fun n => + (((C n ∩ + matchedRadiusBad + (P (n + N)) (I (r n)) (w (n + N)) + (B (n + N) (r n))).card : ℝ) / + (C n).card)) + atTop (𝓝 0) ∧ + Tendsto (fun n => (C n).card) atTop atTop := by + let guard : ℕ → Prop := fun n => + eta n ≤ (1 : ℝ) / 2 ∧ + 2 * (Real.exp (H n) - 1 + 2 * eta n) < 1 + have hguard : ∀ᶠ n in atTop, guard n := + source_compression_scale_guard_eventually H eta hH heta + obtain ⟨N, r, C, hN, hg, hr, hC, hCboundary, hCbad, hClarge⟩ := + exists_matched_slow_diagonal_large_components_on_guarded_tail + S hS hgen σ U hU P Q R hR D hD guard hguard + (fun n hn C hC => hmajor n hn.1 hn.2 C hC) + hdiscard hsymm I w hword B hbad hboundary hrealize N₀ + exact ⟨N, r, C, hN, + (fun n => (hg n).1), (fun n => (hg n).2), + hr, hC, hCboundary, hCbad, hClarge⟩ + +end KunResidualRetainedSelection + +namespace KunUniversalGoodRootReferenceCuts + +open scoped symmDiff + +private theorem reference_difference_le_symmDiff_add_missing + {α : Type*} [DecidableEq α] + (U T W : Finset α) (hsub : T ⊆ W) : + (U \ W).card + (W \ U).card ≤ + (U ∆ T).card + (W \ T).card := by + have hdisjoint : Disjoint (U \ W) (W \ U) := + Finset.disjoint_of_subset_right Finset.sdiff_subset + Finset.sdiff_disjoint + have htw : (T ∆ W).card = (W \ T).card := by + rw [Finset.symmDiff_def, + Finset.sdiff_eq_empty_iff_subset.mpr hsub, + Finset.empty_union] + calc + (U \ W).card + (W \ U).card = (U ∆ W).card := by + rw [Finset.symmDiff_def, + Finset.card_union_of_disjoint hdisjoint] + _ ≤ ((U ∆ T) ∪ (T ∆ W)).card := + Finset.card_le_card (symmDiff_triangle U T W) + _ ≤ (U ∆ T).card + (T ∆ W).card := + Finset.card_union_le _ _ + _ = (U ∆ T).card + (W \ T).card := by rw [htw] + +private theorem reference_difference_le_of_good_root_threshold + {V ι : Type*} [Fintype V] [DecidableEq V] + [Fintype ι] [Nonempty ι] + (σ : ι → Equiv.Perm V) (p : Equiv.Perm V) + (B : Finset V) (T U : Finset (V × V)) + (t : ℕ) (q : ℝ) (hq : q < 1) + (hsub : T ⊆ permutationGraph p) + (hmissing : + (permutationGraph p \ T).card ≤ 2 * B.card) + (hbad : + 2 * (Fintype.card ι : ℝ) * (B.card : ℝ) ≤ (t : ℝ)) + (hdefect : permutationCommutationDefect σ p ≤ 2 * t) + (hboundary : + boundary (fun i => (σ i).prodCongr (σ i)) T ≤ + permutationCommutationDefect σ p + + 2 * Fintype.card ι * B.card) + (hthreshold : + ((U ∆ T).card : ℝ) ≤ + 72 * (boundary + (fun i => (σ i).prodCongr (σ i)) T : ℝ) / + ((Fintype.card ι : ℝ) * (1 - q) ^ 2)) : + (((U \ permutationGraph p).card + + (permutationGraph p \ U).card : ℕ) : ℝ) ≤ + (216 / ((Fintype.card ι : ℝ) * (1 - q) ^ 2) + + 1 / (Fintype.card ι : ℝ)) * (t : ℝ) := by + have hd : 0 < (Fintype.card ι : ℝ) := by + exact_mod_cast Fintype.card_pos_iff.mpr + (inferInstance : Nonempty ι) + have hden : 0 < (Fintype.card ι : ℝ) * (1 - q) ^ 2 := + mul_pos hd (sq_pos_of_pos (sub_pos.mpr hq)) + have hdefect_real : + (permutationCommutationDefect σ p : ℝ) ≤ + 2 * (t : ℝ) := by + exact_mod_cast hdefect + have hboundary_real : + (boundary + (fun i => (σ i).prodCongr (σ i)) T : ℝ) ≤ + 3 * (t : ℝ) := by + have hbound : + (boundary + (fun i => (σ i).prodCongr (σ i)) T : ℝ) ≤ + (permutationCommutationDefect σ p : ℝ) + + 2 * (Fintype.card ι : ℝ) * (B.card : ℝ) := by + exact_mod_cast hboundary + linarith + have hmissing_real : + ((permutationGraph p \ T).card : ℝ) ≤ + (t : ℝ) / (Fintype.card ι : ℝ) := by + have hm : + ((permutationGraph p \ T).card : ℝ) ≤ + 2 * (B.card : ℝ) := by + exact_mod_cast hmissing + apply (le_div_iff₀ hd).2 + nlinarith + have htransfer : + (((U \ permutationGraph p).card + + (permutationGraph p \ U).card : ℕ) : ℝ) ≤ + ((U ∆ T).card : ℝ) + + ((permutationGraph p \ T).card : ℝ) := by + exact_mod_cast reference_difference_le_symmDiff_add_missing + U T (permutationGraph p) hsub + calc + (((U \ permutationGraph p).card + + (permutationGraph p \ U).card : ℕ) : ℝ) ≤ + ((U ∆ T).card : ℝ) + + ((permutationGraph p \ T).card : ℝ) := htransfer + _ ≤ 72 * (boundary + (fun i => (σ i).prodCongr (σ i)) T : ℝ) / + ((Fintype.card ι : ℝ) * (1 - q) ^ 2) + + (t : ℝ) / (Fintype.card ι : ℝ) := + add_le_add hthreshold hmissing_real + _ ≤ 72 * (3 * (t : ℝ)) / + ((Fintype.card ι : ℝ) * (1 - q) ^ 2) + + (t : ℝ) / (Fintype.card ι : ℝ) := by + gcongr + _ = (216 / ((Fintype.card ι : ℝ) * (1 - q) ^ 2) + + 1 / (Fintype.card ι : ℝ)) * (t : ℝ) := by + ring + +private theorem rooted_reference_cut_bounds_of_slow_tolerance + {h d C t N Δ u e : ℝ} + (hh : 0 < h) (hd : 0 ≤ d) (hC : 0 ≤ C) + (ht : 0 ≤ t) (hN : 0 < N) + (hdifference : Δ ≤ C * t) + (hcard : u ≤ N + Δ) + (hboundary : e ≤ (h * t / (2 * (h + 8 * d) * N)) * u) + (hslow : 5 * (4 + h * C) * t ≤ h * N) : + 2 * Δ ≤ N ∧ + (h + 8 * d) * e ≤ h * t ∧ + 5 * (4 * e + h * Δ) ≤ h * N := by + have hden : 0 < h + 8 * d := by linarith + have hCt : 5 * (C * t) ≤ N := by + have hscaled : h * (5 * (C * t)) ≤ h * N := by + linarith only [hslow, ht] + exact le_of_mul_le_mul_left hscaled hh + have hCtzero : 0 ≤ C * t := mul_nonneg hC ht + have hnear : 2 * Δ ≤ N := by linarith only [hdifference, hCt, hCtzero] + have hu : u ≤ 2 * N := by linarith only [hcard, hnear, hN] + have hcoefficient : 0 ≤ h * t / (2 * (h + 8 * d) * N) := by + positivity + have he : e ≤ h * t / (h + 8 * d) := by + calc + e ≤ (h * t / (2 * (h + 8 * d) * N)) * u := hboundary + _ ≤ (h * t / (2 * (h + 8 * d) * N)) * (2 * N) := + mul_le_mul_of_nonneg_left hu hcoefficient + _ = h * t / (h + 8 * d) := by field_simp + have himprovement : (h + 8 * d) * e ≤ h * t := by + have he' := (le_div_iff₀ hden).mp he + linarith only [he'] + have het : e ≤ t := by + calc + e ≤ h * t / (h + 8 * d) := he + _ ≤ t := (div_le_iff₀ hden).2 (by linarith only [mul_nonneg hd ht]) + refine ⟨hnear, himprovement, ?_⟩ + calc + 5 * (4 * e + h * Δ) ≤ 5 * (4 * t + h * (C * t)) := by + gcongr + _ = 5 * (4 + h * C) * t := by ring + _ ≤ h * N := hslow + +private theorem hasAlmostCentralizerImprovement_of_universal_good_root_thresholds + {V ι : Type*} + [Fintype V] [Nonempty V] [DecidableEq V] + [Fintype ι] [Nonempty ι] + (σ : ι → Equiv.Perm V) (tolerance : ℕ) + (h q : ℝ) (hpositive : 0 < h) (hq : q < 1) + (B : Finset V) + (good : Equiv.Perm V → Finset (V × V)) + (hexp : ∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ)) + (hbad : + 2 * (Fintype.card ι : ℝ) * (B.card : ℝ) ≤ + (tolerance : ℝ)) + (hgood_subset : ∀ p : Equiv.Perm V, + good p ⊆ permutationGraph p) + (hgood_missing : ∀ p : Equiv.Perm V, + (permutationGraph p \ good p).card ≤ + 2 * B.card) + (hgood_boundary : ∀ p : Equiv.Perm V, + boundary + (fun i => (σ i).prodCongr (σ i)) (good p) ≤ + permutationCommutationDefect σ p + + 2 * Fintype.card ι * B.card) + (hslow : + 5 * (4 + h * + (216 / ((Fintype.card ι : ℝ) * (1 - q) ^ 2) + + 1 / (Fintype.card ι : ℝ))) * (tolerance : ℝ) ≤ + h * (Fintype.card V : ℝ)) + (hthreshold : ∀ p : Equiv.Perm V, + permutationCommutationDefect σ p ≤ 2 * tolerance → + ∃ U : Finset (V × V), + ((U ∆ good p).card : ℝ) ≤ + 72 * (boundary + (fun i => (σ i).prodCongr (σ i)) (good p) : ℝ) / + ((Fintype.card ι : ℝ) * (1 - q) ^ 2) ∧ + (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) ≤ + (h * (tolerance : ℝ) / + (2 * (h + 8 * (Fintype.card ι : ℝ)) * + (Fintype.card V : ℝ))) * (U.card : ℝ)) : + HasAlmostCentralizerImprovement σ tolerance := by + let d : ℝ := Fintype.card ι + let C : ℝ := 216 / (d * (1 - q) ^ 2) + 1 / d + have hd : 0 < d := by + dsimp [d] + exact_mod_cast Fintype.card_pos_iff.mpr + (inferInstance : Nonempty ι) + have hC : 0 ≤ C := by + dsimp [C] + positivity + apply KunThomFiberCoarea.hasAlmostCentralizerImprovement_of_rooted_reference_cuts + σ tolerance h hpositive hexp + intro p hp + obtain ⟨U, hnear_good, hboundary⟩ := hthreshold p hp + have hdifference : + (((U \ permutationGraph p).card + + (permutationGraph p \ U).card : ℕ) : ℝ) ≤ + C * (tolerance : ℝ) := by + simpa only [C, d] using + reference_difference_le_of_good_root_threshold + σ p B (good p) U tolerance q hq + (hgood_subset p) (hgood_missing p) + hbad hp (hgood_boundary p) hnear_good + have hN : 0 < (Fintype.card V : ℝ) := by + exact_mod_cast Fintype.card_pos_iff.mpr + (inferInstance : Nonempty V) + have hcardnat : + U.card ≤ Fintype.card V + + ((U \ permutationGraph p).card + + (permutationGraph p \ U).card) := by + have hinter := Finset.card_sdiff_add_card_inter + U (permutationGraph p) + have hsubset : + (U ∩ permutationGraph p).card ≤ + (permutationGraph p).card := + Finset.card_le_card Finset.inter_subset_right + have hgraph := KunThomFiberCoarea.permutationGraph_card p + omega + have hcard : + (U.card : ℝ) ≤ (Fintype.card V : ℝ) + + (((U \ permutationGraph p).card + + (permutationGraph p \ U).card : ℕ) : ℝ) := by + exact_mod_cast hcardnat + have hslow' : + 5 * (4 + h * C) * (tolerance : ℝ) ≤ + h * (Fintype.card V : ℝ) := by + simpa only [C, d] using hslow + have hboundary' : + (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) ≤ + (h * (tolerance : ℝ) / + (2 * (h + 8 * d) * (Fintype.card V : ℝ))) * + (U.card : ℝ) := by + simpa only [d] using hboundary + obtain ⟨hnear, himprovement, hdistance⟩ := + rooted_reference_cut_bounds_of_slow_tolerance + hpositive hd.le hC (Nat.cast_nonneg tolerance) hN + hdifference hcard hboundary' hslow' + refine ⟨U, ?_, ?_, ?_⟩ + · exact_mod_cast hnear + · simpa only [d] using himprovement + · have hleft : + ((U \ permutationGraph p).card : ℝ) ≤ + (((U \ permutationGraph p).card + + (permutationGraph p \ U).card : ℕ) : ℝ) := by + exact_mod_cast Nat.le_add_right + (U \ permutationGraph p).card + (permutationGraph p \ U).card + linarith only [hdistance, mul_nonneg hpositive.le + (sub_nonneg.mpr hleft)] + +end KunUniversalGoodRootReferenceCuts + +open KunUniversalGoodRootReferenceCuts + +namespace KunRootedWordPower + +open Filter Topology +open KunRootedIndicatorCrossing +open KunThomInvariantOrthogonal +open scoped BigOperators ComplexConjugate ComplexOrder InnerProductSpace Pointwise symmDiff + +universe u + +private instance rootedSparseModelDecidableEq + {G ι : Type u} (X : RootedIndicatorMarkovModel G ι) : + DecidableEq X.carrier := + Classical.decEq X.carrier + +private theorem exists_rooted_word_radius_real_markov_sq_error_le_boundary + {G : Type u} [Group G] + (P : KazhdanPair.{u, u} G) + (S : Finset G) (honeS : 1 ∈ S) + (hcover : P.generators ⊆ S) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (w : G → List ↥S) + (k : ℕ) : + ∃ r : ℕ, ∀ X : RootedIndicatorMarkovModel G ↥S, + X.IsGenerated (fun i : ↥S => (i : G)) w → + X.IsRootedAtRadius w r → + ∀ T : Finset X.carrier, + (∀ x : X.carrier, + X.indicator x = if x ∈ T then (1 : ℝ) else 0) → + (∑ x : X.carrier, + ((((KunFinitePermutationMarkovMass.realPermutationMarkov + X.generator)^[k]) + (KunFinitePermutationMarkovMass.realIndicator T)) x - + if x ∈ T then (1 : ℝ) else 0) ^ 2) ≤ + 8 * (boundary X.generator T : ℝ) / + ((S.card : ℝ) * + (1 - kazhdanMarkovContractionFactor P S) ^ 2) := by + let : Nonempty (↥S) := ⟨⟨1, honeS⟩⟩ + let q := kazhdanMarkovContractionFactor P S + have hgap : 0 < 1 - q := + sub_pos.mpr + (kazhdanMarkovContractionFactor_lt_one P S ⟨1, honeS⟩) + have hdegree : 0 < (S.card : ℝ) := by + exact_mod_cast Finset.card_pos.mpr ⟨1, honeS⟩ + obtain ⟨r, hr⟩ := + exists_rooted_word_radius_geometric_markov_displacement + P S honeS hcover hsymmetric w k + refine ⟨r, ?_⟩ + intro X hgenerated hroot T hindicator + let χ : X.carrier → ℝ := + KunFinitePermutationMarkovMass.realIndicator T + have hχ : X.indicator = χ := by + funext x + simpa [χ, + KunFinitePermutationMarkovMass.realIndicator] + using hindicator x + have hgeo := hr X hgenerated hroot + rw [hχ] at hgeo + have hjensen : + ‖permutationMarkov X.generator (indicatorVector χ) - + indicatorVector χ‖ ^ 2 ≤ + 2 * (boundary X.generator T : ℝ) / + (S.card : ℝ) := by + simpa only [Fintype.card_coe] using rooted_indicator_defect_sq_le_boundary X.generator T + have hcoef : 0 ≤ 2 / (1 - q) := + div_nonneg (by norm_num) hgap.le + have hsquare : + ‖((permutationMarkov X.generator)^[k]) + (indicatorVector χ) - indicatorVector χ‖ ^ 2 ≤ + (2 / (1 - q)) ^ 2 * + ‖permutationMarkov X.generator (indicatorVector χ) - + indicatorVector χ‖ ^ 2 := by + calc + ‖((permutationMarkov X.generator)^[k]) + (indicatorVector χ) - indicatorVector χ‖ ^ 2 ≤ + ((2 / (1 - q)) * + ‖permutationMarkov X.generator (indicatorVector χ) - + indicatorVector χ‖) ^ 2 := + (sq_le_sq₀ (norm_nonneg _) + (mul_nonneg hcoef (norm_nonneg _))).mpr hgeo + _ = (2 / (1 - q)) ^ 2 * + ‖permutationMarkov X.generator (indicatorVector χ) - + indicatorVector χ‖ ^ 2 := by + rw [mul_pow] + rw [← rooted_markov_real_iterate_sq_error X.generator T k] + change + ‖((permutationMarkov X.generator)^[k]) + (indicatorVector χ) - indicatorVector χ‖ ^ 2 ≤ + 8 * (boundary X.generator T : ℝ) / + ((S.card : ℝ) * (1 - q) ^ 2) + calc + ‖((permutationMarkov X.generator)^[k]) + (indicatorVector χ) - indicatorVector χ‖ ^ 2 ≤ + (2 / (1 - q)) ^ 2 * + ‖permutationMarkov X.generator (indicatorVector χ) - + indicatorVector χ‖ ^ 2 := hsquare + _ ≤ (2 / (1 - q)) ^ 2 * + (2 * (boundary X.generator T : ℝ) / + (S.card : ℝ)) := + mul_le_mul_of_nonneg_left hjensen (sq_nonneg _) + _ = 8 * (boundary X.generator T : ℝ) / + ((S.card : ℝ) * (1 - q) ^ 2) := by + field_simp + ring + +private theorem rooted_final_realMarkov_eq_mass_realPermutationMarkov + {ι V : Type*} [Fintype ι] + (p : ι → Equiv.Perm V) : + KunActualFinalRestrictedVariation.realMarkov p = + KunFinitePermutationMarkovMass.realPermutationMarkov p := by + funext f x + simp only [KunActualFinalRestrictedVariation.realMarkov, div_eq_mul_inv, mul_comm, + KunFinitePermutationMarkovMass.realPermutationMarkov] + +private theorem rooted_real_markov_iterate_residual_sqrt_eq + {ι V : Type*} [Fintype ι] [Fintype V] [DecidableEq V] + (p : ι → Equiv.Perm V) (T : Finset V) (k : ℕ) : + Real.sqrt + (∑ x : V, + (KunActualFinalRestrictedVariation.realMarkov p + ((((KunFinitePermutationMarkovMass.realPermutationMarkov p)^[k]) + (KunFinitePermutationMarkovMass.realIndicator T))) x - + ((((KunFinitePermutationMarkovMass.realPermutationMarkov p)^[k]) + (KunFinitePermutationMarkovMass.realIndicator T)) x)) ^ 2) = + ‖((permutationMarkov p)^[k + 1]) + (indicatorVector + (KunFinitePermutationMarkovMass.realIndicator T)) - + ((permutationMarkov p)^[k]) + (indicatorVector + (KunFinitePermutationMarkovMass.realIndicator T))‖ := by + have hcomplex : + KunRealComplexMarkovBridge.permutationMarkov p = + KunRootedIndicatorCrossing.permutationMarkov p := rfl + have hvector : + KunRealComplexMarkovBridge.indicatorVector + (KunFinitePermutationMarkovMass.realIndicator T) = + KunRootedIndicatorCrossing.indicatorVector + (KunFinitePermutationMarkovMass.realIndicator T) := rfl + have henergy := + KunRealComplexMarkovBridge.norm_iterate_permutationMarkov_indicator_sub_iterate_sq + p (KunFinitePermutationMarkovMass.realIndicator T) k + rw [hcomplex, hvector, + rooted_realMarkov_eq_mass_realPermutationMarkov] at henergy + have hfinal := rooted_final_realMarkov_eq_mass_realPermutationMarkov p + have hsum : + (∑ x : V, + (KunActualFinalRestrictedVariation.realMarkov p + ((((KunFinitePermutationMarkovMass.realPermutationMarkov p)^[k]) + (KunFinitePermutationMarkovMass.realIndicator T))) x - + ((((KunFinitePermutationMarkovMass.realPermutationMarkov p)^[k]) + (KunFinitePermutationMarkovMass.realIndicator T)) x)) ^ 2) = + ‖((permutationMarkov p)^[k + 1]) + (indicatorVector + (KunFinitePermutationMarkovMass.realIndicator T)) - + ((permutationMarkov p)^[k]) + (indicatorVector + (KunFinitePermutationMarkovMass.realIndicator T))‖ ^ 2 := by + rw [hfinal] + simpa only [Function.iterate_succ_apply'] using henergy.symm + rw [hsum, Real.sqrt_sq (norm_nonneg _)] + +private theorem close_and_large_of_symmDiff_bound + {V : Type*} [DecidableEq V] (U T : Finset V) + (boundaryValue denominator : ℝ) + (hdenominator : 0 < denominator) + (hdistance : + (((U ∆ T).card : ℝ)) ≤ + 72 * boundaryValue / denominator) + (hscaled : + 216 * boundaryValue < denominator * (T.card : ℝ)) : + 3 * (U ∆ T).card < T.card ∧ + 2 * (T.card : ℝ) ≤ 3 * (U.card : ℝ) := by + have hcloseReal : + (3 : ℝ) * (((U ∆ T).card : ℝ)) < (T.card : ℝ) := by + calc + (3 : ℝ) * (((U ∆ T).card : ℝ)) ≤ + 216 * boundaryValue / denominator := by + calc + (3 : ℝ) * (((U ∆ T).card : ℝ)) ≤ + 3 * (72 * boundaryValue / denominator) := + mul_le_mul_of_nonneg_left hdistance (by norm_num) + _ = 216 * boundaryValue / denominator := by ring + _ < (T.card : ℝ) := + (div_lt_iff₀ hdenominator).2 (by nlinarith only [hscaled]) + have hclose : 3 * (U ∆ T).card < T.card := by + exact_mod_cast hcloseReal + have hsub : T ⊆ U ∪ (U ∆ T) := by + intro x hx + by_cases hxU : x ∈ U + · exact Finset.mem_union.mpr (Or.inl hxU) + · exact Finset.mem_union.mpr + (Or.inr (Finset.mem_symmDiff.mpr (Or.inr ⟨hx, hxU⟩))) + have hcard : T.card ≤ U.card + (U ∆ T).card := + (Finset.card_le_card hsub).trans (Finset.card_union_le U (U ∆ T)) + have hcardReal : + (T.card : ℝ) ≤ (U.card : ℝ) + (((U ∆ T).card : ℝ)) := by + exact_mod_cast hcard + exact ⟨hclose, by linarith only [hcardReal, hcloseReal]⟩ + +private theorem exists_rooted_word_radius_sparse_cut_of_boundary + {G : Type u} [Group G] + (P : KazhdanPair.{u, u} G) + (S : Finset G) (honeS : 1 ∈ S) + (hcover : P.generators ⊆ S) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (w : G → List ↥S) + (γ α : ℝ) (_hγ : 0 < γ) (hα : 0 < α) + (hγsmall : + 216 * γ < + (S.card : ℝ) * + (1 - kazhdanMarkovContractionFactor P S) ^ 2) : + ∃ (k r : ℕ), ∀ X : RootedIndicatorMarkovModel G ↥S, + X.IsGenerated (fun i : ↥S => (i : G)) w → + X.IsRootedAtRadius w r → + ∀ T : Finset X.carrier, + T.Nonempty → + (∀ x : X.carrier, + X.indicator x = if x ∈ T then (1 : ℝ) else 0) → + (boundary X.generator T : ℝ) < + γ * (T.card : ℝ) → + ∃ U : Finset X.carrier, + (((U ∆ T).card : ℝ)) ≤ + 9 * (∑ x : X.carrier, + ((((KunFinitePermutationMarkovMass.realPermutationMarkov + X.generator)^[k]) + (KunFinitePermutationMarkovMass.realIndicator T)) x - + if x ∈ T then (1 : ℝ) else 0) ^ 2) ∧ + (((U ∆ T).card : ℝ)) ≤ + 72 * (boundary X.generator T : ℝ) / + ((S.card : ℝ) * + (1 - kazhdanMarkovContractionFactor P S) ^ 2) ∧ + 3 * (U ∆ T).card < T.card ∧ + (boundary X.generator U : ℝ) ≤ + α * (U.card : ℝ) := by + classical + let : Nonempty (↥S) := ⟨⟨1, honeS⟩⟩ + let q := kazhdanMarkovContractionFactor P S + have hqzero : 0 ≤ q := + kazhdanMarkovContractionFactor_nonneg P S + have hqone : q < 1 := + kazhdanMarkovContractionFactor_lt_one P S ⟨1, honeS⟩ + have hgap : 0 < 1 - q := sub_pos.mpr hqone + have hdegree : 0 < (S.card : ℝ) := by + exact_mod_cast Finset.card_pos.mpr ⟨1, honeS⟩ + let η : ℝ := 4 * α ^ 2 / (486 * (S.card : ℝ) ^ 2) + have hη : 0 < η := by + dsimp [η] + positivity + obtain ⟨k, hk⟩ := exists_pow_lt_of_lt_one hη hqone + let ε : ℝ := (η - q ^ k) / 2 + have hε : 0 < ε := by + dsimp [ε] + linarith + obtain ⟨rnear, hnear⟩ := + exists_rooted_word_radius_real_markov_sq_error_le_boundary + P S honeS hcover hsymmetric w k + obtain ⟨rfinal, hfinal⟩ := + exists_rooted_word_radius_markov_iterate_contraction + P S honeS hcover hsymmetric w k ε hε + refine ⟨k, max rnear rfinal, ?_⟩ + intro X hgenerated hroot T hT hindicator hboundary + have hrootnear := hroot.mono (le_max_left rnear rfinal) + have hrootfinal := hroot.mono (le_max_right rnear rfinal) + let χ : X.carrier → ℝ := + KunFinitePermutationMarkovMass.realIndicator T + let f : X.carrier → ℝ := + ((KunFinitePermutationMarkovMass.realPermutationMarkov + X.generator)^[k]) χ + let b : ℝ := + ‖permutationMarkov X.generator (indicatorVector χ) - + indicatorVector χ‖ + have hχ : X.indicator = χ := by + funext x + simpa [χ, + KunFinitePermutationMarkovMass.realIndicator] + using hindicator x + have hD : + (∑ x : X.carrier, + (f x - if x ∈ T then (1 : ℝ) else 0) ^ 2) ≤ + 8 * (boundary X.generator T : ℝ) / + ((S.card : ℝ) * (1 - q) ^ 2) := by + simpa only using hnear X hgenerated hrootnear T hindicator + have hstep := hfinal X hgenerated hrootfinal + rw [hχ] at hstep + have hresidual : + Real.sqrt + (∑ x : X.carrier, + (KunActualFinalRestrictedVariation.realMarkov + X.generator f x - f x) ^ 2) ≤ η * b := by + calc + Real.sqrt + (∑ x : X.carrier, + (KunActualFinalRestrictedVariation.realMarkov + X.generator f x - f x) ^ 2) = + ‖((permutationMarkov X.generator)^[k + 1]) + (indicatorVector χ) - + ((permutationMarkov X.generator)^[k]) + (indicatorVector χ)‖ := by + simpa only [Function.iterate_succ, Function.comp_apply, f, χ] using + rooted_real_markov_iterate_residual_sqrt_eq X.generator T k + _ ≤ (q ^ k + ε) * b := hstep + _ ≤ η * b := by + apply mul_le_mul_of_nonneg_right _ (norm_nonneg _) + dsimp [ε] + linarith + have hfzero : ∀ x : X.carrier, 0 ≤ f x := by + intro x + exact + (KunFinitePermutationMarkovMass.realPermutationMarkov_iterate_indicator_mem_unitInterval + X.generator T k x).1 + have hfone : ∀ x : X.carrier, f x ≤ 1 := by + intro x + exact + (KunFinitePermutationMarkovMass.realPermutationMarkov_iterate_indicator_mem_unitInterval + X.generator T k x).2 + have hmass : (∑ x : X.carrier, f x) = (T.card : ℝ) := + KunFinitePermutationMarkovMass.sum_realPermutationMarkov_iterate_indicator + X.generator T k + have hjensen : + b ^ 2 ≤ + 2 * (boundary X.generator T : ℝ) / + (S.card : ℝ) := by + simpa only [Fintype.card_coe] using rooted_indicator_defect_sq_le_boundary X.generator T + have hgaple : 1 - q ≤ 1 := by linarith + have hgapzero : 0 ≤ 1 - q := hgap.le + have hgap_sq_le_one : (1 - q) ^ 2 ≤ 1 := + pow_le_one₀ hgapzero hgaple + have hgamma_degree : 2 * γ ≤ (S.card : ℝ) := by + have hsmalldegree : + (S.card : ℝ) * (1 - q) ^ 2 ≤ (S.card : ℝ) := + mul_le_of_le_one_right hdegree.le hgap_sq_le_one + change 216 * γ < (S.card : ℝ) * (1 - q) ^ 2 + at hγsmall + linarith only [hγsmall, hsmalldegree, _hγ] + have hbase : b ^ 2 ≤ (T.card : ℝ) := by + refine hjensen.trans ?_ + apply (div_le_iff₀ hdegree).2 + have hscaled := + mul_le_mul_of_nonneg_right hgamma_degree + (Nat.cast_nonneg T.card) + have hboundary' := + mul_le_mul_of_nonneg_left hboundary.le + (by norm_num : (0 : ℝ) ≤ 2) + nlinarith only [hscaled, hboundary'] + have hsmall : + 486 * (Fintype.card (↥S) : ℝ) ^ 2 * η ≤ + 4 * α ^ 2 := by + have hne : (486 : ℝ) * (S.card : ℝ) ^ 2 ≠ 0 := by positivity + rw [Fintype.card_coe] + change 486 * (S.card : ℝ) ^ 2 * (4 * α ^ 2 / (486 * (S.card : ℝ) ^ 2)) ≤ _ + rw [mul_div_cancel₀ _ hne] + have hvariation := + KunActualFinalRestrictedVariation.highSupport_variation_le_of_realMarkov_residual + X.generator T f α η b hfzero hfone hmass + hα.le hη.le hbase hresidual hsmall + obtain ⟨t, _ht, hcut, hdistance⟩ := + KunSharpThresholdCut.exists_upperLevel_boundary_and_symmDiff_le + X.generator T f + let U : Finset X.carrier := + KunSharpThresholdCut.upperLevel f t + have hquant : + (((U ∆ T).card : ℝ)) ≤ + 72 * (boundary X.generator T : ℝ) / + ((S.card : ℝ) * (1 - q) ^ 2) := by + calc + (((U ∆ T).card : ℝ)) ≤ + 9 * ∑ x : X.carrier, + (f x - if x ∈ T then (1 : ℝ) else 0) ^ 2 := + hdistance + _ ≤ 9 * + (8 * (boundary X.generator T : ℝ) / + ((S.card : ℝ) * (1 - q) ^ 2)) := + mul_le_mul_of_nonneg_left hD (by norm_num) + _ = 72 * (boundary X.generator T : ℝ) / + ((S.card : ℝ) * (1 - q) ^ 2) := by ring + have hTpos : 0 < (T.card : ℝ) := by + exact_mod_cast Finset.card_pos.mpr hT + have hdenom : + 0 < (S.card : ℝ) * (1 - q) ^ 2 := + mul_pos hdegree (sq_pos_of_pos hgap) + have hscaled : + 216 * (boundary X.generator T : ℝ) < + ((S.card : ℝ) * (1 - q) ^ 2) * (T.card : ℝ) := by + calc + 216 * (boundary X.generator T : ℝ) < + 216 * (γ * (T.card : ℝ)) := + mul_lt_mul_of_pos_left hboundary (by norm_num) + _ = (216 * γ) * (T.card : ℝ) := by ring + _ < ((S.card : ℝ) * (1 - q) ^ 2) * (T.card : ℝ) := + mul_lt_mul_of_pos_right hγsmall hTpos + obtain ⟨hclose, hlarge⟩ := + close_and_large_of_symmDiff_bound U T + (boundary X.generator T) + ((S.card : ℝ) * (1 - q) ^ 2) + hdenom hquant hscaled + have hscaledlarge := + mul_le_mul_of_nonneg_left hlarge hα.le + have hboundaryU : + (boundary X.generator U : ℝ) ≤ + α * (U.card : ℝ) := by + change + (boundary X.generator + (KunSharpThresholdCut.upperLevel f t) : ℝ) ≤ _ + nlinarith only [hcut, hvariation, hscaledlarge] + exact ⟨U, by simpa only [f, χ] using hdistance, + by simpa only [q] using hquant, hclose, hboundaryU⟩ + +end KunRootedWordPower + +namespace SourceCompressionRetainedDiscard + +open Filter Topology +open scoped BigOperators symmDiff + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def witnesslessComponents + {V : Type*} [Fintype V] [DecidableEq V] + (P Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) (b : V → ℤ) (eta : ℝ) : + Finset (Finset V) := + (P.parts \ insufficientOverlapComponents P Q eta).filter + (fun C => ∀ y ∈ C ∩ maximumOverlapPart Q C, + b (T.symm y) ≠ b y) + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def retainedComponents + {V : Type*} [Fintype V] [DecidableEq V] + (P Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) (b : V → ℤ) (eta : ℝ) : + Finset (Finset V) := + P.parts \ (insufficientOverlapComponents P Q eta ∪ + witnesslessComponents P Q T b eta) + +private theorem witnesslessComponents_subset_parts + {V : Type*} [Fintype V] [DecidableEq V] + (P Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) (b : V → ℤ) (eta : ℝ) : + witnesslessComponents P Q T b eta ⊆ P.parts := by + intro C hC + exact (Finset.mem_sdiff.mp + (Finset.mem_filter.mp hC).1).1 + +private theorem overlapBad_disjoint_witnesslessComponents + {V : Type*} [Fintype V] [DecidableEq V] + (P Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) (b : V → ℤ) (eta : ℝ) : + Disjoint (insufficientOverlapComponents P Q eta) + (witnesslessComponents P Q T b eta) := by + apply Finset.disjoint_left.mpr + intro C hbad hwitnessless + exact (Finset.mem_sdiff.mp + (Finset.mem_filter.mp hwitnessless).1).2 hbad + +public +theorem retainedComponents_spec + {V : Type*} [Fintype V] [DecidableEq V] + (P Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) (b : V → ℤ) (eta : ℝ) + (C : Finset V) + (hC : C ∈ retainedComponents P Q T b eta) : + C ∈ P.parts ∧ + maximumOverlapPart Q C ∈ Q.parts ∧ + (1 - eta) * (C.card : ℝ) ≤ + ((C ∩ maximumOverlapPart Q C).card : ℝ) ∧ + ∃ y ∈ C ∩ maximumOverlapPart Q C, + b (T.symm y) = b y := by + have hmem := Finset.mem_sdiff.mp hC + have hpart : C ∈ P.parts := hmem.1 + have hnotbad : C ∉ insufficientOverlapComponents P Q eta := + fun h => hmem.2 (Finset.mem_union_left _ h) + have hnotwitnessless : C ∉ witnesslessComponents P Q T b eta := + fun h => hmem.2 (Finset.mem_union_right _ h) + have htarget : maximumOverlapPart Q C ∈ Q.parts := + maximumOverlapPart_mem Q C + (P.nonempty_of_mem_parts hpart) (P.subset hpart) + have hoverlap := + maximumOverlapPart_overlap_of_not_mem_insufficient + P Q eta C hpart hnotbad + refine ⟨hpart, htarget, hoverlap, ?_⟩ + by_contra hnone + push Not at hnone + apply hnotwitnessless + exact Finset.mem_filter.mpr + ⟨Finset.mem_sdiff.mpr ⟨hpart, hnotbad⟩, hnone⟩ + +private theorem witnessless_component_card_le_twice_rankChanging + {V : Type*} [Fintype V] [DecidableEq V] + (P Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) (b : V → ℤ) + (eta : ℝ) (heta : eta ≤ (1 : ℝ) / 2) + (C : Finset V) + (hC : C ∈ witnesslessComponents P Q T b eta) : + C.card ≤ + 2 * (C ∩ RankArcCharging.rankChangingArc + (Finset.univ : Finset V) b T.symm).card := by + have hfilter := Finset.mem_filter.mp hC + have hgood := Finset.mem_sdiff.mp hfilter.1 + have hpart : C ∈ P.parts := hgood.1 + have hnotbad : C ∉ insufficientOverlapComponents P Q eta := + hgood.2 + have hoverlap := + maximumOverlapPart_overlap_of_not_mem_insufficient + P Q eta C hpart hnotbad + have hsubset : + C ∩ maximumOverlapPart Q C ⊆ + C ∩ RankArcCharging.rankChangingArc + (Finset.univ : Finset V) b T.symm := by + intro y hy + have hy' := Finset.mem_inter.mp hy + refine Finset.mem_inter.mpr ⟨hy'.1, ?_⟩ + exact Finset.mem_filter.mpr + ⟨Finset.mem_univ y, hfilter.2 y hy⟩ + have hcard : + ((C ∩ maximumOverlapPart Q C).card : ℝ) ≤ + ((C ∩ RankArcCharging.rankChangingArc + (Finset.univ : Finset V) b T.symm).card : ℝ) := by + exact_mod_cast Finset.card_le_card hsubset + have hhalf : + (1 / 2 : ℝ) * (C.card : ℝ) ≤ + (1 - eta) * (C.card : ℝ) := by + apply mul_le_mul_of_nonneg_right (by linarith) (by positivity) + have hreal : + (C.card : ℝ) ≤ + 2 * ((C ∩ RankArcCharging.rankChangingArc + (Finset.univ : Finset V) b T.symm).card : ℝ) := by + linarith + exact_mod_cast hreal + +private theorem witnesslessComponents_mass_le_twice_rankChanging + {V : Type*} [Fintype V] [DecidableEq V] + (P Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) (b : V → ℤ) + (eta : ℝ) (heta : eta ≤ (1 : ℝ) / 2) : + (∑ C ∈ witnesslessComponents P Q T b eta, C.card) ≤ + 2 * (RankArcCharging.rankChangingArc + (Finset.univ : Finset V) b T.symm).card := by + let B := RankArcCharging.rankChangingArc + (Finset.univ : Finset V) b T.symm + have hsum : + (∑ C ∈ witnesslessComponents P Q T b eta, (C ∩ B).card) ≤ + ∑ C ∈ P.parts, (C ∩ B).card := by + exact Finset.sum_le_sum_of_subset_of_nonneg + (witnesslessComponents_subset_parts P Q T b eta) + (fun _ _ _ => Nat.zero_le _) + have hpartition : + (∑ C ∈ P.parts, (C ∩ B).card) = B.card := by + simpa only [Finset.univ_inter] using matched_sum_card_inter_partition P B + calc + (∑ C ∈ witnesslessComponents P Q T b eta, C.card) ≤ + ∑ C ∈ witnesslessComponents P Q T b eta, + 2 * (C ∩ B).card := by + exact Finset.sum_le_sum fun C hC => + witnessless_component_card_le_twice_rankChanging + P Q T b eta heta C hC + _ = 2 * (∑ C ∈ witnesslessComponents P Q T b eta, + (C ∩ B).card) := by + simp only [Finset.mul_sum] + _ ≤ 2 * (∑ C ∈ P.parts, (C ∩ B).card) := + Nat.mul_le_mul_left 2 hsum + _ = 2 * B.card := by rw [hpartition] + +private theorem retained_missing_card_le_overlap_add_twice_rankChanging + {V : Type*} [Fintype V] [DecidableEq V] + (P Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) (b : V → ℤ) + (eta : ℝ) (heta : eta ≤ (1 : ℝ) / 2) : + ((Finset.univ : Finset V) \ + matchedRetainedSupport + (retainedComponents P Q T b eta)).card ≤ + (∑ C ∈ insufficientOverlapComponents P Q eta, C.card) + + 2 * (RankArcCharging.rankChangingArc + (Finset.univ : Finset V) b T.symm).card := by + let O := insufficientOverlapComponents P Q eta + let W := witnesslessComponents P Q T b eta + let R := retainedComponents P Q T b eta + let B := RankArcCharging.rankChangingArc + (Finset.univ : Finset V) b T.symm + have hR : R ⊆ P.parts := Finset.sdiff_subset + have hmiss : + ((Finset.univ : Finset V) \ + matchedRetainedSupport R).card = + ∑ C ∈ P.parts \ R, C.card := by + have hsplit : + (∑ C ∈ P.parts \ R, C.card) + + (∑ C ∈ R, C.card) = + ∑ C ∈ P.parts, C.card := + Finset.sum_sdiff hR + have hcover := P.sum_card_parts + have hret := matchedRetainedSupport_card P R hR + have hcard := Finset.card_sdiff_add_card_eq_card + (matchedRetainedSupport_subset P R hR) + omega + have hsubset : P.parts \ R ⊆ O ∪ W := by + intro C hC + have hC' := Finset.mem_sdiff.mp hC + by_contra hbad + apply hC'.2 + change C ∈ P.parts \ (O ∪ W) + exact Finset.mem_sdiff.mpr ⟨hC'.1, hbad⟩ + have hsum : + (∑ C ∈ P.parts \ R, C.card) ≤ + ∑ C ∈ O ∪ W, C.card := + Finset.sum_le_sum_of_subset_of_nonneg hsubset + (fun _ _ _ => Nat.zero_le _) + have hdis : Disjoint O W := + overlapBad_disjoint_witnesslessComponents P Q T b eta + have hunion : + (∑ C ∈ O ∪ W, C.card) = + (∑ C ∈ O, C.card) + (∑ C ∈ W, C.card) := + Finset.sum_union hdis + have hwitness : (∑ C ∈ W, C.card) ≤ 2 * B.card := + witnesslessComponents_mass_le_twice_rankChanging + P Q T b eta heta + change + ((Finset.univ : Finset V) \ + matchedRetainedSupport R).card ≤ + (∑ C ∈ O, C.card) + 2 * B.card + omega + +public +theorem retained_missing_density_tendsto_zero + (V : ℕ → Type*) + [∀ n, Fintype (V n)] [∀ n, DecidableEq (V n)] + (P Q : (n : ℕ) → Finpartition + (Finset.univ : Finset (V n))) + (T : (n : ℕ) → Equiv.Perm (V n)) + (b : (n : ℕ) → V n → ℤ) (eta : ℕ → ℝ) + (heta : Tendsto eta atTop (nhds 0)) + (hoverlap : Tendsto + (fun n => + ((∑ C ∈ insufficientOverlapComponents + (P n) (Q n) (eta n), C.card : ℕ) : ℝ) / + Fintype.card (V n)) + atTop (nhds 0)) + (hrank : Tendsto + (fun n => + ((RankArcCharging.rankChangingArc + (Finset.univ : Finset (V n)) (b n) (T n).symm).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0)) : + Tendsto + (fun n => + (((Finset.univ : Finset (V n)) \ + matchedRetainedSupport + (retainedComponents (P n) (Q n) (T n) (b n) + (eta n))).card : ℝ) / Fintype.card (V n)) + atTop (nhds 0) := by + have hhalf : ∀ᶠ n in atTop, eta n < (1 : ℝ) / 2 := + heta.eventually (gt_mem_nhds (by norm_num)) + have htwice : Tendsto + (fun n => (2 : ℝ) * + (((RankArcCharging.rankChangingArc + (Finset.univ : Finset (V n)) (b n) (T n).symm).card : ℝ) / + Fintype.card (V n))) + atTop (nhds 0) := by + simpa only [mul_zero] using hrank.const_mul 2 + have hupper : Tendsto + (fun n => + ((∑ C ∈ insufficientOverlapComponents + (P n) (Q n) (eta n), C.card : ℕ) : ℝ) / + Fintype.card (V n) + + (2 : ℝ) * + (((RankArcCharging.rankChangingArc + (Finset.univ : Finset (V n)) (b n) (T n).symm).card : ℝ) / + Fintype.card (V n))) + atTop (nhds 0) := by + simpa only [zero_add] using hoverlap.add htwice + refine squeeze_zero' + (Eventually.of_forall fun n => by positivity) ?_ hupper + filter_upwards [hhalf] with n hn + have hnat := retained_missing_card_le_overlap_add_twice_rankChanging + (P n) (Q n) (T n) (b n) (eta n) hn.le + have hreal : + (((Finset.univ : Finset (V n)) \ + matchedRetainedSupport + (retainedComponents (P n) (Q n) (T n) (b n) + (eta n))).card : ℝ) ≤ + ((∑ C ∈ insufficientOverlapComponents + (P n) (Q n) (eta n), C.card : ℕ) : ℝ) + + 2 * ((RankArcCharging.rankChangingArc + (Finset.univ : Finset (V n)) (b n) (T n).symm).card : ℝ) := by + exact_mod_cast hnat + calc + (((Finset.univ : Finset (V n)) \ + matchedRetainedSupport + (retainedComponents (P n) (Q n) (T n) (b n) + (eta n))).card : ℝ) / Fintype.card (V n) ≤ + (((∑ C ∈ insufficientOverlapComponents + (P n) (Q n) (eta n), C.card : ℕ) : ℝ) + + 2 * ((RankArcCharging.rankChangingArc + (Finset.univ : Finset (V n)) (b n) (T n).symm).card : ℝ)) / + Fintype.card (V n) := + div_le_div_of_nonneg_right hreal (by positivity) + _ = ((∑ C ∈ insufficientOverlapComponents + (P n) (Q n) (eta n), C.card : ℕ) : ℝ) / + Fintype.card (V n) + + (2 : ℝ) * + (((RankArcCharging.rankChangingArc + (Finset.univ : Finset (V n)) (b n) (T n).symm).card : ℝ) / + Fintype.card (V n)) := by + ring + +end SourceCompressionRetainedDiscard + +namespace SourceGeneratedWordCrossing + +open Filter Topology +open scoped BigOperators + + + +private theorem card_partitionWordCrossing_mul_le + {V : Type*} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) + (p q : Equiv.Perm V) : + (partitionWordCrossing Q (p * q)).card ≤ + (partitionWordCrossing Q p).card + + (partitionWordCrossing Q q).card := by + classical + have hsub : + partitionWordCrossing Q (p * q) ⊆ + partitionWordCrossing Q q ∪ + (partitionWordCrossing Q p).map + q.symm.toEmbedding := by + intro x hx + have hpq := (SourceCompressionTransportCrossing.mem_partitionWordCrossing_univ Q (p * q) x).1 hx + by_cases hq : Q.part x ≠ Q.part (q x) + · exact Finset.mem_union_left _ + ((SourceCompressionTransportCrossing.mem_partitionWordCrossing_univ Q q x).2 hq) + · apply Finset.mem_union_right + apply Finset.mem_map.2 + refine ⟨q x, (SourceCompressionTransportCrossing.mem_partitionWordCrossing_univ Q p (q x)).2 + ?_, + by simp only [Function.Embedding.coeFn_mk, Equiv.symm_apply_apply]⟩ + intro heq + apply hpq + have hpart : Q.part x = Q.part (q x) := not_ne_iff.mp hq + simpa only [Equiv.Perm.mul_apply] using hpart.trans heq + have hcard := (Finset.card_le_card hsub).trans + (Finset.card_union_le + (partitionWordCrossing Q q) + ((partitionWordCrossing Q p).map + q.symm.toEmbedding)) + simpa only [ge_iff_le, Finset.card_map, Nat.add_comm] using hcard + +public +theorem sum_generator_crossing_eq_sum_partition_boundary + {V ι : Type*} [Fintype V] [DecidableEq V] + [Fintype ι] + (Q : Finpartition (Finset.univ : Finset V)) + (σ : ι → Equiv.Perm V) : + (∑ i : ι, (partitionWordCrossing Q (σ i)).card) = + ∑ C ∈ Q.parts, boundary σ C := by + classical + have hpart (i : ι) (C : Finset V) (hC : C ∈ Q.parts) : + C ∩ partitionWordCrossing Q (σ i) = + C.filter (fun x => σ i x ∉ C) := by + ext x + simp only [Finset.mem_inter, Finset.mem_filter, + partitionWordCrossing, Finset.mem_univ, true_and] + constructor + · rintro ⟨hx, hcross⟩ + refine ⟨hx, ?_⟩ + simpa only [Q.part_eq_of_mem hC hx] using hcross + · rintro ⟨hx, hcross⟩ + refine ⟨hx, ?_⟩ + simpa only [Q.part_eq_of_mem hC hx] using hcross + calc + (∑ i : ι, (partitionWordCrossing Q (σ i)).card) = + ∑ i : ι, ∑ C ∈ Q.parts, + (C.filter (fun x => σ i x ∉ C)).card := by + apply Finset.sum_congr rfl + intro i _ + have hsum := sum_card_inter_partition Q + (partitionWordCrossing Q (σ i)) + simp only [Finset.univ_inter] at hsum + calc + (partitionWordCrossing Q (σ i)).card = + ∑ C ∈ Q.parts, + (C ∩ partitionWordCrossing Q (σ i)).card := + hsum.symm + _ = ∑ C ∈ Q.parts, + (C.filter (fun x => σ i x ∉ C)).card := by + apply Finset.sum_congr rfl + intro C hC + rw [hpart i C hC] + _ = ∑ C ∈ Q.parts, + ∑ i : ι, (C.filter (fun x => σ i x ∉ C)).card := by + rw [Finset.sum_comm] + _ = ∑ C ∈ Q.parts, boundary σ C := by + simp only [boundary] + +public +theorem generator_crossing_density_tendsto_zero + {V : ℕ → Type*} + [∀ n, Fintype (V n)] [∀ n, DecidableEq (V n)] + {ι : Type*} [Fintype ι] + (Q : ∀ n, Finpartition (Finset.univ : Finset (V n))) + (σ : ∀ n, ι → Equiv.Perm (V n)) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary (σ n) C : ℝ)) / + Fintype.card (V n)) + atTop (nhds 0)) + (i : ι) : + Tendsto + (fun n => + ((partitionWordCrossing (Q n) + (σ n i)).card : ℝ) / Fintype.card (V n)) + atTop (nhds 0) := by + refine squeeze_zero (fun n => by positivity) ?_ hboundary + intro n + have hsingle : + (partitionWordCrossing (Q n) (σ n i)).card ≤ + ∑ j : ι, + (partitionWordCrossing (Q n) (σ n j)).card := by + exact Finset.single_le_sum + (fun j _ => Nat.zero_le + (partitionWordCrossing (Q n) (σ n j)).card) + (Finset.mem_univ i) + have hsum := sum_generator_crossing_eq_sum_partition_boundary + (Q n) (σ n) + have hreal : + ((partitionWordCrossing (Q n) (σ n i)).card : ℝ) ≤ + ∑ C ∈ (Q n).parts, + (boundary (σ n) C : ℝ) := by + exact_mod_cast hsingle.trans (le_of_eq hsum) + exact div_le_div_of_nonneg_right hreal (by positivity) + +private theorem list_generator_crossing_density_tendsto_zero + {V : ℕ → Type*} + [∀ n, Fintype (V n)] [∀ n, DecidableEq (V n)] + {ι : Type*} + (Q : ∀ n, Finpartition (Finset.univ : Finset (V n))) + (σ : ∀ n, ι → Equiv.Perm (V n)) + (hgenerator : ∀ i : ι, Tendsto + (fun n => + ((partitionWordCrossing (Q n) + (σ n i)).card : ℝ) / Fintype.card (V n)) + atTop (nhds 0)) + (l : List ι) : + Tendsto + (fun n => + ((partitionWordCrossing (Q n) + ((l.map (σ n)).prod)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0) := by + induction l with + | nil => + simp only [partitionWordCrossing, List.map_nil, List.prod_nil, Equiv.Perm.coe_one, id_eq, + Finpartition.mem_part_self, Finset.mem_univ, not_true_eq_false, Finset.filter_false, + Finset.card_empty, + CharP.cast_eq_zero, zero_div, tendsto_const_nhds_iff] + | cons i l ih => + have hupper : Tendsto + (fun n => + ((partitionWordCrossing (Q n) + (σ n i)).card : ℝ) / Fintype.card (V n) + + ((partitionWordCrossing (Q n) + ((l.map (σ n)).prod)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0) := by + simpa only [add_zero] using (hgenerator i).add ih + refine squeeze_zero (fun n => by positivity) ?_ hupper + intro n + have hnat := card_partitionWordCrossing_mul_le (Q n) + (σ n i) ((l.map (σ n)).prod) + have hreal : + ((partitionWordCrossing (Q n) + (σ n i * (l.map (σ n)).prod)).card : ℝ) ≤ + ((partitionWordCrossing (Q n) + (σ n i)).card : ℝ) + + ((partitionWordCrossing (Q n) + ((l.map (σ n)).prod)).card : ℝ) := by + exact_mod_cast hnat + simpa only [List.map_cons, List.prod_cons, ge_iff_le, add_div] using + (div_le_div_of_nonneg_right hreal (by positivity : (0 : ℝ) ≤ Fintype.card (V n))) + +private theorem action_list_prod_tendsto + {G : Type*} [Group G] + (A : SoficApproximation G) (l : List G) : + Tendsto + (fun n => + normalizedHamming + ((A.model n).action l.prod) + ((l.map (A.model n).action).prod)) + atTop (nhds 0) := by + induction l with + | nil => + simp only [List.prod_nil, PermutationModel.map_one, List.map_nil, normalizedHamming_self, + tendsto_const_nhds_iff] + | cons g l ih => + simp only [List.map_cons, List.prod_cons] + have hupper : Tendsto + (fun n => + normalizedHamming + ((A.model n).action (g * l.prod)) + ((A.model n).action g * (A.model n).action l.prod) + + normalizedHamming + ((A.model n).action l.prod) + ((l.map (A.model n).action).prod)) + atTop (nhds 0) := by + simpa only [add_zero] using (A.multiplicative g l.prod).add ih + refine squeeze_zero + (fun n => normalizedHamming_nonneg _ _) ?_ hupper + intro n + have htriangle := normalizedHamming_triangle + ((A.model n).action (g * l.prod)) + ((A.model n).action g * (A.model n).action l.prod) + ((A.model n).action g * + (l.map (A.model n).action).prod) + rw [normalizedHamming_mul_left] at htriangle + exact htriangle + +private theorem exists_word_of_symmetric_generators + {H : Type*} [Group H] + (S : Finset H) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set H) = ⊤) + (g : H) : + ∃ l : List ↥S, + ((l.map fun i : ↥S => (i : H)).prod) = g := by + classical + have hg : g ∈ Subgroup.closure (S : Set H) := by + rw [hgenerates] + simp only [Subgroup.mem_top] + induction hg using Subgroup.closure_induction with + | mem x hx => + exact ⟨[⟨x, hx⟩], by simp only [List.map_cons, List.map_nil, List.prod_cons, List.prod_nil, + mul_one]⟩ + | one => + exact ⟨[], by simp only [List.map_nil, List.prod_nil]⟩ + | mul x y _ _ ihx ihy => + obtain ⟨lx, hlx⟩ := ihx + obtain ⟨ly, hly⟩ := ihy + refine ⟨lx ++ ly, ?_⟩ + rw [List.map_append, List.prod_append, hlx, hly] + | inv x _ ih => + obtain ⟨l, hl⟩ := ih + let invLetter : ↥S → ↥S := + fun i => ⟨(i : H)⁻¹, hsymmetric (i : H) i.property⟩ + refine ⟨(l.map invLetter).reverse, ?_⟩ + rw [List.map_reverse, List.map_map] + change ((l.map fun i : ↥S => (i : H)⁻¹).reverse).prod = x⁻¹ + have hmap : + (l.map fun i : ↥S => (i : H)⁻¹) = + (l.map (fun i : ↥S => (i : H))).map + (fun z : H => z⁻¹) := by + rw [List.map_map] + rfl + rw [hmap, ← List.prod_inv_reverse, hl] + +public +theorem crossing_density_tendsto_zero_of_normalizedHamming + {V : ℕ → Type*} + [∀ n, Fintype (V n)] [∀ n, DecidableEq (V n)] + (Q : ∀ n, Finpartition (Finset.univ : Finset (V n))) + (p q : ∀ n, Equiv.Perm (V n)) + (hq : Tendsto + (fun n => + ((partitionWordCrossing (Q n) (q n)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0)) + (hdist : Tendsto + (fun n => normalizedHamming (p n) (q n)) + atTop (nhds 0)) : + Tendsto + (fun n => + ((partitionWordCrossing (Q n) (p n)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0) := by + have hupper : Tendsto + (fun n => + ((partitionWordCrossing (Q n) (q n)).card : ℝ) / + Fintype.card (V n) + + normalizedHamming (p n) (q n)) + atTop (nhds 0) := by + simpa only [add_zero] using hq.add hdist + refine squeeze_zero (fun n => by positivity) ?_ hupper + intro n + have hnat := SourceCompressionTransportCrossing.card_partitionWordCrossing_le_add_distance + (Q n) (p n) (q n) + have hreal : + ((partitionWordCrossing (Q n) (p n)).card : ℝ) ≤ + ((partitionWordCrossing (Q n) (q n)).card : ℝ) + + (permutationDistance (p n) (q n) : ℝ) := by + exact_mod_cast hnat + calc + ((partitionWordCrossing (Q n) (p n)).card : ℝ) / + Fintype.card (V n) ≤ + (((partitionWordCrossing (Q n) (q n)).card : ℝ) + + (permutationDistance (p n) (q n) : ℝ)) / + Fintype.card (V n) := + div_le_div_of_nonneg_right hreal (by positivity) + _ = ((partitionWordCrossing (Q n) (q n)).card : ℝ) / + Fintype.card (V n) + + normalizedHamming (p n) (q n) := by + simp only [permutationDistance, add_div, normalizedHamming] + +public +theorem fixed_generated_word_crossing_density_tendsto_zero + {G H : Type*} [Group G] [Group H] + (A : SoficApproximation G) + (φ : H →* G) (S : Finset H) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set H) = ⊤) + (Q : ∀ n, Finpartition + (Finset.univ : Finset (Fin (A.model n).size))) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥S => (A.model n).action (φ (i : H))) C : ℝ)) / + (A.model n).size) + atTop (nhds 0)) + (g : H) : + Tendsto + (fun n => + ((partitionWordCrossing (Q n) + ((A.model n).action (φ g))).card : ℝ) / + (A.model n).size) + atTop (nhds 0) := by + classical + obtain ⟨l, hl⟩ := + exists_word_of_symmetric_generators S hsymmetric hgenerates g + have hgenerator (i : ↥S) : Tendsto + (fun n => + ((partitionWordCrossing (Q n) + ((A.model n).action (φ (i : H)))).card : ℝ) / + (A.model n).size) + atTop (nhds 0) := by + simpa only [Fintype.card_fin] using + generator_crossing_density_tendsto_zero + (V := fun n => Fin (A.model n).size) + Q (fun n (j : ↥S) => (A.model n).action (φ (j : H))) + (by simpa only [Fintype.card_fin] using hboundary) i + have hlist : Tendsto + (fun n => + ((partitionWordCrossing (Q n) + ((l.map fun i : ↥S => + (A.model n).action (φ (i : H))).prod)).card : ℝ) / + (A.model n).size) + atTop (nhds 0) := by + simpa only [Fintype.card_fin] using + list_generator_crossing_density_tendsto_zero + (V := fun n => Fin (A.model n).size) + Q (fun n (i : ↥S) => (A.model n).action (φ (i : H))) + (fun i => by + simpa only [Fintype.card_fin] using hgenerator i) + l + have hprod : + ((l.map fun i : ↥S => φ (i : H)).prod) = φ g := by + calc + ((l.map fun i : ↥S => φ (i : H)).prod) = + φ ((l.map fun i : ↥S => (i : H)).prod) := by + simpa only [List.map_subtype, List.map_id_fun', id_eq] using + (map_list_prod φ (l.map fun i : ↥S => (i : H))).symm + _ = φ g := by rw [hl] + have hdist : Tendsto + (fun n => normalizedHamming + ((A.model n).action (φ g)) + ((l.map fun i : ↥S => + (A.model n).action (φ (i : H))).prod)) + atTop (nhds 0) := by + have h := action_list_prod_tendsto A + (l.map fun i : ↥S => φ (i : H)) + rw [hprod] at h + simpa only [List.map_subtype, List.map_map, Function.comp_def] using h + simpa only [Fintype.card_fin] using + crossing_density_tendsto_zero_of_normalizedHamming + (V := fun n => Fin (A.model n).size) + Q (fun n => (A.model n).action (φ g)) + (fun n => + (l.map fun i : ↥S => (A.model n).action (φ (i : H))).prod) + (by simpa only [Fintype.card_fin] using hlist) + hdist + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def sourceAlphaInclusion : + prefixElementaryGroup alphaPrefixCode →* + prefixElementaryGroup ninePrefixCode where + toFun g := + ⟨g.val, + SourceGeneration.alphaPrefixElementaryGroup_le_nine + g.property⟩ + map_one' := rfl + map_mul' _ _ := rfl + +public +theorem source_alpha_word_crossing_density_tendsto_zero + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (S : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure + (S : Set + (prefixElementaryGroup alphaPrefixCode)) = ⊤) + (Q : ∀ n, Finpartition + (Finset.univ : Finset (Fin (A.model n).size))) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥S => + (A.model n).action (sourceAlphaInclusion i)) C : ℝ)) / + (A.model n).size) + atTop (nhds 0)) + (g : prefixElementaryGroup alphaPrefixCode) : + Tendsto + (fun n => + ((partitionWordCrossing (Q n) + ((A.model n).action (sourceAlphaInclusion g))).card : ℝ) / + (A.model n).size) + atTop (nhds 0) := + fixed_generated_word_crossing_density_tendsto_zero + A sourceAlphaInclusion S hsymmetric hgenerates Q hboundary g + +end SourceGeneratedWordCrossing + +namespace KunRootedUniversalToleranceNumerics + +private theorem rooted_graph_boundary_lt_of_slow_tolerance + {h d q t N b c e : ℝ} + (hh : 0 < h) (hd : 0 < d) (hq : q < 1) + (ht : 0 < t) + (hbad : 2 * d * b ≤ t) + (hmissing : N - 2 * b ≤ c) + (hboundary : e ≤ 3 * t) + (hslow : + 5 * (4 + h * + (216 / (d * (1 - q) ^ 2) + 1 / d)) * t ≤ h * N) : + e < (d * (1 - q) ^ 2 / 288) * c := by + let δ : ℝ := d * (1 - q) ^ 2 + let γ : ℝ := δ / 288 + let C : ℝ := 216 / δ + 1 / d + have hδ : 0 < δ := by + dsimp [δ] + positivity + have hγ : 0 < γ := by + dsimp [γ] + positivity + have hC : 0 ≤ C := by + dsimp [C] + positivity + have hslowCscaled : h * (5 * C * t) ≤ h * N := by + have hslow' : 5 * (4 + h * C) * t ≤ h * N := by + simpa only [C, δ] using hslow + linarith only [hslow', ht] + have hslowC : 5 * C * t ≤ N := + le_of_mul_le_mul_left hslowCscaled hh + have hb : 2 * b ≤ t / d := by + apply (le_div_iff₀ hd).2 + linarith only [hbad] + have hgraph : N - t / d ≤ c := by + linarith + have hgraphscaled : γ * (N - t / d) ≤ γ * c := + mul_le_mul_of_nonneg_left hgraph hγ.le + have hNscaled : γ * (5 * C * t) ≤ γ * N := + mul_le_mul_of_nonneg_left hslowC hγ.le + have hγC : γ * C = (3 / 4 : ℝ) + γ / d := by + change + (δ / 288) * (216 / δ + 1 / d) = + (3 / 4 : ℝ) + (δ / 288) / d + field_simp [ne_of_gt hδ, ne_of_gt hd] + ring + have hidentity : + γ * (5 * C * t) - γ * (t / d) = + (15 / 4 : ℝ) * t + 4 * (γ / d) * t := by + calc + γ * (5 * C * t) - γ * (t / d) = + 5 * (γ * C) * t - (γ / d) * t := by ring + _ = 5 * ((3 / 4 : ℝ) + γ / d) * t - + (γ / d) * t := by rw [hγC] + _ = (15 / 4 : ℝ) * t + 4 * (γ / d) * t := by ring + have hpositive : 0 ≤ 4 * (γ / d) * t := by + positivity + have hstrict : 3 * t < γ * c := by + linarith only [hgraphscaled, hNscaled, hidentity, hpositive, ht] + simpa only [γ, δ] using lt_of_le_of_lt hboundary hstrict + +private theorem rooted_graph_coefficient_small + {d q : ℝ} (hd : 0 < d) (hq : q < 1) : + 0 < d * (1 - q) ^ 2 / 288 ∧ + 216 * (d * (1 - q) ^ 2 / 288) < d * (1 - q) ^ 2 := by + have hgap : 0 < d * (1 - q) ^ 2 := by + positivity + constructor + · positivity + · nlinarith + +end KunRootedUniversalToleranceNumerics + +namespace SourceBothCompressionNormalization + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def sourceCompressionUElement : + prefixElementaryGroup ninePrefixCode := + ⟨compressionU, + compressionU_mem_ninePrefixElementaryGroup⟩ + +private def sourceCompressionVElement : + prefixElementaryGroup ninePrefixCode := + ⟨compressionV, + compressionV_mem_ninePrefixElementaryGroup⟩ + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def sourceAlphaElement + (g : prefixElementaryGroup alphaPrefixCode) : + prefixElementaryGroup ninePrefixCode := + ⟨g.val, + SourceGeneration.alphaPrefixElementaryGroup_le_nine + g.property⟩ + +private def sourceConjugatedAlphaUElement + (g : prefixElementaryGroup alphaPrefixCode) : + prefixElementaryGroup alphaPrefixCode := by + refine ⟨compressionU * g.val * + compressionU⁻¹, ?_⟩ + apply alphaZero_prefixElementaryGroup_le + rw [← compressionU_map_alphaPrefixElementaryGroup] + refine ⟨g.val, g.property, ?_⟩ + simp only [MulEquiv.toMonoidHom_eq_coe, MonoidHom.coe_coe, MulAut.conj_apply] + +private def sourceConjugatedAlphaVElement + (g : prefixElementaryGroup alphaPrefixCode) : + prefixElementaryGroup alphaPrefixCode := by + refine ⟨compressionV * g.val * + compressionV⁻¹, ?_⟩ + apply alphaZero_prefixElementaryGroup_le + rw [← compressionV_map_alphaPrefixElementaryGroup] + refine ⟨g.val, g.property, ?_⟩ + simp only [MulEquiv.toMonoidHom_eq_coe, MonoidHom.coe_coe, MulAut.conj_apply] + +private theorem sourceCompressionUElement_conjugates_alpha + (g : prefixElementaryGroup alphaPrefixCode) : + sourceCompressionUElement * sourceAlphaElement g * + sourceCompressionUElement⁻¹ = + sourceAlphaElement (sourceConjugatedAlphaUElement g) := by + apply Subtype.ext + rfl + +private theorem sourceCompressionVElement_conjugates_alpha + (g : prefixElementaryGroup alphaPrefixCode) : + sourceCompressionVElement * sourceAlphaElement g * + sourceCompressionVElement⁻¹ = + sourceAlphaElement (sourceConjugatedAlphaVElement g) := by + apply Subtype.ext + rfl + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def sourceCompressionTable : + Fin 2 → prefixElementaryGroup ninePrefixCode := + ![sourceCompressionUElement, sourceCompressionVElement] + +public +theorem sourceCompressionTable_conjugates_alpha + (i : Fin 2) + (g : prefixElementaryGroup alphaPrefixCode) : + ∃ k : prefixElementaryGroup alphaPrefixCode, + sourceCompressionTable i * sourceAlphaElement g * + (sourceCompressionTable i)⁻¹ = + sourceAlphaElement k := by + fin_cases i + · exact ⟨sourceConjugatedAlphaUElement g, + sourceCompressionUElement_conjugates_alpha g⟩ + · exact ⟨sourceConjugatedAlphaVElement g, + sourceCompressionVElement_conjugates_alpha g⟩ + +end SourceBothCompressionNormalization + +namespace KunCompletedProductDiagonalSparseCut + +open KunDiagonalGoodRootGraphLoss +open KunRootedIndicatorCrossing +open KunRootedWordPower +open KunThomInvariantOrthogonal +open scoped BigOperators symmDiff + +universe u + +private def completedDiagonalPermutationHom {V : Type*} : + Equiv.Perm V →* Equiv.Perm (V × V) where + toFun p := p.prodCongr p + map_one' := by + ext z <;> rfl + map_mul' := by + intro p q + ext z <;> rfl + +private def completedGoodPermutationGraphIndicator + {V : Type*} [DecidableEq V] + (T : Finset (V × V)) (z : V × V) : ℝ := + if z ∈ T then 1 else 0 + +private def completedGoodPermutationGraphRootedModel + {G ι V : Type u} [Fintype V] [DecidableEq V] + (σ : ι → Equiv.Perm V) (φ : G → Equiv.Perm V) + (p : Equiv.Perm V) (B : Finset V) : + RootedIndicatorMarkovModel G ι where + carrier := V × V + fintype := inferInstance + generator i := completedDiagonalPermutationHom (σ i) + indicator := completedGoodPermutationGraphIndicator + (goodPermutationGraph p B) + evaluation g := completedDiagonalPermutationHom (φ g) + +private theorem completedGoodPermutationGraphRootedModel_isGenerated + {G ι V : Type u} [Group G] [Fintype ι] + [Fintype V] [DecidableEq V] + (s : ι → G) (w : G → List ι) + (σ : ι → Equiv.Perm V) (φ : G → Equiv.Perm V) + (hword : ∀ g : G, φ g = ((w g).map σ).prod) + (hone : φ 1 = 1) + (hgenerator : ∀ i : ι, φ (s i) = σ i) + (p : Equiv.Perm V) (B : Finset V) : + (completedGoodPermutationGraphRootedModel σ φ p B).IsGenerated s w := by + refine ⟨?_, ?_, ?_, ?_⟩ + · intro z + change + completedGoodPermutationGraphIndicator + (goodPermutationGraph p B) z = 0 ∨ + completedGoodPermutationGraphIndicator + (goodPermutationGraph p B) z = 1 + unfold completedGoodPermutationGraphIndicator + by_cases hz : z ∈ goodPermutationGraph p B + · exact Or.inr (ite_eq_left hz) + · exact Or.inl (ite_eq_right hz) + · intro g + change + completedDiagonalPermutationHom (φ g) = + ((w g).map + fun i : ι => completedDiagonalPermutationHom (σ i)).prod + rw [hword g, map_list_prod, List.map_map] + rfl + · change + completedDiagonalPermutationHom (φ 1) = + (1 : Equiv.Perm (V × V)) + rw [hone, map_one] + · intro i + change + completedDiagonalPermutationHom (φ (s i)) = + completedDiagonalPermutationHom (σ i) + rw [hgenerator i] + +private theorem completedGoodPermutationGraphRootedModel_isRootedAtRadius + {G ι V : Type u} [Group G] + [Fintype V] [DecidableEq V] + (w : G → List ι) (σ : ι → Equiv.Perm V) + (φ : G → Equiv.Perm V) + (p : Equiv.Perm V) (B : Finset V) (r : ℕ) + (hroot : ∀ a g : G, + (w a).length + (w g).length + (w (a * g)).length ≤ r → + ∀ x : V, x ∉ B → + φ (a * g) x = (φ a * φ g) x) : + (completedGoodPermutationGraphRootedModel + σ φ p B).IsRootedAtRadius w r := by + refine ⟨?_⟩ + intro a g hword z hz + have hzreal : + completedGoodPermutationGraphIndicator + (goodPermutationGraph p B) z ≠ 0 := by + intro hzero + apply hz + change + (completedGoodPermutationGraphIndicator + (goodPermutationGraph p B) z : ℂ) = 0 + exact_mod_cast hzero + have hzgraph : z ∈ goodPermutationGraph p B := by + by_contra hnot + apply hzreal + exact ite_eq_right hnot + have hgood : z.1 ∉ B ∧ z.2 ∉ B := + (Finset.mem_filter.mp hzgraph).2 + apply Prod.ext + · exact hroot a g hword z.1 hgood.1 + · exact hroot a g hword z.2 hgood.2 + +private theorem exists_completed_goodPermutationGraph_sparse_cut + {G : Type u} [Group G] + (P : KazhdanPair.{u, u} G) + (S : Finset G) (honeS : 1 ∈ S) + (hcover : P.generators ⊆ S) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (w : G → List ↥S) + (γ α : ℝ) (hγ : 0 < γ) (hα : 0 < α) + (hγsmall : + 216 * γ < + (S.card : ℝ) * + (1 - kazhdanMarkovContractionFactor P S) ^ 2) : + ∃ r : ℕ, + ∀ (V : Type u) [Fintype V] [DecidableEq V] + (σ : ↥S → Equiv.Perm V) (φ : G → Equiv.Perm V), + (∀ g : G, φ g = ((w g).map σ).prod) → + φ 1 = 1 → + (∀ i : ↥S, φ (i : G) = σ i) → + ∀ (p : Equiv.Perm V) (B : Finset V), + (∀ a g : G, + (w a).length + (w g).length + (w (a * g)).length ≤ r → + ∀ x : V, x ∉ B → + φ (a * g) x = (φ a * φ g) x) → + let T := goodPermutationGraph p B + T.Nonempty → + (boundary + (fun i : ↥S => (σ i).prodCongr (σ i)) T : ℝ) < + γ * (T.card : ℝ) → + ∃ U : Finset (V × V), + (((U ∆ T).card : ℝ)) ≤ + 72 * (boundary + (fun i : ↥S => (σ i).prodCongr (σ i)) T : ℝ) / + ((S.card : ℝ) * + (1 - kazhdanMarkovContractionFactor P S) ^ 2) ∧ + 3 * (U ∆ T).card < T.card ∧ + (boundary + (fun i : ↥S => (σ i).prodCongr (σ i)) U : ℝ) ≤ + α * (U.card : ℝ) := by + classical + obtain ⟨k, r, hr⟩ := + exists_rooted_word_radius_sparse_cut_of_boundary + P S honeS hcover hsymmetric w γ α hγ hα hγsmall + refine ⟨r, ?_⟩ + intro V _ _ σ φ hword hone hgenerator p B hroot + have hproductInstance : + (instDecidableEqProd : DecidableEq (V × V)) = + Classical.decEq (V × V) := + Subsingleton.elim _ _ + let : DecidableEq (V × V) := Classical.decEq (V × V) + dsimp only + intro hT hboundary + rw [hproductInstance] at hboundary ⊢ + let X : RootedIndicatorMarkovModel G ↥S := + completedGoodPermutationGraphRootedModel σ φ p B + let T : Finset X.carrier := goodPermutationGraph p B + have hgenerated : X.IsGenerated (fun i : ↥S => (i : G)) w := + completedGoodPermutationGraphRootedModel_isGenerated + (fun i : ↥S => (i : G)) w σ φ + hword hone hgenerator p B + have hrooted : X.IsRootedAtRadius w r := + completedGoodPermutationGraphRootedModel_isRootedAtRadius + w σ φ p B r hroot + have hindicator : ∀ z : X.carrier, + X.indicator z = if z ∈ T then (1 : ℝ) else 0 := by + intro z + by_cases hz : z ∈ goodPermutationGraph p B + · have hzT : z ∈ T := hz + rw [ite_eq_left hzT] + change + completedGoodPermutationGraphIndicator + (goodPermutationGraph p B) z = 1 + exact ite_eq_left hz + · have hzT : z ∉ T := hz + rw [ite_eq_right hzT] + change + completedGoodPermutationGraphIndicator + (goodPermutationGraph p B) z = 0 + exact ite_eq_right hz + have hT' : T.Nonempty := hT + have hboundary' : + (boundary X.generator T : ℝ) < + γ * (T.card : ℝ) := by + change + (boundary + (fun i : ↥S => (σ i).prodCongr (σ i)) + (goodPermutationGraph p B) : ℝ) < + γ * ((goodPermutationGraph p B).card : ℝ) + exact hboundary + obtain ⟨U, _hmarkov, hdistance, hclose, hcut⟩ := + hr X hgenerated hrooted T hT' hindicator hboundary' + refine ⟨U, ?_, ?_, ?_⟩ + · exact hdistance + · exact hclose + · exact hcut + +end KunCompletedProductDiagonalSparseCut + +namespace KunTransportedAmbientOverlap + +open Filter Topology +open scoped BigOperators symmDiff + +private theorem intersection_generator_exit_subset_union + {V : Type*} [DecidableEq V] + (p : Equiv.Perm V) (C D : Finset V) : + ((C ∩ D).filter fun x => p x ∉ C ∩ D) ⊆ + ((C.filter fun x => p x ∉ C) ∩ D) ∪ + ((D.filter fun x => p x ∉ D) ∩ C) := by + intro x hx + obtain ⟨hxCD, hout⟩ := Finset.mem_filter.mp hx + obtain ⟨hxC, hxD⟩ := Finset.mem_inter.mp hxCD + by_cases hpC : p x ∈ C + · apply Finset.mem_union_right + apply Finset.mem_inter.mpr + refine ⟨Finset.mem_filter.mpr ⟨hxD, ?_⟩, hxC⟩ + intro hpD + exact hout (Finset.mem_inter.mpr ⟨hpC, hpD⟩) + · apply Finset.mem_union_left + exact Finset.mem_inter.mpr + ⟨Finset.mem_filter.mpr ⟨hxC, hpC⟩, hxD⟩ + +private theorem sum_intersection_generator_exit_card_le + {V : Type*} [DecidableEq V] + {U : Finset V} (P Q : Finpartition U) + (p : Equiv.Perm V) : + (∑ C ∈ P.parts, ∑ D ∈ Q.parts, + ((C ∩ D).filter fun x => p x ∉ C ∩ D).card) ≤ + (∑ C ∈ P.parts, + (C.filter fun x => p x ∉ C).card) + + (∑ D ∈ Q.parts, + (D.filter fun x => p x ∉ D).card) := by + classical + have hcell (C D : Finset V) : + ((C ∩ D).filter fun x => p x ∉ C ∩ D).card ≤ + (((C.filter fun x => p x ∉ C) ∩ D).card) + + (((D.filter fun x => p x ∉ D) ∩ C).card) := + (Finset.card_le_card + (intersection_generator_exit_subset_union p C D)).trans + (Finset.card_union_le _ _) + have hfirst (C : Finset V) (hC : C ∈ P.parts) : + (∑ D ∈ Q.parts, + ((C.filter fun x => p x ∉ C) ∩ D).card) = + (C.filter fun x => p x ∉ C).card := by + have h := sum_card_inter_partition Q + (C.filter fun x => p x ∉ C) + have hsub : + (C.filter fun x => p x ∉ C) ⊆ U := + (Finset.filter_subset _ _).trans (P.subset hC) + simpa only [Finset.inter_comm, Finset.inter_eq_right.mpr hsub] using h + have hsecond (D : Finset V) (hD : D ∈ Q.parts) : + (∑ C ∈ P.parts, + ((D.filter fun x => p x ∉ D) ∩ C).card) = + (D.filter fun x => p x ∉ D).card := by + have h := sum_card_inter_partition P + (D.filter fun x => p x ∉ D) + have hsub : + (D.filter fun x => p x ∉ D) ⊆ U := + (Finset.filter_subset _ _).trans (Q.subset hD) + simpa only [Finset.inter_comm, Finset.inter_eq_right.mpr hsub] using h + calc + (∑ C ∈ P.parts, ∑ D ∈ Q.parts, + ((C ∩ D).filter fun x => p x ∉ C ∩ D).card) ≤ + ∑ C ∈ P.parts, ∑ D ∈ Q.parts, + ((((C.filter fun x => p x ∉ C) ∩ D).card) + + (((D.filter fun x => p x ∉ D) ∩ C).card)) := by + apply Finset.sum_le_sum + intro C _ + apply Finset.sum_le_sum + intro D _ + exact hcell C D + _ = (∑ C ∈ P.parts, ∑ D ∈ Q.parts, + ((C.filter fun x => p x ∉ C) ∩ D).card) + + (∑ D ∈ Q.parts, ∑ C ∈ P.parts, + ((D.filter fun x => p x ∉ D) ∩ C).card) := by + simp_rw [Finset.sum_add_distrib] + congr 1 + rw [Finset.sum_comm] + _ = (∑ C ∈ P.parts, + (C.filter fun x => p x ∉ C).card) + + (∑ D ∈ Q.parts, + (D.filter fun x => p x ∉ D).card) := by + congr 1 + · apply Finset.sum_congr rfl + intro C hC + exact hfirst C hC + · apply Finset.sum_congr rfl + intro D hD + exact hsecond D hD + +private theorem sum_intersection_boundary_le_partition_boundaries + {V ι : Type*} [DecidableEq V] [Fintype ι] + {U : Finset V} (P Q : Finpartition U) + (σ : ι → Equiv.Perm V) : + (∑ C ∈ P.parts, ∑ D ∈ Q.parts, + boundary σ (C ∩ D)) ≤ + (∑ C ∈ P.parts, boundary σ C) + + (∑ D ∈ Q.parts, boundary σ D) := by + classical + calc + (∑ C ∈ P.parts, ∑ D ∈ Q.parts, + boundary σ (C ∩ D)) = + ∑ i : ι, ∑ C ∈ P.parts, ∑ D ∈ Q.parts, + ((C ∩ D).filter fun x => σ i x ∉ C ∩ D).card := by + simp_rw [boundary] + calc + (∑ C ∈ P.parts, ∑ D ∈ Q.parts, ∑ i : ι, + ((C ∩ D).filter fun x => σ i x ∉ C ∩ D).card) = + ∑ C ∈ P.parts, ∑ i : ι, ∑ D ∈ Q.parts, + ((C ∩ D).filter fun x => σ i x ∉ C ∩ D).card := by + apply Finset.sum_congr rfl + intro C _ + rw [Finset.sum_comm] + _ = ∑ i : ι, ∑ C ∈ P.parts, ∑ D ∈ Q.parts, + ((C ∩ D).filter fun x => σ i x ∉ C ∩ D).card := by + rw [Finset.sum_comm] + _ ≤ ∑ i : ι, + ((∑ C ∈ P.parts, (C.filter fun x => σ i x ∉ C).card) + + (∑ D ∈ Q.parts, (D.filter fun x => σ i x ∉ D).card)) := by + apply Finset.sum_le_sum + intro i _ + exact sum_intersection_generator_exit_card_le P Q (σ i) + _ = (∑ C ∈ P.parts, boundary σ C) + + (∑ D ∈ Q.parts, boundary σ D) := by + simp_rw [Finset.sum_add_distrib] + congr 1 + · simp_rw [boundary] + rw [Finset.sum_comm] + · simp_rw [boundary] + rw [Finset.sum_comm] + +private theorem dominant_component_loss_le_ambient_intersection_boundaries + {V ι : Type*} [DecidableEq V] [Fintype ι] + {U : Finset V} (P Q : Finpartition U) + (σ : ι → Equiv.Perm V) (gamma : ℝ) + (hexp : ∀ C ∈ P.parts, ∀ E : Finset V, E ⊆ C → + 2 * E.card ≤ C.card → + gamma * (E.card : ℝ) ≤ + (boundary σ E : ℝ)) + (C : Finset V) (hC : C ∈ P.parts) : + gamma * + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart Q C).card : ℝ)) ≤ + ∑ E ∈ Q.parts, + (boundary σ (C ∩ E) : ℝ) := by + classical + let D : Finset V := maximumOverlapPart Q C + have hCU : C ⊆ U := P.subset hC + have hD : D ∈ Q.parts := + maximumOverlapPart_mem Q C + (P.nonempty_of_mem_parts hC) hCU + have hmax : ∀ E ∈ Q.parts, (C ∩ E).card ≤ (C ∩ D).card := + maximumOverlapPart_maximal Q C + (P.nonempty_of_mem_parts hC) hCU + have hsmall (E : Finset V) (hE : E ∈ Q.parts.erase D) : + gamma * ((C ∩ E).card : ℝ) ≤ + (boundary σ (C ∩ E) : ℝ) := by + obtain ⟨hne, hEmem⟩ := Finset.mem_erase.mp hE + have hdisj : Disjoint (C ∩ E) (C ∩ D) := + (Q.disjoint hEmem hD hne).mono + Finset.inter_subset_right Finset.inter_subset_right + have hunion : (C ∩ E) ∪ (C ∩ D) ⊆ C := + Finset.union_subset Finset.inter_subset_left + Finset.inter_subset_left + have hcard : + (C ∩ E).card + (C ∩ D).card ≤ C.card := by + rw [← Finset.card_union_of_disjoint hdisj] + exact Finset.card_le_card hunion + have hhalf : 2 * (C ∩ E).card ≤ C.card := by + have hmaximum := hmax E hEmem + omega + exact hexp C hC (C ∩ E) Finset.inter_subset_left hhalf + have hsum : + (∑ E ∈ Q.parts, ((C ∩ E).card : ℝ)) = + (C.card : ℝ) := by + exact_mod_cast + sum_card_component_inter_partition Q C hCU + have herase : + (∑ E ∈ Q.parts.erase D, ((C ∩ E).card : ℝ)) = + (C.card : ℝ) - ((C ∩ D).card : ℝ) := by + have hsplit := Finset.add_sum_erase Q.parts + (fun E : Finset V => ((C ∩ E).card : ℝ)) hD + linarith + change gamma * ((C.card : ℝ) - ((C ∩ D).card : ℝ)) ≤ _ + calc + gamma * ((C.card : ℝ) - ((C ∩ D).card : ℝ)) = + ∑ E ∈ Q.parts.erase D, + gamma * ((C ∩ E).card : ℝ) := by + rw [← Finset.mul_sum, herase] + _ ≤ ∑ E ∈ Q.parts.erase D, + (boundary σ (C ∩ E) : ℝ) := + Finset.sum_le_sum hsmall + _ ≤ ∑ E ∈ Q.parts, + (boundary σ (C ∩ E) : ℝ) := by + apply Finset.sum_le_sum_of_subset_of_nonneg + (Finset.erase_subset _ _) + intro E _ _ + exact Nat.cast_nonneg _ + +private theorem sum_dominant_component_losses_le_partition_boundaries + {V ι : Type*} [DecidableEq V] [Fintype ι] + {U : Finset V} (P Q : Finpartition U) + (σ : ι → Equiv.Perm V) (gamma : ℝ) + (hexp : ∀ C ∈ P.parts, ∀ E : Finset V, E ⊆ C → + 2 * E.card ≤ C.card → + gamma * (E.card : ℝ) ≤ + (boundary σ E : ℝ)) : + gamma * + (∑ C ∈ P.parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart Q C).card : ℝ))) ≤ + (∑ C ∈ P.parts, (boundary σ C : ℝ)) + + (∑ D ∈ Q.parts, (boundary σ D : ℝ)) := by + classical + calc + gamma * + (∑ C ∈ P.parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart Q C).card : ℝ))) = + ∑ C ∈ P.parts, + gamma * ((C.card : ℝ) - + ((C ∩ maximumOverlapPart Q C).card : ℝ)) := by + rw [Finset.mul_sum] + _ ≤ ∑ C ∈ P.parts, ∑ D ∈ Q.parts, + (boundary σ (C ∩ D) : ℝ) := by + apply Finset.sum_le_sum + intro C hC + exact dominant_component_loss_le_ambient_intersection_boundaries + P Q σ gamma hexp C hC + _ ≤ (∑ C ∈ P.parts, (boundary σ C : ℝ)) + + (∑ D ∈ Q.parts, (boundary σ D : ℝ)) := by + exact_mod_cast + sum_intersection_boundary_le_partition_boundaries P Q σ + +public +theorem dominant_component_loss_density_tendsto_zero + {V : ℕ → Type*} + [∀ n, Fintype (V n)] [∀ n, Nonempty (V n)] + [∀ n, DecidableEq (V n)] + {ι : Type*} [Fintype ι] + (P Q : ∀ n, Finpartition (Finset.univ : Finset (V n))) + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (gamma : ℝ) (hgamma : 0 < gamma) + (hexp : ∀ n C, C ∈ (P n).parts → + ∀ E : Finset (V n), E ⊆ C → + 2 * E.card ≤ C.card → + gamma * (E.card : ℝ) ≤ + (boundary (σ n) E : ℝ)) + (hsource : Tendsto + (fun n => + (∑ C ∈ (P n).parts, + (boundary (σ n) C : ℝ)) / + Fintype.card (V n)) + atTop (nhds 0)) + (htarget : Tendsto + (fun n => + (∑ D ∈ (Q n).parts, + (boundary (σ n) D : ℝ)) / + Fintype.card (V n)) + atTop (nhds 0)) : + Tendsto + (fun n => + (∑ C ∈ (P n).parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart (Q n) C).card : ℝ))) / + Fintype.card (V n)) + atTop (nhds 0) := by + have hupper : Tendsto + (fun n => (1 / gamma) * + ((∑ C ∈ (P n).parts, + (boundary (σ n) C : ℝ)) / + Fintype.card (V n) + + (∑ D ∈ (Q n).parts, + (boundary (σ n) D : ℝ)) / + Fintype.card (V n))) + atTop (nhds 0) := by + simpa only [add_zero, mul_zero] using + ((tendsto_const_nhds : + Tendsto (fun _ : ℕ => (1 / gamma : ℝ)) + atTop (nhds (1 / gamma))).mul (hsource.add htarget)) + refine squeeze_zero (fun n => ?_) (fun n => ?_) hupper + · apply div_nonneg + · apply Finset.sum_nonneg + intro C _ + apply sub_nonneg.mpr + exact_mod_cast Finset.card_le_card + (Finset.inter_subset_left : + C ∩ maximumOverlapPart (Q n) C ⊆ C) + · exact Nat.cast_nonneg _ + · have hcard : (0 : ℝ) < Fintype.card (V n) := by + exact_mod_cast Fintype.card_pos_iff.mpr inferInstance + have hbound := + sum_dominant_component_losses_le_partition_boundaries + (P n) (Q n) (σ n) gamma (hexp n) + have hdivide : + (∑ C ∈ (P n).parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart (Q n) C).card : ℝ))) ≤ + ((∑ C ∈ (P n).parts, + (boundary (σ n) C : ℝ)) + + (∑ D ∈ (Q n).parts, + (boundary (σ n) D : ℝ))) / gamma := by + apply (le_div_iff₀ hgamma).2 + simpa only [Finset.sum_sub_distrib, mul_comm] using hbound + calc + (∑ C ∈ (P n).parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart (Q n) C).card : ℝ))) / + Fintype.card (V n) ≤ + (((∑ C ∈ (P n).parts, + (boundary (σ n) C : ℝ)) + + (∑ D ∈ (Q n).parts, + (boundary (σ n) D : ℝ))) / gamma) / + Fintype.card (V n) := + div_le_div_of_nonneg_right hdivide hcard.le + _ = (1 / gamma) * + ((∑ C ∈ (P n).parts, + (boundary (σ n) C : ℝ)) / + Fintype.card (V n) + + (∑ D ∈ (Q n).parts, + (boundary (σ n) D : ℝ)) / + Fintype.card (V n)) := by + ring + +private theorem boundary_conjugate_map + {V ι : Type*} [DecidableEq V] [Fintype ι] + (σ : ι → Equiv.Perm V) (T : Equiv.Perm V) + (C : Finset V) : + boundary + (fun i => T * σ i * T⁻¹) + (C.map T.toEmbedding) = + boundary σ C := by + classical + unfold boundary + apply Finset.sum_congr rfl + intro i _ + have hfilter : + ((C.map T.toEmbedding).filter fun y => + (T * σ i * T⁻¹) y ∉ C.map T.toEmbedding) = + (C.filter fun x => σ i x ∉ C).map T.toEmbedding := by + ext y + simp only [Equiv.Perm.mul_apply, Equiv.Perm.coe_inv, Finset.mem_map_mk, Finset.mem_filter, + Finset.mem_map_equiv] + rw [hfilter, Finset.card_map] + +public +theorem transportedUnivFinpartition_half_expansion + {V ι : Type*} [Fintype V] [DecidableEq V] [Fintype ι] + (Q : Finpartition (Finset.univ : Finset V)) + (σ : ι → Equiv.Perm V) (T : Equiv.Perm V) + (gamma : ℝ) + (hexp : ∀ C ∈ Q.parts, ∀ E : Finset V, E ⊆ C → + 2 * E.card ≤ C.card → + gamma * (E.card : ℝ) ≤ + (boundary σ E : ℝ)) : + ∀ C ∈ (transportedUnivFinpartition Q T).parts, + ∀ E : Finset V, E ⊆ C → + 2 * E.card ≤ C.card → + gamma * (E.card : ℝ) ≤ + (boundary + (fun i => T * σ i * T⁻¹) E : ℝ) := by + classical + intro C hC + rw [transportedUnivFinpartition_parts] at hC + obtain ⟨C₀, hC₀, rfl⟩ := Finset.mem_image.mp hC + intro E hE hhalf + let E₀ : Finset V := E.map T.symm.toEmbedding + have hrecovery : E₀.map T.toEmbedding = E := by + simp only [Finset.map_map, Function.Embedding.mk_trans_mk, Equiv.self_comp_symm, + Function.Embedding.mk_id, + Finset.map_refl, E₀] + have hsub : E₀ ⊆ C₀ := by + apply (Finset.map_subset_map (f := T.toEmbedding)).mp + simpa only [hrecovery] using hE + have hhalf₀ : 2 * E₀.card ≤ C₀.card := by + simpa [E₀] using hhalf + have hsource := hexp C₀ hC₀ E₀ hsub hhalf₀ + have hboundary := + boundary_conjugate_map σ T E₀ + calc + gamma * (E.card : ℝ) = gamma * (E₀.card : ℝ) := by + simp only [Finset.card_map, E₀] + _ ≤ (boundary σ E₀ : ℝ) := hsource + _ = (boundary + (fun i => T * σ i * T⁻¹) + (E₀.map T.toEmbedding) : ℝ) := by + exact_mod_cast hboundary.symm + _ = (boundary + (fun i => T * σ i * T⁻¹) E : ℝ) := by + rw [hrecovery] + +private theorem sum_boundary_transportedUnivFinpartition + {V ι : Type*} [Fintype V] [DecidableEq V] [Fintype ι] + (Q : Finpartition (Finset.univ : Finset V)) + (σ : ι → Equiv.Perm V) (T : Equiv.Perm V) : + (∑ C ∈ (transportedUnivFinpartition Q T).parts, + boundary + (fun i => T * σ i * T⁻¹) C) = + ∑ C ∈ Q.parts, boundary σ C := by + classical + rw [transportedUnivFinpartition_parts] + rw [Finset.sum_image] + · apply Finset.sum_congr rfl + intro C _ + exact boundary_conjugate_map σ T C + · intro C hC D hD heq + exact T.finsetCongr.injective heq + +public +theorem transported_partition_boundary_density_tendsto_zero + {V : ℕ → Type*} + [∀ n, Fintype (V n)] [∀ n, DecidableEq (V n)] + {ι : Type*} [Fintype ι] + (Q : ∀ n, Finpartition (Finset.univ : Finset (V n))) + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (T : (n : ℕ) → Equiv.Perm (V n)) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary (σ n) C : ℝ)) / + Fintype.card (V n)) + atTop (nhds 0)) : + Tendsto + (fun n => + (∑ C ∈ + (transportedUnivFinpartition (Q n) (T n)).parts, + (boundary + (fun i => T n * σ n i * (T n)⁻¹) C : ℝ)) / + Fintype.card (V n)) + atTop (nhds 0) := by + have hsum (n : ℕ) : + (∑ C ∈ + (transportedUnivFinpartition (Q n) (T n)).parts, + (boundary + (fun i => T n * σ n i * (T n)⁻¹) C : ℝ)) = + ∑ C ∈ (Q n).parts, + (boundary (σ n) C : ℝ) := by + exact_mod_cast + sum_boundary_transportedUnivFinpartition (Q n) (σ n) (T n) + simpa only [hsum] using hboundary + +public +theorem exists_common_slow_overlap_scales_for_transported_partitions + {V : ℕ → Type*} + [∀ n, Fintype (V n)] [∀ n, Nonempty (V n)] + [∀ n, DecidableEq (V n)] + {ι κ : Type*} [Fintype ι] [Finite κ] + (Q : ∀ n, Finpartition (Finset.univ : Finset (V n))) + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (T : (n : ℕ) → κ → Equiv.Perm (V n)) + (gamma : ℝ) (hgamma : 0 < gamma) + (hexp : ∀ n C, C ∈ (Q n).parts → + ∀ E : Finset (V n), E ⊆ C → + 2 * E.card ≤ C.card → + gamma * (E.card : ℝ) ≤ + (boundary (σ n) E : ℝ)) + (hsource : Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary (σ n) C : ℝ)) / + Fintype.card (V n)) + atTop (nhds 0)) + (htarget : ∀ j : κ, Tendsto + (fun n => + (∑ D ∈ (Q n).parts, + (boundary + (fun i => T n j * σ n i * (T n j)⁻¹) D : ℝ)) / + Fintype.card (V n)) + atTop (nhds 0)) : + ∃ eta H : ℕ → ℝ, + (∀ n, 0 < eta n) ∧ + Antitone eta ∧ + Tendsto eta atTop (nhds 0) ∧ + (∀ n, 0 < H n) ∧ + Antitone H ∧ + Tendsto H atTop (nhds 0) ∧ + Tendsto (fun n => eta n / H n) atTop (nhds 0) ∧ + ∀ j : κ, Tendsto + (fun n => + (∑ C ∈ insufficientOverlapComponents + (transportedUnivFinpartition + (Q n) (T n j)) + (Q n) (eta n), (C.card : ℝ)) / + Fintype.card (V n)) + atTop (nhds 0) := by + classical + let : Fintype κ := Fintype.ofFinite κ + let L : κ → ℕ → ℝ := fun j n => + (∑ C ∈ + (transportedUnivFinpartition + (Q n) (T n j)).parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart (Q n) C).card : ℝ))) / + Fintype.card (V n) + have hLnonneg (j : κ) (n : ℕ) : 0 ≤ L j n := by + dsimp [L] + apply div_nonneg + · apply Finset.sum_nonneg + intro C _ + apply sub_nonneg.mpr + exact_mod_cast Finset.card_le_card + (Finset.inter_subset_left : + C ∩ maximumOverlapPart (Q n) C ⊆ C) + · exact Nat.cast_nonneg _ + have hLlimit (j : κ) : + Tendsto (L j) atTop (nhds 0) := by + apply dominant_component_loss_density_tendsto_zero + (fun n => + transportedUnivFinpartition (Q n) (T n j)) + Q + (fun n i => T n j * σ n i * (T n j)⁻¹) + gamma hgamma + · intro n + exact transportedUnivFinpartition_half_expansion + (Q n) (σ n) (T n j) gamma (hexp n) + · exact transported_partition_boundary_density_tendsto_zero + Q σ (fun n => T n j) hsource + · exact htarget j + let e : ℕ → ℝ := fun n => ∑ j : κ, L j n + have henonneg (n : ℕ) : 0 ≤ e n := by + exact Finset.sum_nonneg fun j _ => hLnonneg j n + have helimit : Tendsto e atTop (nhds 0) := by + dsimp [e] + simpa only [Finset.sum_const_zero] using tendsto_finsetSum Finset.univ (fun j _ => hLlimit j) + obtain ⟨eta, H, heta, hetaanti, hetalimit, + hH, hHanti, hHlimit, hslow, hratio⟩ := + exists_positive_antitone_slow_overlap_scales + e henonneg helimit + refine ⟨eta, H, heta, hetaanti, hetalimit, + hH, hHanti, hHlimit, hratio, ?_⟩ + intro j + refine squeeze_zero (fun n => + div_nonneg (Finset.sum_nonneg fun C _ => Nat.cast_nonneg C.card) + (Nat.cast_nonneg _)) ?_ hslow + intro n + let P : Finpartition (Finset.univ : Finset (V n)) := + transportedUnivFinpartition (Q n) (T n j) + have hmass := + insufficientOverlapComponents_mass_le_loss + P (Q n) (eta n) + have hdivide : + (∑ C ∈ insufficientOverlapComponents + P (Q n) (eta n), (C.card : ℝ)) ≤ + (∑ C ∈ P.parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart (Q n) C).card : + ℝ))) / eta n := by + apply (le_div_iff₀ (heta n)).2 + simpa only [mul_comm, Finset.sum_sub_distrib] using hmass + have hcard : (0 : ℝ) < Fintype.card (V n) := by + exact_mod_cast Fintype.card_pos_iff.mpr inferInstance + have hsingle : L j n ≤ e n := by + exact Finset.single_le_sum + (fun k _ => hLnonneg k n) + (Finset.mem_univ j) + change + (∑ C ∈ insufficientOverlapComponents + P (Q n) (eta n), (C.card : ℝ)) / + Fintype.card (V n) ≤ e n / eta n + calc + (∑ C ∈ insufficientOverlapComponents + P (Q n) (eta n), (C.card : ℝ)) / + Fintype.card (V n) ≤ + ((∑ C ∈ P.parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart (Q n) C).card : ℝ))) / + eta n) / Fintype.card (V n) := + div_le_div_of_nonneg_right hdivide hcard.le + _ = L j n / eta n := by + dsimp [L, P] + ring + _ ≤ e n / eta n := + div_le_div_of_nonneg_right hsingle (heta n).le + +end KunTransportedAmbientOverlap + +namespace KunUniformCompletedRootRadiusImprovement + +open KunDiagonalGoodRootGraphLoss +open KunThomInvariantOrthogonal +open scoped BigOperators symmDiff + +universe u + +public +theorem exists_uniform_radius_hasAlmostCentralizerImprovement + {G : Type u} [Group G] + (P : KazhdanPair.{u, u} G) + (S : Finset G) (honeS : 1 ∈ S) + (hcover : P.generators ⊆ S) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (w : G → List ↥S) + (h α : ℝ) (hpositive : 0 < h) (hα : 0 < α) : + ∃ r : ℕ, + ∀ (V : Type u) [Fintype V] [Nonempty V] [DecidableEq V] + (σ : ↥S → Equiv.Perm V) (φ : G → Equiv.Perm V) + (tolerance : ℕ) (B : Finset V), + (∀ g : G, φ g = ((w g).map σ).prod) → + φ 1 = 1 → + (∀ i : ↥S, φ (i : G) = σ i) → + (∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ)) → + (5 * (4 + h * + (216 / ((S.card : ℝ) * + (1 - kazhdanMarkovContractionFactor P S) ^ 2) + + 1 / (S.card : ℝ))) * (tolerance : ℝ) ≤ + h * (Fintype.card V : ℝ)) → + (tolerance = 0 ∨ + (0 < (tolerance : ℝ) ∧ + α ≤ h * (tolerance : ℝ) / + (2 * (h + 8 * (S.card : ℝ)) * + (Fintype.card V : ℝ)) ∧ + 2 * (S.card : ℝ) * (B.card : ℝ) ≤ + (tolerance : ℝ) ∧ + ∀ a g : G, + (w a).length + (w g).length + + (w (a * g)).length ≤ r → + ∀ x : V, x ∉ B → + φ (a * g) x = (φ a * φ g) x)) → + HasAlmostCentralizerImprovement σ tolerance := by + classical + let : Nonempty (↥S) := ⟨⟨1, honeS⟩⟩ + let d : ℝ := S.card + let q : ℝ := kazhdanMarkovContractionFactor P S + let γ : ℝ := d * (1 - q) ^ 2 / 288 + have hd : 0 < d := by + dsimp [d] + exact_mod_cast Finset.card_pos.mpr ⟨1, honeS⟩ + have hq : q < 1 := by + exact kazhdanMarkovContractionFactor_lt_one + P S ⟨1, honeS⟩ + have hγpair := + KunRootedUniversalToleranceNumerics.rooted_graph_coefficient_small + hd hq + have hγ : 0 < γ := by + simpa only [γ] using hγpair.1 + have hγsmall : + 216 * γ < (S.card : ℝ) * (1 - q) ^ 2 := by + simpa only [γ, d] using hγpair.2 + obtain ⟨r, hspectral⟩ := + KunCompletedProductDiagonalSparseCut.exists_completed_goodPermutationGraph_sparse_cut + P S honeS hcover hsymmetric w γ α hγ hα + (by simpa only [q] using hγsmall) + refine ⟨r, ?_⟩ + intro V _ _ _ σ φ tolerance B hword hone hgenerator + hexp hslow hcase + rcases hcase with htzero | ⟨ht, htarget, hbadS, hlocal⟩ + · subst tolerance + exact KunCompletedPrunedComponent.hasAlmostCentralizerImprovement_zero σ + have hbad : + 2 * (Fintype.card (↥S) : ℝ) * (B.card : ℝ) ≤ + (tolerance : ℝ) := by + simpa only [Fintype.card_coe] using hbadS + have hslowq : + 5 * (4 + h * + (216 / ((Fintype.card (↥S) : ℝ) * (1 - q) ^ 2) + + 1 / (Fintype.card (↥S) : ℝ))) * + (tolerance : ℝ) ≤ + h * (Fintype.card V : ℝ) := by + simpa only [Fintype.card_coe, q] using hslow + apply + hasAlmostCentralizerImprovement_of_universal_good_root_thresholds + σ tolerance h q hpositive hq B + (fun p => goodPermutationGraph p B) hexp + hbad + (fun p => goodPermutationGraph_subset p B) + (fun p => card_permutationGraph_sdiff_goodPermutationGraph_le p B) + (fun p => + boundary_goodPermutationGraph_le_commutationDefect_add σ p B) + hslowq + intro p hp + let T : Finset (V × V) := goodPermutationGraph p B + have hcard : + (Fintype.card V : ℝ) - 2 * (B.card : ℝ) ≤ + (T.card : ℝ) := by + exact card_goodPermutationGraph_ge_card_sub_twice_bad p B + have hboundary : + (boundary + (fun i : ↥S => (σ i).prodCongr (σ i)) T : ℝ) ≤ + 3 * (tolerance : ℝ) := by + have hbound := + boundary_goodPermutationGraph_le_commutationDefect_add σ p B + have hbound_real : + (boundary + (fun i : ↥S => (σ i).prodCongr (σ i)) T : ℝ) ≤ + (permutationCommutationDefect σ p : ℝ) + + 2 * (Fintype.card (↥S) : ℝ) * (B.card : ℝ) := by + exact_mod_cast hbound + have hp_real : + (permutationCommutationDefect σ p : ℝ) ≤ + 2 * (tolerance : ℝ) := by + exact_mod_cast hp + linarith + have hsparse : + (boundary + (fun i : ↥S => (σ i).prodCongr (σ i)) T : ℝ) < + γ * (T.card : ℝ) := by + have hslowS : + 5 * (4 + h * + (216 / (d * (1 - q) ^ 2) + 1 / d)) * + (tolerance : ℝ) ≤ + h * (Fintype.card V : ℝ) := by + simpa only [d, q] using hslow + have hbad' : + 2 * d * (B.card : ℝ) ≤ (tolerance : ℝ) := by + simpa only [d] using hbadS + have hs := + KunRootedUniversalToleranceNumerics.rooted_graph_boundary_lt_of_slow_tolerance + hpositive hd hq ht hbad' hcard hboundary hslowS + simpa only [γ] using hs + have hT : T.Nonempty := by + apply Finset.card_pos.mp + have hnonnegative : + 0 ≤ (boundary + (fun i : ↥S => (σ i).prodCongr (σ i)) T : ℝ) := by + positivity + have hpositiveT : 0 < (T.card : ℝ) := + (mul_pos_iff_of_pos_left hγ).mp + (lt_of_le_of_lt hnonnegative hsparse) + exact_mod_cast hpositiveT + obtain ⟨U, hreference, _hclose, hcut⟩ := + hspectral V σ φ hword hone hgenerator p B hlocal hT hsparse + refine ⟨U, ?_, ?_⟩ + · simpa only [T, q, Fintype.card_coe] using hreference + · calc + (boundary + (fun i : ↥S => (σ i).prodCongr (σ i)) U : ℝ) ≤ + α * (U.card : ℝ) := hcut + _ ≤ (h * (tolerance : ℝ) / + (2 * (h + 8 * (Fintype.card (↥S) : ℝ)) * + (Fintype.card V : ℝ))) * (U.card : ℝ) := by + apply mul_le_mul_of_nonneg_right _ (Nat.cast_nonneg _) + simpa only [Fintype.card_coe] using htarget + +end KunUniformCompletedRootRadiusImprovement + +namespace CompletedChosenWordLocalRoot + +open Filter Topology +open scoped BigOperators + + +private theorem list_permutation_hamming_tendsto + (V : ℕ → Type*) + [∀ n, Fintype (V n)] [∀ n, DecidableEq (V n)] + {ι : Type*} + (σ τ : ∀ n, ι → Equiv.Perm (V n)) + (hletter : ∀ i : ι, + Tendsto + (fun n => normalizedHamming (σ n i) (τ n i)) + atTop (nhds 0)) + (l : List ι) : + Tendsto + (fun n => normalizedHamming + ((l.map (σ n)).prod) ((l.map (τ n)).prod)) + atTop (nhds 0) := by + induction l with + | nil => + simp only [List.map_nil, List.prod_nil, normalizedHamming_self, tendsto_const_nhds_iff] + | cons i l ih => + simp only [List.map_cons, List.prod_cons] + have hupper : Tendsto + (fun n => + normalizedHamming (σ n i) (τ n i) + + normalizedHamming + ((l.map (σ n)).prod) ((l.map (τ n)).prod)) + atTop (nhds 0) := by + simpa only [add_zero] using (hletter i).add ih + refine squeeze_zero + (fun n => normalizedHamming_nonneg _ _) ?_ hupper + intro n + exact KunActualSoficRootRadius.normalizedHamming_mul_le + (σ n i) (τ n i) + ((l.map (σ n)).prod) ((l.map (τ n)).prod) + +private theorem approximate_action_list_prod_tendsto + {G : Type*} [Group G] + (V : ℕ → Type*) + [∀ n, Fintype (V n)] [∀ n, DecidableEq (V n)] + (p : ∀ n, G → Equiv.Perm (V n)) + (hone : ∀ n, p n 1 = 1) + (hmul : ∀ a g : G, + Tendsto + (fun n => normalizedHamming + (p n (a * g)) (p n a * p n g)) + atTop (nhds 0)) + (l : List G) : + Tendsto + (fun n => normalizedHamming + (p n l.prod) ((l.map (p n)).prod)) + atTop (nhds 0) := by + induction l with + | nil => + simp only [List.prod_nil, hone, List.map_nil, normalizedHamming_self, tendsto_const_nhds_iff] + | cons a l ih => + simp only [List.map_cons, List.prod_cons] + have hupper : Tendsto + (fun n => + normalizedHamming + (p n (a * l.prod)) (p n a * p n l.prod) + + normalizedHamming + (p n l.prod) ((l.map (p n)).prod)) + atTop (nhds 0) := by + simpa only [add_zero] using (hmul a l.prod).add ih + refine squeeze_zero + (fun n => normalizedHamming_nonneg _ _) ?_ hupper + intro n + have h := normalizedHamming_triangle + (p n (a * l.prod)) + (p n a * p n l.prod) + (p n a * (l.map (p n)).prod) + rw [normalizedHamming_mul_left] at h + exact h + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def chosenWordEvaluation + {G ι V : Type*} + (σ : ι → Equiv.Perm V) (w : G → List ι) (g : G) : + Equiv.Perm V := + ((w g).map σ).prod + +private theorem chosenWordEvaluation_tendsto_action + {G ι : Type*} [Group G] + (V : ℕ → Type*) + [∀ n, Fintype (V n)] [∀ n, DecidableEq (V n)] + (p : ∀ n, G → Equiv.Perm (V n)) + (hone : ∀ n, p n 1 = 1) + (hmul : ∀ a g : G, + Tendsto + (fun n => normalizedHamming + (p n (a * g)) (p n a * p n g)) + atTop (nhds 0)) + (s : ι → G) (w : G → List ι) + (hw : ∀ g : G, ((w g).map s).prod = g) + (σ : ∀ n, ι → Equiv.Perm (V n)) + (hletter : ∀ i : ι, + Tendsto + (fun n => normalizedHamming + (σ n i) (p n (s i))) + atTop (nhds 0)) + (g : G) : + Tendsto + (fun n => normalizedHamming + (chosenWordEvaluation (σ n) w g) (p n g)) + atTop (nhds 0) := by + have hσ : Tendsto + (fun n => normalizedHamming + (chosenWordEvaluation (σ n) w g) + (((w g).map fun i => p n (s i)).prod)) + atTop (nhds 0) := by + exact list_permutation_hamming_tendsto V + σ (fun n i => p n (s i)) hletter (w g) + have hp : Tendsto + (fun n => normalizedHamming + (p n g) (((w g).map fun i => p n (s i)).prod)) + atTop (nhds 0) := by + have h := approximate_action_list_prod_tendsto + V p hone hmul ((w g).map s) + simpa only [hw g, List.map_map, Function.comp_def] using h + have hp' : Tendsto + (fun n => normalizedHamming + (((w g).map fun i => p n (s i)).prod) (p n g)) + atTop (nhds 0) := by + have heq : + (fun n => normalizedHamming + (((w g).map fun i => p n (s i)).prod) (p n g)) = + (fun n => normalizedHamming + (p n g) (((w g).map fun i => p n (s i)).prod)) := by + funext n + exact normalizedHamming_comm _ _ + rw [heq] + exact hp + have hupper : Tendsto + (fun n => + normalizedHamming + (chosenWordEvaluation (σ n) w g) + (((w g).map fun i => p n (s i)).prod) + + normalizedHamming + (((w g).map fun i => p n (s i)).prod) (p n g)) + atTop (nhds 0) := by + simpa only [add_zero] using hσ.add hp' + exact squeeze_zero + (fun n => normalizedHamming_nonneg _ _) + (fun n => normalizedHamming_triangle _ _ _) + hupper + +public +theorem chosenWordEvaluation_multiplicative_tendsto + {G ι : Type*} [Group G] + (V : ℕ → Type*) + [∀ n, Fintype (V n)] [∀ n, DecidableEq (V n)] + (p : ∀ n, G → Equiv.Perm (V n)) + (hone : ∀ n, p n 1 = 1) + (hmul : ∀ a g : G, + Tendsto + (fun n => normalizedHamming + (p n (a * g)) (p n a * p n g)) + atTop (nhds 0)) + (s : ι → G) (w : G → List ι) + (hw : ∀ g : G, ((w g).map s).prod = g) + (σ : ∀ n, ι → Equiv.Perm (V n)) + (hletter : ∀ i : ι, + Tendsto + (fun n => normalizedHamming + (σ n i) (p n (s i))) + atTop (nhds 0)) + (a g : G) : + Tendsto + (fun n => normalizedHamming + (chosenWordEvaluation (σ n) w (a * g)) + (chosenWordEvaluation (σ n) w a * + chosenWordEvaluation (σ n) w g)) + atTop (nhds 0) := by + let φ : ∀ n, G → Equiv.Perm (V n) := + fun n k => chosenWordEvaluation (σ n) w k + have hφ (k : G) : Tendsto + (fun n => normalizedHamming (φ n k) (p n k)) + atTop (nhds 0) := + chosenWordEvaluation_tendsto_action + V p hone hmul s w hw σ hletter k + have hpa : Tendsto + (fun n => normalizedHamming (p n a) (φ n a)) + atTop (nhds 0) := by + have heq : + (fun n => normalizedHamming (p n a) (φ n a)) = + (fun n => normalizedHamming (φ n a) (p n a)) := by + funext n + exact normalizedHamming_comm _ _ + rw [heq] + exact hφ a + have hpg : Tendsto + (fun n => normalizedHamming (p n g) (φ n g)) + atTop (nhds 0) := by + have heq : + (fun n => normalizedHamming (p n g) (φ n g)) = + (fun n => normalizedHamming (φ n g) (p n g)) := by + funext n + exact normalizedHamming_comm _ _ + rw [heq] + exact hφ g + have hupper : Tendsto + (fun n => + normalizedHamming + (φ n (a * g)) (p n (a * g)) + + (normalizedHamming + (p n (a * g)) (p n a * p n g) + + (normalizedHamming (p n a) (φ n a) + + normalizedHamming (p n g) (φ n g)))) + atTop (nhds 0) := by + simpa only [add_zero] using (hφ (a * g)).add ((hmul a g).add (hpa.add hpg)) + change Tendsto + (fun n => normalizedHamming + (φ n (a * g)) (φ n a * φ n g)) atTop (nhds 0) + refine squeeze_zero + (fun n => normalizedHamming_nonneg _ _) ?_ hupper + intro n + calc + normalizedHamming + (φ n (a * g)) (φ n a * φ n g) ≤ + normalizedHamming + (φ n (a * g)) (p n (a * g)) + + normalizedHamming + (p n (a * g)) (φ n a * φ n g) := + normalizedHamming_triangle _ _ _ + _ ≤ normalizedHamming + (φ n (a * g)) (p n (a * g)) + + (normalizedHamming + (p n (a * g)) (p n a * p n g) + + normalizedHamming + (p n a * p n g) (φ n a * φ n g)) := by + gcongr + exact normalizedHamming_triangle _ _ _ + _ ≤ normalizedHamming + (φ n (a * g)) (p n (a * g)) + + (normalizedHamming + (p n (a * g)) (p n a * p n g) + + (normalizedHamming (p n a) (φ n a) + + normalizedHamming (p n g) (φ n g))) := by + gcongr + exact KunActualSoficRootRadius.normalizedHamming_mul_le + (p n a) (φ n a) (p n g) (φ n g) + +end CompletedChosenWordLocalRoot + +namespace CompletedSourceChosenWordRestrictionTransfer + +open Filter Topology +open MatchedComponentCompletion +open MatchedComponentExitBudget +open MatchedFirstStageWordRadiusTransfer +open scoped BigOperators + +private theorem completedGenerator_permutationDistance_le_deleted + {V : Type*} [Fintype V] [DecidableEq V] + (σ : Equiv.Perm V) (Z : Finset V) + (τ : Equiv.Perm {x : V // x ∈ Z}) + (hagrees : ∀ x : {x : V // x ∈ Z}, + σ (x : V) ∈ Z → + ((τ x : {x : V // x ∈ Z}) : V) = σ (x : V)) : + permutationDistance + τ (completedRestriction σ Z) ≤ + (Finset.univ \ Z).card := by + let E : Finset V := Z.filter fun x => σ x ∉ Z + have hpoint : ∀ x : {x : V // x ∈ Z}, + (x : V) ∉ E → τ x = completedRestriction σ Z x := by + intro x hx + have hinside : σ (x : V) ∈ Z := by + by_contra hout + apply hx + exact Finset.mem_filter.mpr ⟨x.property, hout⟩ + apply Subtype.ext + calc + ((τ x : {x : V // x ∈ Z}) : V) = + σ (x : V) := hagrees x hinside + _ = ((completedRestriction σ Z x : + {x : V // x ∈ Z}) : V) := by + symm + exact completedRestriction_apply_of_mem + σ Z x x.property hinside + calc + permutationDistance + τ (completedRestriction σ Z) ≤ + (subtypeBad Z E).card := + permutationDistance_le_subtypeBad Z E + τ (completedRestriction σ Z) hpoint + _ = (Z ∩ E).card := card_subtypeBad Z E + _ ≤ E.card := Finset.card_le_card Finset.inter_subset_right + _ ≤ (Finset.univ \ Z).card := by + simpa only [E] using + card_permutation_exit_le_deleted σ Z + +private theorem completedGenerator_normalizedHamming_le_deleted + {V : Type*} [Fintype V] [DecidableEq V] + (σ : Equiv.Perm V) (Z : Finset V) + (τ : Equiv.Perm {x : V // x ∈ Z}) + (hagrees : ∀ x : {x : V // x ∈ Z}, + σ (x : V) ∈ Z → + ((τ x : {x : V // x ∈ Z}) : V) = σ (x : V)) : + normalizedHamming + τ (completedRestriction σ Z) ≤ + (((Finset.univ \ Z).card : ℝ) / Z.card) := by + have hnat := + completedGenerator_permutationDistance_le_deleted + σ Z τ hagrees + have hreal : + (permutationDistance + τ (completedRestriction σ Z) : ℝ) ≤ + (Finset.univ \ Z).card := by + exact_mod_cast hnat + have hdiv := div_le_div_of_nonneg_right hreal + (show (0 : ℝ) ≤ (Z.card : ℝ) by positivity) + simpa only [normalizedHamming, + permutationDistance, Fintype.card_coe] using hdiv + +private theorem completedGenerator_normalizedHamming_tendsto_zero + (V : ℕ → Type*) [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + (σ : (n : ℕ) → Equiv.Perm (V n)) + (Z : (n : ℕ) → Finset (V n)) + (τ : (n : ℕ) → Equiv.Perm {x : V n // x ∈ Z n}) + (hagrees : ∀ n, ∀ x : {x : V n // x ∈ Z n}, + σ n (x : V n) ∈ Z n → + ((τ n x : {x : V n // x ∈ Z n}) : V n) = + σ n (x : V n)) + (hdeleted : Tendsto + (fun n => (((Finset.univ \ Z n).card : ℝ) / (Z n).card)) + atTop (nhds 0)) : + Tendsto + (fun n => + normalizedHamming + (τ n) (completedRestriction (σ n) (Z n))) + atTop (nhds 0) := by + apply squeeze_zero' + (Filter.Eventually.of_forall fun n => + normalizedHamming_nonneg + (τ n) (completedRestriction (σ n) (Z n))) + (Filter.Eventually.of_forall fun n => + completedGenerator_normalizedHamming_le_deleted + (σ n) (Z n) (τ n) (hagrees n)) + hdeleted + +end CompletedSourceChosenWordRestrictionTransfer + +namespace CompletedSourceFinalGeneratorTransfer + +open Filter Topology +open MatchedComponentCompletion +open CompletedSourceChosenWordRestrictionTransfer + +public +theorem surviving_card_ratio_tendsto_one + (V : ℕ → Type*) [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + (D : (n : ℕ) → Finset (V n)) + (hZ : ∀ n, (Finset.univ \ D n : Finset (V n)).Nonempty) + (hdeleted : Tendsto + (fun n => ((D n).card : ℝ) / Fintype.card (V n)) + atTop (nhds 0)) : + Tendsto + (fun n => + (((Finset.univ \ D n : Finset (V n)).card : ℝ) / + Fintype.card (V n))) + atTop (nhds 1) := by + have hbase : Tendsto + (fun n => (1 : ℝ) - + ((D n).card : ℝ) / Fintype.card (V n)) + atTop (nhds 1) := by + simpa only [sub_zero] using tendsto_const_nhds.sub hdeleted + convert hbase using 1 + funext n + have hU : (Finset.univ : Finset (V n)).Nonempty := by + obtain ⟨x, _⟩ := hZ n + exact ⟨x, Finset.mem_univ x⟩ + have hcard : Fintype.card (V n) ≠ 0 := by + exact Finset.card_ne_zero.mpr hU + rw [Finset.card_sdiff_of_subset + (Finset.subset_univ (D n)), + Finset.card_univ, + Nat.cast_sub (Finset.card_le_univ (D n))] + field_simp + +public +theorem deleted_density_relative_survivors + (V : ℕ → Type*) [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + (D : (n : ℕ) → Finset (V n)) + (hZ : ∀ n, (Finset.univ \ D n : Finset (V n)).Nonempty) + (hdeleted : Tendsto + (fun n => ((D n).card : ℝ) / Fintype.card (V n)) + atTop (nhds 0)) : + Tendsto + (fun n => + ((D n).card : ℝ) / + (Finset.univ \ D n : Finset (V n)).card) + atTop (nhds 0) := by + have hcover := + surviving_card_ratio_tendsto_one V D hZ hdeleted + have hquotient : Tendsto + ((fun n => ((D n).card : ℝ) / Fintype.card (V n)) / + (fun n => + ((Finset.univ \ D n : Finset (V n)).card : ℝ) / + Fintype.card (V n))) + atTop (nhds 0) := by + simpa only [zero_div] using + hdeleted.div hcover (by norm_num : (1 : ℝ) ≠ 0) + convert hquotient using 1 + funext n + have hN : Fintype.card (V n) ≠ 0 := by + obtain ⟨x, _⟩ := hZ n + exact Finset.card_ne_zero.mpr + (show (Finset.univ : Finset (V n)).Nonempty from + ⟨x, Finset.mem_univ x⟩) + have hNreal : (Fintype.card (V n) : ℝ) ≠ 0 := by + exact_mod_cast hN + have hZreal : + ((Finset.univ \ D n : Finset (V n)).card : ℝ) ≠ 0 := by + exact_mod_cast Finset.card_ne_zero.mpr (hZ n) + change + ((D n).card : ℝ) / + (Finset.univ \ D n : Finset (V n)).card = + (((D n).card : ℝ) / Fintype.card (V n)) / + (((Finset.univ \ D n : Finset (V n)).card : ℝ) / + Fintype.card (V n)) + field_simp [hNreal, hZreal] + +public +theorem twiceCompleted_sourceGenerator_normalizedHamming_tendsto_zero + (V : ℕ → Type*) [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + {ι J : Type*} + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (p : (n : ℕ) → J → Equiv.Perm (V n)) + (s : ι → J) + (P : (n : ℕ) → Finset (V n)) + (D : (n : ℕ) → Finset {x : V n // x ∈ P n}) + (τ : (n : ℕ) → (i : ι) → + Equiv.Perm + {x : {x : V n // x ∈ P n} // + x ∈ (Finset.univ \ D n : + Finset {x : V n // x ∈ P n})}) + (hsource : ∀ n i, σ n i = p n (s i)) + (hagrees : ∀ n i, + ∀ x : {x : {x : V n // x ∈ P n} // + x ∈ (Finset.univ \ D n : + Finset {x : V n // x ∈ P n})}, + completedRestriction (σ n i) (P n) x.val ∈ + (Finset.univ \ D n : + Finset {x : V n // x ∈ P n}) → + (τ n i x).val = + completedRestriction (σ n i) (P n) x.val) + (hZ : ∀ n, + (Finset.univ \ D n : + Finset {x : V n // x ∈ P n}).Nonempty) + (hdeleted : Tendsto + (fun n => ((D n).card : ℝ) / (P n).card) + atTop (nhds 0)) : + ∀ i : ι, + Tendsto + (fun n => + normalizedHamming + (τ n i) + (completedRestriction + (completedRestriction (p n (s i)) (P n)) + (Finset.univ \ D n))) + atTop (nhds 0) := by + intro i + have hdeletedbase : Tendsto + (fun n => + ((D n).card : ℝ) / + Fintype.card {x : V n // x ∈ P n}) + atTop (nhds 0) := by + simpa only [Fintype.card_coe] using hdeleted + have hsurvivors := + deleted_density_relative_survivors + (fun n => {x : V n // x ∈ P n}) D hZ hdeletedbase + have hdeletedfinal : Tendsto + (fun n => + (((Finset.univ \ + (Finset.univ \ D n : + Finset {x : V n // x ∈ P n})).card : ℝ) / + (Finset.univ \ D n : + Finset {x : V n // x ∈ P n}).card)) + atTop (nhds 0) := by + convert hsurvivors using 1 + funext n + have hset : + (Finset.univ \ + (Finset.univ \ D n : + Finset {x : V n // x ∈ P n})) = D n := by + ext x + simp only [Finset.univ_eq_attach, sdiff_sdiff_right_self, Finset.inf_eq_inter', + Finset.mem_inter, + Finset.mem_attach, true_and] + rw [hset] + have hletter := + completedGenerator_normalizedHamming_tendsto_zero + (fun n => {x : V n // x ∈ P n}) + (fun n => completedRestriction (σ n i) (P n)) + (fun n => (Finset.univ \ D n : + Finset {x : V n // x ∈ P n})) + (fun n => τ n i) + (fun n => hagrees n i) + hdeletedfinal + convert hletter using 1 + funext n + rw [hsource n i] + +end CompletedSourceFinalGeneratorTransfer + +namespace CompletedPrescribedSpectralRadiusSchedule + +open Filter Topology +open scoped Pointwise + +private theorem mem_generator_pow_of_chosen_word_length + {G : Type*} [Group G] [DecidableEq G] + (S : Finset G) (hone : 1 ∈ S) + (w : G → List ↥S) + (hw : ∀ a : G, + ((w a).map fun i : ↥S => (i : G)).prod = a) + {a : G} {r : ℕ} (ha : (w a).length ≤ r) : + a ∈ S ^ r := by + have hprod : ∀ l : List ↥S, + ((l.map fun i : ↥S => (i : G)).prod) ∈ S ^ l.length := by + intro l + induction l with + | nil => simp only [List.length_nil, pow_zero, List.map_nil, List.prod_nil, Finset.mem_one] + | cons i l ih => + simpa only [List.length_cons, pow_succ', List.map_cons, List.map_subtype, List.map_id_fun', + id_eq, + List.prod_cons] using (Finset.mul_mem_mul i.property ih) + apply Finset.pow_subset_pow_right hone ha + simpa only [hw a] using hprod (w a) + +private def multiplicationBad + {G V : Type*} [Group G] [Fintype V] [DecidableEq V] + (φ : G → Equiv.Perm V) (a g : G) : Finset V := + Finset.univ.filter (fun x => φ (a * g) x ≠ (φ a * φ g) x) + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def fixedRadiusRootBad + {G V : Type*} [Group G] [DecidableEq G] + [Fintype V] [DecidableEq V] + (φ : G → Equiv.Perm V) (S : Finset G) (r : ℕ) : Finset V := + ((S ^ r).product (S ^ r)).biUnion fun ag => + multiplicationBad φ ag.1 ag.2 + +public +theorem fixedRadiusRootBad_rooted + {G V : Type*} [Group G] [DecidableEq G] + [Fintype V] [DecidableEq V] + (S : Finset G) (hone : 1 ∈ S) + (w : G → List ↥S) + (hw : ∀ a : G, + ((w a).map fun i : ↥S => (i : G)).prod = a) + (φ : G → Equiv.Perm V) (r : ℕ) + (a g : G) + (hr : (w a).length + (w g).length + + (w (a * g)).length ≤ r) + (x : V) (hx : x ∉ fixedRadiusRootBad φ S r) : + φ (a * g) x = (φ a * φ g) x := by + have ha : a ∈ S ^ r := + mem_generator_pow_of_chosen_word_length S hone w hw (by omega) + have hg : g ∈ S ^ r := + mem_generator_pow_of_chosen_word_length S hone w hw (by omega) + by_contra hfailure + apply hx + unfold fixedRadiusRootBad + apply Finset.mem_biUnion.mpr + refine ⟨(a, g), Finset.mem_product.mpr ⟨ha, hg⟩, ?_⟩ + unfold multiplicationBad + exact Finset.mem_filter.mpr ⟨Finset.mem_univ x, hfailure⟩ + +public +theorem fixedRadiusRootBad_density_tendsto_zero + {G : Type*} [Group G] [DecidableEq G] + (V : ℕ → Type*) + [∀ n, Fintype (V n)] [∀ n, DecidableEq (V n)] + (φ : ∀ n, G → Equiv.Perm (V n)) + (S : Finset G) + (hmul : ∀ a g : G, + Tendsto + (fun n => normalizedHamming + (φ n (a * g)) (φ n a * φ n g)) + atTop (𝓝 0)) + (r : ℕ) : + Tendsto + (fun n => + ((fixedRadiusRootBad (φ n) S r).card : ℝ) / + Fintype.card (V n)) + atTop (𝓝 0) := by + classical + have hpair : ∀ ag ∈ (S ^ r).product (S ^ r), + Tendsto + (fun n => + (((Finset.univ : Finset (V n)) ∩ + multiplicationBad (φ n) ag.1 ag.2).card : ℝ) / + (Finset.univ : Finset (V n)).card) + atTop (𝓝 0) := by + intro ag _ + simpa only [multiplicationBad, Equiv.Perm.coe_mul, Function.comp_apply, ne_eq, + Finset.univ_inter, + Finset.card_univ, normalizedHamming, hammingDist] using hmul ag.1 ag.2 + have h := finite_union_bad_density_tendsto_zero + ((S ^ r).product (S ^ r)) + (fun n => (Finset.univ : Finset (V n))) + (fun n ag => multiplicationBad (φ n) ag.1 ag.2) + hpair + simpa only [fixedRadiusRootBad, Finset.product_eq_sprod, Finset.product_biUnion, + Finset.univ_inter, + Finset.card_univ] using h + +end CompletedPrescribedSpectralRadiusSchedule + +namespace KunSourceUnconditionalFullDecomposition + +section + +open Filter Topology +open KunActualSoficRootRadius +open KunActualRootedModelBridge +open KunRootedWordPower +open KunThomInvariantOrthogonal +open scoped BigOperators symmDiff + +private theorem exists_source_sparse_cut_at_radius + {G : Type} [Group G] [DecidableEq G] + (P : KazhdanPair.{0, 0} G) + (S : Finset G) (hone : 1 ∈ S) + (hcover : P.generators ⊆ S) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) + (γ α : ℝ) (hγ : 0 < γ) (hα : 0 < α) + (hsmall : + 216 * γ < + (S.card : ℝ) * + (1 - kazhdanMarkovContractionFactor P S) ^ 2) : + ∃ r : ℕ, + ∀ (A : SoficApproximation G) (n : ℕ) + (T : Finset (Fin (A.model n).size)), + Disjoint T + (chosenCayleyRadiusBad A S + (symmetricGeneratorWord S hsymmetric hgenerates) n r) → + (boundary + (fun i : ↥S => (A.model n).action (i : G)) T : ℝ) < + γ * (T.card : ℝ) → + ∃ U : Finset (Fin (A.model n).size), + 3 * (U ∆ T).card < T.card ∧ + (boundary + (fun i : ↥S => (A.model n).action (i : G)) U : ℝ) ≤ + α * (U.card : ℝ) := by + classical + obtain ⟨k, r, hr⟩ := + exists_rooted_word_radius_sparse_cut_of_boundary + P S hone hcover hsymmetric + (symmetricGeneratorWord S hsymmetric hgenerates) + γ α hγ hα hsmall + refine ⟨r, ?_⟩ + intro A n T hgood hboundary + have hvertexInstance : + (instDecidableEqFin (A.model n).size : + DecidableEq (Fin (A.model n).size)) = + Classical.decEq (Fin (A.model n).size) := + Subsingleton.elim _ _ + let : DecidableEq (Fin (A.model n).size) := + Classical.decEq (Fin (A.model n).size) + rw [hvertexInstance] at hboundary ⊢ + have hT : T.Nonempty := by + by_contra hnot + have hempty : T = ∅ := + Finset.not_nonempty_iff_eq_empty.mp hnot + subst T + simp only [ + boundary, + Finset.univ_eq_attach, + Finset.notMem_empty, + not_false_eq_true, + Finset.filter_empty, + Finset.card_empty, + Finset.sum_const_zero, + CharP.cast_eq_zero, + mul_zero, + lt_self_iff_false + ] at hboundary + let X := + sourceRootedIndicatorMarkovModel + A S hsymmetric hgenerates n T + have hgenerated : + X.IsGenerated (fun i : ↥S => (i : G)) + (symmetricGeneratorWord S hsymmetric hgenerates) := + sourceRootedIndicatorMarkovModel_isGenerated + A S hsymmetric hgenerates n T + have hrooted : + X.IsRootedAtRadius + (symmetricGeneratorWord S hsymmetric hgenerates) r := + sourceRootedIndicatorMarkovModel_isRootedAtRadius + A S hone hsymmetric hgenerates n r T hgood + have hboundary' : + (boundary X.generator T : ℝ) < + γ * (T.card : ℝ) := by + change + (boundary + (fun i : ↥S => (A.model n).action (i : G)) T : ℝ) < + γ * (T.card : ℝ) + exact hboundary + obtain ⟨U, _hmarkov, _hreference, hclose, hcut⟩ := + hr X hgenerated hrooted T hT + (by + intro x + dsimp only [X, sourceRootedIndicatorMarkovModel, + sourceFiniteIndicator] + split + next hleft => + split + next => rfl + next hright => + exfalso + apply hright + exact Finset.mem_def.mpr (Finset.mem_def.mp hleft) + next hleft => + split + next hright => + exfalso + apply hleft + exact Finset.mem_def.mpr (Finset.mem_def.mp hright) + next => rfl) + hboundary' + exact ⟨U, hclose, hcut⟩ + +private theorem exists_source_full_finpartition_sequence_of_kazhdan + {G : Type} [Group G] + (A : SoficApproximation G) + (P : KazhdanPair.{0, 0} G) + (S : Finset G) (hone : 1 ∈ S) + (hcover : P.generators ⊆ S) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) : + ∃ (γ : ℝ) + (Q : (n : ℕ) → + Finpartition + (Finset.univ : Finset (Fin (A.model n).size))), + 0 < γ ∧ + (∀ n, ∀ C ∈ (Q n).parts, + ∀ E : Finset (Fin (A.model n).size), + E ⊆ C → + 2 * E.card ≤ C.card → + γ * (E.card : ℝ) ≤ + (boundary + (fun i : ↥S => + (A.model n).action (i : G)) E : ℝ)) ∧ + Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥S => + (A.model n).action (i : G)) C : ℝ)) / + (A.model n).size) + atTop (𝓝 0) := by + classical + let : Nonempty (↥S) := ⟨⟨1, hone⟩⟩ + let q : ℝ := kazhdanMarkovContractionFactor P S + let γ : ℝ := (S.card : ℝ) * (1 - q) ^ 2 / 288 + have hq : q < 1 := + kazhdanMarkovContractionFactor_lt_one P S ⟨1, hone⟩ + have hd : 0 < (S.card : ℝ) := by + exact_mod_cast Finset.card_pos.mpr ⟨1, hone⟩ + have hγ : 0 < γ := by + dsimp [γ] + positivity + have hsmall : + 216 * γ < + (S.card : ℝ) * + (1 - kazhdanMarkovContractionFactor P S) ^ 2 := by + have hgap : 0 < (S.card : ℝ) * (1 - q) ^ 2 := by + positivity + dsimp [γ, q] + nlinarith + let α : ℕ → ℝ := fun j => 1 / ((j : ℝ) + 1) + have hα (j : ℕ) : 0 < α j := by + dsimp [α] + positivity + have hαzero : Tendsto α atTop (𝓝 0) := by + simpa [α] using + (tendsto_one_div_add_atTop_nhds_zero_nat (𝕜 := ℝ)) + have hsparse (j : ℕ) := + exists_source_sparse_cut_at_radius + P S hone hcover hsymmetric hgenerates + γ (α j) hγ (hα j) hsmall + let radius : ℕ → ℕ := fun j => (hsparse j).choose + let w : G → List ↥S := + symmetricGeneratorWord S hsymmetric hgenerates + have hw : ∀ g : G, + ((w g).map fun i : ↥S => (i : G)).prod = g := by + intro g + exact symmetricGeneratorWord_prod S hsymmetric hgenerates g + let e : ℕ → ℕ → ℝ := fun n j => + ((chosenCayleyRadiusBad A S w n (radius j)).card : ℝ) / + (A.model n).size + have henonnegative : ∀ n j, 0 ≤ e n j := by + intro n j + dsimp [e] + positivity + have hezero (j : ℕ) : + Tendsto (fun n => e n j) atTop (𝓝 0) := by + simpa only [e] using + chosenCayleyRadiusBad_density_tendsto_zero + A S w hw (radius j) + obtain ⟨m, hm, he⟩ := + exists_diverging_radius_with_vanishing_diagonal_error + e henonnegative hezero + let B : (n : ℕ) → Finset (Fin (A.model n).size) := + fun n => chosenCayleyRadiusBad A S w n (radius (m n)) + let a : ℕ → ℝ := fun n => α (m n) + let σ : (n : ℕ) → ↥S → Equiv.Perm (Fin (A.model n).size) := + fun n i => (A.model n).action (i : G) + let (n : ℕ) : Nonempty (Fin (A.model n).size) := + ⟨⟨0, (A.model n).size_pos⟩⟩ + have hazero : Tendsto a atTop (𝓝 0) := by + exact hαzero.comp hm + have hbad : + Tendsto + (fun n => + ((B n).card : ℝ) / + Fintype.card (Fin (A.model n).size)) + atTop (𝓝 0) := by + simpa only [B, e, Fintype.card_fin] using he + have himprove : + ∀ n (T : Finset (Fin (A.model n).size)), + T ⊆ Finset.univ \ B n → + (boundary (σ n) T : ℝ) < + γ * (T.card : ℝ) → + ∃ U : Finset (Fin (A.model n).size), + 3 * (U ∆ T).card < T.card ∧ + (boundary (σ n) U : ℝ) ≤ + a n * (U.card : ℝ) := by + intro n T hT hboundary + have hdisjoint : Disjoint T (B n) := by + apply Finset.disjoint_left.mpr + intro x hx hbadx + exact (Finset.mem_sdiff.mp (hT hx)).2 hbadx + have hgood : + Disjoint T + (chosenCayleyRadiusBad A S + (symmetricGeneratorWord S hsymmetric hgenerates) + n ((hsparse (m n)).choose)) := by + simpa only [B, w, radius] using hdisjoint + have hboundary' : + (boundary + (fun i : ↥S => (A.model n).action (i : G)) T : ℝ) < + γ * (T.card : ℝ) := by + simpa only [σ] using hboundary + obtain ⟨U, hclose, hcut⟩ := + (hsparse (m n)).choose_spec A n T hgood hboundary' + refine ⟨U, hclose, ?_⟩ + simpa only [σ, a] using hcut + obtain ⟨Q, hγ', hQ, hbudget⟩ := + KunResidualExpanderDecomposition.exists_expanding_full_finpartition_sequence + (↥S) (fun n => Fin (A.model n).size) + σ B γ hγ a + (fun n => (hα (m n)).le) + hazero hbad himprove + refine ⟨γ, Q, hγ', ?_, ?_⟩ + · simpa only [σ] using hQ + · simpa only [σ, Fintype.card_fin] using hbudget + +end + +section + +open Filter Topology + +public +theorem exists_source_subgroup_and_ambient_full_finpartition_sequences + {G Γ : Type} [Group G] [Group Γ] + (A : SoficApproximation G) + (f : Γ →* G) (hf : Function.Injective f) + (PΓ : KazhdanPair.{0, 0} Γ) + (PG : KazhdanPair.{0, 0} G) + (SΓ : Finset Γ) (SG : Finset G) + (honeΓ : 1 ∈ SΓ) (honeG : 1 ∈ SG) + (hcoverΓ : PΓ.generators ⊆ SΓ) + (hcoverG : PG.generators ⊆ SG) + (hsymmetricΓ : ∀ g ∈ SΓ, g⁻¹ ∈ SΓ) + (hsymmetricG : ∀ g ∈ SG, g⁻¹ ∈ SG) + (hgeneratesΓ : Subgroup.closure (SΓ : Set Γ) = ⊤) + (hgeneratesG : Subgroup.closure (SG : Set G) = ⊤) : + ∃ (γΓ γG : ℝ) + (QΓ QG : (n : ℕ) → + Finpartition + (Finset.univ : Finset (Fin (A.model n).size))), + 0 < γΓ ∧ + 0 < γG ∧ + (∀ n, ∀ C ∈ (QΓ n).parts, + ∀ E : Finset (Fin (A.model n).size), + E ⊆ C → + 2 * E.card ≤ C.card → + γΓ * (E.card : ℝ) ≤ + (boundary + (fun i : ↥SΓ => + (A.model n).action (f (i : Γ))) E : ℝ)) ∧ + (∀ n, ∀ C ∈ (QG n).parts, + ∀ E : Finset (Fin (A.model n).size), + E ⊆ C → + 2 * E.card ≤ C.card → + γG * (E.card : ℝ) ≤ + (boundary + (fun i : ↥SG => + (A.model n).action (i : G)) E : ℝ)) ∧ + Tendsto + (fun n => + (∑ C ∈ (QΓ n).parts, + (boundary + (fun i : ↥SΓ => + (A.model n).action (f (i : Γ))) C : ℝ)) / + (A.model n).size) + atTop (𝓝 0) ∧ + Tendsto + (fun n => + (∑ C ∈ (QG n).parts, + (boundary + (fun i : ↥SG => + (A.model n).action (i : G)) C : ℝ)) / + (A.model n).size) + atTop (𝓝 0) := by + classical + obtain ⟨γΓ, QΓ, hγΓ, hexpΓ, hbudgetΓ⟩ := + exists_source_full_finpartition_sequence_of_kazhdan + (pullbackSoficApproximation f hf A) + PΓ SΓ honeΓ hcoverΓ hsymmetricΓ hgeneratesΓ + obtain ⟨γG, QG, hγG, hexpG, hbudgetG⟩ := + exists_source_full_finpartition_sequence_of_kazhdan + A PG SG honeG hcoverG hsymmetricG hgeneratesG + refine ⟨γΓ, γG, QΓ, QG, hγΓ, hγG, ?_, hexpG, ?_, + hbudgetG⟩ + · exact hexpΓ + · exact hbudgetΓ + +end + +end KunSourceUnconditionalFullDecomposition + +namespace KunActualCompressedSourceGroupFoundations + +universe v + +public +theorem alphaZeroPrefixElementaryGroup_infinite : + Infinite + (prefixElementaryGroup alphaZeroPrefixCode) := by + let : Infinite (binaryLeavittElementaryGroup 3) := + binaryLeavittEL3_infinite + exact Infinite.of_injective + (binaryPrefixElementaryGroupEquiv + alphaZeroPrefixCode) + (binaryPrefixElementaryGroupEquiv + alphaZeroPrefixCode).injective + +end KunActualCompressedSourceGroupFoundations + +namespace KunExactKazhdanGeneratorChange + +universe u v + +private theorem unitary_word_displacement_le + {G : Type u} {H : Type v} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) + (ξ : H) (l : List G) (δ : ℝ) + (hletters : ∀ g ∈ l, ‖π g ξ - ξ‖ ≤ δ) : + ‖π l.prod ξ - ξ‖ ≤ (l.length : ℝ) * δ := by + induction l with + | nil => + simp only [List.prod_nil, map_one, LinearIsometryEquiv.coe_one, id_eq, sub_self, norm_zero, + List.length_nil, + CharP.cast_eq_zero, zero_mul, Std.le_refl] + | cons g l ih => + have hg : ‖π g ξ - ξ‖ ≤ δ := + hletters g (by simp only [List.mem_cons, true_or]) + have htail : + ∀ a ∈ l, ‖π a ξ - ξ‖ ≤ δ := by + intro a ha + exact hletters a (by simp only [List.mem_cons, ha, or_true]) + have hword := ih htail + calc + ‖π (g :: l).prod ξ - ξ‖ = + ‖π g (π l.prod ξ - ξ) + (π g ξ - ξ)‖ := by + congr 1 + simp only [List.prod_cons, map_mul, LinearIsometryEquiv.coe_mul, Function.comp_apply, + map_sub, + sub_add_sub_cancel] + _ ≤ ‖π g (π l.prod ξ - ξ)‖ + + ‖π g ξ - ξ‖ := norm_add_le _ _ + _ = ‖π l.prod ξ - ξ‖ + ‖π g ξ - ξ‖ := by + rw [LinearIsometryEquiv.norm_map] + _ ≤ (l.length : ℝ) * δ + δ := by linarith + _ = ((g :: l).length : ℝ) * δ := by + simp only [List.length_cons, Nat.cast_add, Nat.cast_one] + ring + +private theorem exists_word_of_symmetric_generating_finset + {G : Type u} [Group G] (S : Finset G) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) (g : G) : + ∃ l : List ↥S, ((l.map fun i : ↥S => (i : G)).prod) = g := by + classical + have hg : g ∈ Subgroup.closure (S : Set G) := by + rw [hgenerates] + simp only [Subgroup.mem_top] + induction hg using Subgroup.closure_induction with + | mem x hx => + exact ⟨[⟨x, hx⟩], by simp only [List.map_cons, List.map_nil, List.prod_cons, List.prod_nil, + mul_one]⟩ + | one => + exact ⟨[], by simp only [List.map_nil, List.prod_nil]⟩ + | mul x y _ _ ihx ihy => + obtain ⟨lx, hlx⟩ := ihx + obtain ⟨ly, hly⟩ := ihy + refine ⟨lx ++ ly, ?_⟩ + rw [List.map_append, List.prod_append, hlx, hly] + | inv x _ ih => + obtain ⟨l, hl⟩ := ih + let invLetter : ↥S → ↥S := + fun i => ⟨(i : G)⁻¹, hsymmetric (i : G) i.property⟩ + refine ⟨(l.map invLetter).reverse, ?_⟩ + rw [List.map_reverse, List.map_map] + change ((l.map fun i : ↥S => (i : G)⁻¹).reverse).prod = x⁻¹ + have hmap : + (l.map fun i : ↥S => (i : G)⁻¹) = + (l.map fun i : ↥S => (i : G)).map + (fun z : G => z⁻¹) := by + rw [List.map_map] + rfl + rw [hmap, ← List.prod_inv_reverse, hl] + +private def symmetricGeneratingWord + {G : Type u} [Group G] (S : Finset G) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) (g : G) : + List ↥S := + (exists_word_of_symmetric_generating_finset + S hsymmetric hgenerates g).choose + +private theorem symmetricGeneratingWord_prod + {G : Type u} [Group G] (S : Finset G) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) (g : G) : + (((symmetricGeneratingWord S hsymmetric hgenerates g).map + fun i : ↥S => (i : G)).prod) = g := + (exists_word_of_symmetric_generating_finset + S hsymmetric hgenerates g).choose_spec + +private def kazhdanPairOnSymmetricGeneratingFinset + {G : Type u} [Group G] + (P : KazhdanPair.{u, v} G) + (S : Finset G) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) : + KazhdanPair.{u, v} G := by + classical + let w : G → List ↥S := + symmetricGeneratingWord S hsymmetric hgenerates + let L : ℕ := 1 + ∑ g ∈ P.generators, (w g).length + have hL : 0 < L := by + dsimp [L] + omega + have hLreal : 0 < (L : ℝ) := by + exact_mod_cast hL + refine + { generators := S + kazhdanConstant := P.kazhdanConstant / (L : ℝ) + positive := div_pos P.positive hLreal + invariant := ?_ } + intro H _ _ _ π ξ hξ hS + apply P.invariant H π ξ hξ + intro g hg + have hlength : + (w g).length < L := by + have hsingle : + (w g).length ≤ + ∑ a ∈ P.generators, (w a).length := + Finset.single_le_sum + (fun a _ => Nat.zero_le (w a).length) hg + dsimp [L] + omega + have hlengthreal : + ((w g).length : ℝ) < (L : ℝ) := by + exact_mod_cast hlength + have hδ : 0 < P.kazhdanConstant / (L : ℝ) := + div_pos P.positive hLreal + have hword : + ‖π (((w g).map fun i : ↥S => (i : G)).prod) ξ - ξ‖ ≤ + ((w g).length : ℝ) * + (P.kazhdanConstant / (L : ℝ)) := by + have hbound := + unitary_word_displacement_le π ξ + ((w g).map fun i : ↥S => (i : G)) + (P.kazhdanConstant / (L : ℝ)) + (by + intro a ha + obtain ⟨i, _hi, rfl⟩ := List.mem_map.mp ha + exact (hS (i : G) i.property).le) + simpa only [List.length_map] using hbound + calc + ‖π g ξ - ξ‖ = + ‖π (((w g).map fun i : ↥S => (i : G)).prod) ξ - ξ‖ := by + rw [show + (((w g).map fun i : ↥S => (i : G)).prod) = g from + symmetricGeneratingWord_prod + S hsymmetric hgenerates g] + _ ≤ ((w g).length : ℝ) * + (P.kazhdanConstant / (L : ℝ)) := hword + _ < (L : ℝ) * (P.kazhdanConstant / (L : ℝ)) := + mul_lt_mul_of_pos_right hlengthreal hδ + _ = P.kazhdanConstant := by + field_simp [Nat.cast_ne_zero.mpr hL.ne'] + +private theorem kazhdanPairOnSymmetricGeneratingFinset_generators + {G : Type u} [Group G] + (P : KazhdanPair.{u, v} G) + (S : Finset G) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) : + (kazhdanPairOnSymmetricGeneratingFinset + P S hsymmetric hgenerates).generators = S := by + rfl + +public +theorem exists_kazhdanPair_with_exact_symmetric_generators + {G : Type u} [Group G] + [HasPropertyT.{u, v} G] + (S : Finset G) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) : + ∃ P : KazhdanPair.{u, v} G, + P.generators = S := by + obtain ⟨P⟩ := + HasPropertyT.exists_kazhdanPair (G := G) + exact ⟨kazhdanPairOnSymmetricGeneratingFinset + P S hsymmetric hgenerates, + kazhdanPairOnSymmetricGeneratingFinset_generators + P S hsymmetric hgenerates⟩ + +end KunExactKazhdanGeneratorChange + +namespace KunExactActualSourceAmbientGenerators + +section + +open KunExactKazhdanGeneratorChange + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def sourceAlphaInclusion : + prefixElementaryGroup alphaPrefixCode →* + prefixElementaryGroup ninePrefixCode where + toFun g := + ⟨g.val, + SourceGeneration.alphaPrefixElementaryGroup_le_nine + g.property⟩ + map_one' := rfl + map_mul' _ _ := rfl + +private theorem sourceAlphaInclusion_injective : + Function.Injective sourceAlphaInclusion := by + intro x y hxy + apply Subtype.ext + exact congrArg + (fun z : + prefixElementaryGroup ninePrefixCode => + z.val) hxy + +private def sourceCompressionU : + prefixElementaryGroup ninePrefixCode := + ⟨compressionU, + compressionU_mem_ninePrefixElementaryGroup⟩ + +private def sourceCompressionV : + prefixElementaryGroup ninePrefixCode := + ⟨compressionV, + compressionV_mem_ninePrefixElementaryGroup⟩ + +private noncomputable def sourcePositiveGenerators + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) : + Finset + (prefixElementaryGroup ninePrefixCode) := by + classical + exact SΓ.image sourceAlphaInclusion ∪ + {sourceCompressionU, sourceCompressionV} + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def sourceAmbientSymmetricGenerators + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) : + Finset + (prefixElementaryGroup ninePrefixCode) := by + classical + exact insert 1 + (sourcePositiveGenerators SΓ ∪ + (sourcePositiveGenerators SΓ).image fun g => g⁻¹) + +private theorem one_mem_sourceAmbientSymmetricGenerators + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) : + 1 ∈ sourceAmbientSymmetricGenerators SΓ := by + classical + simp only [sourceAmbientSymmetricGenerators, Finset.mem_insert, Finset.mem_union, + Finset.mem_image, + inv_eq_one, exists_eq_right, or_self, true_or] + +private theorem sourceAmbientSymmetricGenerators_inv_mem + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (g : prefixElementaryGroup ninePrefixCode) + (hg : g ∈ sourceAmbientSymmetricGenerators SΓ) : + g⁻¹ ∈ sourceAmbientSymmetricGenerators SΓ := by + classical + have hcases : + g = 1 ∨ + g ∈ sourcePositiveGenerators SΓ ∨ + ∃ y ∈ sourcePositiveGenerators SΓ, y⁻¹ = g := by + simpa only [Subtype.exists, sourceAmbientSymmetricGenerators, Finset.mem_insert, + Finset.mem_union, + Finset.mem_image] using hg + rcases hcases with rfl | hgpos | ⟨y, hy, rfl⟩ + · simp only [sourceAmbientSymmetricGenerators, inv_one, Finset.mem_insert, Finset.mem_union, + Finset.mem_image, + inv_eq_one, exists_eq_right, or_self, true_or] + · have hinv : + g⁻¹ ∈ (sourcePositiveGenerators SΓ).image + (fun x => x⁻¹) := + Finset.mem_image.mpr ⟨g, hgpos, rfl⟩ + simp only [sourceAmbientSymmetricGenerators, Finset.mem_insert, inv_eq_one, Finset.mem_union, + hinv, or_true] + · simp only [sourceAmbientSymmetricGenerators, inv_inv, Finset.mem_insert, Finset.mem_union, hy, + Finset.mem_image, Subtype.exists, true_or, or_true] + +private theorem sourceAmbientSymmetricGenerators_generate + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hgeneratesΓ : + Subgroup.closure + (SΓ : Set + (prefixElementaryGroup + alphaPrefixCode)) = ⊤) : + Subgroup.closure + (sourceAmbientSymmetricGenerators SΓ : Set + (prefixElementaryGroup + ninePrefixCode)) = ⊤ := by + classical + let K : Subgroup + (prefixElementaryGroup ninePrefixCode) := + Subgroup.closure + (sourceAmbientSymmetricGenerators SΓ : Set + (prefixElementaryGroup + ninePrefixCode)) + have hpositive : + ∀ x ∈ sourcePositiveGenerators SΓ, x ∈ K := by + intro x hx + apply Subgroup.subset_closure + change x ∈ sourceAmbientSymmetricGenerators SΓ + simp only [sourceAmbientSymmetricGenerators, Finset.mem_insert, Finset.mem_union, hx, + Finset.mem_image, + Subtype.exists, true_or, or_true] + have hcorner : + ∀ g : + prefixElementaryGroup alphaPrefixCode, + sourceAlphaInclusion g ∈ K := by + intro g + have hsub : + Subgroup.closure + (SΓ : Set + (prefixElementaryGroup + alphaPrefixCode)) ≤ + K.comap sourceAlphaInclusion := by + rw [Subgroup.closure_le] + intro x hx + change sourceAlphaInclusion x ∈ K + apply hpositive + change sourceAlphaInclusion x ∈ + SΓ.image sourceAlphaInclusion ∪ + {sourceCompressionU, sourceCompressionV} + exact Finset.mem_union_left _ + (Finset.mem_image.mpr ⟨x, hx, rfl⟩) + apply hsub + rw [hgeneratesΓ] + simp only [Subgroup.mem_top] + let U : Subgroup BinaryLeavittˣ := + K.map + (prefixElementaryGroup + ninePrefixCode).subtype + have hsource : + SourceGeneration.sourceGeneratedGroup ≤ U := by + rw [SourceGeneration.sourceGeneratedGroup, + Subgroup.closure_le] + intro x hx + rcases hx with hα | htables + · let a : + prefixElementaryGroup + alphaPrefixCode := ⟨x, hα⟩ + exact ⟨sourceAlphaInclusion a, hcorner a, rfl⟩ + · simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at htables + rcases htables with rfl | rfl + · exact ⟨sourceCompressionU, + hpositive sourceCompressionU + (by simp only [sourcePositiveGenerators, Finset.union_insert, Finset.union_singleton, + Finset.mem_insert, + Finset.mem_image, Subtype.exists, true_or]), rfl⟩ + · exact ⟨sourceCompressionV, + hpositive sourceCompressionV + (by simp only [sourcePositiveGenerators, Finset.union_insert, Finset.union_singleton, + Finset.mem_insert, + Finset.mem_image, Subtype.exists, true_or, or_true]), rfl⟩ + have htop : + (⊤ : Subgroup + (prefixElementaryGroup + ninePrefixCode)) ≤ K := by + intro x _hx + have hxin : + (x.val : BinaryLeavittˣ) ∈ + SourceGeneration.sourceGeneratedGroup := by + rw [sourceGeneratedGroup_eq_nine] + exact x.property + obtain ⟨y, hy, hval⟩ := hsource hxin + have heq : y = x := by + apply Subtype.ext + exact hval + simpa only [← heq, SetLike.mem_coe] using hy + exact top_unique htop + +private theorem exists_kazhdanPair_on_exact_sourceAmbientSymmetricGenerators + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hgeneratesΓ : + Subgroup.closure + (SΓ : Set + (prefixElementaryGroup + alphaPrefixCode)) = ⊤) + [HasPropertyT.{0, 0} + (prefixElementaryGroup + ninePrefixCode)] : + ∃ P : KazhdanPair.{0, 0} + (prefixElementaryGroup + ninePrefixCode), + P.generators = sourceAmbientSymmetricGenerators SΓ := by + exact exists_kazhdanPair_with_exact_symmetric_generators + (sourceAmbientSymmetricGenerators SΓ) + (sourceAmbientSymmetricGenerators_inv_mem SΓ) + (sourceAmbientSymmetricGenerators_generate SΓ hgeneratesΓ) + +end + +section + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def sourceCompressionTable : + Fin 2 → + prefixElementaryGroup ninePrefixCode := + ![sourceCompressionU, sourceCompressionV] + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def sourcePositiveGeneratorMap + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) : + (↥SΓ ⊕ Fin 2) → + prefixElementaryGroup ninePrefixCode := + Sum.elim (fun i : ↥SΓ => sourceAlphaInclusion (i : + prefixElementaryGroup alphaPrefixCode)) + sourceCompressionTable + +private theorem range_sourcePositiveGeneratorMap + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) : + Set.range (sourcePositiveGeneratorMap SΓ) = + (sourcePositiveGenerators SΓ : Set + (prefixElementaryGroup + ninePrefixCode)) := by + classical + ext x + constructor + · rintro ⟨i, rfl⟩ + rcases i with i | i + · change + sourceAlphaInclusion + (i : + prefixElementaryGroup + alphaPrefixCode) ∈ + sourcePositiveGenerators SΓ + change + sourceAlphaInclusion + (i : + prefixElementaryGroup + alphaPrefixCode) ∈ + SΓ.image sourceAlphaInclusion ∪ + {sourceCompressionU, sourceCompressionV} + apply Finset.mem_union_left + exact Finset.mem_image.mpr + ⟨(i : + prefixElementaryGroup + alphaPrefixCode), i.property, rfl⟩ + · fin_cases i + · change sourceCompressionU ∈ + sourcePositiveGenerators SΓ + change sourceCompressionU ∈ + SΓ.image sourceAlphaInclusion ∪ + {sourceCompressionU, sourceCompressionV} + exact Finset.mem_union_right _ (by simp only [Finset.mem_insert, Finset.mem_singleton, + true_or]) + · change sourceCompressionV ∈ + sourcePositiveGenerators SΓ + change sourceCompressionV ∈ + SΓ.image sourceAlphaInclusion ∪ + {sourceCompressionU, sourceCompressionV} + exact Finset.mem_union_right _ (by simp only [Finset.mem_insert, Finset.mem_singleton, + or_true]) + · intro hx + change + x ∈ SΓ.image sourceAlphaInclusion ∪ + {sourceCompressionU, sourceCompressionV} at hx + rcases Finset.mem_union.mp hx with hcorner | htables + · obtain ⟨g, hg, heq⟩ := Finset.mem_image.mp hcorner + refine ⟨Sum.inl ⟨g, hg⟩, ?_⟩ + exact heq + · simp only [Finset.mem_insert, Finset.mem_singleton] at htables + rcases htables with rfl | rfl + · refine ⟨Sum.inr (0 : Fin 2), ?_⟩ + rfl + · refine ⟨Sum.inr (1 : Fin 2), ?_⟩ + rfl + +private theorem sourcePositiveGenerators_generate + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hgeneratesΓ : + Subgroup.closure + (SΓ : Set + (prefixElementaryGroup + alphaPrefixCode)) = ⊤) : + Subgroup.closure + (sourcePositiveGenerators SΓ : Set + (prefixElementaryGroup + ninePrefixCode)) = ⊤ := by + classical + let K : Subgroup + (prefixElementaryGroup ninePrefixCode) := + Subgroup.closure + (sourcePositiveGenerators SΓ : Set + (prefixElementaryGroup + ninePrefixCode)) + have hcontain : + (sourceAmbientSymmetricGenerators SΓ : Set + (prefixElementaryGroup + ninePrefixCode)) ⊆ + (K : Set + (prefixElementaryGroup + ninePrefixCode)) := by + intro x hx + have hcases : + x = 1 ∨ + x ∈ sourcePositiveGenerators SΓ ∨ + x⁻¹ ∈ sourcePositiveGenerators SΓ := by + simpa only [sourceAmbientSymmetricGenerators, Finset.coe_insert, Finset.coe_union, + Finset.coe_image, + Set.image_inv_eq_inv, Set.mem_insert_iff, Set.mem_union, SetLike.mem_coe, Set.mem_inv] using + hx + rcases hcases with rfl | hxpositive | hxinverse + · exact K.one_mem + · exact Subgroup.subset_closure hxpositive + · simpa only [SetLike.mem_coe, inv_inv] using K.inv_mem (Subgroup.subset_closure hxinverse) + have hle : + Subgroup.closure + (sourceAmbientSymmetricGenerators SΓ : Set + (prefixElementaryGroup + ninePrefixCode)) ≤ K := by + rw [Subgroup.closure_le] + exact hcontain + have htop : + (⊤ : Subgroup + (prefixElementaryGroup + ninePrefixCode)) ≤ K := by + rw [← sourceAmbientSymmetricGenerators_generate SΓ hgeneratesΓ] + exact hle + exact top_unique htop + +private theorem sourcePositiveGeneratorMap_range_generate + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hgeneratesΓ : + Subgroup.closure + (SΓ : Set + (prefixElementaryGroup + alphaPrefixCode)) = ⊤) : + Subgroup.closure + (Set.range (sourcePositiveGeneratorMap SΓ)) = ⊤ := by + rw [range_sourcePositiveGeneratorMap] + exact sourcePositiveGenerators_generate SΓ hgeneratesΓ + +end + +end KunExactActualSourceAmbientGenerators + +namespace KunUnconditionalActualSourceGeneratorData + +open KunExactKazhdanGeneratorChange +open KunExactActualSourceAmbientGenerators + +private theorem exists_symmetric_generating_finset_of_finitelyGenerated + {G : Type*} [Group G] + (hfg : Group.FG G) : + ∃ S : Finset G, + 1 ∈ S ∧ + (∀ g ∈ S, g⁻¹ ∈ S) ∧ + Subgroup.closure (S : Set G) = ⊤ := by + classical + obtain ⟨_, T, _, hT⟩ := (Group.fg_iff').1 hfg + let S : Finset G := insert 1 (T ∪ T.image fun g => g⁻¹) + refine ⟨S, by simp only [Finset.mem_insert, Finset.mem_union, Finset.mem_image, inv_eq_one, + exists_eq_right, or_self, + true_or, S], ?_, ?_⟩ + · intro g hg + have hcases : + g = 1 ∨ g ∈ T ∨ + ∃ y ∈ T, y⁻¹ = g := by + simpa [S, Finset.mem_image] using hg + rcases hcases with rfl | hgT | ⟨y, hy, rfl⟩ + · simp only [inv_one, Finset.mem_insert, Finset.mem_union, Finset.mem_image, inv_eq_one, + exists_eq_right, + or_self, true_or, S] + · have hmem : + g⁻¹ ∈ T.image fun z => z⁻¹ := + Finset.mem_image.mpr ⟨g, hgT, rfl⟩ + simp only [Finset.mem_insert, inv_eq_one, Finset.mem_union, hmem, or_true, S] + · simp only [inv_inv, Finset.mem_insert, Finset.mem_union, hy, Finset.mem_image, true_or, + or_true, S] + · have hsubset : (T : Set G) ⊆ (S : Set G) := by + intro g hg + change g ∈ T at hg + change g ∈ S + simp only [Finset.mem_insert, Finset.mem_union, hg, Finset.mem_image, true_or, or_true, S] + apply top_unique + rw [← hT] + exact Subgroup.closure_mono hsubset + +private theorem exists_actual_source_alpha_symmetric_generators : + ∃ SΓ : Finset + (prefixElementaryGroup + alphaPrefixCode), + 1 ∈ SΓ ∧ + (∀ g ∈ SΓ, g⁻¹ ∈ SΓ) ∧ + Subgroup.closure + (SΓ : Set + (prefixElementaryGroup + alphaPrefixCode)) = ⊤ := + exists_symmetric_generating_finset_of_finitelyGenerated + alphaPrefixElementaryGroup_finitelyGenerated + +public +theorem exists_unconditional_actual_source_generator_data : + ∃ (SΓ : Finset + (prefixElementaryGroup + alphaPrefixCode)) + (PΓ : KazhdanPair.{0, 0} + (prefixElementaryGroup + alphaPrefixCode)) + (PG : KazhdanPair.{0, 0} + (prefixElementaryGroup + ninePrefixCode)), + 1 ∈ SΓ ∧ + (∀ g ∈ SΓ, g⁻¹ ∈ SΓ) ∧ + Subgroup.closure + (SΓ : Set + (prefixElementaryGroup + alphaPrefixCode)) = ⊤ ∧ + PΓ.generators = SΓ ∧ + 1 ∈ sourceAmbientSymmetricGenerators SΓ ∧ + (∀ g ∈ sourceAmbientSymmetricGenerators SΓ, + g⁻¹ ∈ sourceAmbientSymmetricGenerators SΓ) ∧ + Subgroup.closure + (sourceAmbientSymmetricGenerators SΓ : Set + (prefixElementaryGroup + ninePrefixCode)) = ⊤ ∧ + PG.generators = sourceAmbientSymmetricGenerators SΓ ∧ + Function.Injective sourceAlphaInclusion ∧ + Subgroup.closure + (Set.range (sourcePositiveGeneratorMap SΓ)) = ⊤ := by + let : HasPropertyT.{0, 0} + (prefixElementaryGroup + alphaPrefixCode) := + alphaPrefixElementaryGroup_hasPropertyT_unconditional + let : HasPropertyT.{0, 0} + (prefixElementaryGroup + ninePrefixCode) := + ninePrefixElementaryGroup_hasPropertyT_unconditional + obtain ⟨SΓ, honeΓ, hsymmetricΓ, hgeneratesΓ⟩ := + exists_actual_source_alpha_symmetric_generators + obtain ⟨PΓ, hPΓ⟩ := + exists_kazhdanPair_with_exact_symmetric_generators + SΓ hsymmetricΓ hgeneratesΓ + obtain ⟨PG, hPG⟩ := + exists_kazhdanPair_on_exact_sourceAmbientSymmetricGenerators + SΓ hgeneratesΓ + refine ⟨SΓ, PΓ, PG, honeΓ, hsymmetricΓ, hgeneratesΓ, + hPΓ, one_mem_sourceAmbientSymmetricGenerators SΓ, + sourceAmbientSymmetricGenerators_inv_mem SΓ, + sourceAmbientSymmetricGenerators_generate SΓ hgeneratesΓ, + hPG, sourceAlphaInclusion_injective, ?_⟩ + exact sourcePositiveGeneratorMap_range_generate SΓ hgeneratesΓ + +end KunUnconditionalActualSourceGeneratorData + +namespace SourceCommonComponentComparisonBad + +open Filter Topology +open scoped BigOperators + +private noncomputable def comparisonBad + {V : Type*} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) + (p : Equiv.Perm V) (eta : ℝ) : Finset V := by + classical + exact Finset.univ.filter fun x => + ¬ (1 - eta) * (partitionComponentSize Q x : ℝ) ≤ + (partitionComponentSize Q (p x) : ℝ) + +private noncomputable def familyComparisonBad + {V ι : Type*} [Fintype V] [DecidableEq V] [Fintype ι] + (Q : Finpartition (Finset.univ : Finset V)) + (p : ι → Equiv.Perm V) (eta : ℝ) : Finset (ι × V) := by + classical + exact Finset.univ.filter fun e => + ¬ (1 - eta) * (partitionComponentSize Q e.2 : ℝ) ≤ + (partitionComponentSize Q (p e.1 e.2) : ℝ) + +private theorem familyComparisonBad_card + {V ι : Type*} [Fintype V] [DecidableEq V] [Fintype ι] + (Q : Finpartition (Finset.univ : Finset V)) + (p : ι → Equiv.Perm V) (eta : ℝ) : + (familyComparisonBad Q p eta).card = + ∑ i : ι, (comparisonBad Q (p i) eta).card := by + classical + unfold familyComparisonBad + rw [Finset.card_filter, ← Finset.univ_product_univ, + Finset.sum_product] + apply Finset.sum_congr rfl + intro i _ + unfold comparisonBad + rw [Finset.card_filter] + +private theorem comparisonBad_subset_partitionWordCrossing + {V : Type*} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) + (p : Equiv.Perm V) (eta : ℝ) (heta : 0 ≤ eta) : + comparisonBad Q p eta ⊆ partitionWordCrossing Q p := by + classical + intro x hx + unfold comparisonBad at hx + have hbad := (Finset.mem_filter.mp hx).2 + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ x, ?_⟩ + intro hsame + apply hbad + have hpart : Q.part (p x) = Q.part x := + Q.part_eq_of_mem (Q.part_mem.mpr (Finset.mem_univ x)) hsame + have hsize : partitionComponentSize Q (p x) = + partitionComponentSize Q x := by + unfold partitionComponentSize + rw [hpart] + rw [hsize] + have hnonneg : (0 : ℝ) ≤ + (partitionComponentSize Q x : ℝ) := by + positivity + nlinarith + +private noncomputable def overlapRetainedComponents + {V : Type*} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) (eta : ℝ) : Finset (Finset V) := + (transportedUnivFinpartition Q T).parts \ + insufficientOverlapComponents + (transportedUnivFinpartition Q T) Q eta + +private theorem comparisonBad_subset_matchedWordPreimageBad + {V : Type*} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) (eta : ℝ) : + comparisonBad Q T eta ⊆ + matchedWordPreimageBad + (Finset.univ : Finset V) + (overlapRetainedComponents Q T eta) + (maximumOverlapPart Q) T := by + classical + intro x hx + have hbad : ¬ (1 - eta) * + (partitionComponentSize Q x : ℝ) ≤ + (partitionComponentSize Q (T x) : ℝ) := by + unfold comparisonBad at hx + exact (Finset.mem_filter.mp hx).2 + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ x, Finset.mem_sdiff.mpr + ⟨Finset.mem_univ (T x), ?_⟩⟩ + intro hcore + obtain ⟨C, hC, hy⟩ := Finset.mem_biUnion.mp hcore + have hparts : C ∈ + (transportedUnivFinpartition Q T).parts := + (Finset.mem_sdiff.mp hC).1 + have hret : C ∉ insufficientOverlapComponents + (transportedUnivFinpartition Q T) Q eta := + (Finset.mem_sdiff.mp hC).2 + have hyC : T x ∈ C := (Finset.mem_inter.mp hy).1 + have hyD : T x ∈ maximumOverlapPart Q C := + (Finset.mem_inter.mp hy).2 + have hxpart : Q.part x ∈ Q.parts := + Q.part_mem.mpr (Finset.mem_univ x) + have hmap : (Q.part x).map T.toEmbedding ∈ + (transportedUnivFinpartition Q T).parts := by + rw [transportedUnivFinpartition_parts] + exact Finset.mem_image_of_mem + (fun D : Finset V => D.map T.toEmbedding) hxpart + have hyMap : T x ∈ (Q.part x).map T.toEmbedding := + Finset.mem_map.mpr + ⟨x, Q.mem_part (Finset.mem_univ x), rfl⟩ + have heq : (Q.part x).map T.toEmbedding = C := by + have hfirst := + (transportedUnivFinpartition Q T).part_eq_of_mem + hmap hyMap + have hsecond := + (transportedUnivFinpartition Q T).part_eq_of_mem + hparts hyC + exact hfirst.symm.trans hsecond + apply hbad + apply partitionComponentSize_transport_lower_of_retained + Q T (Q.part x) hxpart eta + · simpa only [heq] using hret + · exact Q.mem_part (Finset.mem_univ x) + · simpa only [heq] using hyD + +private theorem matchedCore_missing_card_le_overlap_and_loss + {V : Type*} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) (eta : ℝ) : + ((Finset.univ : Finset V) \ + matchedCore + (overlapRetainedComponents Q T eta) + (maximumOverlapPart Q)).card ≤ + (∑ C ∈ insufficientOverlapComponents + (transportedUnivFinpartition Q T) Q eta, + C.card) + + ∑ C ∈ (transportedUnivFinpartition Q T).parts, + (C \ + maximumOverlapPart Q C).card := by + classical + let P := transportedUnivFinpartition Q T + let O := insufficientOverlapComponents P Q eta + let R := P.parts \ + insufficientOverlapComponents P Q eta + have hR : R ⊆ P.parts := Finset.sdiff_subset + have hO : O ⊆ P.parts := + insufficientOverlapComponents_subset P Q eta + have hparts : P.parts \ R = O := by + ext C + constructor + · intro h + obtain ⟨hCP, hnot⟩ := Finset.mem_sdiff.mp h + by_contra hCO + exact hnot (Finset.mem_sdiff.mpr ⟨hCP, hCO⟩) + · intro h + exact Finset.mem_sdiff.mpr + ⟨hO h, fun hR' => (Finset.mem_sdiff.mp hR').2 h⟩ + have hmissing : + ((Finset.univ : Finset V) \ + matchedRetainedSupport R).card = + ∑ C ∈ O, C.card := by + have hsplit := Finset.sum_sdiff hR (f := fun C : Finset V => C.card) + rw [hparts] at hsplit + have hfull := P.sum_card_parts + have hret := matchedRetainedSupport_card P R hR + have hcard := Finset.card_sdiff_add_card_eq_card + (matchedRetainedSupport_subset P R hR) + omega + change + ((Finset.univ : Finset V) \ + matchedCore R + (maximumOverlapPart Q)).card ≤ + (∑ C ∈ O, C.card) + + ∑ C ∈ P.parts, + (C \ maximumOverlapPart Q C).card + rw [matchedCore_missing_card P R hR + (maximumOverlapPart Q), hmissing] + apply Nat.add_le_add_left + exact Finset.sum_le_sum_of_subset_of_nonneg hR + (fun _ _ _ => Nat.zero_le _) + +private theorem comparisonBad_card_le_overlap_and_loss + {V : Type*} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) (eta : ℝ) : + (comparisonBad Q T eta).card ≤ + (∑ C ∈ insufficientOverlapComponents + (transportedUnivFinpartition Q T) Q eta, + C.card) + + ∑ C ∈ (transportedUnivFinpartition Q T).parts, + (C \ + maximumOverlapPart Q C).card := by + calc + (comparisonBad Q T eta).card ≤ + (matchedWordPreimageBad + (Finset.univ : Finset V) + (overlapRetainedComponents Q T eta) + (maximumOverlapPart Q) T).card := + Finset.card_le_card + (comparisonBad_subset_matchedWordPreimageBad Q T eta) + _ ≤ ((Finset.univ : Finset V) \ + matchedCore + (overlapRetainedComponents Q T eta) + (maximumOverlapPart Q)).card := + matchedWordPreimageBad_card_le + (Finset.univ : Finset V) + (overlapRetainedComponents Q T eta) + (maximumOverlapPart Q) T + _ ≤ _ := matchedCore_missing_card_le_overlap_and_loss Q T eta + +private theorem cast_card_sdiff_eq_sub_card_inter + {V : Type*} [DecidableEq V] (C D : Finset V) : + ((C \ D).card : ℝ) = + (C.card : ℝ) - ((C ∩ D).card : ℝ) := by + have hnat := Finset.card_sdiff_add_card_inter C D + have hreal : ((C \ D).card : ℝ) + + ((C ∩ D).card : ℝ) = (C.card : ℝ) := by + exact_mod_cast hnat + linarith + +private theorem subgroup_comparisonBad_density_tendsto_zero + (V : ℕ → Type*) [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + (Q : (n : ℕ) → Finpartition (Finset.univ : Finset (V n))) + (p : (n : ℕ) → Equiv.Perm (V n)) + (eta : ℕ → ℝ) (heta : ∀ n, 0 ≤ eta n) + (hcross : Tendsto + (fun n => + ((partitionWordCrossing (Q n) (p n)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0)) : + Tendsto + (fun n => + ((comparisonBad (Q n) (p n) (eta n)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0) := by + refine squeeze_zero (fun n => by positivity) ?_ hcross + intro n + have hnat := Finset.card_le_card + (comparisonBad_subset_partitionWordCrossing + (Q n) (p n) (eta n) (heta n)) + have hreal : + ((comparisonBad (Q n) (p n) (eta n)).card : ℝ) ≤ + ((partitionWordCrossing + (Q n) (p n)).card : ℝ) := by + exact_mod_cast hnat + exact div_le_div_of_nonneg_right hreal (by positivity) + +private theorem transported_comparisonBad_density_tendsto_zero + (V : ℕ → Type*) [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + (Q : (n : ℕ) → Finpartition (Finset.univ : Finset (V n))) + (T : (n : ℕ) → Equiv.Perm (V n)) + (eta : ℕ → ℝ) + (hoverlap : Tendsto + (fun n => + (∑ C ∈ insufficientOverlapComponents + (transportedUnivFinpartition (Q n) (T n)) + (Q n) (eta n), (C.card : ℝ)) / + Fintype.card (V n)) + atTop (nhds 0)) + (hloss : Tendsto + (fun n => + (∑ C ∈ + (transportedUnivFinpartition (Q n) (T n)).parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart (Q n) C).card : ℝ))) / + Fintype.card (V n)) + atTop (nhds 0)) : + Tendsto + (fun n => + ((comparisonBad (Q n) (T n) (eta n)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0) := by + have hlimit : Tendsto + (fun n => + (∑ C ∈ insufficientOverlapComponents + (transportedUnivFinpartition (Q n) (T n)) + (Q n) (eta n), (C.card : ℝ)) / + Fintype.card (V n) + + (∑ C ∈ + (transportedUnivFinpartition (Q n) (T n)).parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart (Q n) C).card : ℝ))) / + Fintype.card (V n)) + atTop (nhds 0) := by + simpa only [zero_add] using hoverlap.add hloss + refine squeeze_zero (fun n => by positivity) ?_ hlimit + intro n + have hnat := comparisonBad_card_le_overlap_and_loss + (Q n) (T n) (eta n) + have hreal : + ((comparisonBad (Q n) (T n) (eta n)).card : ℝ) ≤ + (∑ C ∈ insufficientOverlapComponents + (transportedUnivFinpartition (Q n) (T n)) + (Q n) (eta n), (C.card : ℝ)) + + ∑ C ∈ + (transportedUnivFinpartition (Q n) (T n)).parts, + ((C \ maximumOverlapPart (Q n) C).card : ℝ) := by + exact_mod_cast hnat + simp_rw [cast_card_sdiff_eq_sub_card_inter] at hreal + calc + ((comparisonBad (Q n) (T n) (eta n)).card : ℝ) / + Fintype.card (V n) ≤ + ((∑ C ∈ insufficientOverlapComponents + (transportedUnivFinpartition (Q n) (T n)) + (Q n) (eta n), (C.card : ℝ)) + + ∑ C ∈ + (transportedUnivFinpartition (Q n) (T n)).parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart (Q n) C).card : ℝ))) / + Fintype.card (V n) := + div_le_div_of_nonneg_right hreal (by positivity) + _ = _ := by ring + +private theorem combined_positive_comparisonBad_density_tendsto_zero + (V : ℕ → Type*) [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + (ι κ : Type*) [Fintype ι] [Fintype κ] + (Q : (n : ℕ) → Finpartition (Finset.univ : Finset (V n))) + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (T : (n : ℕ) → κ → Equiv.Perm (V n)) + (eta : ℕ → ℝ) (heta : ∀ n, 0 ≤ eta n) + (hcross : ∀ i : ι, Tendsto + (fun n => + ((partitionWordCrossing + (Q n) (σ n i)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0)) + (hoverlap : ∀ j : κ, Tendsto + (fun n => + (∑ C ∈ insufficientOverlapComponents + (transportedUnivFinpartition + (Q n) (T n j)) (Q n) (eta n), (C.card : ℝ)) / + Fintype.card (V n)) + atTop (nhds 0)) + (hloss : ∀ j : κ, Tendsto + (fun n => + (∑ C ∈ + (transportedUnivFinpartition + (Q n) (T n j)).parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart (Q n) C).card : ℝ))) / + Fintype.card (V n)) + atTop (nhds 0)) : + Tendsto + (fun n => + ((familyComparisonBad (Q n) + (Sum.elim (σ n) (T n)) (eta n)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0) := by + classical + have hsingle (i : ι ⊕ κ) : Tendsto + (fun n => + ((comparisonBad (Q n) + (Sum.elim (σ n) (T n) i) (eta n)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0) := by + cases i with + | inl i => + exact subgroup_comparisonBad_density_tendsto_zero + V Q (fun n => σ n i) eta heta (hcross i) + | inr j => + exact transported_comparisonBad_density_tendsto_zero + V Q (fun n => T n j) eta (hoverlap j) (hloss j) + have hsum : Tendsto + (fun n => ∑ i : ι ⊕ κ, + ((comparisonBad (Q n) + (Sum.elim (σ n) (T n) i) (eta n)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0) := by + simpa only [Fintype.sum_sum_type, Sum.elim_inl, Sum.elim_inr, Finset.sum_const_zero] using + tendsto_finsetSum Finset.univ (fun i _ => hsingle i) + have hrewrite (n : ℕ) : + ((familyComparisonBad (Q n) + (Sum.elim (σ n) (T n)) (eta n)).card : ℝ) / + Fintype.card (V n) = + ∑ i : ι ⊕ κ, + ((comparisonBad (Q n) + (Sum.elim (σ n) (T n) i) (eta n)).card : ℝ) / + Fintype.card (V n) := by + rw [familyComparisonBad_card] + push_cast + rw [Finset.sum_div] + simpa only [hrewrite] using hsum + +end SourceCommonComponentComparisonBad + +namespace SourceCommonOffsetMidrankEnergy + +open Filter Topology +open scoped BigOperators + +private noncomputable def realComponentSize + {V : Type*} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) (x : V) : ℝ := + (partitionComponentSize Q x : ℝ) + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def componentLogRank + {V : Type*} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) + (H r : ℝ) : V → ℤ := + MidrankPermutationEnergy.offsetFloorRank + (fun x => Real.log (realComponentSize Q x)) H r + +private noncomputable def componentSizeComparisonBad + {V ι : Type*} [Fintype V] [DecidableEq V] [Fintype ι] + (Q : Finpartition (Finset.univ : Finset V)) + (p : ι → Equiv.Perm V) (eta : ℝ) : Finset (ι × V) := by + classical + exact Finset.univ.filter fun e => + ¬ (1 - eta) * realComponentSize Q e.2 ≤ + realComponentSize Q (p e.1 e.2) + +private theorem componentSizeComparison_of_not_mem + {V ι : Type*} [Fintype V] [DecidableEq V] [Fintype ι] + (Q : Finpartition (Finset.univ : Finset V)) + (p : ι → Equiv.Perm V) (eta : ℝ) + (i : ι) (x : V) + (hx : (i, x) ∉ componentSizeComparisonBad Q p eta) : + (1 - eta) * realComponentSize Q x ≤ + realComponentSize Q (p i x) := by + classical + by_contra h + apply hx + unfold componentSizeComparisonBad + exact Finset.mem_filter.mpr ⟨Finset.mem_univ _, h⟩ + +private theorem exists_common_component_log_rank_with_vanishing_drops + (V : ℕ → Type*) + [∀ n, Fintype (V n)] [∀ n, Nonempty (V n)] + [∀ n, DecidableEq (V n)] + (ι : Type*) [Fintype ι] + (Q : (n : ℕ) → Finpartition (Finset.univ : Finset (V n))) + (p : (n : ℕ) → ι → Equiv.Perm (V n)) + (eta H : ℕ → ℝ) + (heta0 : ∀ n, 0 ≤ eta n) + (heta1 : ∀ n, eta n < 1) + (hH : ∀ n, 0 < H n) + (heta : Tendsto eta atTop (nhds 0)) + (hratio : Tendsto (fun n => eta n / H n) atTop (nhds 0)) + (hbad : Tendsto + (fun n => + ((componentSizeComparisonBad (Q n) (p n) (eta n)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0)) : + ∃ r : ℕ → ℝ, + (∀ n, r n ∈ Set.Ico 0 (H n)) ∧ + Tendsto + (fun n => + (∑ i : ι, + ((MidrankPermutationEnergy.rankDecreasingVertices + Finset.univ + (componentLogRank (Q n) (H n) (r n)) + (p n i)).card : ℝ)) / + Fintype.card (V n)) + atTop (nhds 0) := by + classical + let B : (n : ℕ) → Finset (ι × V n) := + fun n => componentSizeComparisonBad (Q n) (p n) (eta n) + let E : (n : ℕ) → Finset (ι × V n) := + fun n => Finset.univ \ B n + have hN (n : ℕ) : (0 : ℝ) < Fintype.card (V n) := by + exact_mod_cast Fintype.card_pos_iff.mpr inferInstance + have hpositive (n : ℕ) (e : ι × V n) (_he : e ∈ E n) : + 0 < realComponentSize (Q n) e.2 := by + have hpart : (Q n).part e.2 ∈ (Q n).parts := + (Q n).part_mem.mpr (Finset.mem_univ e.2) + have hnonempty := (Q n).nonempty_of_mem_parts hpart + unfold realComponentSize partitionComponentSize + exact_mod_cast Finset.card_pos.mpr hnonempty + have hcard (n : ℕ) : + ((E n).card : ℝ) ≤ + (Fintype.card ι : ℝ) * (Fintype.card (V n) : ℝ) := by + have hnat : (E n).card ≤ Fintype.card ι * Fintype.card (V n) := by + simpa only [Fintype.card_prod] using + (Finset.card_le_univ (E n)) + exact_mod_cast hnat + have hcomparison (n : ℕ) (e : ι × V n) (he : e ∈ E n) : + (1 - eta n) * realComponentSize (Q n) e.2 ≤ + realComponentSize (Q n) (p n e.1 e.2) := by + apply componentSizeComparison_of_not_mem (Q n) (p n) (eta n) + e.1 e.2 + exact (Finset.mem_sdiff.mp he).2 + have hexceptions : Tendsto + (fun n => + (((Finset.univ : Finset (ι × V n)) \ E n).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0) := by + simpa [E, B] using hbad + obtain ⟨r, hr, hdrop⟩ := + ExceptionalRankOffset.exists_common_log_rank_offsets_tendsto_zero_except + (fun n => ι × V n) E + (fun n e => realComponentSize (Q n) e.2) + (fun n e => realComponentSize (Q n) (p n e.1 e.2)) + eta H (fun n => (Fintype.card (V n) : ℝ)) + (Fintype.card ι : ℝ) + hpositive heta0 heta1 hH hN hcard hcomparison + heta hratio hexceptions + have hrewrite (n : ℕ) : + rankDropCount + (fun e : ι × V n => Real.log (realComponentSize (Q n) e.2)) + (fun e : ι × V n => + Real.log (realComponentSize (Q n) (p n e.1 e.2))) + (H n) (r n) = + ∑ i : ι, + ((MidrankPermutationEnergy.rankDecreasingVertices + Finset.univ (componentLogRank (Q n) (H n) (r n)) + (p n i)).card : ℝ) := by + simpa only [componentLogRank] using + (MidrankPermutationEnergy.rankDropCount_eq_sum_rankDecreasingVertices + (fun x : V n => Real.log (realComponentSize (Q n) x)) + (p n) (H n) (r n)) + refine ⟨r, hr, ?_⟩ + simpa only [hrewrite] using hdrop + +private theorem exists_common_component_log_rank_with_vanishing_midrank_energy + (V : ℕ → Type*) + [∀ n, Fintype (V n)] [∀ n, Nonempty (V n)] + [∀ n, DecidableEq (V n)] + (ι : Type*) [Fintype ι] + (Q A : (n : ℕ) → Finpartition (Finset.univ : Finset (V n))) + (p : (n : ℕ) → ι → Equiv.Perm (V n)) + (eta H : ℕ → ℝ) + (heta0 : ∀ n, 0 ≤ eta n) + (heta1 : ∀ n, eta n < 1) + (hH : ∀ n, 0 < H n) + (heta : Tendsto eta atTop (nhds 0)) + (hratio : Tendsto (fun n => eta n / H n) atTop (nhds 0)) + (hbad : Tendsto + (fun n => + ((componentSizeComparisonBad (Q n) (p n) (eta n)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0)) + (hcross : Tendsto + (fun n => + (∑ i : ι, + ((partitionWordCrossing (A n) (p n i)).card : ℝ)) / + Fintype.card (V n)) + atTop (nhds 0)) : + ∃ r : ℕ → ℝ, + (∀ n, r n ∈ Set.Ico 0 (H n)) ∧ + Tendsto + (fun n => + (∑ i : ι, + ((MidrankPermutationEnergy.rankDecreasingVertices + Finset.univ + (componentLogRank (Q n) (H n) (r n)) + (p n i)).card : ℝ)) / + Fintype.card (V n)) + atTop (nhds 0) ∧ + Tendsto + (fun n => + (∑ i : ι, ∑ x : V n, + (MidrankPermutationEnergy.partitionVertexMidrank + (A n) (componentLogRank (Q n) (H n) (r n)) (p n i x) - + MidrankPermutationEnergy.partitionVertexMidrank + (A n) (componentLogRank (Q n) (H n) (r n)) x) ^ 2) / + Fintype.card (V n)) + atTop (nhds 0) := by + obtain ⟨r, hr, hdrop⟩ := + exists_common_component_log_rank_with_vanishing_drops + V ι Q p eta H heta0 heta1 hH heta hratio hbad + refine ⟨r, hr, hdrop, ?_⟩ + apply MidrankPermutationEnergy.partitionVertexMidrank_permutation_energy_tendsto_zero + V (fun _ => ι) A + (fun n => componentLogRank (Q n) (H n) (r n)) p + (fun n => (Fintype.card (V n) : ℝ)) + · intro n + exact_mod_cast Fintype.card_pos_iff.mpr inferInstance + · exact hcross + · exact hdrop + +end SourceCommonOffsetMidrankEnergy + +namespace SourceCommonComponentRankNoBad + +open Filter Topology +open scoped BigOperators + +public +theorem exists_common_positive_component_log_rank_with_vanishing_midrank_energy + (V : ℕ → Type*) + [∀ n, Fintype (V n)] [∀ n, Nonempty (V n)] + [∀ n, DecidableEq (V n)] + (ι κ : Type*) [Fintype ι] [Fintype κ] + (Q A : (n : ℕ) → Finpartition (Finset.univ : Finset (V n))) + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (T : (n : ℕ) → κ → Equiv.Perm (V n)) + (eta H : ℕ → ℝ) + (heta0 : ∀ n, 0 ≤ eta n) + (heta1 : ∀ n, eta n < 1) + (hH : ∀ n, 0 < H n) + (heta : Tendsto eta atTop (nhds 0)) + (hratio : Tendsto (fun n => eta n / H n) atTop (nhds 0)) + (hcrossQ : ∀ i : ι, Tendsto + (fun n => + ((partitionWordCrossing + (Q n) (σ n i)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0)) + (hoverlap : ∀ j : κ, Tendsto + (fun n => + (∑ C ∈ insufficientOverlapComponents + (transportedUnivFinpartition + (Q n) (T n j)) (Q n) (eta n), (C.card : ℝ)) / + Fintype.card (V n)) + atTop (nhds 0)) + (hloss : ∀ j : κ, Tendsto + (fun n => + (∑ C ∈ + (transportedUnivFinpartition + (Q n) (T n j)).parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart (Q n) C).card : ℝ))) / + Fintype.card (V n)) + atTop (nhds 0)) + (hcrossA : Tendsto + (fun n => + (∑ i : ι ⊕ κ, + ((partitionWordCrossing + (A n) (Sum.elim (σ n) (T n) i)).card : ℝ)) / + Fintype.card (V n)) + atTop (nhds 0)) : + ∃ r : ℕ → ℝ, + (∀ n, r n ∈ Set.Ico 0 (H n)) ∧ + Tendsto + (fun n => + (∑ i : ι ⊕ κ, + ((MidrankPermutationEnergy.rankDecreasingVertices + Finset.univ + (SourceCommonOffsetMidrankEnergy.componentLogRank + (Q n) (H n) (r n)) + (Sum.elim (σ n) (T n) i)).card : ℝ)) / + Fintype.card (V n)) + atTop (nhds 0) ∧ + Tendsto + (fun n => + (∑ i : ι ⊕ κ, ∑ x : V n, + (MidrankPermutationEnergy.partitionVertexMidrank + (A n) + (SourceCommonOffsetMidrankEnergy.componentLogRank + (Q n) (H n) (r n)) + (Sum.elim (σ n) (T n) i x) - + MidrankPermutationEnergy.partitionVertexMidrank + (A n) + (SourceCommonOffsetMidrankEnergy.componentLogRank + (Q n) (H n) (r n)) x) ^ 2) / + Fintype.card (V n)) + atTop (nhds 0) := by + have hsource := + SourceCommonComponentComparisonBad.combined_positive_comparisonBad_density_tendsto_zero + V ι κ Q σ T eta heta0 hcrossQ hoverlap hloss + have hsets (n : ℕ) : + SourceCommonOffsetMidrankEnergy.componentSizeComparisonBad + (Q n) (Sum.elim (σ n) (T n)) (eta n) = + SourceCommonComponentComparisonBad.familyComparisonBad + (Q n) (Sum.elim (σ n) (T n)) (eta n) := by + classical + ext e + constructor + · intro he + unfold + SourceCommonOffsetMidrankEnergy.componentSizeComparisonBad + at he + have hfail := (Finset.mem_filter.mp he).2 + unfold SourceCommonComponentComparisonBad.familyComparisonBad + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + simpa only + [SourceCommonOffsetMidrankEnergy.realComponentSize] + using hfail + · intro he + unfold + SourceCommonComponentComparisonBad.familyComparisonBad + at he + have hfail := (Finset.mem_filter.mp he).2 + unfold + SourceCommonOffsetMidrankEnergy.componentSizeComparisonBad + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + simpa only + [SourceCommonOffsetMidrankEnergy.realComponentSize] + using hfail + have hbad : Tendsto + (fun n => + ((SourceCommonOffsetMidrankEnergy.componentSizeComparisonBad + (Q n) (Sum.elim (σ n) (T n)) (eta n)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0) := by + simpa only [hsets] using hsource + exact + SourceCommonOffsetMidrankEnergy.exists_common_component_log_rank_with_vanishing_midrank_energy + V (ι ⊕ κ) Q A (fun n => Sum.elim (σ n) (T n)) + eta H heta0 heta1 hH heta hratio hbad hcrossA + +end SourceCommonComponentRankNoBad + +namespace KunPositiveWordMidrankEnergy + +open Filter Topology +open scoped BigOperators + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def squaredPermutationEnergy + {V : Type*} [Fintype V] (f : V → ℝ) (p : Equiv.Perm V) : ℝ := + ∑ x : V, (f (p x) - f x) ^ 2 + +private theorem squaredPermutationEnergy_nonneg + {V : Type*} [Fintype V] (f : V → ℝ) (p : Equiv.Perm V) : + 0 ≤ squaredPermutationEnergy f p := by + exact Finset.sum_nonneg fun _ _ => sq_nonneg _ + +private theorem squaredPermutationEnergy_inv + {V : Type*} [Fintype V] (f : V → ℝ) (p : Equiv.Perm V) : + squaredPermutationEnergy f p⁻¹ = squaredPermutationEnergy f p := by + unfold squaredPermutationEnergy + calc + (∑ x : V, (f (p⁻¹ x) - f x) ^ 2) = + ∑ x : V, (f x - f (p x)) ^ 2 := by + simpa only [Equiv.Perm.coe_inv, Equiv.symm_apply_apply] using + (Equiv.sum_comp p (fun x : V => (f (p⁻¹ x) - f x) ^ 2)).symm + _ = ∑ x : V, (f (p x) - f x) ^ 2 := by + apply Finset.sum_congr rfl + intro x _ + ring + +private theorem squaredPermutationEnergy_mul_le + {V : Type*} [Fintype V] + (f : V → ℝ) (p q : Equiv.Perm V) : + squaredPermutationEnergy f (p * q) ≤ + 2 * squaredPermutationEnergy f p + + 2 * squaredPermutationEnergy f q := by + unfold squaredPermutationEnergy + calc + (∑ x : V, (f ((p * q) x) - f x) ^ 2) ≤ + ∑ x : V, + (2 * (f (p (q x)) - f (q x)) ^ 2 + + 2 * (f (q x) - f x) ^ 2) := by + apply Finset.sum_le_sum + intro x _ + simp only [Equiv.Perm.mul_apply] + nlinarith [sq_nonneg + ((f (p (q x)) - f (q x)) - (f (q x) - f x))] + _ = 2 * (∑ x : V, (f (p x) - f x) ^ 2) + + 2 * (∑ x : V, (f (q x) - f x) ^ 2) := by + rw [Finset.sum_add_distrib, ← Finset.mul_sum, ← Finset.mul_sum, + Equiv.sum_comp q (fun x : V => (f (p x) - f x) ^ 2)] + +private theorem squaredPermutationEnergy_le_add_hammingDist + {V : Type*} [Fintype V] [DecidableEq V] + (f : V → ℝ) (hf0 : ∀ x, 0 ≤ f x) (hf1 : ∀ x, f x ≤ 1) + (p q : Equiv.Perm V) : + squaredPermutationEnergy f p ≤ + squaredPermutationEnergy f q + + (hammingDist (fun x => p x) (fun x => q x) : ℝ) := by + classical + have hpoint (x : V) : + (f (p x) - f x) ^ 2 ≤ + (f (q x) - f x) ^ 2 + + if p x = q x then 0 else 1 := by + split_ifs with hx + · simp only [hx, add_zero, le_refl] + · have hp0 := hf0 (p x) + have hp1 := hf1 (p x) + have hx0 := hf0 x + have hx1 := hf1 x + nlinarith [sq_nonneg (f (q x) - f x), + mul_nonneg + (show 0 ≤ 1 - (f (p x) - f x) by linarith) + (show 0 ≤ 1 + (f (p x) - f x) by linarith)] + have hindicator : + (∑ x : V, if p x = q x then (0 : ℝ) else 1) = + (hammingDist (fun x => p x) (fun x => q x) : ℝ) := by + have hswitch (x : V) : + (if p x = q x then (0 : ℝ) else 1) = + if p x ≠ q x then 1 else 0 := by + split_ifs <;> simp_all + simp_rw [hswitch] + simpa only [ne_eq, ite_not, hammingDist] using + (Finset.sum_boole (fun x : V => p x ≠ q x) (Finset.univ : Finset V)) + unfold squaredPermutationEnergy + calc + (∑ x : V, (f (p x) - f x) ^ 2) ≤ + ∑ x : V, + ((f (q x) - f x) ^ 2 + + if p x = q x then 0 else 1) := + Finset.sum_le_sum fun x _ => hpoint x + _ = (∑ x : V, (f (q x) - f x) ^ 2) + + (hammingDist (fun x => p x) (fun x => q x) : ℝ) := by + rw [Finset.sum_add_distrib, hindicator] + +private theorem squaredPermutationEnergy_tendsto_of_normalizedHamming + (V : ℕ → Type*) + [∀ n, Fintype (V n)] [∀ n, DecidableEq (V n)] + (f : (n : ℕ) → V n → ℝ) + (hf0 : ∀ n x, 0 ≤ f n x) + (hf1 : ∀ n x, f n x ≤ 1) + (p q : (n : ℕ) → Equiv.Perm (V n)) + (hq : Tendsto + (fun n => squaredPermutationEnergy (f n) (q n) / + Fintype.card (V n)) atTop (𝓝 0)) + (hd : Tendsto + (fun n => normalizedHamming (p n) (q n)) + atTop (𝓝 0)) : + Tendsto + (fun n => squaredPermutationEnergy (f n) (p n) / + Fintype.card (V n)) atTop (𝓝 0) := by + have hupper : Tendsto + (fun n => squaredPermutationEnergy (f n) (q n) / + Fintype.card (V n) + + normalizedHamming (p n) (q n)) + atTop (𝓝 0) := by + simpa only [add_zero] using hq.add hd + refine squeeze_zero (fun n => + div_nonneg (squaredPermutationEnergy_nonneg (f n) (p n)) + (Nat.cast_nonneg _)) ?_ hupper + intro n + have he := squaredPermutationEnergy_le_add_hammingDist + (f n) (hf0 n) (hf1 n) (p n) (q n) + calc + squaredPermutationEnergy (f n) (p n) / + Fintype.card (V n) ≤ + (squaredPermutationEnergy (f n) (q n) + + (hammingDist (fun x => p n x) (fun x => q n x) : ℝ)) / + Fintype.card (V n) := + div_le_div_of_nonneg_right he (Nat.cast_nonneg _) + _ = squaredPermutationEnergy (f n) (q n) / + Fintype.card (V n) + + normalizedHamming (p n) (q n) := by + rw [add_div] + rfl + +private theorem squaredPermutationEnergy_mul_tendsto_zero + (V : ℕ → Type*) [∀ n, Fintype (V n)] + (f : (n : ℕ) → V n → ℝ) + (p q : (n : ℕ) → Equiv.Perm (V n)) + (hp : Tendsto + (fun n => squaredPermutationEnergy (f n) (p n) / + Fintype.card (V n)) atTop (𝓝 0)) + (hq : Tendsto + (fun n => squaredPermutationEnergy (f n) (q n) / + Fintype.card (V n)) atTop (𝓝 0)) : + Tendsto + (fun n => squaredPermutationEnergy (f n) (p n * q n) / + Fintype.card (V n)) atTop (𝓝 0) := by + have hupper : Tendsto + (fun n => + 2 * (squaredPermutationEnergy (f n) (p n) / + Fintype.card (V n)) + + 2 * (squaredPermutationEnergy (f n) (q n) / + Fintype.card (V n))) atTop (𝓝 0) := by + simpa only [mul_zero, add_zero] using + (Filter.Tendsto.const_mul (2 : ℝ) hp).add (Filter.Tendsto.const_mul (2 : ℝ) hq) + refine squeeze_zero (fun n => + div_nonneg (squaredPermutationEnergy_nonneg (f n) (p n * q n)) + (Nat.cast_nonneg _)) ?_ hupper + intro n + calc + squaredPermutationEnergy (f n) (p n * q n) / + Fintype.card (V n) ≤ + (2 * squaredPermutationEnergy (f n) (p n) + + 2 * squaredPermutationEnergy (f n) (q n)) / + Fintype.card (V n) := + div_le_div_of_nonneg_right + (squaredPermutationEnergy_mul_le (f n) (p n) (q n)) + (Nat.cast_nonneg _) + _ = 2 * (squaredPermutationEnergy (f n) (p n) / + Fintype.card (V n)) + + 2 * (squaredPermutationEnergy (f n) (q n) / + Fintype.card (V n)) := by ring + +private theorem sofic_action_inverse_normalizedHamming_tendsto_zero + {G : Type*} [Group G] + (A : SoficApproximation G) (g : G) : + Tendsto + (fun n => + normalizedHamming + (((A.model n).action g)⁻¹) + ((A.model n).action (g⁻¹))) + atTop (𝓝 0) := by + have heq : + (fun n => + normalizedHamming + (((A.model n).action g)⁻¹) + ((A.model n).action (g⁻¹))) = + (fun n => + normalizedHamming + ((A.model n).action (g * g⁻¹)) + ((A.model n).action g * + (A.model n).action (g⁻¹))) := by + funext n + calc + normalizedHamming + (((A.model n).action g)⁻¹) + ((A.model n).action (g⁻¹)) = + normalizedHamming + ((A.model n).action g * + ((A.model n).action g)⁻¹) + ((A.model n).action g * + (A.model n).action (g⁻¹)) := + (normalizedHamming_mul_left + ((A.model n).action g) + (((A.model n).action g)⁻¹) + ((A.model n).action (g⁻¹))).symm + _ = normalizedHamming + ((A.model n).action (g * g⁻¹)) + ((A.model n).action g * + (A.model n).action (g⁻¹)) := by + simp only [mul_inv_cancel, (A.model n).map_one] + rw [heq] + exact A.multiplicative g (g⁻¹) + +private theorem sofic_action_squared_energy_mul + {G : Type*} [Group G] + (A : SoficApproximation G) + (f : (n : ℕ) → Fin (A.model n).size → ℝ) + (hf0 : ∀ n x, 0 ≤ f n x) + (hf1 : ∀ n x, f n x ≤ 1) + (g h : G) + (hg : Tendsto + (fun n => + squaredPermutationEnergy (f n) ((A.model n).action g) / + (A.model n).size) atTop (𝓝 0)) + (hh : Tendsto + (fun n => + squaredPermutationEnergy (f n) ((A.model n).action h) / + (A.model n).size) atTop (𝓝 0)) : + Tendsto + (fun n => + squaredPermutationEnergy (f n) ((A.model n).action (g * h)) / + (A.model n).size) atTop (𝓝 0) := by + have hproduct : Tendsto + (fun n => + squaredPermutationEnergy (f n) + ((A.model n).action g * (A.model n).action h) / + (A.model n).size) atTop (𝓝 0) := by + simpa only [Fintype.card_fin] using + (squaredPermutationEnergy_mul_tendsto_zero + (fun n => Fin (A.model n).size) f + (fun n => (A.model n).action g) + (fun n => (A.model n).action h) + (by simpa only [Fintype.card_fin] using hg) + (by simpa only [Fintype.card_fin] using hh)) + simpa only [Fintype.card_fin] using + (squaredPermutationEnergy_tendsto_of_normalizedHamming + (fun n => Fin (A.model n).size) f hf0 hf1 + (fun n => (A.model n).action (g * h)) + (fun n => (A.model n).action g * (A.model n).action h) + (by simpa only [Fintype.card_fin] using hproduct) + (A.multiplicative g h)) + +private theorem sofic_action_squared_energy_inv + {G : Type*} [Group G] + (A : SoficApproximation G) + (f : (n : ℕ) → Fin (A.model n).size → ℝ) + (hf0 : ∀ n x, 0 ≤ f n x) + (hf1 : ∀ n x, f n x ≤ 1) + (g : G) + (hg : Tendsto + (fun n => + squaredPermutationEnergy (f n) ((A.model n).action g) / + (A.model n).size) atTop (𝓝 0)) : + Tendsto + (fun n => + squaredPermutationEnergy (f n) ((A.model n).action (g⁻¹)) / + (A.model n).size) atTop (𝓝 0) := by + have htrue : Tendsto + (fun n => + squaredPermutationEnergy (f n) (((A.model n).action g)⁻¹) / + (A.model n).size) atTop (𝓝 0) := by + simpa only [squaredPermutationEnergy_inv] using hg + have hd : Tendsto + (fun n => + normalizedHamming + ((A.model n).action (g⁻¹)) + (((A.model n).action g)⁻¹)) atTop (𝓝 0) := by + have heq : + (fun n => + normalizedHamming + ((A.model n).action (g⁻¹)) + (((A.model n).action g)⁻¹)) = + (fun n => + normalizedHamming + (((A.model n).action g)⁻¹) + ((A.model n).action (g⁻¹))) := by + funext n + exact normalizedHamming_comm _ _ + rw [heq] + exact sofic_action_inverse_normalizedHamming_tendsto_zero A g + simpa only [Fintype.card_fin] using + (squaredPermutationEnergy_tendsto_of_normalizedHamming + (fun n => Fin (A.model n).size) f hf0 hf1 + (fun n => (A.model n).action (g⁻¹)) + (fun n => ((A.model n).action g)⁻¹) + (by simpa only [Fintype.card_fin] using htrue) hd) + +private theorem action_energy_tendsto_zero_of_positive_generator_sum + {G ι : Type*} [Group G] [Fintype ι] + (A : SoficApproximation G) + (s : ι → G) + (hgenerate : Subgroup.closure (Set.range s) = ⊤) + (f : (n : ℕ) → Fin (A.model n).size → ℝ) + (hf0 : ∀ n x, 0 ≤ f n x) + (hf1 : ∀ n x, f n x ≤ 1) + (hpositive : Tendsto + (fun n => + (∑ i : ι, + squaredPermutationEnergy (f n) + ((A.model n).action (s i))) / + (A.model n).size) atTop (𝓝 0)) : + ∀ g : G, + Tendsto + (fun n => + squaredPermutationEnergy (f n) ((A.model n).action g) / + (A.model n).size) atTop (𝓝 0) := by + classical + have hsingle (i : ι) : + Tendsto + (fun n => + squaredPermutationEnergy (f n) ((A.model n).action (s i)) / + (A.model n).size) atTop (𝓝 0) := by + refine squeeze_zero (fun n => + div_nonneg + (squaredPermutationEnergy_nonneg (f n) + ((A.model n).action (s i))) + (Nat.cast_nonneg _)) ?_ hpositive + intro n + apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg _) + exact Finset.single_le_sum + (fun j _ => squaredPermutationEnergy_nonneg + (f n) ((A.model n).action (s j))) + (Finset.mem_univ i) + intro g + have hg : g ∈ Subgroup.closure (Set.range s) := by + rw [hgenerate] + exact Subgroup.mem_top g + induction hg using Subgroup.closure_induction with + | mem x hx => + obtain ⟨i, rfl⟩ := hx + exact hsingle i + | one => + have heq : + (fun n => + squaredPermutationEnergy (f n) ((A.model n).action 1) / + (A.model n).size) = + (fun _ : ℕ => (0 : ℝ)) := by + funext n + simp only [squaredPermutationEnergy, (A.model n).map_one, Equiv.Perm.coe_one, id_eq, + sub_self, ne_eq, + OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, Finset.sum_const_zero, zero_div] + rw [heq] + exact tendsto_const_nhds + | mul x y _ _ hx hy => + exact sofic_action_squared_energy_mul A f hf0 hf1 x y hx hy + | inv x _ hx => + exact sofic_action_squared_energy_inv A f hf0 hf1 x hx + +public +theorem sum_action_energy_tendsto_zero_of_positive_generator_sum + {G ι : Type*} [Group G] [Fintype ι] + (A : SoficApproximation G) + (s : ι → G) + (hgenerate : Subgroup.closure (Set.range s) = ⊤) + (f : (n : ℕ) → Fin (A.model n).size → ℝ) + (hf0 : ∀ n x, 0 ≤ f n x) + (hf1 : ∀ n x, f n x ≤ 1) + (hpositive : Tendsto + (fun n => + (∑ i : ι, + squaredPermutationEnergy (f n) + ((A.model n).action (s i))) / + (A.model n).size) atTop (𝓝 0)) + (S : Finset G) : + Tendsto + (fun n => + (∑ g ∈ S, + squaredPermutationEnergy (f n) ((A.model n).action g)) / + (A.model n).size) atTop (𝓝 0) := by + have hall := action_energy_tendsto_zero_of_positive_generator_sum + A s hgenerate f hf0 hf1 hpositive + have hsum : Tendsto + (fun n => + ∑ g ∈ S, + squaredPermutationEnergy (f n) ((A.model n).action g) / + (A.model n).size) atTop (𝓝 0) := by + simpa only [Finset.sum_const_zero] using tendsto_finsetSum S (fun g _ => hall g) + simpa only [Finset.sum_div] using hsum + +end KunPositiveWordMidrankEnergy + +namespace KunAdditiveMedianPoincare + +open CheegerPoincare +open Filter Topology +open scoped BigOperators + +private def permutationRealVariation + {V ι : Type*} [Fintype V] [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) : ℝ := + ∑ i : ι, ∑ x : V, |f (σ i x) - f x| + +private theorem sum_indicator_real_eq_mul_card + {V : Type*} (A : Finset V) + (q : V → Prop) [DecidablePred q] (m : ℝ) : + (∑ x ∈ A, if q x then m else 0) = + m * (A.filter q).card := by + calc + (∑ x ∈ A, if q x then m else 0) = + m * (∑ x ∈ A, if q x then (1 : ℝ) else 0) := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro x _ + split <;> simp + _ = m * (A.filter q).card := by + congr 1 + exact Finset.sum_boole (R := ℝ) q A + +private theorem permutationRealVariation_subtract_layer + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (f : V → ℝ) + (A : Finset V) (m : ℝ) (hm : 0 ≤ m) + (hinside : ∀ x ∈ A, m ≤ f x) + (houtside : ∀ x, x ∉ A → f x = 0) : + permutationRealVariation σ f = + permutationRealVariation σ + (fun x => if x ∈ A then f x - m else 0) + + 2 * m * (boundary σ A : ℝ) := by + classical + let g : V → ℝ := fun x => if x ∈ A then f x - m else 0 + have hpair (i : ι) (x : V) : + |f (σ i x) - f x| = + |g (σ i x) - g x| + + (if x ∈ A ∧ σ i x ∉ A then m else 0) + + (if x ∉ A ∧ σ i x ∈ A then m else 0) := by + by_cases hx : x ∈ A + · by_cases hy : σ i x ∈ A + · simp only [hy, ↓reduceIte, hx, sub_sub_sub_cancel_right, not_true_eq_false, and_false, + add_zero, and_true, g] + · have hyzero := houtside (σ i x) hy + have hxnonnegative : 0 ≤ f x := hm.trans (hinside x hx) + simp only [hyzero, zero_sub, abs_neg, abs_of_nonneg hxnonnegative, hy, ↓reduceIte, hx, + neg_sub, + abs_of_nonpos (sub_nonpos.mpr (hinside x hx)), not_false_eq_true, and_self, + sub_add_cancel, not_true_eq_false, + add_zero, g] + · by_cases hy : σ i x ∈ A + · have hxzero := houtside x hx + have hynonnegative : 0 ≤ f (σ i x) := + hm.trans (hinside (σ i x) hy) + have hysub : 0 ≤ f (σ i x) - m := + sub_nonneg.mpr (hinside (σ i x) hy) + simp only [hxzero, sub_zero, abs_of_nonneg hynonnegative, hy, ↓reduceIte, hx, abs_of_nonneg + hysub, + not_true_eq_false, and_self, add_zero, not_false_eq_true, sub_add_cancel, g] + · simp only [houtside (σ i x) hy, houtside x hx, sub_self, abs_zero, hy, ↓reduceIte, hx, + not_false_eq_true, + and_true, add_zero, and_false, g] + have hone (i : ι) : + (∑ x : V, |f (σ i x) - f x|) = + (∑ x : V, |g (σ i x) - g x|) + + 2 * m * (A.filter fun x => σ i x ∉ A).card := by + have hexit : + (∑ x : V, if x ∈ A ∧ σ i x ∉ A then m else 0) = + m * (A.filter fun x => σ i x ∉ A).card := by + have hset : + Finset.univ.filter + (fun x : V => x ∈ A ∧ σ i x ∉ A) = + A.filter fun x => σ i x ∉ A := by + ext x + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + simpa only [hset] using + sum_indicator_real_eq_mul_card Finset.univ + (fun x : V => x ∈ A ∧ σ i x ∉ A) m + have henter : + (∑ x : V, if x ∉ A ∧ σ i x ∈ A then m else 0) = + m * (Finset.univ.filter fun x => + x ∉ A ∧ σ i x ∈ A).card := + sum_indicator_real_eq_mul_card + Finset.univ (fun x => x ∉ A ∧ σ i x ∈ A) m + calc + (∑ x : V, |f (σ i x) - f x|) = + ∑ x : V, + (|g (σ i x) - g x| + + (if x ∈ A ∧ σ i x ∉ A then m else 0) + + (if x ∉ A ∧ σ i x ∈ A then m else 0)) := by + apply Finset.sum_congr rfl + intro x _ + exact hpair i x + _ = (∑ x : V, |g (σ i x) - g x|) + + (∑ x : V, + if x ∈ A ∧ σ i x ∉ A then m else 0) + + (∑ x : V, + if x ∉ A ∧ σ i x ∈ A then m else 0) := by + simp_rw [Finset.sum_add_distrib] + _ = (∑ x : V, |g (σ i x) - g x|) + + m * (A.filter fun x => σ i x ∉ A).card + + m * (Finset.univ.filter fun x => + x ∉ A ∧ σ i x ∈ A).card := by + rw [hexit, henter] + _ = (∑ x : V, |g (σ i x) - g x|) + + 2 * m * (A.filter fun x => σ i x ∉ A).card := by + have hcross : + (Finset.univ.filter fun x => + x ∉ A ∧ σ i x ∈ A).card = + (A.filter fun x => σ i x ∉ A).card := + KunThomFiberCoarea.card_entering_eq_card_exiting + (σ i) A + rw [hcross] + ring + unfold permutationRealVariation boundary + calc + (∑ i : ι, ∑ x : V, |f (σ i x) - f x|) = + ∑ i : ι, + ((∑ x : V, |g (σ i x) - g x|) + + 2 * m * (A.filter fun x => σ i x ∉ A).card) := by + apply Finset.sum_congr rfl + intro i _ + exact hone i + _ = (∑ i : ι, ∑ x : V, |g (σ i x) - g x|) + + 2 * m * + (∑ i : ι, (A.filter fun x => σ i x ∉ A).card) := by + push_cast + simp only [Finset.sum_add_distrib, Finset.mul_sum] + +private theorem additive_permutation_small_support_coarea + {V ι : Type*} [Fintype V] + [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (γ ε : ℝ) + (hε : 0 ≤ ε) + (hexp : ∀ A : Finset V, + γ * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ) + ε) + (f : V → ℝ) (M : ℝ) (hM : 0 ≤ M) + (hf : ∀ x, 0 ≤ f x) + (hfM : ∀ x, f x ≤ M) + (hhalf : + 2 * (CheegerPoincare.positiveSupport f).card ≤ + Fintype.card V) : + 2 * γ * (∑ x : V, f x) ≤ + permutationRealVariation σ f + 2 * ε * M := by + classical + generalize hn : + (CheegerPoincare.positiveSupport f).card = n + induction n using Nat.strong_induction_on generalizing f M with + | h n ih => + by_cases hnonempty : + (CheegerPoincare.positiveSupport f).Nonempty + · let A : Finset V := + CheegerPoincare.positiveSupport f + have hA : A.Nonempty := hnonempty + have himage : (A.image f).Nonempty := + Finset.image_nonempty.mpr hA + let m : ℝ := (A.image f).min' himage + have hmem : m ∈ A.image f := Finset.min'_mem _ _ + obtain ⟨z, hzA, hzm⟩ := Finset.mem_image.mp hmem + have hmpos : 0 < m := by + rw [← hzm] + exact + (CheegerPoincare.mem_positiveSupport f z).mp hzA + have hmle : ∀ x ∈ A, m ≤ f x := by + intro x hx + exact Finset.min'_le (A.image f) (f x) + (Finset.mem_image.mpr ⟨x, hx, rfl⟩) + have hmM : m ≤ M := by + rw [← hzm] + exact hfM z + let g : V → ℝ := fun x => + if x ∈ A then f x - m else 0 + have hgnonnegative : ∀ x, 0 ≤ g x := by + intro x + by_cases hx : x ∈ A + · simpa [g, hx] using sub_nonneg.mpr (hmle x hx) + · simp only [hx, ↓reduceIte, Std.le_refl, g] + have hgupper : ∀ x, g x ≤ M - m := by + intro x + by_cases hx : x ∈ A + · simp only [g, ite_eq_left hx] + linarith [hfM x] + · simp only [g, ite_eq_right hx] + linarith + have hgsub : + CheegerPoincare.positiveSupport g ⊆ A := by + intro x hx + have hpositive := + (CheegerPoincare.mem_positiveSupport g x).mp hx + by_contra hxA + simp only [hxA, ↓reduceIte, lt_self_iff_false, g] at hpositive + have hznot : + z ∉ CheegerPoincare.positiveSupport g := by + intro hz + have hpositive := + (CheegerPoincare.mem_positiveSupport g z).mp hz + have hzero : g z = 0 := by + simp only [hzA, ↓reduceIte, hzm, sub_self, g] + simp only [hzero, lt_self_iff_false] at hpositive + have hstrict : + CheegerPoincare.positiveSupport g ⊂ A := by + apply Finset.ssubset_iff_subset_ne.mpr + refine ⟨hgsub, ?_⟩ + intro heq + exact hznot (heq.symm ▸ hzA) + have hgcard : + (CheegerPoincare.positiveSupport g).card < n := by + rw [← hn] + exact Finset.card_lt_card hstrict + have hghalf : + 2 * (CheegerPoincare.positiveSupport g).card ≤ + Fintype.card V := + (Nat.mul_le_mul_left 2 (Finset.card_le_card hgsub)).trans hhalf + have hgbound : + 2 * γ * (∑ x : V, g x) ≤ + permutationRealVariation σ g + 2 * ε * (M - m) := + ih (CheegerPoincare.positiveSupport g).card + hgcard g (M - m) (sub_nonneg.mpr hmM) + hgnonnegative hgupper hghalf rfl + have hhalfre : (2 : ℝ) * A.card ≤ Fintype.card V := by + exact_mod_cast hhalf + have hmin : + (A.card : ℝ) ≤ (Fintype.card V : ℝ) - A.card := by + linarith + have hcut : + γ * (A.card : ℝ) ≤ + (boundary σ A : ℝ) + ε := by + simpa only [min_eq_left hmin] using hexp A + have houtside : ∀ x, x ∉ A → f x = 0 := by + intro x hx + have hnot : ¬ 0 < f x := by + intro hpositive + exact hx + ((CheegerPoincare.mem_positiveSupport f x).mpr + hpositive) + exact le_antisymm (le_of_not_gt hnot) (hf x) + have hsumindicator : + (∑ x : V, if x ∈ A then m else 0) = + m * (A.card : ℝ) := by + simpa only [Finset.sum_ite_mem, Finset.univ_inter, Finset.sum_const, nsmul_eq_mul, + Finset.subset_univ, + Finset.filter_mem_eq_of_subset] using sum_indicator_real_eq_mul_card Finset.univ (fun x : + V => x ∈ A) m + have hsum : + (∑ x : V, f x) = + (∑ x : V, g x) + m * (A.card : ℝ) := by + calc + (∑ x : V, f x) = + ∑ x : V, + (g x + if x ∈ A then m else 0) := by + apply Finset.sum_congr rfl + intro x _ + by_cases hx : x ∈ A + · simp only [hx, ↓reduceIte, sub_add_cancel, g] + · simp only [houtside x hx, hx, ↓reduceIte, add_zero, g] + _ = (∑ x : V, g x) + + (∑ x : V, if x ∈ A then m else 0) := by + rw [Finset.sum_add_distrib] + _ = (∑ x : V, g x) + m * (A.card : ℝ) := by + rw [hsumindicator] + have hvariation : + permutationRealVariation σ f = + permutationRealVariation σ g + + 2 * m * (boundary σ A : ℝ) := + permutationRealVariation_subtract_layer + σ f A m hmpos.le hmle houtside + have hscaled := + mul_le_mul_of_nonneg_left hcut + (show 0 ≤ 2 * m by positivity) + rw [hsum, hvariation] + linarith only [hgbound, hscaled] + · have hzero : ∀ x, f x = 0 := by + intro x + have hx : ¬ 0 < f x := by + intro hpositive + apply hnonempty + exact ⟨x, + (CheegerPoincare.mem_positiveSupport f x).mpr + hpositive⟩ + exact le_antisymm (le_of_not_gt hx) (hf x) + simp only [hzero, Finset.sum_const_zero, mul_zero, permutationRealVariation, sub_self, + abs_zero, zero_add, + ge_iff_le] + positivity + +private theorem positive_negative_abs_eq (a b : ℝ) : + |max a 0 - max b 0| + + |max (-a) 0 - max (-b) 0| = |a - b| := by + rcases le_total 0 a with ha | ha <;> + rcases le_total 0 b with hb | hb <;> + simp only [max_eq_left, max_eq_right, ha, hb, neg_nonneg, neg_nonpos, + sub_zero, zero_sub, sub_self, abs_zero, add_zero, zero_add, abs_neg, + neg_sub_neg] + · rw [abs_of_nonneg ha, abs_of_nonpos hb, + abs_of_nonneg (by linarith : (0 : ℝ) ≤ a - b)] + ring + · rw [abs_of_nonneg hb, abs_of_nonpos ha, + abs_of_nonpos (by linarith : a - b ≤ 0)] + ring + · exact abs_sub_comm b a + +private theorem permutationRealVariation_positive_negative + {V ι : Type*} [Fintype V] [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) (m : ℝ) : + permutationRealVariation σ (fun x => max (f x - m) 0) + + permutationRealVariation σ (fun x => max (m - f x) 0) = + permutationRealVariation σ f := by + unfold permutationRealVariation + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro i _ + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro x _ + have hx : m - f x = -(f x - m) := by ring + have hy : m - f (σ i x) = -(f (σ i x) - m) := by ring + have hxy : + (f (σ i x) - m) - (f x - m) = f (σ i x) - f x := by + ring + simpa only [hx, hy, hxy] using + positive_negative_abs_eq (f (σ i x) - m) (f x - m) + +private theorem exists_bounded_finite_real_median + {V : Type*} [Fintype V] [Nonempty V] + (f : V → ℝ) + (hf : ∀ x, 0 ≤ f x) + (hf_one : ∀ x, f x ≤ 1) : + ∃ m : ℝ, 0 ≤ m ∧ m ≤ 1 ∧ + 2 * (CheegerPoincare.lowerLevel f m).card ≤ + Fintype.card V ∧ + 2 * (CheegerPoincare.upperLevel f m).card ≤ + Fintype.card V := by + classical + obtain ⟨m, hbelow, habove⟩ := + CheegerPoincare.exists_finite_real_median f + have hcard : 0 < Fintype.card V := Fintype.card_pos_iff.mpr + (inferInstance : Nonempty V) + have hm_nonnegative : 0 ≤ m := by + by_contra hnot + have hm_negative : m < 0 := lt_of_not_ge hnot + have hupper : + CheegerPoincare.upperLevel f m = + (Finset.univ : Finset V) := by + ext x + simp only [CheegerPoincare.mem_upperLevel, + Finset.mem_univ, iff_true] + exact hm_negative.trans_le (hf x) + rw [hupper, Finset.card_univ] at habove + omega + have hm_one : m ≤ 1 := by + by_contra hnot + have hm_greater : 1 < m := lt_of_not_ge hnot + have hlower : + CheegerPoincare.lowerLevel f m = + (Finset.univ : Finset V) := by + ext x + simp only [CheegerPoincare.mem_lowerLevel, + Finset.mem_univ, iff_true] + exact (hf_one x).trans_lt hm_greater + rw [hlower, Finset.card_univ] at hbelow + omega + exact ⟨m, hm_nonnegative, hm_one, hbelow, habove⟩ + +private theorem additive_permutation_median_absolute_deviation + {V ι : Type*} [Fintype V] [Nonempty V] + [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (γ ε : ℝ) + (hε : 0 ≤ ε) + (hexp : ∀ A : Finset V, + γ * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ) + ε) + (f : V → ℝ) + (hf : ∀ x, 0 ≤ f x) + (hf_one : ∀ x, f x ≤ 1) : + ∃ m : ℝ, 0 ≤ m ∧ m ≤ 1 ∧ + 2 * γ * (∑ x : V, |f x - m|) ≤ + permutationRealVariation σ f + 4 * ε := by + classical + obtain ⟨m, hm_nonnegative, hm_one, hbelow, habove⟩ := + exists_bounded_finite_real_median f hf hf_one + let p : V → ℝ := fun x => max (f x - m) 0 + let q : V → ℝ := fun x => max (m - f x) 0 + have hp_nonnegative : ∀ x, 0 ≤ p x := by + intro x + exact le_max_right _ _ + have hq_nonnegative : ∀ x, 0 ≤ q x := by + intro x + exact le_max_right _ _ + have hp_one : ∀ x, p x ≤ 1 := by + intro x + apply max_le + · linarith [hf_one x] + · norm_num + have hq_one : ∀ x, q x ≤ 1 := by + intro x + apply max_le + · linarith [hf x] + · norm_num + have hp_half : + 2 * (CheegerPoincare.positiveSupport p).card ≤ + Fintype.card V := by + simpa only [p, CheegerPoincare.positiveSupport_max_sub] + using habove + have hq_half : + 2 * (CheegerPoincare.positiveSupport q).card ≤ + Fintype.card V := by + simpa only [q, + CheegerPoincare.positiveSupport_max_sub_reverse] + using hbelow + have hp_coarea := additive_permutation_small_support_coarea + σ γ ε hε hexp p 1 (by norm_num) hp_nonnegative hp_one hp_half + have hq_coarea := additive_permutation_small_support_coarea + σ γ ε hε hexp q 1 (by norm_num) hq_nonnegative hq_one hq_half + have hvariation : + permutationRealVariation σ p + + permutationRealVariation σ q = + permutationRealVariation σ f := by + simpa only [p, q] using + permutationRealVariation_positive_negative σ f m + have hpoint (x : V) : p x + q x = |f x - m| := by + dsimp [p, q] + rcases le_total m (f x) with hx | hx + · rw [max_eq_left (sub_nonneg.mpr hx), + max_eq_right (sub_nonpos.mpr hx), + abs_of_nonneg (sub_nonneg.mpr hx)] + ring + · rw [max_eq_right (sub_nonpos.mpr hx), + max_eq_left (sub_nonneg.mpr hx), + abs_of_nonpos (sub_nonpos.mpr hx)] + ring + have hmass : + (∑ x : V, p x) + (∑ x : V, q x) = + ∑ x : V, |f x - m| := by + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro x _ + exact hpoint x + refine ⟨m, hm_nonnegative, hm_one, ?_⟩ + rw [← hmass, ← hvariation] + nlinarith [hp_coarea, hq_coarea] + +private theorem additive_permutation_median_variance + {V ι : Type*} [Fintype V] [Nonempty V] + [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (γ ε : ℝ) + (hγ : 0 ≤ γ) + (hε : 0 ≤ ε) + (hexp : ∀ A : Finset V, + γ * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ) + ε) + (f : V → ℝ) + (hf : ∀ x, 0 ≤ f x) + (hf_one : ∀ x, f x ≤ 1) : + 2 * γ * + (∑ x : V, + (f x - CheegerPoincare.finiteMean f) ^ 2) ≤ + permutationRealVariation σ f + 4 * ε := by + obtain ⟨m, hm_nonnegative, hm_one, hmedian⟩ := + additive_permutation_median_absolute_deviation + σ γ ε hε hexp f hf hf_one + have hpoint (x : V) : (f x - m) ^ 2 ≤ |f x - m| := by + have hlower : -1 ≤ f x - m := by + linarith [hf x] + have hupper : f x - m ≤ 1 := by + linarith [hf_one x] + rcases le_total 0 (f x - m) with hx | hx + · rw [abs_of_nonneg hx] + nlinarith + · rw [abs_of_nonpos hx] + nlinarith + have hsq : + (∑ x : V, (f x - m) ^ 2) ≤ + ∑ x : V, |f x - m| := by + exact Finset.sum_le_sum fun x _ => hpoint x + have hmean := + CheegerPoincare.sum_sq_sub_finiteMean_le f m + have hfactor : 0 ≤ 2 * γ := mul_nonneg (by norm_num) hγ + calc + 2 * γ * + (∑ x : V, + (f x - CheegerPoincare.finiteMean f) ^ 2) ≤ + 2 * γ * (∑ x : V, (f x - m) ^ 2) := + mul_le_mul_of_nonneg_left hmean hfactor + _ ≤ 2 * γ * (∑ x : V, |f x - m|) := + mul_le_mul_of_nonneg_left hsq hfactor + _ ≤ permutationRealVariation σ f + 4 * ε := hmedian + +private theorem additive_permutation_finiteVariance + {V ι : Type*} [Fintype V] [Nonempty V] + [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (γ ε : ℝ) + (hγ : 0 ≤ γ) + (hε : 0 ≤ ε) + (hexp : ∀ A : Finset V, + γ * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ) + ε) + (f : V → ℝ) + (hf : ∀ x, 0 ≤ f x) + (hf_one : ∀ x, f x ≤ 1) : + 2 * γ * (Fintype.card V : ℝ) * + CheegerPoincare.finiteVariance f ≤ + permutationRealVariation σ f + 4 * ε := by + have hvariance := additive_permutation_median_variance + σ γ ε hγ hε hexp f hf hf_one + rw [← CheegerPoincare.card_mul_finiteVariance f] + at hvariance + nlinarith + +end KunAdditiveMedianPoincare + +namespace KunCompletedComponentMidrankVariation + +open Filter Topology +open scoped BigOperators + +private def permutationRealVariation + {V ι : Type*} [Fintype V] [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) : ℝ := + ∑ i : ι, ∑ x : V, |f (σ i x) - f x| + +private theorem permutationRealVariation_sq_le_card_mul_energy + {V ι : Type*} [Fintype V] [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) : + permutationRealVariation σ f ^ 2 ≤ + ((Fintype.card ι : ℝ) * Fintype.card V) * + (∑ i : ι, ∑ x : V, (f (σ i x) - f x) ^ 2) := by + classical + have h := Finset.sum_mul_sq_le_sq_mul_sq + (Finset.univ : Finset (ι × V)) + (fun _ : ι × V => (1 : ℝ)) + (fun z : ι × V => |f (σ z.1 z.2) - f z.2|) + simpa only [one_mul, one_pow, sq_abs, + ← Finset.univ_product_univ, Finset.sum_product, + Finset.sum_const_zero, Finset.sum_const, Finset.card_product, + Finset.card_univ, Nat.cast_mul, nsmul_eq_mul, mul_one, + permutationRealVariation] using h + +private theorem normalized_permutationRealVariation_tendsto_zero_of_energy + (V : ℕ → Type*) + [∀ n, Fintype (V n)] [∀ n, Nonempty (V n)] + (ι : Type*) [Fintype ι] + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (f : (n : ℕ) → V n → ℝ) + (henergy : Tendsto + (fun n => + (∑ i : ι, ∑ x : V n, + (f n (σ n i x) - f n x) ^ 2) / + (Fintype.card (V n) : ℝ)) + atTop (nhds 0)) : + Tendsto + (fun n => + permutationRealVariation (σ n) (f n) / + (Fintype.card (V n) : ℝ)) + atTop (nhds 0) := by + have hN (n : ℕ) : (0 : ℝ) < Fintype.card (V n) := by + exact_mod_cast Fintype.card_pos_iff.mpr inferInstance + have hupper (n : ℕ) : + permutationRealVariation (σ n) (f n) / + (Fintype.card (V n) : ℝ) ≤ + Real.sqrt + ((Fintype.card ι : ℝ) * + ((∑ i : ι, ∑ x : V n, + (f n (σ n i x) - f n x) ^ 2) / + (Fintype.card (V n) : ℝ))) := by + apply Real.le_sqrt_of_sq_le + calc + (permutationRealVariation (σ n) (f n) / + (Fintype.card (V n) : ℝ)) ^ 2 = + permutationRealVariation (σ n) (f n) ^ 2 / + (Fintype.card (V n) : ℝ) ^ 2 := by + ring + _ ≤ + (((Fintype.card ι : ℝ) * Fintype.card (V n)) * + (∑ i : ι, ∑ x : V n, + (f n (σ n i x) - f n x) ^ 2)) / + (Fintype.card (V n) : ℝ) ^ 2 := by + exact div_le_div_of_nonneg_right + (permutationRealVariation_sq_le_card_mul_energy + (σ n) (f n)) + (sq_nonneg (Fintype.card (V n) : ℝ)) + _ = (Fintype.card ι : ℝ) * + ((∑ i : ι, ∑ x : V n, + (f n (σ n i x) - f n x) ^ 2) / + (Fintype.card (V n) : ℝ)) := by + field_simp [ne_of_gt (hN n)] + have hroot : Tendsto + (fun n => + Real.sqrt + ((Fintype.card ι : ℝ) * + ((∑ i : ι, ∑ x : V n, + (f n (σ n i x) - f n x) ^ 2) / + (Fintype.card (V n) : ℝ)))) + atTop (nhds 0) := by + have hscaled : Tendsto + (fun n => + (Fintype.card ι : ℝ) * + ((∑ i : ι, ∑ x : V n, + (f n (σ n i x) - f n x) ^ 2) / + (Fintype.card (V n) : ℝ))) + atTop (nhds 0) := by + simpa only [mul_zero] using henergy.const_mul (Fintype.card ι : ℝ) + simpa only [Function.comp_def, Real.sqrt_zero] using + (Real.continuous_sqrt.tendsto (0 : ℝ)).comp hscaled + apply squeeze_zero' + (Eventually.of_forall (fun n => ?_)) + (Eventually.of_forall hupper) + hroot + apply div_nonneg _ (hN n).le + unfold permutationRealVariation + exact Finset.sum_nonneg fun _ _ => + Finset.sum_nonneg fun _ _ => abs_nonneg _ + +private theorem sum_partition_parts_eq + {V : Type*} [Fintype V] [DecidableEq V] + (P : Finpartition (Finset.univ : Finset V)) (f : V → ℝ) : + (∑ C ∈ P.parts, ∑ x ∈ C, f x) = ∑ x : V, f x := by + classical + calc + (∑ C ∈ P.parts, ∑ x ∈ C, f x) = + ∑ x ∈ P.parts.biUnion id, f x := by + symm + exact Finset.sum_biUnion P.disjoint + _ = ∑ x : V, f x := by rw [P.biUnion_parts] + +private theorem completed_component_real_variation_le + {V ι : Type*} [DecidableEq V] [Fintype ι] + (σ : ι → Equiv.Perm V) + (C : Finset V) + (τ : ι → Equiv.Perm {x : V // x ∈ C}) + (hτ : ∀ i (x : V) (hx : x ∈ C) (_hy : σ i x ∈ C), + ((τ i ⟨x, hx⟩ : {x : V // x ∈ C}) : V) = σ i x) + (f : V → ℝ) + (hf0 : ∀ x, 0 ≤ f x) + (hf1 : ∀ x, f x ≤ 1) : + permutationRealVariation τ (fun x => f (x : V)) ≤ + (∑ i : ι, ∑ x ∈ C, |f (σ i x) - f x|) + + (boundary σ C : ℝ) := by + classical + have hunit (x y : V) : |f x - f y| ≤ (1 : ℝ) := by + apply (abs_le).2 + constructor <;> linarith [hf0 x, hf0 y, hf1 x, hf1 y] + have hpoint (i : ι) (x : {x : V // x ∈ C}) : + |f ((τ i x : {x : V // x ∈ C}) : V) - f (x : V)| ≤ + |f (σ i (x : V)) - f (x : V)| + + if σ i (x : V) ∈ C then 0 else 1 := by + by_cases hinside : σ i (x : V) ∈ C + · simp only [ite_eq_left hinside, add_zero] + rw [hτ i (x : V) x.property hinside] + · simp only [ite_eq_right hinside] + linarith [hunit + ((τ i x : {x : V // x ∈ C}) : V) (x : V), + abs_nonneg (f (σ i (x : V)) - f (x : V))] + calc + permutationRealVariation τ (fun x => f (x : V)) ≤ + ∑ i : ι, ∑ x : {x : V // x ∈ C}, + (|f (σ i (x : V)) - f (x : V)| + + if σ i (x : V) ∈ C then 0 else 1) := by + unfold permutationRealVariation + apply Finset.sum_le_sum + intro i _ + apply Finset.sum_le_sum + intro x _ + exact hpoint i x + _ = ∑ i : ι, + ((∑ x ∈ C, |f (σ i x) - f x|) + + ((C.filter fun x => σ i x ∉ C).card : ℝ)) := by + apply Finset.sum_congr rfl + intro i _ + rw [Finset.sum_add_distrib] + have horiginal : + (∑ x : {x : V // x ∈ C}, + |f (σ i (x : V)) - f (x : V)|) = + ∑ x ∈ C, |f (σ i x) - f x| := + (Finset.sum_subtype C (fun _ => Iff.rfl) + (fun x : V => |f (σ i x) - f x|)).symm + have hmiss : + (∑ x : {x : V // x ∈ C}, + if σ i (x : V) ∈ C then (0 : ℝ) else 1) = + ((C.filter fun x => σ i x ∉ C).card : ℝ) := by + calc + (∑ x : {x : V // x ∈ C}, + if σ i (x : V) ∈ C then (0 : ℝ) else 1) = + ∑ x ∈ C, + if σ i x ∈ C then (0 : ℝ) else 1 := + (Finset.sum_subtype C (fun _ => Iff.rfl) + (fun x : V => if σ i x ∈ C then (0 : ℝ) else 1)).symm + _ = ((C.filter fun x => σ i x ∉ C).card : ℝ) := by + simpa only [ite_not] using + (Finset.sum_boole (R := ℝ) + (fun x : V => σ i x ∉ C) C) + rw [horiginal, hmiss] + _ = (∑ i : ι, ∑ x ∈ C, |f (σ i x) - f x|) + + (boundary σ C : ℝ) := by + simp only [Finset.sum_add_distrib, boundary, Nat.cast_sum] + +private theorem sum_completed_component_real_variation_le + {V ι : Type*} [Fintype V] [DecidableEq V] [Fintype ι] + (P : Finpartition (Finset.univ : Finset V)) + (σ : ι → Equiv.Perm V) + (τ : (C : Finset V) → ι → Equiv.Perm {x : V // x ∈ C}) + (hτ : ∀ C ∈ P.parts, ∀ i (x : V) + (hx : x ∈ C) (_hy : σ i x ∈ C), + ((τ C i ⟨x, hx⟩ : {x : V // x ∈ C}) : V) = σ i x) + (f : V → ℝ) + (hf0 : ∀ x, 0 ≤ f x) + (hf1 : ∀ x, f x ≤ 1) : + (∑ C ∈ P.parts, + permutationRealVariation (τ C) (fun x => f (x : V))) ≤ + permutationRealVariation σ f + + ∑ C ∈ P.parts, (boundary σ C : ℝ) := by + classical + have hparts : + (∑ C ∈ P.parts, ∑ i : ι, ∑ x ∈ C, + |f (σ i x) - f x|) = + permutationRealVariation σ f := by + unfold permutationRealVariation + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro i _ + exact sum_partition_parts_eq P + (fun x : V => |f (σ i x) - f x|) + calc + (∑ C ∈ P.parts, + permutationRealVariation (τ C) (fun x => f (x : V))) ≤ + ∑ C ∈ P.parts, + ((∑ i : ι, ∑ x ∈ C, |f (σ i x) - f x|) + + (boundary σ C : ℝ)) := by + apply Finset.sum_le_sum + intro C hC + exact completed_component_real_variation_le + σ C (τ C) (hτ C hC) f hf0 hf1 + _ = permutationRealVariation σ f + + ∑ C ∈ P.parts, (boundary σ C : ℝ) := by + rw [Finset.sum_add_distrib, hparts] + +end KunCompletedComponentMidrankVariation + +open KunCompletedComponentMidrankVariation + +namespace KunGlobalActualAdditiveMidrankVariance + +open Filter Topology +open scoped BigOperators + +private theorem weighted_component_midrankVariance_additive_bound + {V ι : Type*} [Fintype V] [DecidableEq V] [Fintype ι] + (P : Finpartition (Finset.univ : Finset V)) + (σ : ι → Equiv.Perm V) + (τ : (C : Finset V) → ι → Equiv.Perm {x : V // x ∈ C}) + (γ : ℝ) (hγ : 0 ≤ γ) + (hτ : ∀ C ∈ P.parts, ∀ i (x : V) + (hx : x ∈ C) (_hy : σ i x ∈ C), + ((τ C i ⟨x, hx⟩ : {x : V // x ∈ C}) : V) = σ i x) + (hexpand : ∀ C ∈ P.parts, ∀ E : Finset V, E ⊆ C → + 2 * E.card ≤ C.card → + γ * (E.card : ℝ) ≤ (boundary σ E : ℝ)) + (b : V → ℤ) : + 2 * γ * + (∑ C ∈ P.parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C b)) ≤ + KunCompletedComponentMidrankVariation.permutationRealVariation + σ (MidrankPermutationEnergy.partitionVertexMidrank P b) + + 5 * (∑ C ∈ P.parts, (boundary σ C : ℝ)) := by + classical + let f : V → ℝ := + MidrankPermutationEnergy.partitionVertexMidrank P b + have hf0 (x : V) : 0 ≤ f x := + componentVertexMidrank_nonneg (P.part x) b x + have hf1 (x : V) : f x ≤ 1 := + componentVertexMidrank_le_one (P.part x) b x + have hcomponent (C : Finset V) (hC : C ∈ P.parts) : + 2 * γ * (C.card : ℝ) * + midrankVariance + (componentRankMassList C b) ≤ + KunCompletedComponentMidrankVariation.permutationRealVariation + (τ C) (fun x : {x : V // x ∈ C} => f (x : V)) + + 4 * (boundary σ C : ℝ) := by + have hCne : C.Nonempty := P.nonempty_of_mem_parts hC + let : Nonempty {x : V // x ∈ C} := + ⟨⟨hCne.choose, hCne.choose_spec⟩⟩ + have hrestrict : + (fun x : {x : V // x ∈ C} => f (x : V)) = + (fun x : {x : V // x ∈ C} => + componentVertexMidrank C b (x : V)) := by + funext x + change + componentVertexMidrank (P.part (x : V)) b (x : V) = + componentVertexMidrank C b (x : V) + rw [P.part_eq_of_mem hC x.property] + have hcut (E : Finset {x : V // x ∈ C}) : + γ * min (E.card : ℝ) + ((Fintype.card {x : V // x ∈ C} : ℝ) - E.card) ≤ + (boundary (τ C) E : ℝ) + + (boundary σ C : ℝ) := by + have h := + KunResidualExpanderDecomposition.completed_component_additive_expansion + σ C (τ C) (hτ C hC) γ (hexpand C hC) E + have h' : + γ * min (E.card : ℝ) ((C.card : ℝ) - E.card) ≤ + (boundary (τ C) E : ℝ) + + (boundary σ C : ℝ) := by + linarith + simpa only [Fintype.card_coe] using h' + have hp := + KunAdditiveMedianPoincare.additive_permutation_finiteVariance + (τ C) γ (boundary σ C : ℝ) + hγ (Nat.cast_nonneg _) hcut + (fun x : {x : V // x ∈ C} => + componentVertexMidrank C b (x : V)) + (fun x => componentVertexMidrank_nonneg C b (x : V)) + (fun x => componentVertexMidrank_le_one C b (x : V)) + rw [Fintype.card_coe, + ComponentMidrankVariance.componentVertexMidrank_finiteVariance_eq + C b hCne] at hp + rw [← hrestrict] at hp + simpa only + [KunAdditiveMedianPoincare.permutationRealVariation, + KunCompletedComponentMidrankVariation.permutationRealVariation] + using hp + have hsummed : + 2 * γ * + (∑ C ∈ P.parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C b)) ≤ + (∑ C ∈ P.parts, + KunCompletedComponentMidrankVariation.permutationRealVariation + (τ C) (fun x : {x : V // x ∈ C} => f (x : V))) + + 4 * (∑ C ∈ P.parts, (boundary σ C : ℝ)) := by + calc + 2 * γ * + (∑ C ∈ P.parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C b)) = + ∑ C ∈ P.parts, + 2 * γ * (C.card : ℝ) * + midrankVariance + (componentRankMassList C b) := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro C _ + ring + _ ≤ ∑ C ∈ P.parts, + (KunCompletedComponentMidrankVariation.permutationRealVariation + (τ C) (fun x : {x : V // x ∈ C} => f (x : V)) + + 4 * (boundary σ C : ℝ)) := by + apply Finset.sum_le_sum + intro C hC + exact hcomponent C hC + _ = (∑ C ∈ P.parts, + KunCompletedComponentMidrankVariation.permutationRealVariation + (τ C) (fun x : {x : V // x ∈ C} => f (x : V))) + + 4 * (∑ C ∈ P.parts, (boundary σ C : ℝ)) := by + rw [Finset.sum_add_distrib, Finset.mul_sum] + have hcompletion := + KunCompletedComponentMidrankVariation.sum_completed_component_real_variation_le + P σ τ hτ f hf0 hf1 + change + 2 * γ * + (∑ C ∈ P.parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C b)) ≤ + KunCompletedComponentMidrankVariation.permutationRealVariation + σ f + + 5 * (∑ C ∈ P.parts, (boundary σ C : ℝ)) + linarith + +private theorem weighted_component_midrankVariance_tendsto_zero_of_additive_expansion + (V : ℕ → Type*) + [∀ n, Fintype (V n)] [∀ n, Nonempty (V n)] + [∀ n, DecidableEq (V n)] + (ι : Type*) [Fintype ι] + (P : (n : ℕ) → Finpartition (Finset.univ : Finset (V n))) + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (τ : (n : ℕ) → (C : Finset (V n)) → + ι → Equiv.Perm {x : V n // x ∈ C}) + (b : (n : ℕ) → V n → ℤ) + (γ : ℝ) (hγ : 0 < γ) + (hτ : ∀ n C, C ∈ (P n).parts → ∀ i (x : V n) + (hx : x ∈ C) (_hy : σ n i x ∈ C), + ((τ n C i ⟨x, hx⟩ : {x : V n // x ∈ C}) : V n) = + σ n i x) + (hexpand : ∀ n C, C ∈ (P n).parts → ∀ E : Finset (V n), + E ⊆ C → 2 * E.card ≤ C.card → + γ * (E.card : ℝ) ≤ (boundary (σ n) E : ℝ)) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (P n).parts, + (boundary (σ n) C : ℝ)) / + (Fintype.card (V n) : ℝ)) + atTop (nhds 0)) + (henergy : Tendsto + (fun n => + (∑ i : ι, ∑ x : V n, + (MidrankPermutationEnergy.partitionVertexMidrank + (P n) (b n) (σ n i x) - + MidrankPermutationEnergy.partitionVertexMidrank + (P n) (b n) x) ^ 2) / + (Fintype.card (V n) : ℝ)) + atTop (nhds 0)) : + Tendsto + (fun n => + (∑ C ∈ (P n).parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C (b n))) / + (Fintype.card (V n) : ℝ)) + atTop (nhds 0) := by + classical + let f : (n : ℕ) → V n → ℝ := + fun n => + MidrankPermutationEnergy.partitionVertexMidrank + (P n) (b n) + have hN (n : ℕ) : (0 : ℝ) < Fintype.card (V n) := by + exact_mod_cast Fintype.card_pos_iff.mpr inferInstance + have hvariation : Tendsto + (fun n => + KunCompletedComponentMidrankVariation.permutationRealVariation + (σ n) (f n) / (Fintype.card (V n) : ℝ)) + atTop (nhds 0) := by + apply + normalized_permutationRealVariation_tendsto_zero_of_energy + V ι σ f + exact henergy + have hnonnegative : ∀ n, + 0 ≤ + (∑ C ∈ (P n).parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C (b n))) / + (Fintype.card (V n) : ℝ) := by + intro n + apply div_nonneg _ (hN n).le + apply Finset.sum_nonneg + intro C hC + apply mul_nonneg (Nat.cast_nonneg _) + rw [← ComponentMidrankVariance.componentVertexMidrank_finiteVariance_eq + C (b n) ((P n).nonempty_of_mem_parts hC)] + exact CheegerPoincare.finiteVariance_nonneg _ + have hupper (n : ℕ) : + (∑ C ∈ (P n).parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C (b n))) / + (Fintype.card (V n) : ℝ) ≤ + (KunCompletedComponentMidrankVariation.permutationRealVariation + (σ n) (f n) / (Fintype.card (V n) : ℝ) + + 5 * ((∑ C ∈ (P n).parts, + (boundary (σ n) C : ℝ)) / + (Fintype.card (V n) : ℝ))) / (2 * γ) := by + have hfinite := + weighted_component_midrankVariance_additive_bound + (P n) (σ n) (τ n) γ hγ.le (hτ n) + (hexpand n) (b n) + have hfinite' := + (div_le_div_iff_of_pos_right (hN n)).2 hfinite + apply (le_div_iff₀ (mul_pos (by norm_num : (0 : ℝ) < 2) hγ)).2 + calc + ((∑ C ∈ (P n).parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C (b n))) / + (Fintype.card (V n) : ℝ)) * (2 * γ) = + (2 * γ * + (∑ C ∈ (P n).parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C (b n)))) / + (Fintype.card (V n) : ℝ) := by ring + _ ≤ + (KunCompletedComponentMidrankVariation.permutationRealVariation + (σ n) (f n) + + 5 * (∑ C ∈ (P n).parts, + (boundary (σ n) C : ℝ))) / + (Fintype.card (V n) : ℝ) := hfinite' + _ = + KunCompletedComponentMidrankVariation.permutationRealVariation + (σ n) (f n) / (Fintype.card (V n) : ℝ) + + 5 * ((∑ C ∈ (P n).parts, + (boundary (σ n) C : ℝ)) / + (Fintype.card (V n) : ℝ)) := by ring + have hlimit : Tendsto + (fun n => + (KunCompletedComponentMidrankVariation.permutationRealVariation + (σ n) (f n) / (Fintype.card (V n) : ℝ) + + 5 * ((∑ C ∈ (P n).parts, + (boundary (σ n) C : ℝ)) / + (Fintype.card (V n) : ℝ))) / (2 * γ)) + atTop (nhds 0) := by + have hsum := hvariation.add (hboundary.const_mul (5 : ℝ)) + have hscaled := hsum.mul_const ((2 * γ)⁻¹) + simpa only [div_eq_mul_inv, zero_add, zero_mul, mul_zero] using hscaled + exact squeeze_zero' + (Eventually.of_forall hnonnegative) + (Eventually.of_forall hupper) + hlimit + +public +theorem weighted_component_midrankVariance_tendsto_zero_of_source_half_expansion + (V : ℕ → Type*) + [∀ n, Fintype (V n)] [∀ n, Nonempty (V n)] + [∀ n, DecidableEq (V n)] + (ι : Type*) [Fintype ι] + (P : (n : ℕ) → Finpartition (Finset.univ : Finset (V n))) + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (b : (n : ℕ) → V n → ℤ) + (γ : ℝ) (hγ : 0 < γ) + (hexpand : ∀ n C, C ∈ (P n).parts → ∀ E : Finset (V n), + E ⊆ C → 2 * E.card ≤ C.card → + γ * (E.card : ℝ) ≤ (boundary (σ n) E : ℝ)) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (P n).parts, + (boundary (σ n) C : ℝ)) / + (Fintype.card (V n) : ℝ)) + atTop (nhds 0)) + (henergy : Tendsto + (fun n => + (∑ i : ι, ∑ x : V n, + (MidrankPermutationEnergy.partitionVertexMidrank + (P n) (b n) (σ n i x) - + MidrankPermutationEnergy.partitionVertexMidrank + (P n) (b n) x) ^ 2) / + (Fintype.card (V n) : ℝ)) + atTop (nhds 0)) : + Tendsto + (fun n => + (∑ C ∈ (P n).parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C (b n))) / + (Fintype.card (V n) : ℝ)) + atTop (nhds 0) := by + classical + let τ : (n : ℕ) → (C : Finset (V n)) → + ι → Equiv.Perm {x : V n // x ∈ C} := + fun n C i => + Classical.choose + (exists_completion_of_internal_permutation + (σ n i) C) + have hτ (n : ℕ) (C : Finset (V n)) (_hC : C ∈ (P n).parts) + (i : ι) (x : V n) (hx : x ∈ C) (hy : σ n i x ∈ C) : + ((τ n C i ⟨x, hx⟩ : {x : V n // x ∈ C}) : V n) = + σ n i x := by + exact Classical.choose_spec + (exists_completion_of_internal_permutation + (σ n i) C) x hx hy + exact weighted_component_midrankVariance_tendsto_zero_of_additive_expansion + V ι P σ τ b γ hγ hτ hexpand hboundary henergy + +end KunGlobalActualAdditiveMidrankVariance + +namespace KunCommonRankArcInvariance + +open Filter Topology +open scoped BigOperators + +private theorem exists_maximizing_partition_ranks + {V : ℕ → Type*} + [∀ n, Fintype (V n)] [∀ n, DecidableEq (V n)] + (P : (n : ℕ) → Finpartition (Finset.univ : Finset (V n))) + (b : (n : ℕ) → V n → ℤ) : + ∃ j : (n : ℕ) → Finset (V n) → ℤ, + ∀ n C, C ∈ (P n).parts → + j n C ∈ C.image (b n) ∧ + ∀ k ∈ C.image (b n), + componentRankMass C (b n) k ≤ + componentRankMass C (b n) (j n C) := by + classical + let j : (n : ℕ) → Finset (V n) → ℤ := fun n C => + if h : C.Nonempty then + (exists_maximal_componentRankMass + C (b n) h).choose + else 0 + refine ⟨j, ?_⟩ + intro n C hC + have hn : C.Nonempty := (P n).nonempty_of_mem_parts hC + have h := (exists_maximal_componentRankMass + C (b n) hn).choose_spec + simpa only [j, dite_eq_left hn] using h + +private theorem maximizing_partition_rank_omitted_density_tendsto_zero + {V : ℕ → Type*} + [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + (P : (n : ℕ) → Finpartition (Finset.univ : Finset (V n))) + (b : (n : ℕ) → V n → ℤ) + (j : (n : ℕ) → Finset (V n) → ℤ) + (hmax : ∀ n C, C ∈ (P n).parts → + ∀ k ∈ C.image (b n), + componentRankMass C (b n) k ≤ + componentRankMass C (b n) (j n C)) + (hvariance : Tendsto + (fun n => + (∑ C ∈ (P n).parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C (b n))) / + Fintype.card (V n)) + atTop (nhds 0)) : + Tendsto + (fun n => + ((((Finset.univ : Finset (V n)) \ + RankArcCharging.selectedRankSupport + (P n) (b n) (j n)).card : ℝ) / + Fintype.card (V n))) + atTop (nhds 0) := by + classical + have hupper : Tendsto + (fun n => + (12 : ℝ) * + ((∑ C ∈ (P n).parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C (b n))) / + Fintype.card (V n))) + atTop (nhds 0) := by + simpa only [mul_zero] using + ((tendsto_const_nhds : + Tendsto (fun _ : ℕ => (12 : ℝ)) atTop (nhds 12)).mul + hvariance) + refine squeeze_zero (fun n => + div_nonneg (Nat.cast_nonneg _) (Nat.cast_nonneg _)) ?_ hupper + intro n + have hfinite := + actual_weighted_midrank_dominant_mass_le + (P n).parts (fun C : Finset (V n) => C) (b n) (j n) + (fun C hC => (P n).nonempty_of_mem_parts hC) + (fun C hC => hmax n C hC) + have hcard := + RankArcCharging.card_sdiff_selectedRankSupport + (P n) (b n) (j n) + have hcast : + ((((Finset.univ : Finset (V n)) \ + RankArcCharging.selectedRankSupport + (P n) (b n) (j n)).card : ℕ) : ℝ) = + ∑ C ∈ (P n).parts, + (((C.card - + (C.filter fun x => b n x = j n C).card : ℕ) : ℝ)) := by + exact_mod_cast hcard + calc + ((((Finset.univ : Finset (V n)) \ + RankArcCharging.selectedRankSupport + (P n) (b n) (j n)).card : ℝ) / + Fintype.card (V n)) ≤ + (12 * (∑ C ∈ (P n).parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C (b n)))) / + Fintype.card (V n) := by + apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg _) + rw [hcast] + exact hfinite + _ = (12 : ℝ) * + ((∑ C ∈ (P n).parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C (b n))) / + Fintype.card (V n)) := by + ring + +private theorem rankChangingArc_density_tendsto_zero_of_selected_support + {V : ℕ → Type*} + [∀ n, Fintype (V n)] [∀ n, Nonempty (V n)] + [∀ n, DecidableEq (V n)] + {κ : Type*} + (P : (n : ℕ) → Finpartition (Finset.univ : Finset (V n))) + (b : (n : ℕ) → V n → ℤ) + (j : (n : ℕ) → Finset (V n) → ℤ) + (w : (n : ℕ) → κ → Equiv.Perm (V n)) + (homitted : Tendsto + (fun n => + ((((Finset.univ : Finset (V n)) \ + RankArcCharging.selectedRankSupport + (P n) (b n) (j n)).card : ℝ) / + Fintype.card (V n))) + atTop (nhds 0)) + (hcross : ∀ i : κ, Tendsto + (fun n => + ((partitionWordCrossing + (P n) (w n i)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0)) : + ∀ i : κ, Tendsto + (fun n => + ((RankArcCharging.rankChangingArc + (Finset.univ : Finset (V n)) + (b n) (w n i)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0) := by + intro i + exact RankArcCharging.rankChangingArc_density_tendsto_zero + V (fun n => (Finset.univ : Finset (V n))) + P b j (fun n => w n i) + (fun n => (Fintype.card (V n) : ℝ)) + (fun n => by + exact_mod_cast Fintype.card_pos_iff.mpr inferInstance) + (hcross i) homitted + +public +theorem exists_common_rank_invariance_of_midrank_variance + {V : ℕ → Type*} + [∀ n, Fintype (V n)] [∀ n, Nonempty (V n)] + [∀ n, DecidableEq (V n)] + {κ : Type*} + (P : (n : ℕ) → Finpartition (Finset.univ : Finset (V n))) + (b : (n : ℕ) → V n → ℤ) + (w : (n : ℕ) → κ → Equiv.Perm (V n)) + (hvariance : Tendsto + (fun n => + (∑ C ∈ (P n).parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C (b n))) / + Fintype.card (V n)) + atTop (nhds 0)) + (hcross : ∀ i : κ, Tendsto + (fun n => + ((partitionWordCrossing + (P n) (w n i)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0)) : + ∃ j : (n : ℕ) → Finset (V n) → ℤ, + (∀ n C, C ∈ (P n).parts → + j n C ∈ C.image (b n) ∧ + ∀ k ∈ C.image (b n), + componentRankMass C (b n) k ≤ + componentRankMass C (b n) (j n C)) ∧ + Tendsto + (fun n => + ((((Finset.univ : Finset (V n)) \ + RankArcCharging.selectedRankSupport + (P n) (b n) (j n)).card : ℝ) / + Fintype.card (V n))) + atTop (nhds 0) ∧ + ∀ i : κ, Tendsto + (fun n => + ((RankArcCharging.rankChangingArc + (Finset.univ : Finset (V n)) + (b n) (w n i)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0) := by + obtain ⟨j, hj⟩ := exists_maximizing_partition_ranks P b + have homitted := + maximizing_partition_rank_omitted_density_tendsto_zero + P b j (fun n C hC => (hj n C hC).2) hvariance + exact ⟨j, hj, homitted, + rankChangingArc_density_tendsto_zero_of_selected_support + P b j w homitted hcross⟩ + +public +theorem sofic_action_inverse_normalizedHamming_tendsto_zero + {G : Type*} [Group G] + (A : SoficApproximation G) (g : G) : + Tendsto + (fun n => + normalizedHamming + (((A.model n).action g)⁻¹) + ((A.model n).action (g⁻¹))) + atTop (nhds 0) := by + have heq : + (fun n => + normalizedHamming + (((A.model n).action g)⁻¹) + ((A.model n).action (g⁻¹))) = + (fun n => + normalizedHamming + ((A.model n).action (g * g⁻¹)) + ((A.model n).action g * + (A.model n).action (g⁻¹))) := by + funext n + calc + normalizedHamming + (((A.model n).action g)⁻¹) + ((A.model n).action (g⁻¹)) = + normalizedHamming + ((A.model n).action g * + ((A.model n).action g)⁻¹) + ((A.model n).action g * + (A.model n).action (g⁻¹)) := + (normalizedHamming_mul_left + ((A.model n).action g) + (((A.model n).action g)⁻¹) + ((A.model n).action (g⁻¹))).symm + _ = normalizedHamming + ((A.model n).action (g * g⁻¹)) + ((A.model n).action g * + (A.model n).action (g⁻¹)) := by + simp only [mul_inv_cancel, (A.model n).map_one] + rw [heq] + exact A.multiplicative g (g⁻¹) + +end KunCommonRankArcInvariance + +namespace ChosenCayleyMatchedComponentRealization + +open Filter Topology +open KunActualSoficRootRadius +open KunResidualRetainedSelection +open scoped BigOperators Pointwise symmDiff + +private def sourceFirstFactorApproximation + {K J : Type*} [Group K] [Group J] + (A : SoficApproximation (K × J)) : + SoficApproximation K := + pullbackSoficApproximation + (MonoidHom.inl K J) + (fun _ _ h => congrArg Prod.fst h) + A + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def sourceFirstFactorCayleyRadiusBad + {K J : Type*} [Group K] [Group J] [DecidableEq K] + (A : SoficApproximation (K × J)) + (S : Finset K) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set K) = ⊤) + (n k : ℕ) : Finset (Fin (A.model n).size) := + chosenCayleyRadiusBad + (sourceFirstFactorApproximation A) + S (symmetricGeneratorWord S hsymmetric hgenerates) n k + +private theorem sourceFirstFactorCayleyRadiusBad_density_tendsto_zero + {K J : Type*} [Group K] [Group J] [DecidableEq K] + (A : SoficApproximation (K × J)) + (S : Finset K) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set K) = ⊤) + (k : ℕ) : + Tendsto + (fun n => + ((sourceFirstFactorCayleyRadiusBad + A S hsymmetric hgenerates n k).card : ℝ) / + (A.model n).size) + atTop (nhds 0) := by + exact chosenCayleyRadiusBad_density_tendsto_zero + (sourceFirstFactorApproximation A) + S (symmetricGeneratorWord S hsymmetric hgenerates) + (symmetricGeneratorWord_prod S hsymmetric hgenerates) k + +private theorem sourceFirstFactor_injective_ball + {K J : Type*} [Group K] [Group J] [DecidableEq K] + (A : SoficApproximation (K × J)) + (S : Finset K) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set K) = ⊤) + (n k : ℕ) + {x : Fin (A.model n).size} + (hx : x ∉ sourceFirstFactorCayleyRadiusBad + A S hsymmetric hgenerates n k) : + Set.InjOn + (fun g : K => (A.model n).action (g, 1) x) + (↑(S ^ k) : Set K) := by + exact chosenCayleyRadiusBad_injective_ball + (sourceFirstFactorApproximation A) + S (symmetricGeneratorWord S hsymmetric hgenerates) + n k hx + +end ChosenCayleyMatchedComponentRealization + +namespace CanonicalProductRadiusBadMatchedCapture + +open Filter Topology +open KunActualSoficRootRadius +open ChosenCayleyMatchedComponentRealization +open MatchedComponentCompletion +open MatchedComponentExitBudget +open scoped BigOperators Pointwise symmDiff + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def sourceProductRadiusLabels + {K J : Type*} [Group K] [Group J] + [DecidableEq K] [DecidableEq J] + (S : Finset K) (F : Finset J) (k : ℕ) : + Finset (K × J) := + ((S ^ k).image fun a : K => (a, (1 : J))) ∪ + (((CompressionCriterion.productTrackedTable F).image + fun j : J => ((1 : K), j)) ∪ + (S.biUnion fun a => + (CompressionCriterion.productTrackedTable F).image + fun j : J => (a, j))) + +public +theorem firstFactor_mem_sourceProductRadiusLabels + {K J : Type*} [Group K] [Group J] + [DecidableEq K] [DecidableEq J] + (S : Finset K) (F : Finset J) (k : ℕ) + {a : K} (ha : a ∈ S ^ k) : + (a, (1 : J)) ∈ sourceProductRadiusLabels S F k := by + apply Finset.mem_union_left + exact Finset.mem_image.mpr ⟨a, ha, rfl⟩ + +private theorem secondFactor_mem_sourceProductRadiusLabels + {K J : Type*} [Group K] [Group J] + [DecidableEq K] [DecidableEq J] + (S : Finset K) (F : Finset J) (k : ℕ) + {j : J} + (hj : j ∈ CompressionCriterion.productTrackedTable F) : + ((1 : K), j) ∈ sourceProductRadiusLabels S F k := by + apply Finset.mem_union_right + apply Finset.mem_union_left + exact Finset.mem_image.mpr ⟨j, hj, rfl⟩ + +private theorem composite_mem_sourceProductRadiusLabels + {K J : Type*} [Group K] [Group J] + [DecidableEq K] [DecidableEq J] + (S : Finset K) (F : Finset J) (k : ℕ) + {a : K} (ha : a ∈ S) + {j : J} + (hj : j ∈ CompressionCriterion.productTrackedTable F) : + (a, j) ∈ sourceProductRadiusLabels S F k := by + apply Finset.mem_union_right + apply Finset.mem_union_right + apply Finset.mem_biUnion.mpr + exact ⟨a, ha, Finset.mem_image.mpr ⟨j, hj, rfl⟩⟩ + +private theorem generator_mem_sourceProductRadiusLabels + {K J : Type*} [Group K] [Group J] + [DecidableEq K] [DecidableEq J] + (S : Finset K) (F : Finset J) (k : ℕ) + {a : K} (ha : a ∈ S) : + (a, (1 : J)) ∈ sourceProductRadiusLabels S F k := + composite_mem_sourceProductRadiusLabels S F k ha + (CompressionCriterion.one_mem_productTrackedTable F) + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def canonicalProductRadiusBad + {K J : Type*} [Group K] [Group J] + [DecidableEq K] [DecidableEq J] + (A : SoficApproximation (K × J)) + (S : Finset K) + (hsymmetric : ∀ a ∈ S, a⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set K) = ⊤) + (F : Finset J) (n k : ℕ) : + Finset (Fin (A.model n).size) := + sourceFirstFactorCayleyRadiusBad + A S hsymmetric hgenerates n k ∪ + finiteRootBad (A.model n) + (sourceProductRadiusLabels S F k) + +public +theorem canonicalProductRadiusBad_density_tendsto_zero + {K J : Type*} [Group K] [Group J] + [DecidableEq K] [DecidableEq J] + (A : SoficApproximation (K × J)) + (S : Finset K) + (hsymmetric : ∀ a ∈ S, a⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set K) = ⊤) + (F : Finset J) (k : ℕ) : + Tendsto + (fun n => + ((canonicalProductRadiusBad + A S hsymmetric hgenerates F n k).card : ℝ) / + (A.model n).size) + atTop (nhds 0) := by + have hfactor := + sourceFirstFactorCayleyRadiusBad_density_tendsto_zero + A S hsymmetric hgenerates k + have hproduct := + finiteRootBad_density_tendsto_zero + A (sourceProductRadiusLabels S F k) + have hsum : Tendsto + (fun n => + ((sourceFirstFactorCayleyRadiusBad + A S hsymmetric hgenerates n k).card : ℝ) / + (A.model n).size + + ((finiteRootBad (A.model n) + (sourceProductRadiusLabels S F k)).card : ℝ) / + (A.model n).size) + atTop (nhds 0) := by + simpa only [add_zero] using hfactor.add hproduct + refine squeeze_zero (fun n => by positivity) ?_ hsum + intro n + have hcard : + ((canonicalProductRadiusBad + A S hsymmetric hgenerates F n k).card : ℝ) ≤ + (sourceFirstFactorCayleyRadiusBad + A S hsymmetric hgenerates n k).card + + (finiteRootBad (A.model n) + (sourceProductRadiusLabels S F k)).card := by + exact_mod_cast Finset.card_union_le + (sourceFirstFactorCayleyRadiusBad + A S hsymmetric hgenerates n k) + (finiteRootBad (A.model n) + (sourceProductRadiusLabels S F k)) + calc + ((canonicalProductRadiusBad + A S hsymmetric hgenerates F n k).card : ℝ) / + (A.model n).size ≤ + (((sourceFirstFactorCayleyRadiusBad + A S hsymmetric hgenerates n k).card : ℝ) + + ((finiteRootBad (A.model n) + (sourceProductRadiusLabels S F k)).card : ℝ)) / + (A.model n).size := + div_le_div_of_nonneg_right hcard (by positivity) + _ = ((sourceFirstFactorCayleyRadiusBad + A S hsymmetric hgenerates n k).card : ℝ) / + (A.model n).size + + ((finiteRootBad (A.model n) + (sourceProductRadiusLabels S F k)).card : ℝ) / + (A.model n).size := by + rw [add_div] + +private theorem sourceWordTestBad_subset_finiteProductRootBad + {K J : Type*} [Group K] [Group J] + [DecidableEq K] [DecidableEq J] + (A : SoficApproximation (K × J)) + (S : Finset K) (F : Finset J) (n k : ℕ) : + sourceWordTestBad + (fun i : ↥S => (A.model n).action ((i : K), 1)) + (fun j : J => (A.model n).action (1, j)) + F ⊆ + finiteRootBad (A.model n) + (sourceProductRadiusLabels S F k) := by + classical + intro x hx + by_contra hxroot + simp only [sourceWordTestBad, Finset.mem_union, + Finset.mem_biUnion, Finset.mem_filter, + Finset.mem_univ, true_and] at hx + rcases hx with (hcomm | hmul) | hsep + · obtain ⟨i, j, hj, hfailure⟩ := hcomm + have hfirst := + finiteRootBad_multiplicative + (A.model n) (sourceProductRadiusLabels S F k) + (secondFactor_mem_sourceProductRadiusLabels + S F k hj) + (generator_mem_sourceProductRadiusLabels + S F k i.property) + hxroot + have hsecond := + finiteRootBad_multiplicative + (A.model n) (sourceProductRadiusLabels S F k) + (generator_mem_sourceProductRadiusLabels + S F k i.property) + (secondFactor_mem_sourceProductRadiusLabels + S F k hj) + hxroot + apply hfailure + calc + (A.model n).action (1, j) + ((A.model n).action ((i : K), 1) x) = + (A.model n).action ((1, j) * ((i : K), 1)) x := by + simpa only [Prod.mk_mul_mk, one_mul, mul_one, Equiv.Perm.mul_apply] using hfirst.symm + _ = (A.model n).action + (((i : K), 1) * (1, j)) x := by simp only [Prod.mk_mul_mk, one_mul, mul_one] + _ = (A.model n).action ((i : K), 1) + ((A.model n).action (1, j) x) := by + simpa only [Prod.mk_mul_mk, mul_one, one_mul, Equiv.Perm.mul_apply] using hsecond + · obtain ⟨j, hj, l, hl, hfailure⟩ := hmul + have hjT := + CompressionCriterion.mem_productTrackedTable hj + have hlT := + CompressionCriterion.mem_productTrackedTable hl + have hproduct := + finiteRootBad_multiplicative + (A.model n) (sourceProductRadiusLabels S F k) + (secondFactor_mem_sourceProductRadiusLabels + S F k hjT) + (secondFactor_mem_sourceProductRadiusLabels + S F k hlT) + hxroot + apply hfailure + simpa only [Prod.mk_mul_mk, mul_one, Equiv.Perm.mul_apply] using hproduct + · obtain ⟨j, hj, l, hl, hne, heq⟩ := hsep + have hjT := + CompressionCriterion.mem_productTrackedTable hj + have hlT := + CompressionCriterion.mem_productTrackedTable hl + have hne' : ((1 : K), j) ≠ ((1 : K), l) := by + intro h + exact hne (congrArg Prod.snd h) + exact finiteRootBad_separated + (A.model n) (sourceProductRadiusLabels S F k) + (secondFactor_mem_sourceProductRadiusLabels S F k hjT) + (secondFactor_mem_sourceProductRadiusLabels S F k hlT) + hne' hxroot heq + +public +theorem component_exit_mem_partitionWordCrossing + {V : Type*} [DecidableEq V] + {U : Finset V} (P : Finpartition U) + (C : Finset V) (hC : C ∈ P.parts) + (p : Equiv.Perm V) {x : V} + (hx : x ∈ C) (hout : p x ∉ C) : + x ∈ partitionWordCrossing P p := by + have hxU : x ∈ U := P.subset hC hx + change x ∈ U.filter fun y => p y ∉ P.part y + apply Finset.mem_filter.mpr + refine ⟨hxU, ?_⟩ + rwa [P.part_eq_of_mem hC hx] + +public +theorem sourceCompletionBad_subset_canonical_matchedRadiusBad + {K J : Type*} [Group K] [Group J] + [DecidableEq K] [DecidableEq J] + (A : SoficApproximation (K × J)) + (S : Finset K) + (hsymmetric : ∀ a ∈ S, a⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set K) = ⊤) + (F : Finset J) (n k : ℕ) + {U : Finset (Fin (A.model n).size)} + (P : Finpartition U) + (C : Finset (Fin (A.model n).size)) + (hC : C ∈ P.parts) : + sourceCompletionBad + (fun i : ↥S => (A.model n).action ((i : K), 1)) + (fun j : J => (A.model n).action (1, j)) + F C ⊆ + C ∩ matchedRadiusBad + P (sourceProductRadiusLabels S F k) + ((A.model n).action) + (canonicalProductRadiusBad + A S hsymmetric hgenerates F n k) := by + classical + intro x hx + have hxC : x ∈ C := + sourceCompletionBad_subset + (fun i : ↥S => (A.model n).action ((i : K), 1)) + (fun j : J => (A.model n).action (1, j)) + F C hx + refine Finset.mem_inter.mpr ⟨hxC, ?_⟩ + by_contra hnot + have hnotbad : + x ∉ canonicalProductRadiusBad + A S hsymmetric hgenerates F n k := by + intro hbad + apply hnot + exact Finset.mem_union_left _ hbad + have hroot : + x ∉ finiteRootBad (A.model n) + (sourceProductRadiusLabels S F k) := by + intro hbad + exact hnotbad (Finset.mem_union_right _ hbad) + have hnotcross : + ∀ q ∈ sourceProductRadiusLabels S F k, + x ∉ partitionWordCrossing + P ((A.model n).action q) := by + intro q hq hcross + apply hnot + apply Finset.mem_union_right + exact Finset.mem_biUnion.mpr ⟨q, hq, hcross⟩ + have hcovered := + sourceCompletionBad_subset_exit_union_wordBad + (fun i : ↥S => (A.model n).action ((i : K), 1)) + (fun j : J => (A.model n).action (1, j)) + F C hx + simp only [Finset.mem_union, Finset.mem_biUnion, + Finset.mem_filter, Finset.mem_univ, true_and] at hcovered + rcases hcovered with ((hgen | hfactor) | hcomposite) | hword + · obtain ⟨i, hx', hout⟩ := hgen + apply hnotcross + ((i : K), 1) + (generator_mem_sourceProductRadiusLabels + S F k i.property) + exact component_exit_mem_partitionWordCrossing + P C hC _ hx' hout + · obtain ⟨j, hj, hx', hout⟩ := hfactor + apply hnotcross + ((1 : K), j) + (secondFactor_mem_sourceProductRadiusLabels S F k hj) + exact component_exit_mem_partitionWordCrossing + P C hC _ hx' hout + · obtain ⟨i, j, hj, hx', hout⟩ := hcomposite + have hpair := + finiteRootBad_multiplicative + (A.model n) (sourceProductRadiusLabels S F k) + (secondFactor_mem_sourceProductRadiusLabels S F k hj) + (generator_mem_sourceProductRadiusLabels + S F k i.property) + hroot + have hvalue : + (A.model n).action ((i : K), j) x = + (A.model n).action (1, j) + ((A.model n).action ((i : K), 1) x) := by + simpa only [Prod.mk_mul_mk, one_mul, mul_one, Equiv.Perm.mul_apply] using hpair + apply hnotcross + ((i : K), j) + (composite_mem_sourceProductRadiusLabels + S F k i.property hj) + apply component_exit_mem_partitionWordCrossing + P C hC _ hx' + rw [hvalue] + exact hout + · apply hroot + exact sourceWordTestBad_subset_finiteProductRootBad + A S F n k hword + +public +theorem canonical_source_matched_component_cayley_ball_realization + {K J : Type*} [Group K] [Group J] + [DecidableEq K] [DecidableEq J] + (A : SoficApproximation (K × J)) + (S : Finset K) (honeS : 1 ∈ S) + (hsymmetric : ∀ a ∈ S, a⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set K) = ⊤) + (F : Finset J) (n k : ℕ) + {U : Finset (Fin (A.model n).size)} + (P : Finpartition U) + (C : Finset (Fin (A.model n).size)) + (hC : C ∈ P.parts) + (x : Fin (A.model n).size) (hx : x ∈ C) + (hgood : x ∉ + matchedRadiusBad + P (sourceProductRadiusLabels S F k) + ((A.model n).action) + (canonicalProductRadiusBad + A S hsymmetric hgenerates F n k)) : + ∃ f : K → Fin (A.model n).size, + Set.MapsTo f + (↑(S ^ (k / 2)) : Set K) + (↑C : Set (Fin (A.model n).size)) ∧ + Set.InjOn f (↑(S ^ (k / 2)) : Set K) := by + have hxsource : + x ∉ sourceFirstFactorCayleyRadiusBad + A S hsymmetric hgenerates n k := by + intro hbad + apply hgood + apply Finset.mem_union_left + exact Finset.mem_union_left _ hbad + have hroot := + sourceFirstFactor_injective_ball + A S hsymmetric hgenerates n k hxsource + refine ⟨fun a => (A.model n).action (a, 1) x, ?_, ?_⟩ + · intro a ha + have hak : a ∈ S ^ k := + Finset.pow_subset_pow_right honeS + (Nat.div_le_self k 2) ha + have halabel := + firstFactor_mem_sourceProductRadiusLabels S F k hak + have hnotcross : + x ∉ partitionWordCrossing + P ((A.model n).action (a, 1)) := by + intro hcross + apply hgood + apply Finset.mem_union_right + exact Finset.mem_biUnion.mpr + ⟨(a, 1), halabel, hcross⟩ + have himage : (A.model n).action (a, 1) x ∈ C := by + by_contra hout + apply hnotcross + exact component_exit_mem_partitionWordCrossing + P C hC _ hx hout + exact himage + · apply hroot.mono + intro a ha + exact Finset.pow_subset_pow_right honeS + (Nat.div_le_self k 2) ha + +end CanonicalProductRadiusBadMatchedCapture + +namespace CompletedSelectedCentralizerPairwiseSource + +open Filter Topology +open MatchedComponentCompletion +open MatchedFirstStageWordRadiusTransfer +open CanonicalProductRadiusBadMatchedCapture +open scoped BigOperators Pointwise + +private theorem eventually_five_mul_sourceCompletionBad_le_of_density + (V : ℕ → Type*) [∀ n, DecidableEq (V n)] + {ι J : Type*} [Fintype ι] [Group J] + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (p : (n : ℕ) → J → Equiv.Perm (V n)) + (F : Finset J) + (Z : (n : ℕ) → Finset (V n)) + (hZ : ∀ n, (Z n).Nonempty) + (hbad : Tendsto + (fun n => + ((sourceCompletionBad + (σ n) (p n) F (Z n)).card : ℝ) / (Z n).card) + atTop (nhds 0)) : + ∀ᶠ n in atTop, + 5 * (sourceCompletionBad + (σ n) (p n) F (Z n)).card ≤ (Z n).card := by + have hsmall : ∀ᶠ n in atTop, + ((sourceCompletionBad + (σ n) (p n) F (Z n)).card : ℝ) / + (Z n).card < (1 / 5 : ℝ) := + hbad.eventually (gt_mem_nhds (by norm_num)) + filter_upwards [hsmall] with n hn + have hpositive : (0 : ℝ) < (Z n).card := by + exact_mod_cast (hZ n).card_pos + have hreal := (div_lt_iff₀ hpositive).mp hn + have hstrict : + 5 * (sourceCompletionBad + (σ n) (p n) F (Z n)).card < (Z n).card := by + exact_mod_cast (show + (5 : ℝ) * (sourceCompletionBad + (σ n) (p n) F (Z n)).card < (Z n).card by + linarith) + exact hstrict.le + +public +theorem eventually_completed_sourceCentralizer_table_of_bad_density + (V : ℕ → Type*) [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + {ι J : Type*} [Fintype ι] [Group J] + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (p : (n : ℕ) → J → Equiv.Perm (V n)) + (F : Finset J) + (Z : (n : ℕ) → Finset (V n)) + (hZ : ∀ n, (Z n).Nonempty) + (hbad : Tendsto + (fun n => + ((sourceCompletionBad + (σ n) (p n) F (Z n)).card : ℝ) / + (Z n).card) + atTop (nhds 0)) + (σZ : (n : ℕ) → ι → + Equiv.Perm {x : V n // x ∈ Z n}) + (hσZ : ∀ n i (x : V n) (hx : x ∈ Z n) + (_hi : σ n i x ∈ Z n), + ((σZ n i ⟨x, hx⟩ : + {x : V n // x ∈ Z n}) : V n) = σ n i x) + (t : ℕ → ℕ) + (ht : ∀ n, + 2 * Fintype.card ι * + (sourceCompletionBad + (σ n) (p n) F (Z n)).card ≤ t n) : + ∀ᶠ n in atTop, + (∀ a ∈ F, ∀ b ∈ F, + 5 * permutationDistance + (completedRestriction (p n (a * b)) (Z n)) + (completedRestriction (p n a) (Z n) * + completedRestriction (p n b) (Z n)) ≤ + Fintype.card {x : V n // x ∈ Z n}) ∧ + (∀ a ∈ F, ∀ b ∈ F, a ≠ b → + Fintype.card {x : V n // x ∈ Z n} < + 5 * permutationDistance + (completedRestriction (p n a) (Z n)) + (completedRestriction (p n b) (Z n))) ∧ + (∀ a ∈ CompressionCriterion.productTrackedTable F, + permutationCommutationDefect + (σZ n) (completedRestriction (p n a) (Z n)) ≤ + t n) := by + have hevent := + eventually_five_mul_sourceCompletionBad_le_of_density + V σ p F Z hZ hbad + filter_upwards [hevent] with n hn + refine ⟨?_, ?_, ?_⟩ + · intro a ha b hb + have hdist := + completedRestriction_mul_distance_le_sourceCompletionBad + (σ n) (p n) F (Z n) ha hb + simpa only [Fintype.card_coe] using + (Nat.mul_le_mul_left 5 hdist).trans hn + · intro a ha b hb hab + exact completedRestriction_separated_of_sourceCompletionBad + (σ n) (p n) F (Z n) (hZ n) hn ha hb hab + · intro a ha + have hdef := + completedRestriction_commutationDefect_le_sourceCompletionBad + (σ n) (p n) F (Z n) + (σZ n) (hσZ n) ha + have hscale : + Fintype.card ι * + (sourceCompletionBad + (σ n) (p n) F (Z n)).card ≤ t n := by + have hdegree : Fintype.card ι ≤ 2 * Fintype.card ι := by + omega + exact (Nat.mul_le_mul_right + (sourceCompletionBad + (σ n) (p n) F (Z n)).card hdegree).trans (ht n) + exact hdef.trans hscale + +end CompletedSelectedCentralizerPairwiseSource + +namespace KunActualSelectedCentralizerFiniteModel + +open Filter Topology + +private noncomputable def trackedCompletedAlmostCentralizer + {V ι J : Type} [Fintype V] [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) + (p : J → Equiv.Perm V) + (F : Finset J) (t : ℕ) + (hdefect : ∀ j ∈ CompressionCriterion.productTrackedTable F, + permutationCommutationDefect σ (p j) ≤ t) : + J → AlmostCentralizerElement σ t := by + classical + intro j + by_cases hj : j ∈ CompressionCriterion.productTrackedTable F + · exact ⟨p j, hdefect j hj⟩ + · exact ⟨1, by simp only [permutationCommutationDefect_one, zero_le]⟩ + +private theorem trackedCompletedAlmostCentralizer_permutation_of_mem + {V ι J : Type} [Fintype V] [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) + (p : J → Equiv.Perm V) + (F : Finset J) (t : ℕ) + (hdefect : ∀ j ∈ CompressionCriterion.productTrackedTable F, + permutationCommutationDefect σ (p j) ≤ t) + {j : J} + (hj : j ∈ CompressionCriterion.productTrackedTable F) : + (trackedCompletedAlmostCentralizer σ p F t hdefect j).permutation = + p j := by + classical + simp only [trackedCompletedAlmostCentralizer, hj, ↓reduceDIte] + +private theorem trackedCompletedAlmostCentralizer_map_one + {V ι J : Type} [Fintype V] [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) + (p : J → Equiv.Perm V) + (hp : p 1 = 1) + (F : Finset J) (t : ℕ) + (hdefect : ∀ j ∈ CompressionCriterion.productTrackedTable F, + permutationCommutationDefect σ (p j) ≤ t) : + (trackedCompletedAlmostCentralizer σ p F t hdefect 1).permutation = 1 := by + rw [trackedCompletedAlmostCentralizer_permutation_of_mem + σ p F t hdefect + (CompressionCriterion.one_mem_productTrackedTable F), hp] + +private theorem trackedCompletedAlmostCentralizer_multiplicative + {V ι J : Type} [Fintype V] [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) + (p : J → Equiv.Perm V) + (F : Finset J) (t : ℕ) + (hdefect : ∀ j ∈ CompressionCriterion.productTrackedTable F, + permutationCommutationDefect σ (p j) ≤ t) + (hmul : ∀ x ∈ F, ∀ y ∈ F, + 5 * permutationDistance + (p (x * y)) (p x * p y) ≤ Fintype.card V) : + ∀ x ∈ F, ∀ y ∈ F, + 5 * permutationDistance + (trackedCompletedAlmostCentralizer + σ p F t hdefect (x * y)).permutation + ((trackedCompletedAlmostCentralizer + σ p F t hdefect x).permutation * + (trackedCompletedAlmostCentralizer + σ p F t hdefect y).permutation) ≤ Fintype.card V := by + intro x hx y hy + rw [trackedCompletedAlmostCentralizer_permutation_of_mem + σ p F t hdefect + (CompressionCriterion.mul_mem_productTrackedTable hx hy), + trackedCompletedAlmostCentralizer_permutation_of_mem + σ p F t hdefect + (CompressionCriterion.mem_productTrackedTable hx), + trackedCompletedAlmostCentralizer_permutation_of_mem + σ p F t hdefect + (CompressionCriterion.mem_productTrackedTable hy)] + exact hmul x hx y hy + +private theorem trackedCompletedAlmostCentralizer_separated + {V ι J : Type} [Fintype V] [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) + (p : J → Equiv.Perm V) + (F : Finset J) (t : ℕ) + (hdefect : ∀ j ∈ CompressionCriterion.productTrackedTable F, + permutationCommutationDefect σ (p j) ≤ t) + (hsep : ∀ x ∈ F, ∀ y ∈ F, x ≠ y → + Fintype.card V < 5 * permutationDistance (p x) (p y)) : + ∀ x ∈ F, ∀ y ∈ F, x ≠ y → + Fintype.card V < + 5 * permutationDistance + (trackedCompletedAlmostCentralizer + σ p F t hdefect x).permutation + (trackedCompletedAlmostCentralizer + σ p F t hdefect y).permutation := by + intro x hx y hy hxy + rw [trackedCompletedAlmostCentralizer_permutation_of_mem + σ p F t hdefect + (CompressionCriterion.mem_productTrackedTable hx), + trackedCompletedAlmostCentralizer_permutation_of_mem + σ p F t hdefect + (CompressionCriterion.mem_productTrackedTable hy)] + exact hsep x hx y hy hxy + +public +theorem nonempty_expandingCentralizerFiniteModel_of_selected_completed_sequence + {J : Type} [Group J] (F : Finset J) + (V : ℕ → Type) + [∀ n, Fintype (V n)] [∀ n, DecidableEq (V n)] + (ι : Type) [Fintype ι] + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (p : (n : ℕ) → J → Equiv.Perm (V n)) + (hp : ∀ n, p n 1 = 1) + (t : ℕ → ℕ) + (h : ℝ) (hpositive : 0 < h) + (hdefect : ∀ᶠ n in atTop, + ∀ j ∈ CompressionCriterion.productTrackedTable F, + permutationCommutationDefect + (σ n) (p n j) ≤ t n) + (hexp : ∀ᶠ n in atTop, ∀ E : Finset (V n), + h * min (E.card : ℝ) + ((Fintype.card (V n) : ℝ) - E.card) ≤ + (boundary (σ n) E : ℝ)) + (hsmall : ∀ᶠ n in atTop, + (10 : ℝ) * t n < h * Fintype.card (V n)) + (himprove : ∀ᶠ n in atTop, + HasAlmostCentralizerImprovement (σ n) (t n)) + (hmul : ∀ᶠ n in atTop, ∀ x ∈ F, ∀ y ∈ F, + 5 * permutationDistance + (p n (x * y)) (p n x * p n y) ≤ Fintype.card (V n)) + (hsep : ∀ᶠ n in atTop, ∀ x ∈ F, ∀ y ∈ F, x ≠ y → + Fintype.card (V n) < + 5 * permutationDistance (p n x) (p n y)) : + Nonempty (ExpandingCentralizerFiniteModel J F) := by + have hgood := hdefect.and + (hexp.and (hsmall.and (himprove.and (hmul.and hsep)))) + obtain ⟨n, hn⟩ := hgood.exists + obtain ⟨hdefect_n, hexp_n, hsmall_n, + himprove_n, hmul_n, hsep_n⟩ := hn + let f := trackedCompletedAlmostCentralizer + (σ n) (p n) F (t n) hdefect_n + refine ⟨expandingCentralizerFiniteModelOfImprovement + F (σ n) (t n) h hpositive hexp_n hsmall_n himprove_n + f ?_ ?_ ?_⟩ + · exact trackedCompletedAlmostCentralizer_map_one + (σ n) (p n) (hp n) F (t n) hdefect_n + · exact trackedCompletedAlmostCentralizer_multiplicative + (σ n) (p n) F (t n) hdefect_n hmul_n + · exact trackedCompletedAlmostCentralizer_separated + (σ n) (p n) F (t n) hdefect_n hsep_n + +end KunActualSelectedCentralizerFiniteModel + +namespace SourceTopLevelCompression + +open Filter + +public +theorem sourceLocalPrefixTranspositionGroup_lef_of_source_finite_models + (hmodels : + ∀ A : SoficApproximation + (prefixElementaryGroup ninePrefixCode), + Tendsto (fun n => (A.model n).size) atTop atTop → + ∀ F : Finset + (ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1]), + Nonempty (ExpandingCentralizerFiniteModel + (ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1]) F)) + (hsource : Sofic + (prefixElementaryGroup ninePrefixCode)) : + LEF + (ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1]) := by + let : Sofic + (prefixElementaryGroup ninePrefixCode) := + hsource + let : Countable + (prefixElementaryGroup ninePrefixCode) := + ninePrefixElementaryGroup_countable + obtain ⟨A, hA⟩ := exists_soficApproximation_size_tendsto + (prefixElementaryGroup ninePrefixCode) + exact lef_of_expanding_centralizer_models (hmodels A hA) + +end SourceTopLevelCompression + + +end SoficGroups + +end diff --git a/LeanPool/NonSoficGroup/Conclusion.lean b/LeanPool/NonSoficGroup/Conclusion.lean new file mode 100644 index 000000000..0c0a6d278 --- /dev/null +++ b/LeanPool/NonSoficGroup/Conclusion.lean @@ -0,0 +1,5446 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +module + +public import LeanPool.NonSoficGroup.Compression +import all LeanPool.NonSoficGroup.Compression + +/-! +# The finitely presented non-sofic group + +This file completes the finite-model obstruction and derives the headline +existence theorem. +-/ + +noncomputable section + +namespace SoficGroups + +open CanonicalProductRadiusBadMatchedCapture +open CompletedSelectedCentralizerPairwiseSource +open CompletedSourceFinalGeneratorTransfer +open KunActualSelectedCentralizerFiniteModel +open KunGlobalActualAdditiveMidrankVariance +open MatchedFirstStageWordRadiusTransfer +open SourceCommonComponentRankNoBad + +namespace ThompsonFFiniteQuotient + +variable {G : Type*} [Group G] + +/-- The conjugate of `b` by the `n`th power of `a`. -/ +public +def conjugateTerm (a b : G) (n : ℕ) : G := + (a ^ n)⁻¹ * b * a ^ n + +private theorem conjugateTerm_succ (a b : G) (n : ℕ) : + conjugateTerm a b (n + 1) = + a⁻¹ * conjugateTerm a b n * a := by + simp only [conjugateTerm, pow_succ, mul_inv_rev] + group + +private theorem conjugation_shift (a u v w : G) + (h : u⁻¹ * v * u = w) : + (a⁻¹ * u * a)⁻¹ * (a⁻¹ * v * a) * + (a⁻¹ * u * a) = a⁻¹ * w * a := by + calc + (a⁻¹ * u * a)⁻¹ * (a⁻¹ * v * a) * + (a⁻¹ * u * a) = a⁻¹ * (u⁻¹ * v * u) * a := by + group + _ = a⁻¹ * w * a := by rw [h] + +private theorem conjugacy_relation_of_commute (a b : G) (n : ℕ) + (h : Commute (a * b⁻¹) (conjugateTerm a b n)) : + b⁻¹ * conjugateTerm a b n * b = + conjugateTerm a b (n + 1) := by + rw [conjugateTerm_succ] + calc + b⁻¹ * conjugateTerm a b n * b = + a⁻¹ * ((a * b⁻¹) * conjugateTerm a b n) * b := by + group + _ = a⁻¹ * (conjugateTerm a b n * (a * b⁻¹)) * b := by + rw [h.eq] + _ = a⁻¹ * conjugateTerm a b n * a := by + group + +private theorem conjugacy_relation_shift (a b u : G) (n : ℕ) + (h : u⁻¹ * conjugateTerm a b n * u = + conjugateTerm a b (n + 1)) : + (a⁻¹ * u * a)⁻¹ * conjugateTerm a b (n + 1) * + (a⁻¹ * u * a) = conjugateTerm a b (n + 2) := by + rw [conjugateTerm_succ a b n, + conjugateTerm_succ a b (n + 1)] + exact conjugation_shift a u + (conjugateTerm a b n) (conjugateTerm a b (n + 1)) h + +private theorem conjugacy_relation_step (a b : G) (n : ℕ) + (hfirst : b⁻¹ * conjugateTerm a b 1 * b = + conjugateTerm a b 2) + (hprevious : b⁻¹ * conjugateTerm a b n * b = + conjugateTerm a b (n + 1)) + (hcurrent : b⁻¹ * conjugateTerm a b (n + 1) * b = + conjugateTerm a b (n + 2)) : + b⁻¹ * conjugateTerm a b (n + 2) * b = + conjugateTerm a b (n + 3) := by + have hone : conjugateTerm a b 1 = a⁻¹ * b * a := by + simp only [conjugateTerm, pow_one] + have hshift : + (conjugateTerm a b 1)⁻¹ * + conjugateTerm a b (n + 1) * + conjugateTerm a b 1 = + conjugateTerm a b (n + 2) := by + rw [hone] + exact conjugacy_relation_shift a b b n hprevious + have hdouble : + (conjugateTerm a b 2)⁻¹ * + conjugateTerm a b (n + 2) * + conjugateTerm a b 2 = + conjugateTerm a b (n + 3) := by + rw [conjugateTerm_succ a b 1] + exact conjugacy_relation_shift a b + (conjugateTerm a b 1) (n + 1) hshift + calc + b⁻¹ * conjugateTerm a b (n + 2) * b = + (b⁻¹ * conjugateTerm a b 1 * b)⁻¹ * + (b⁻¹ * conjugateTerm a b (n + 1) * b) * + (b⁻¹ * conjugateTerm a b 1 * b) := by + rw [← hshift] + group + _ = (conjugateTerm a b 2)⁻¹ * + conjugateTerm a b (n + 2) * + conjugateTerm a b 2 := by + rw [hfirst, hcurrent] + _ = conjugateTerm a b (n + 3) := hdouble + +private theorem conjugacy_relation_all (a b : G) + (hfirst : b⁻¹ * conjugateTerm a b 1 * b = + conjugateTerm a b 2) + (hsecond : b⁻¹ * conjugateTerm a b 2 * b = + conjugateTerm a b 3) (n : ℕ) : + b⁻¹ * conjugateTerm a b (n + 1) * b = + conjugateTerm a b (n + 2) := by + induction n using Nat.twoStepInduction with + | zero => exact hfirst + | one => exact hsecond + | more n hprevious hcurrent => + simpa only [Nat.add_assoc, Nat.reduceAdd] using conjugacy_relation_step a b (n + 1) hfirst + hprevious hcurrent + +private theorem finite_group_commute_of_thompsonF_two_relations + {G : Type*} [Group G] [Finite G] (a b : G) + (hfirst : Commute (a * b⁻¹) (a⁻¹ * b * a)) + (hsecond : Commute (a * b⁻¹) ((a ^ 2)⁻¹ * b * a ^ 2)) : + Commute a b := by + have hfirst' : b⁻¹ * conjugateTerm a b 1 * b = + conjugateTerm a b 2 := by + apply conjugacy_relation_of_commute a b 1 + simpa only [conjugateTerm, pow_one] using hfirst + have hsecond' : b⁻¹ * conjugateTerm a b 2 * b = + conjugateTerm a b 3 := by + apply conjugacy_relation_of_commute a b 2 + simpa only [conjugateTerm] using hsecond + have hpositive : 0 < orderOf a := orderOf_pos a + have hindex : orderOf a - 1 + 1 = orderOf a := + Nat.sub_add_cancel hpositive + have hnext : orderOf a - 1 + 2 = orderOf a + 1 := by + omega + have hperiod : conjugateTerm a b (orderOf a) = b := by + simp only [conjugateTerm, pow_orderOf_eq_one, inv_one, one_mul, mul_one] + have hconjugate : + conjugateTerm a b (orderOf a + 1) = a⁻¹ * b * a := by + rw [conjugateTerm_succ, hperiod] + have hrelation := conjugacy_relation_all a b hfirst' hsecond' + (orderOf a - 1) + rw [hindex, hnext, hperiod, hconjugate] at hrelation + have heq : b = a⁻¹ * b * a := by + simpa only [inv_mul_cancel, one_mul] using hrelation + change a * b = b * a + calc + a * b = a * (a⁻¹ * b * a) := congrArg (fun z : G => a * z) heq + _ = b * a := by group + +end ThompsonFFiniteQuotient + +namespace ThompsonFTwoRelatorLEF + +open scoped commutatorElement + +private def thompsonFRelator (n : ℕ) : FreeGroup (Fin 2) := + ⁅FreeGroup.of (0 : Fin 2) * (FreeGroup.of (1 : Fin 2))⁻¹, + ((FreeGroup.of (0 : Fin 2)) ^ n)⁻¹ * + FreeGroup.of (1 : Fin 2) * (FreeGroup.of (0 : Fin 2)) ^ n⁆ + +private def thompsonFGeneratorCommutator : FreeGroup (Fin 2) := + ⁅FreeGroup.of (0 : Fin 2), FreeGroup.of (1 : Fin 2)⁆ + +private theorem not_lef_of_thompsonF_two_relations + {G : Type*} [Group G] (a b : G) + (h₁ : Commute (a * b⁻¹) (a⁻¹ * b * a)) + (h₂ : Commute (a * b⁻¹) ((a ^ 2)⁻¹ * b * a ^ 2)) + (hne : ¬ Commute a b) + (hfinite : ∀ (n : ℕ) (x y : Equiv.Perm (Fin n)), + Commute (x * y⁻¹) (x⁻¹ * y * x) → + Commute (x * y⁻¹) ((x ^ 2)⁻¹ * y * x ^ 2) → + Commute x y) : + ¬ LEF G := by + classical + intro hlef + let φ : FreeGroup (Fin 2) →* G := FreeGroup.lift ![a, b] + let r₁ : FreeGroup (Fin 2) := thompsonFRelator 1 + let r₂ : FreeGroup (Fin 2) := thompsonFRelator 2 + let w : FreeGroup (Fin 2) := thompsonFGeneratorCommutator + let tracked : Finset (FreeGroup (Fin 2)) := {r₁, r₂, w} + let controls : FreeGroup (Fin 2) → Finset G := + fun q => Classical.choose (exists_local_word_control φ q) + have hcontrols (q : FreeGroup (Fin 2)) : + ∀ (H : Type) [Group H] (f : G → H), + LocalMultiplicativeOn (controls q) f → + FreeGroup.lift (fun i => f (φ (FreeGroup.of i))) q = f (φ q) := + Classical.choose_spec (exists_local_word_control φ q) + let support : Finset G := + insert 1 (insert (φ w) (tracked.biUnion controls)) + obtain ⟨n, f, hf_inj, hf_local⟩ := hlef.approximate support + let ψ : FreeGroup (Fin 2) →* Equiv.Perm (Fin n) := + FreeGroup.lift (fun i => f (φ (FreeGroup.of i))) + have hword (q : FreeGroup (Fin 2)) (hq : q ∈ tracked) : + ψ q = f (φ q) := by + apply hcontrols q (Equiv.Perm (Fin n)) f + apply hf_local.mono + intro z hz + simp only [support, Finset.mem_insert, Finset.mem_biUnion] + exact Or.inr (Or.inr ⟨q, hq, hz⟩) + have hφ₁ : φ r₁ = 1 := by + simpa [φ, r₁, thompsonFRelator] using h₁.commutator_eq + have hφ₂ : φ r₂ = 1 := by + simpa [φ, r₂, thompsonFRelator] using h₂.commutator_eq + have hψ₁ : ψ r₁ = 1 := by + calc + ψ r₁ = f (φ r₁) := hword r₁ (by simp only [Finset.mem_insert, Finset.mem_singleton, true_or, + tracked]) + _ = 1 := by rw [hφ₁, hf_local.map_one] + have hψ₂ : ψ r₂ = 1 := by + calc + ψ r₂ = f (φ r₂) := hword r₂ (by simp only [Finset.mem_insert, Finset.mem_singleton, true_or, + or_true, tracked]) + _ = 1 := by rw [hφ₂, hf_local.map_one] + have hf₁ : + Commute (f a * (f b)⁻¹) ((f a)⁻¹ * f b * f a) := by + apply commutatorElement_eq_one_iff_commute.mp + simpa [ψ, φ, r₁, thompsonFRelator] using hψ₁ + have hf₂ : + Commute (f a * (f b)⁻¹) + (((f a) ^ 2)⁻¹ * f b * (f a) ^ 2) := by + apply commutatorElement_eq_one_iff_commute.mp + simpa [ψ, φ, r₂, thompsonFRelator] using hψ₂ + have hψw : ψ w = 1 := by + simpa [ψ, φ, w, thompsonFGeneratorCommutator] using + (hfinite n (f a) (f b) hf₁ hf₂).commutator_eq + have hφw : φ w ≠ 1 := by + intro hz + apply hne + apply commutatorElement_eq_one_iff_commute.mp + simpa [φ, w, thompsonFGeneratorCommutator] using hz + apply hφw + apply hf_inj + · simp only [Finset.coe_insert, Finset.coe_biUnion, SetLike.mem_coe, Set.mem_insert_iff, + Set.mem_iUnion, + exists_prop, true_or, or_true, support] + · simp only [Finset.coe_insert, Finset.coe_biUnion, SetLike.mem_coe, Set.mem_insert_iff, + Set.mem_iUnion, + exists_prop, true_or, support] + calc + f (φ w) = ψ w := (hword w (by simp only [Finset.mem_insert, Finset.mem_singleton, or_true, + tracked])).symm + _ = 1 := hψw + _ = f 1 := hf_local.map_one.symm + +end ThompsonFTwoRelatorLEF + +namespace ThompsonFLocalWitness + +open ThompsonPrefixInsertion + +private theorem prefixWordAction_inv {g : BinaryLeavittˣ} + {a b : List (Fin 2)} (h : PrefixWordAction g a b) : + PrefixWordAction g⁻¹ b a := by + have hunit : (↑g⁻¹ : BinaryLeavitt) * (g : BinaryLeavitt) = 1 := by + simp only [Units.inv_mul] + constructor + · calc + (↑g⁻¹ : BinaryLeavitt) * leavittWordS b = + (↑g⁻¹ : BinaryLeavitt) * + ((g : BinaryLeavitt) * leavittWordS a) := by + rw [h.prefixing] + _ = ((↑g⁻¹ : BinaryLeavitt) * (g : BinaryLeavitt)) * + leavittWordS a := by rw [mul_assoc] + _ = leavittWordS a := by rw [hunit, one_mul] + · change leavittWordT b * (g : BinaryLeavitt) = leavittWordT a + calc + leavittWordT b * (g : BinaryLeavitt) = + (leavittWordT a * (↑g⁻¹ : BinaryLeavitt)) * + (g : BinaryLeavitt) := by rw [h.deletion] + _ = leavittWordT a * + ((↑g⁻¹ : BinaryLeavitt) * (g : BinaryLeavitt)) := by + rw [mul_assoc] + _ = leavittWordT a := by rw [hunit, mul_one] + +private theorem prefixWordAction_prefixInsertion {g : BinaryLeavittˣ} + {a b : List (Fin 2)} (l : List (Fin 2)) + (h : PrefixWordAction g a b) : + PrefixWordAction (prefixInsertionHom l g) (l ++ a) (l ++ b) := by + have hl := leavittWordT_mul_wordS_self l + have hl' (x : BinaryLeavitt) : + leavittWordT l * (leavittWordS l * x) = x := by + rw [← mul_assoc, hl, one_mul] + constructor + · rw [prefixInsertionHom_val, leavittWordS_append, + leavittWordS_append] + simp only [leavittCylinder] + noncomm_ring [hl, hl', h.prefixing] + · have hinv : + (prefixInsertionHom l g)⁻¹ = prefixInsertionHom l g⁻¹ := + ((prefixInsertionHom l).map_inv g).symm + rw [hinv, prefixInsertionHom_val, leavittWordT_append, + leavittWordT_append] + simp only [leavittCylinder] + noncomm_ring [hl, hl', h.deletion] + rw [← mul_assoc, h.deletion] + +private def rootRotation : BinaryLeavittˣ := + cylinderSwap [0] [1, 0] (by decide) (by decide) * + cylinderSwap [0] [1, 1] (by decide) (by decide) * + cylinderSwap [0] [1] (by decide) (by decide) + +private def rightRotation : BinaryLeavittˣ := + prefixInsertionHom [1] rootRotation + +private theorem rootRotation_action_zero_zero : + PrefixWordAction rootRotation [0, 0] [0] := by + unfold rootRotation + rw [mul_assoc] + refine prefixWordAction_mul (b := [1, 0]) ?_ ?_ + · exact ThompsonFiniteGeneration.cylinderSwap_prefixWordAction_of_cases + (by decide) (by decide) (by decide) + · refine prefixWordAction_mul (b := [1, 0]) ?_ ?_ + · exact ThompsonFiniteGeneration.cylinderSwap_prefixWordAction_of_cases + (by decide) (by decide) (by decide) + · exact ThompsonFiniteGeneration.cylinderSwap_prefixWordAction_of_cases + (by decide) (by decide) (by decide) + +private theorem rootRotation_action_zero_one : + PrefixWordAction rootRotation [0, 1] [1, 0] := by + unfold rootRotation + rw [mul_assoc] + refine prefixWordAction_mul (b := [0]) ?_ ?_ + · exact ThompsonFiniteGeneration.cylinderSwap_prefixWordAction_of_cases + (by decide) (by decide) (by decide) + · refine prefixWordAction_mul (b := [1, 1]) ?_ ?_ + · exact ThompsonFiniteGeneration.cylinderSwap_prefixWordAction_of_cases + (by decide) (by decide) (by decide) + · exact ThompsonFiniteGeneration.cylinderSwap_prefixWordAction_of_cases + (by decide) (by decide) (by decide) + +private theorem rootRotation_action_one : + PrefixWordAction rootRotation [1] [1, 1] := by + unfold rootRotation + rw [mul_assoc] + refine prefixWordAction_mul (b := [1, 1]) ?_ ?_ + · exact ThompsonFiniteGeneration.cylinderSwap_prefixWordAction_of_cases + (by decide) (by decide) (by decide) + · refine prefixWordAction_mul (b := [0]) ?_ ?_ + · exact ThompsonFiniteGeneration.cylinderSwap_prefixWordAction_of_cases + (by decide) (by decide) (by decide) + · exact ThompsonFiniteGeneration.cylinderSwap_prefixWordAction_of_cases + (by decide) (by decide) (by decide) + +private theorem generatorB_eq_prefixInsertion : + rightRotation⁻¹ = prefixInsertionHom [1] rootRotation⁻¹ := by + change + (prefixInsertionHom [1] rootRotation)⁻¹ = + prefixInsertionHom [1] rootRotation⁻¹ + exact ((prefixInsertionHom [1]).map_inv rootRotation).symm + +private theorem generator_two_eq_prefixInsertion : + rootRotation⁻¹⁻¹ * rightRotation⁻¹ * rootRotation⁻¹ = + prefixInsertionHom [1, 1] rootRotation⁻¹ := by + calc + rootRotation⁻¹⁻¹ * rightRotation⁻¹ * rootRotation⁻¹ = + rootRotation * prefixInsertionHom [1] rootRotation⁻¹ * + rootRotation⁻¹ := by + rw [generatorB_eq_prefixInsertion] + simp only [inv_inv, Fin.isValue, map_inv] + _ = prefixInsertionHom [1, 1] rootRotation⁻¹ := + prefixInsertionHom_conjugate_of_prefixWordAction + rootRotation [1] [1, 1] rootRotation_action_one rootRotation⁻¹ + +private theorem generator_three_eq_prefixInsertion : + (rootRotation⁻¹ ^ 2)⁻¹ * rightRotation⁻¹ * rootRotation⁻¹ ^ 2 = + prefixInsertionHom [1, 1, 1] rootRotation⁻¹ := by + have hrotation : + PrefixWordAction rootRotation [1, 1] [1, 1, 1] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using + prefixWordAction_append rootRotation_action_one [1] + calc + (rootRotation⁻¹ ^ 2)⁻¹ * rightRotation⁻¹ * rootRotation⁻¹ ^ 2 = + rootRotation * + (rootRotation⁻¹⁻¹ * rightRotation⁻¹ * rootRotation⁻¹) * + rootRotation⁻¹ := by + simp only [pow_two, mul_inv_rev, inv_inv, mul_assoc] + _ = rootRotation * prefixInsertionHom [1, 1] rootRotation⁻¹ * + rootRotation⁻¹ := by rw [generator_two_eq_prefixInsertion] + _ = prefixInsertionHom [1, 1, 1] rootRotation⁻¹ := + prefixInsertionHom_conjugate_of_prefixWordAction + rootRotation [1, 1] [1, 1, 1] hrotation rootRotation⁻¹ + +private theorem generator_difference_action_one_one : + PrefixWordAction (rootRotation⁻¹ * rightRotation⁻¹⁻¹) [1, 1] [1, 1] := by + have hrotation : + PrefixWordAction rootRotation [1, 1] [1, 1, 1] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using + prefixWordAction_append rootRotation_action_one [1] + have hright : + PrefixWordAction rightRotation [1, 1] [1, 1, 1] := by + unfold rightRotation + simpa only [Fin.isValue, List.cons_append, List.nil_append] using + prefixWordAction_prefixInsertion [1] rootRotation_action_one + change + PrefixWordAction + (rootRotation⁻¹ * (rightRotation⁻¹)⁻¹) [1, 1] [1, 1] + simp only [inv_inv] + exact prefixWordAction_mul (prefixWordAction_inv hrotation) hright + +private theorem commute_prefixInsertion_of_prefixWordAction_fixed + (g : BinaryLeavittˣ) (w : List (Fin 2)) + (h : PrefixWordAction g w w) (u : BinaryLeavittˣ) : + Commute g (prefixInsertionHom w u) := by + have hconjugate := + prefixInsertionHom_conjugate_of_prefixWordAction g w w h u + apply (commute_iff_eq _ _).2 + calc + g * prefixInsertionHom w u = + (g * prefixInsertionHom w u * g⁻¹) * g := by group + _ = prefixInsertionHom w u * g := by rw [hconjugate] + +private theorem relator_one : + Commute (rootRotation⁻¹ * rightRotation⁻¹⁻¹) + (rootRotation⁻¹⁻¹ * rightRotation⁻¹ * rootRotation⁻¹) := by + rw [generator_two_eq_prefixInsertion] + exact commute_prefixInsertion_of_prefixWordAction_fixed + (rootRotation⁻¹ * rightRotation⁻¹⁻¹) [1, 1] + generator_difference_action_one_one rootRotation⁻¹ + +private theorem relator_two : + Commute (rootRotation⁻¹ * rightRotation⁻¹⁻¹) + ((rootRotation⁻¹ ^ 2)⁻¹ * rightRotation⁻¹ * rootRotation⁻¹ ^ 2) := by + rw [generator_three_eq_prefixInsertion] + apply commute_prefixInsertion_of_prefixWordAction_fixed + (rootRotation⁻¹ * rightRotation⁻¹⁻¹) [1, 1, 1] _ rootRotation⁻¹ + simpa only [Fin.isValue, List.cons_append, List.nil_append] using + prefixWordAction_append generator_difference_action_one_one [1] + +private theorem cylinderSwap_mem_binaryPrefixTranspositionGroup + (a b : List (Fin 2)) + (hab : ¬ a <+: b) (hba : ¬ b <+: a) : + cylinderSwap a b hab hba ∈ binaryPrefixTranspositionGroup := + Subgroup.subset_closure ⟨a, b, hab, hba, rfl⟩ + +private theorem rootRotation_mem_binaryPrefixTranspositionGroup : + rootRotation ∈ binaryPrefixTranspositionGroup := by + unfold rootRotation + exact binaryPrefixTranspositionGroup.mul_mem + (binaryPrefixTranspositionGroup.mul_mem + (cylinderSwap_mem_binaryPrefixTranspositionGroup + [0] [1, 0] (by decide) (by decide)) + (cylinderSwap_mem_binaryPrefixTranspositionGroup + [0] [1, 1] (by decide) (by decide))) + (cylinderSwap_mem_binaryPrefixTranspositionGroup + [0] [1] (by decide) (by decide)) + +private theorem generatorA_mem_binaryPrefixTranspositionGroup : + rootRotation⁻¹ ∈ binaryPrefixTranspositionGroup := + binaryPrefixTranspositionGroup.inv_mem + rootRotation_mem_binaryPrefixTranspositionGroup + +private theorem generatorB_mem_binaryPrefixTranspositionGroup : + rightRotation⁻¹ ∈ binaryPrefixTranspositionGroup := by + rw [generatorB_eq_prefixInsertion] + exact prefixInsertionHom_mem_binaryPrefixTranspositionGroup + [1] rootRotation⁻¹ generatorA_mem_binaryPrefixTranspositionGroup + +private theorem generators_not_commute : ¬ Commute rootRotation⁻¹ rightRotation⁻¹ := by + have ha_zero_one : + PrefixWordAction rootRotation⁻¹ [1, 0] [0, 1] := + prefixWordAction_inv rootRotation_action_zero_one + have ha_one : + PrefixWordAction rootRotation⁻¹ [1, 1] [1] := + prefixWordAction_inv rootRotation_action_one + have hb_one_one_zero : + PrefixWordAction rightRotation⁻¹ [1, 1, 0] [1, 0, 1] := by + apply prefixWordAction_inv + unfold rightRotation + simpa only [Fin.isValue, List.cons_append, List.nil_append] using + prefixWordAction_prefixInsertion [1] rootRotation_action_zero_one + have hb_one_zero : + PrefixWordAction rightRotation⁻¹ [1, 0] [1, 0, 0] := by + apply prefixWordAction_inv + unfold rightRotation + simpa only [Fin.isValue, List.cons_append, List.nil_append] using + prefixWordAction_prefixInsertion [1] rootRotation_action_zero_zero + have hab : + PrefixWordAction (rootRotation⁻¹ * rightRotation⁻¹) + [1, 1, 0] [0, 1, 1] := + prefixWordAction_mul + (by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using + prefixWordAction_append ha_zero_one [1]) + hb_one_one_zero + have hba : + PrefixWordAction (rightRotation⁻¹ * rootRotation⁻¹) + [1, 1, 0] [1, 0, 0] := + prefixWordAction_mul hb_one_zero + (by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using + prefixWordAction_append ha_one [0]) + intro hcommute + have hwords : + leavittWordS [0, 1, 1] = leavittWordS [1, 0, 0] := by + calc + leavittWordS [0, 1, 1] = + (↑(rootRotation⁻¹ * rightRotation⁻¹) : BinaryLeavitt) * + leavittWordS [1, 1, 0] := hab.prefixing.symm + _ = (↑(rightRotation⁻¹ * rootRotation⁻¹) : BinaryLeavitt) * + leavittWordS [1, 1, 0] := by rw [hcommute.eq] + _ = leavittWordS [1, 0, 0] := hba.prefixing + apply (one_ne_zero : (1 : BinaryLeavitt) ≠ 0) + calc + (1 : BinaryLeavitt) = + leavittWordT [0, 1, 1] * leavittWordS [0, 1, 1] := + (leavittWordT_mul_wordS_self [0, 1, 1]).symm + _ = leavittWordT [0, 1, 1] * leavittWordS [1, 0, 0] := by + rw [hwords] + _ = 0 := leavittWordT_mul_wordS_of_incomparable + [0, 1, 1] [1, 0, 0] (by decide) (by decide) + +private def sourceGeneratorA : + localPrefixTranspositionGroup [0, 0, 0, 1] := + ⟨prefixInsertionHom [0, 0, 0, 1] rootRotation⁻¹, + ⟨rootRotation⁻¹, generatorA_mem_binaryPrefixTranspositionGroup, rfl⟩⟩ + +private def sourceGeneratorB : + localPrefixTranspositionGroup [0, 0, 0, 1] := + ⟨prefixInsertionHom [0, 0, 0, 1] rightRotation⁻¹, + ⟨rightRotation⁻¹, generatorB_mem_binaryPrefixTranspositionGroup, rfl⟩⟩ + +private theorem source_relator_one : + Commute (sourceGeneratorA * sourceGeneratorB⁻¹) + (sourceGeneratorA⁻¹ * sourceGeneratorB * sourceGeneratorA) := by + apply (commute_iff_eq _ _).2 + apply Subtype.ext + simpa only [sourceGeneratorA, sourceGeneratorB, + Subgroup.coe_mul, Subgroup.coe_inv, map_mul, map_inv] using + (relator_one.map + (prefixInsertionHom [0, 0, 0, 1])).eq + +private theorem source_relator_two : + Commute (sourceGeneratorA * sourceGeneratorB⁻¹) + ((sourceGeneratorA ^ 2)⁻¹ * sourceGeneratorB * + sourceGeneratorA ^ 2) := by + apply (commute_iff_eq _ _).2 + apply Subtype.ext + simpa only [sourceGeneratorA, sourceGeneratorB, + Subgroup.coe_mul, Subgroup.coe_inv, Subgroup.coe_pow, + map_mul, map_inv, map_pow] using + (relator_two.map + (prefixInsertionHom [0, 0, 0, 1])).eq + +private theorem source_generators_not_commute : + ¬ Commute sourceGeneratorA sourceGeneratorB := by + intro hcommute + apply generators_not_commute + apply Commute.of_map + (prefixInsertionHom_injective [0, 0, 0, 1]) + apply (commute_iff_eq _ _).2 + have heq := congrArg + (fun x : + localPrefixTranspositionGroup [0, 0, 0, 1] => + (x : BinaryLeavittˣ)) hcommute.eq + simpa only [sourceGeneratorA, sourceGeneratorB, Subgroup.coe_mul] + using heq + +end ThompsonFLocalWitness + +section + +private theorem sourceLocalPrefixTranspositionGroup_notLEF : + ¬ LEF + (ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1]) := by + apply ThompsonFTwoRelatorLEF.not_lef_of_thompsonF_two_relations + ThompsonFLocalWitness.sourceGeneratorA + ThompsonFLocalWitness.sourceGeneratorB + ThompsonFLocalWitness.source_relator_one + ThompsonFLocalWitness.source_relator_two + ThompsonFLocalWitness.source_generators_not_commute + intro n x y hfirst hsecond + exact ThompsonFFiniteQuotient.finite_group_commute_of_thompsonF_two_relations + x y hfirst hsecond + +end + +namespace KunUnconditionalActualSourceDecomposition + +open Filter Topology +open KunSourceUnconditionalFullDecomposition +open KunExactActualSourceAmbientGenerators +open KunUnconditionalActualSourceGeneratorData + +private theorem exists_unconditional_actual_source_dual_finpartition_sequences + (A : SoficApproximation + (prefixElementaryGroup + ninePrefixCode)) : + ∃ (SΓ : Finset + (prefixElementaryGroup + alphaPrefixCode)) + (SG : Finset + (prefixElementaryGroup + ninePrefixCode)) + (QΓ QG : (n : ℕ) → + Finpartition + (Finset.univ : Finset (Fin (A.model n).size))) + (γΓ γG : ℝ), + SG = sourceAmbientSymmetricGenerators SΓ ∧ + 1 ∈ SΓ ∧ + (∀ g ∈ SΓ, g⁻¹ ∈ SΓ) ∧ + Subgroup.closure + (SΓ : Set + (prefixElementaryGroup + alphaPrefixCode)) = ⊤ ∧ + 1 ∈ SG ∧ + (∀ g ∈ SG, g⁻¹ ∈ SG) ∧ + Subgroup.closure + (SG : Set + (prefixElementaryGroup + ninePrefixCode)) = ⊤ ∧ + Function.Injective sourceAlphaInclusion ∧ + Subgroup.closure + (Set.range (sourcePositiveGeneratorMap SΓ)) = ⊤ ∧ + 0 < γΓ ∧ + 0 < γG ∧ + (∀ n, ∀ C ∈ (QΓ n).parts, + ∀ E : Finset (Fin (A.model n).size), + E ⊆ C → + 2 * E.card ≤ C.card → + γΓ * (E.card : ℝ) ≤ + (boundary + (fun i : ↥SΓ => + (A.model n).action + (sourceAlphaInclusion (i : + prefixElementaryGroup + alphaPrefixCode))) E : ℝ)) ∧ + (∀ n, ∀ C ∈ (QG n).parts, + ∀ E : Finset (Fin (A.model n).size), + E ⊆ C → + 2 * E.card ≤ C.card → + γG * (E.card : ℝ) ≤ + (boundary + (fun i : ↥SG => + (A.model n).action (i : + prefixElementaryGroup + ninePrefixCode)) E : ℝ)) ∧ + Tendsto + (fun n => + (∑ C ∈ (QΓ n).parts, + (boundary + (fun i : ↥SΓ => + (A.model n).action + (sourceAlphaInclusion (i : + prefixElementaryGroup + alphaPrefixCode))) C : ℝ)) / + (A.model n).size) + atTop (𝓝 0) ∧ + Tendsto + (fun n => + (∑ C ∈ (QG n).parts, + (boundary + (fun i : ↥SG => + (A.model n).action (i : + prefixElementaryGroup + ninePrefixCode)) C : ℝ)) / + (A.model n).size) + atTop (𝓝 0) := by + classical + obtain ⟨SΓ, PΓ, PG, honeΓ, hsymmetricΓ, hgeneratesΓ, + hPΓ, honeG, hsymmetricG, hgeneratesG, hPG, + hfaithful, hpositive⟩ := + exists_unconditional_actual_source_generator_data + let SG := sourceAmbientSymmetricGenerators SΓ + have hcoverΓ : PΓ.generators ⊆ SΓ := by + rw [hPΓ] + have hcoverG : PG.generators ⊆ SG := by + dsimp [SG] + rw [hPG] + obtain ⟨γΓ, γG, QΓ, QG, hγΓ, hγG, hexpΓ, + hexpG, hboundaryΓ, hboundaryG⟩ := + exists_source_subgroup_and_ambient_full_finpartition_sequences + A sourceAlphaInclusion hfaithful + PΓ PG SΓ SG honeΓ honeG hcoverΓ hcoverG + hsymmetricΓ hsymmetricG hgeneratesΓ hgeneratesG + exact ⟨SΓ, SG, QΓ, QG, γΓ, γG, rfl, + honeΓ, hsymmetricΓ, hgeneratesΓ, + honeG, hsymmetricG, hgeneratesG, hfaithful, + hpositive, hγΓ, hγG, hexpΓ, hexpG, + hboundaryΓ, hboundaryG⟩ + +end KunUnconditionalActualSourceDecomposition + +open KunUnconditionalActualSourceDecomposition + +namespace KunCombinedPrescribedRootSourceTolerance + +open Filter Topology + +private theorem eventually_scaled_tolerance_lt + (N t : ℕ → ℕ) + (hN : ∀ n, 0 < N n) + (ht : Tendsto (fun n => (t n : ℝ) / (N n : ℝ)) atTop (𝓝 0)) + (c ell : ℝ) (hc : 0 < c) (hell : 0 < ell) : + ∀ᶠ n in atTop, c * (t n : ℝ) < ell * (N n : ℝ) := by + have hthreshold : 0 < ell / c := div_pos hell hc + filter_upwards [ht.eventually (gt_mem_nhds hthreshold)] with n hn + have hNreal : (0 : ℝ) < N n := by + exact_mod_cast hN n + have hratio : (t n : ℝ) < (ell / c) * (N n : ℝ) := + (div_lt_iff₀ hNreal).mp hn + calc + c * (t n : ℝ) < c * ((ell / c) * (N n : ℝ)) := + mul_lt_mul_of_pos_left hratio hc + _ = ell * (N n : ℝ) := by + field_simp + +private theorem union_card_ratio_tendsto_zero + (V : ℕ → Type*) + [∀ n, Fintype (V n)] [∀ n, DecidableEq (V n)] + (hVpositive : ∀ n, 0 < Fintype.card (V n)) + (left right : (n : ℕ) → Finset (V n)) + (hleft : Tendsto + (fun n => ((left n).card : ℝ) / Fintype.card (V n)) + atTop (𝓝 0)) + (hright : Tendsto + (fun n => ((right n).card : ℝ) / Fintype.card (V n)) + atTop (𝓝 0)) : + Tendsto + (fun n => ((left n ∪ right n).card : ℝ) / + Fintype.card (V n)) + atTop (𝓝 0) := by + have hsum : Tendsto + (fun n => + ((left n).card : ℝ) / Fintype.card (V n) + + ((right n).card : ℝ) / Fintype.card (V n)) + atTop (𝓝 0) := by + simpa only [zero_add] using hleft.add hright + refine squeeze_zero (fun _ => by positivity) ?_ hsum + intro n + have hcard : + ((left n ∪ right n).card : ℝ) ≤ + ((left n).card : ℝ) + ((right n).card : ℝ) := by + exact_mod_cast Finset.card_union_le (left n) (right n) + calc + ((left n ∪ right n).card : ℝ) / Fintype.card (V n) ≤ + (((left n).card : ℝ) + ((right n).card : ℝ)) / + Fintype.card (V n) := + div_le_div_of_nonneg_right hcard + (by exact_mod_cast (hVpositive n).le) + _ = ((left n).card : ℝ) / Fintype.card (V n) + + ((right n).card : ℝ) / Fintype.card (V n) := by ring + +private theorem scaled_card_le_augmented_budget + {V : Type*} + (d extra : ℕ) (selected combined : Finset V) + (hsubset : selected ⊆ combined) : + 2 * d * selected.card ≤ 2 * d * combined.card + extra + 1 := by + have hcard := Finset.card_le_card hsubset + have hscaled : 2 * d * selected.card ≤ 2 * d * combined.card := + Nat.mul_le_mul_left (2 * d) hcard + omega + +private theorem exists_prescribed_radius_union_source_completed_tolerance + (V : ℕ → Type*) + [∀ n, Fintype (V n)] [∀ n, DecidableEq (V n)] + (hVpositive : ∀ n, 0 < Fintype.card (V n)) + (hV : Tendsto (fun n => Fintype.card (V n)) atTop atTop) + (root : (n : ℕ) → ℕ → Finset (V n)) + (source : (n : ℕ) → Finset (V n)) + (hroot : ∀ r : ℕ, + Tendsto + (fun n => ((root n r).card : ℝ) / Fintype.card (V n)) + atTop (𝓝 0)) + (hsource : Tendsto + (fun n => ((source n).card : ℝ) / Fintype.card (V n)) + atTop (𝓝 0)) + (δ : ℕ → ℝ) + (hδpositive : ∀ j, 0 < δ j) + (hδ : Tendsto δ atTop (𝓝 0)) + (R : ℕ → ℕ) (hR : ∀ j, j ≤ R j) + (d : ℕ) (hd : 0 < d) + (ell q : ℝ) (hell : 0 < ell) (hq : q < 1) : + ∃ m rootError t : ℕ → ℕ, + Tendsto m atTop atTop ∧ + Tendsto (fun n => R (m n)) atTop atTop ∧ + Tendsto (fun n => δ (m n)) atTop (𝓝 0) ∧ + Tendsto + (fun n => + (((root n (R (m n)) ∪ source n).card : ℝ) / + (δ (m n) * (Fintype.card (V n) : ℝ)))) + atTop (𝓝 0) ∧ + (∀ n, + rootError n = + Nat.ceil (δ (m n) * (Fintype.card (V n) : ℝ))) ∧ + (∀ n, + δ (m n) ≤ + (rootError n : ℝ) / (Fintype.card (V n) : ℝ)) ∧ + Tendsto + (fun n => + (rootError n : ℝ) / (Fintype.card (V n) : ℝ)) + atTop (𝓝 0) ∧ + (∀ n, + t n = + 2 * d * (root n (R (m n)) ∪ source n).card + + rootError n + 1) ∧ + (∀ n, 0 < t n) ∧ + (∀ n, + 2 * d * (root n (R (m n))).card ≤ t n) ∧ + (∀ n, + 2 * d * (source n).card ≤ t n) ∧ + (∀ n, rootError n ≤ t n) ∧ + Tendsto + (fun n => + (t n : ℝ) / (Fintype.card (V n) : ℝ)) + atTop (𝓝 0) ∧ + (∀ n, + ell * δ (m n) / (2 * (ell + 8 * (d : ℝ))) ≤ + ell * (t n : ℝ) / + (2 * (ell + 8 * (d : ℝ)) * + (Fintype.card (V n) : ℝ))) ∧ + (∀ᶠ n in atTop, + (10 : ℝ) * (t n : ℝ) < + ell * (Fintype.card (V n) : ℝ)) ∧ + (∀ᶠ n in atTop, + (5 : ℝ) * + (4 + ell * + (216 / ((d : ℝ) * (1 - q) ^ 2) + + 1 / (d : ℝ))) * (t n : ℝ) ≤ + ell * (Fintype.card (V n) : ℝ)) := by + classical + let N : ℕ → ℕ := fun n => Fintype.card (V n) + let B : (n : ℕ) → ℕ → Finset (V n) := + fun n j => root n (R j) ∪ source n + have hNpositive (n : ℕ) : (0 : ℝ) < N n := by + exact_mod_cast hVpositive n + have hunion (j : ℕ) : + Tendsto + (fun n => ((B n j).card : ℝ) / (N n : ℝ)) + atTop (𝓝 0) := by + simpa only [B, N] using + union_card_ratio_tendsto_zero V hVpositive + (fun n => root n (R j)) source (hroot (R j)) hsource + let e : ℕ → ℕ → ℝ := fun n j => + (((B n j).card : ℝ) / (N n : ℝ)) / δ j + have hepositive (n j : ℕ) : 0 ≤ e n j := by + dsimp [e] + exact div_nonneg + (div_nonneg (Nat.cast_nonneg _) (hNpositive n).le) + (hδpositive j).le + have hevanishes (j : ℕ) : + Tendsto (fun n => e n j) atTop (𝓝 0) := by + simpa only [zero_div] using (hunion j).div_const (δ j) + obtain ⟨m, hm, herror⟩ := + exists_diverging_radius_with_vanishing_diagonal_error + e hepositive hevanishes + have hδm : Tendsto (fun n => δ (m n)) atTop (𝓝 0) := + hδ.comp hm + have hRm : Tendsto (fun n => R (m n)) atTop atTop := + tendsto_atTop_mono (fun n => hR (m n)) hm + have hrelative : Tendsto + (fun n => + ((B n (m n)).card : ℝ) / + (δ (m n) * (N n : ℝ))) + atTop (𝓝 0) := by + convert herror using 1 + funext n + dsimp [e] + ring + have hbadselected : Tendsto + (fun n => ((B n (m n)).card : ℝ) / (N n : ℝ)) + atTop (𝓝 0) := by + have hp := hrelative.mul hδm + convert hp using 1 + · funext n + have hne : δ (m n) ≠ 0 := (hδpositive (m n)).ne' + rw [div_mul_eq_mul_div, mul_comm _ (δ (m n)), + mul_div_mul_left _ _ hne] + · norm_num + have honeover : Tendsto + (fun n => (1 : ℝ) / (N n : ℝ)) + atTop (𝓝 0) := + (tendsto_one_div_atTop_nhds_zero_nat (𝕜 := ℝ)).comp hV + let rootError : ℕ → ℕ := + fun n => Nat.ceil (δ (m n) * (N n : ℝ)) + have hrootlower (n : ℕ) : + δ (m n) ≤ (rootError n : ℝ) / (N n : ℝ) := by + apply (le_div_iff₀ (hNpositive n)).2 + exact Nat.le_ceil _ + have hrootupper (n : ℕ) : + (rootError n : ℝ) / (N n : ℝ) ≤ + δ (m n) + 1 / (N n : ℝ) := by + apply (div_le_iff₀ (hNpositive n)).2 + have hceil := + (Nat.ceil_lt_add_one + (mul_nonneg (hδpositive (m n)).le + (hNpositive n).le)).le + have hone : (1 / (N n : ℝ)) * (N n : ℝ) = 1 := by + field_simp [ne_of_gt (hNpositive n)] + change (rootError n : ℝ) ≤ _ + dsimp [rootError] at hceil ⊢ + linarith only [hceil, hone] + have hrootlimit : Tendsto + (fun n => (rootError n : ℝ) / (N n : ℝ)) + atTop (𝓝 0) := by + have hupper : Tendsto + (fun n => δ (m n) + 1 / (N n : ℝ)) + atTop (𝓝 0) := by + simpa only [one_div, add_zero] using hδm.add honeover + exact squeeze_zero (fun n => by positivity) hrootupper hupper + let t : ℕ → ℕ := + fun n => 2 * d * (B n (m n)).card + rootError n + 1 + have htpositive (n : ℕ) : 0 < t n := by + dsimp [t] + omega + have hrootbudget (n : ℕ) : + 2 * d * (root n (R (m n))).card ≤ t n := by + apply scaled_card_le_augmented_budget + · dsimp [B] + exact Finset.subset_union_left + have hsourcebudget (n : ℕ) : + 2 * d * (source n).card ≤ t n := by + apply scaled_card_le_augmented_budget + · dsimp [B] + exact Finset.subset_union_right + have hrooterrorbudget (n : ℕ) : rootError n ≤ t n := by + dsimp [t] + omega + have htzero : Tendsto + (fun n => (t n : ℝ) / (N n : ℝ)) + atTop (𝓝 0) := by + have hscaled : Tendsto + (fun n => + ((2 * d : ℕ) : ℝ) * + (((B n (m n)).card : ℝ) / (N n : ℝ))) + atTop (𝓝 0) := by + simpa only [Nat.cast_mul, Nat.cast_ofNat, mul_zero] using hbadselected.const_mul ((2 * d : ℕ) + : ℝ) + have hsum := (hscaled.add hrootlimit).add honeover + convert hsum using 1 + · funext n + dsimp [t] + push_cast + ring + · norm_num + have hdreal : (0 : ℝ) < d := by + exact_mod_cast hd + have hden : 0 < (2 : ℝ) * (ell + 8 * (d : ℝ)) := by + positivity + have htarget (n : ℕ) : + ell * δ (m n) / (2 * (ell + 8 * (d : ℝ))) ≤ + ell * (t n : ℝ) / + (2 * (ell + 8 * (d : ℝ)) * (N n : ℝ)) := by + have hratio : δ (m n) ≤ (t n : ℝ) / (N n : ℝ) := by + calc + δ (m n) ≤ (rootError n : ℝ) / (N n : ℝ) := + hrootlower n + _ ≤ (t n : ℝ) / (N n : ℝ) := by + apply div_le_div_of_nonneg_right + (by exact_mod_cast hrooterrorbudget n) + (hNpositive n).le + calc + ell * δ (m n) / (2 * (ell + 8 * (d : ℝ))) ≤ + ell * ((t n : ℝ) / (N n : ℝ)) / + (2 * (ell + 8 * (d : ℝ))) := by + apply div_le_div_of_nonneg_right + (mul_le_mul_of_nonneg_left hratio hell.le) hden.le + _ = ell * (t n : ℝ) / + (2 * (ell + 8 * (d : ℝ)) * (N n : ℝ)) := by + field_simp [ne_of_gt (hNpositive n), ne_of_gt hden] + have hten : + ∀ᶠ n in atTop, + (10 : ℝ) * (t n : ℝ) < ell * (N n : ℝ) := + eventually_scaled_tolerance_lt + N t (fun n => hVpositive n) htzero + 10 ell (by norm_num) hell + let c : ℝ := + 5 * (4 + ell * + (216 / ((d : ℝ) * (1 - q) ^ 2) + 1 / (d : ℝ))) + have hdiff : 0 < 1 - q := sub_pos.mpr hq + have hc : 0 < c := by + dsimp [c] + positivity + have hspectral : + ∀ᶠ n in atTop, + c * (t n : ℝ) ≤ ell * (N n : ℝ) := + (eventually_scaled_tolerance_lt + N t (fun n => hVpositive n) htzero c ell hc hell).mono + fun _ h => h.le + refine ⟨m, rootError, t, hm, hRm, hδm, + ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · simpa only [B, N] using hrelative + · intro n + rfl + · simpa only [N] using hrootlower + · simpa only [N] using hrootlimit + · intro n + rfl + · exact htpositive + · exact hrootbudget + · exact hsourcebudget + · exact hrooterrorbudget + · simpa only [N] using htzero + · simpa only [N] using htarget + · simpa only [N] using hten + · simpa only [N, c] using hspectral + +end KunCombinedPrescribedRootSourceTolerance + +open KunCombinedPrescribedRootSourceTolerance + +namespace KunLiteralSourceSelectedComponents + +open Filter Topology +open scoped BigOperators Pointwise + +private def sourceConjugacyDisagreementBad + {G : Type*} [Group G] + (A : SoficApproximation G) + (u g : G) (n : ℕ) : Finset (Fin (A.model n).size) := by + classical + exact Finset.univ.filter fun x => + (A.model n).action (u * g * u⁻¹) x ≠ + ((A.model n).action u * (A.model n).action g * + ((A.model n).action u)⁻¹) x + +private theorem sourceConjugacyDisagreementBad_density_tendsto_zero + {G : Type*} [Group G] + (A : SoficApproximation G) + (u g : G) : + Tendsto + (fun n => + ((sourceConjugacyDisagreementBad A u g n).card : ℝ) / + (A.model n).size) + atTop (nhds 0) := by + classical + simpa only [sourceConjugacyDisagreementBad, Equiv.Perm.coe_mul, Equiv.Perm.coe_inv, + Function.comp_apply, + ne_eq, normalizedHamming, hammingDist, Fintype.card_fin] using + SourceCompressionTransportCrossing.tendsto_action_conjugate A u g + +end KunLiteralSourceSelectedComponents + +namespace KunActualBothTransportedOverlapScales + +open Filter Topology +open scoped BigOperators + +private theorem source_both_transported_generator_boundary_density_tendsto_zero + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (S : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure + (S : Set + (prefixElementaryGroup alphaPrefixCode)) = + ⊤) + (Q : ∀ n, Finpartition + (Finset.univ : Finset (Fin (A.model n).size))) + (hsource : Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥S => + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode))) C : ℝ)) / + (A.model n).size) + atTop (nhds 0)) : + ∀ j : Fin 2, Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥S => + (A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j) * + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode)) * + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j))⁻¹) + C : ℝ)) / + (A.model n).size) + atTop (nhds 0) := by + classical + have hsource' : Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥S => + (A.model n).action + (SourceGeneratedWordCrossing.sourceAlphaInclusion + (i : prefixElementaryGroup + alphaPrefixCode))) C : ℝ)) / + (A.model n).size) + atTop (nhds 0) := by + exact hsource + intro j + have hcross (i : ↥S) : Tendsto + (fun n => + ((partitionWordCrossing (Q n) + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j) * + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode)) * + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j))⁻¹)).card : + ℝ) / + (A.model n).size) + atTop (nhds 0) := by + obtain ⟨k, hk⟩ := + SourceBothCompressionNormalization.sourceCompressionTable_conjugates_alpha + j (i : prefixElementaryGroup + alphaPrefixCode) + have hword := + SourceGeneratedWordCrossing.source_alpha_word_crossing_density_tendsto_zero + A S hsymmetric hgenerates Q hsource' k + have hword' : Tendsto + (fun n => + ((partitionWordCrossing (Q n) + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j * + SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode) * + (SourceBothCompressionNormalization.sourceCompressionTable j)⁻¹))).card + : ℝ) / + (A.model n).size) + atTop (nhds 0) := by + rw [hk] + exact hword + exact + SourceCompressionTransportCrossing.conjugated_word_crossing_density_tendsto_zero + A + (SourceBothCompressionNormalization.sourceCompressionTable j) + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode)) + Q hword' + have hsum : Tendsto + (fun n => + ∑ i : ↥S, + ((partitionWordCrossing (Q n) + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j) * + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode)) * + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j))⁻¹)).card + : ℝ) / + (A.model n).size) + atTop (nhds 0) := by + simpa only [Finset.univ_eq_attach, Finset.sum_const_zero] using + tendsto_finsetSum Finset.univ (fun i _ => hcross i) + have hidentity (n : ℕ) : + (∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥S => + (A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j) * + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode)) * + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j))⁻¹) + C : ℝ)) / (A.model n).size = + ∑ i : ↥S, + ((partitionWordCrossing (Q n) + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j) * + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode)) * + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j))⁻¹)).card + : ℝ) / + (A.model n).size := by + have hnat := + SourceGeneratedWordCrossing.sum_generator_crossing_eq_sum_partition_boundary + (Q n) + (fun i : ↥S => + (A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j) * + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode)) * + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j))⁻¹) + have hreal : + (∑ i : ↥S, + ((partitionWordCrossing (Q n) + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j) * + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode)) * + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j))⁻¹)).card + : ℝ)) = + ∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥S => + (A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j) * + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode)) * + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j))⁻¹) + C : ℝ) := by + exact_mod_cast hnat + rw [← hreal, Finset.sum_div] + rw [show + (fun n => + (∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥S => + (A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j) * + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode)) * + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j))⁻¹) + C : ℝ)) / (A.model n).size) = + (fun n => + ∑ i : ↥S, + ((partitionWordCrossing (Q n) + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j) * + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode)) * + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j))⁻¹)).card + : ℝ) / + (A.model n).size) from funext hidentity] + exact hsum + +private theorem exists_source_both_common_slow_overlap_scales + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (S : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure + (S : Set + (prefixElementaryGroup alphaPrefixCode)) = + ⊤) + (Q : ∀ n, Finpartition + (Finset.univ : Finset (Fin (A.model n).size))) + (gamma : ℝ) (hgamma : 0 < gamma) + (hexpand : ∀ n C, C ∈ (Q n).parts → + ∀ E : Finset (Fin (A.model n).size), E ⊆ C → + 2 * E.card ≤ C.card → + gamma * (E.card : ℝ) ≤ + (boundary + (fun i : ↥S => + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode))) E : ℝ)) + (hsource : Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥S => + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode))) C : ℝ)) / + (A.model n).size) + atTop (nhds 0)) : + ∃ eta H : ℕ → ℝ, + (∀ n, 0 < eta n) ∧ + Antitone eta ∧ + Tendsto eta atTop (nhds 0) ∧ + (∀ n, 0 < H n) ∧ + Antitone H ∧ + Tendsto H atTop (nhds 0) ∧ + Tendsto (fun n => eta n / H n) atTop (nhds 0) ∧ + (∀ j : Fin 2, Tendsto + (fun n => + (∑ C ∈ insufficientOverlapComponents + (transportedUnivFinpartition + (Q n) + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j))) + (Q n) (eta n), (C.card : ℝ)) / + (A.model n).size) + atTop (nhds 0)) ∧ + (∀ j : Fin 2, Tendsto + (fun n => + (∑ C ∈ + (transportedUnivFinpartition + (Q n) + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j))).parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart (Q n) C).card : ℝ))) / + (A.model n).size) + atTop (nhds 0)) ∧ + ∃ N : ℕ, ∀ n : ℕ, eta (n + N) < 1 := by + classical + have hnonempty (n : ℕ) : Nonempty (Fin (A.model n).size) := + Fin.pos_iff_nonempty.mp (A.model n).size_pos + let : ∀ n, Nonempty (Fin (A.model n).size) := hnonempty + let σ : (n : ℕ) → ↥S → Equiv.Perm (Fin (A.model n).size) := + fun n i => + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode)) + let T : (n : ℕ) → Fin 2 → Equiv.Perm (Fin (A.model n).size) := + fun n j => + (A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j) + have hsource' : Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary (σ n) C : ℝ)) / + Fintype.card (Fin (A.model n).size)) + atTop (nhds 0) := by + simpa only [σ, Fintype.card_fin] using hsource + have htarget : ∀ j : Fin 2, Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary + (fun i => T n j * σ n i * (T n j)⁻¹) C : ℝ)) / + Fintype.card (Fin (A.model n).size)) + atTop (nhds 0) := by + intro j + simpa only [σ, T, Fintype.card_fin] using + source_both_transported_generator_boundary_density_tendsto_zero + A S hsymmetric hgenerates Q hsource j + obtain ⟨eta, H, heta, hetaanti, heta0, hH, hHanti, + hH0, hratio, hoverlap⟩ := + KunTransportedAmbientOverlap.exists_common_slow_overlap_scales_for_transported_partitions + Q σ T gamma hgamma + (by + intro n C hC E hE hhalf + simpa only [σ] using hexpand n C hC E hE hhalf) + hsource' htarget + have hloss : ∀ j : Fin 2, Tendsto + (fun n => + (∑ C ∈ + (transportedUnivFinpartition + (Q n) (T n j)).parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart (Q n) C).card : ℝ))) / + Fintype.card (Fin (A.model n).size)) + atTop (nhds 0) := by + intro j + apply + KunTransportedAmbientOverlap.dominant_component_loss_density_tendsto_zero + (fun n => + transportedUnivFinpartition (Q n) (T n j)) + Q (fun n i => T n j * σ n i * (T n j)⁻¹) + gamma hgamma + · intro n + exact + KunTransportedAmbientOverlap.transportedUnivFinpartition_half_expansion + (Q n) (σ n) (T n j) gamma + (fun C hC E hE hhalf => + by simpa only [σ] using hexpand n C hC E hE hhalf) + · exact + KunTransportedAmbientOverlap.transported_partition_boundary_density_tendsto_zero + Q σ (fun n => T n j) hsource' + · exact htarget j + have htail : ∃ N : ℕ, ∀ n : ℕ, eta (n + N) < 1 := by + have heventually : ∀ᶠ n in atTop, eta n < 1 := + heta0.eventually (gt_mem_nhds (by norm_num : (0 : ℝ) < 1)) + obtain ⟨N, hN⟩ := (eventually_atTop.1 heventually) + refine ⟨N, ?_⟩ + intro n + apply hN + omega + refine ⟨eta, H, heta, hetaanti, heta0, hH, hHanti, + hH0, hratio, ?_, ?_, htail⟩ + · intro j + simpa only [T, Fintype.card_fin] using hoverlap j + · intro j + simpa only [T, Fintype.card_fin] using hloss j + +end KunActualBothTransportedOverlapScales +namespace SourceProductThroughAlpha + +open Filter Topology +open scoped BigOperators + +universe v + +private def sourceCompressionUAlphaHom : + prefixElementaryGroup alphaPrefixCode →* + prefixElementaryGroup alphaZeroPrefixCode := + ((MulAut.conj compressionU).toMonoidHom.comp + (prefixElementaryGroup + alphaPrefixCode).subtype).codRestrict + (prefixElementaryGroup + alphaZeroPrefixCode) + (by + intro g + rw [← compressionU_map_alphaPrefixElementaryGroup] + exact ⟨g.val, g.property, rfl⟩) + +private noncomputable def sourceCompressionUAlphaEquiv : + prefixElementaryGroup alphaPrefixCode ≃* + prefixElementaryGroup alphaZeroPrefixCode := by + apply MulEquiv.ofBijective sourceCompressionUAlphaHom + constructor + · intro g g' heq + apply Subtype.ext + apply (MulAut.conj compressionU).injective + exact congrArg + (fun k : prefixElementaryGroup + alphaZeroPrefixCode => + (k : BinaryLeavittˣ)) heq + · intro k + have hk : + (k : BinaryLeavittˣ) ∈ + (prefixElementaryGroup + alphaPrefixCode).map + (MulAut.conj compressionU).toMonoidHom := by + rw [compressionU_map_alphaPrefixElementaryGroup] + exact k.property + obtain ⟨g, hg, heq⟩ := hk + refine ⟨⟨g, hg⟩, ?_⟩ + apply Subtype.ext + exact heq + +private noncomputable def sourceCompressedGeneratingFinset + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) : + Finset + (prefixElementaryGroup alphaZeroPrefixCode) := by + classical + exact SΓ.image sourceCompressionUAlphaEquiv + +private theorem sourceCompressedGeneratingFinset_one_mem + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hone : 1 ∈ SΓ) : + 1 ∈ sourceCompressedGeneratingFinset SΓ := by + classical + change 1 ∈ SΓ.image sourceCompressionUAlphaEquiv + exact Finset.mem_image.mpr + ⟨1, hone, map_one sourceCompressionUAlphaEquiv⟩ + +private theorem sourceCompressedGeneratingFinset_inv_mem + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hsymmetric : ∀ g ∈ SΓ, g⁻¹ ∈ SΓ) + (k : prefixElementaryGroup + alphaZeroPrefixCode) + (hk : k ∈ sourceCompressedGeneratingFinset SΓ) : + k⁻¹ ∈ sourceCompressedGeneratingFinset SΓ := by + classical + change k ∈ SΓ.image sourceCompressionUAlphaEquiv at hk + change k⁻¹ ∈ SΓ.image sourceCompressionUAlphaEquiv + obtain ⟨g, hg, rfl⟩ := Finset.mem_image.mp hk + exact Finset.mem_image.mpr + ⟨g⁻¹, hsymmetric g hg, + map_inv sourceCompressionUAlphaEquiv g⟩ + +private theorem sourceCompressedGeneratingFinset_closure + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hgenerates : Subgroup.closure + (SΓ : Set + (prefixElementaryGroup alphaPrefixCode)) = + ⊤) : + Subgroup.closure + (sourceCompressedGeneratingFinset SΓ : Set + (prefixElementaryGroup + alphaZeroPrefixCode)) = ⊤ := by + classical + change Subgroup.closure + ((SΓ.image sourceCompressionUAlphaEquiv : Finset + (prefixElementaryGroup + alphaZeroPrefixCode)) : Set + (prefixElementaryGroup + alphaZeroPrefixCode)) = ⊤ + rw [Finset.coe_image] + change + Subgroup.closure + (sourceCompressionUAlphaEquiv.toMonoidHom '' + (SΓ : Set + (prefixElementaryGroup + alphaPrefixCode))) = ⊤ + rw [← MonoidHom.map_closure, hgenerates, + Subgroup.map_top_of_surjective + sourceCompressionUAlphaEquiv.toMonoidHom + sourceCompressionUAlphaEquiv.surjective] + +private theorem exists_sourceCompressedKazhdanPair_with_same_generators + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hsymmetric : ∀ g ∈ SΓ, g⁻¹ ∈ SΓ) + (hgenerates : Subgroup.closure + (SΓ : Set + (prefixElementaryGroup alphaPrefixCode)) = + ⊤) : + ∃ P : KazhdanPair.{0, v} + (prefixElementaryGroup + alphaZeroPrefixCode), + P.generators = sourceCompressedGeneratingFinset SΓ := by + let : HasPropertyT.{0, v} + (prefixElementaryGroup + alphaZeroPrefixCode) := + alphaZeroPrefixElementaryGroup_hasPropertyT_unconditional + exact + KunExactKazhdanGeneratorChange.exists_kazhdanPair_with_exact_symmetric_generators + (sourceCompressedGeneratingFinset SΓ) + (sourceCompressedGeneratingFinset_inv_mem SΓ hsymmetric) + (sourceCompressedGeneratingFinset_closure SΓ hgenerates) + +private def sourceCompressedLocalProductToAlpha : + (prefixElementaryGroup alphaZeroPrefixCode × + ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1]) →* + prefixElementaryGroup alphaPrefixCode := + ThompsonPrefixInsertion.sourceCompressedLocalProductHom.codRestrict + (prefixElementaryGroup alphaPrefixCode) + (by + intro x + change + (x.1 : BinaryLeavittˣ) * + (x.2 : BinaryLeavittˣ) ∈ + prefixElementaryGroup alphaPrefixCode + exact + (prefixElementaryGroup + alphaPrefixCode).mul_mem + (alphaZero_prefixElementaryGroup_le x.1.property) + (ThompsonPrefixInsertion.sourceLocalPrefixTranspositionGroup_le_alpha_sourceWord + x.2.property)) + +private theorem sourceCompressedLocalProductEmbedding_factors_through_alpha : + SourceGeneratedWordCrossing.sourceAlphaInclusion.comp + sourceCompressedLocalProductToAlpha = + ThompsonPrefixInsertion.sourceCompressedLocalProductEmbedding := by + apply MonoidHom.ext + intro x + apply Subtype.ext + rfl + +private theorem source_compressed_local_product_word_crossing_density_tendsto_zero + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hsymmetric : ∀ g ∈ SΓ, g⁻¹ ∈ SΓ) + (hgenerates : Subgroup.closure + (SΓ : Set + (prefixElementaryGroup alphaPrefixCode)) = + ⊤) + (Q : ∀ n, Finpartition + (Finset.univ : Finset (Fin (A.model n).size))) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥SΓ => + (A.model n).action + (SourceGeneratedWordCrossing.sourceAlphaInclusion + i)) C : ℝ)) / + (A.model n).size) + atTop (𝓝 0)) + (z : prefixElementaryGroup + alphaZeroPrefixCode × + ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1]) : + Tendsto + (fun n => + ((partitionWordCrossing (Q n) + ((A.model n).action + (ThompsonPrefixInsertion.sourceCompressedLocalProductEmbedding + z))).card : ℝ) / + (A.model n).size) + atTop (𝓝 0) := by + have hfactor : + SourceGeneratedWordCrossing.sourceAlphaInclusion + (sourceCompressedLocalProductToAlpha z) = + ThompsonPrefixInsertion.sourceCompressedLocalProductEmbedding + z := by + simpa only [MonoidHom.comp_apply] using + DFunLike.congr_fun + sourceCompressedLocalProductEmbedding_factors_through_alpha z + have hword := + SourceGeneratedWordCrossing.source_alpha_word_crossing_density_tendsto_zero + A SΓ hsymmetric hgenerates Q hboundary + (sourceCompressedLocalProductToAlpha z) + simpa only [hfactor] using hword + +private theorem source_compressed_local_product_ball_crossing_density_tendsto_zero + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hsymmetric : ∀ g ∈ SΓ, g⁻¹ ∈ SΓ) + (hgenerates : Subgroup.closure + (SΓ : Set + (prefixElementaryGroup alphaPrefixCode)) = + ⊤) + (Q : ∀ n, Finpartition + (Finset.univ : Finset (Fin (A.model n).size))) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥SΓ => + (A.model n).action + (SourceGeneratedWordCrossing.sourceAlphaInclusion + i)) C : ℝ)) / + (A.model n).size) + atTop (𝓝 0)) + (I : ℕ → Finset + (prefixElementaryGroup + alphaZeroPrefixCode × + ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1])) + (k : ℕ) : + Tendsto + (fun n => + ((∑ z ∈ I k, + (partitionWordCrossing (Q n) + ((A.model n).action + (ThompsonPrefixInsertion.sourceCompressedLocalProductEmbedding + z))).card : ℕ) : ℝ) / + (A.model n).size) + atTop (𝓝 0) := by + have hsum : + Tendsto + (fun n => + ∑ z ∈ I k, + ((partitionWordCrossing (Q n) + ((A.model n).action + (ThompsonPrefixInsertion.sourceCompressedLocalProductEmbedding + z))).card : ℝ) / + (A.model n).size) + atTop (𝓝 0) := by + simpa only [Finset.sum_const_zero] using + tendsto_finsetSum (I k) + (fun z _ => + source_compressed_local_product_word_crossing_density_tendsto_zero A SΓ hsymmetric + hgenerates Q hboundary z) + simpa only [Nat.cast_sum, Finset.sum_div] using hsum + +private def sourceCompressedLocalProductApproximation + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) : + SoficApproximation + (prefixElementaryGroup + alphaZeroPrefixCode × + ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1]) := + pullbackSoficApproximation + ThompsonPrefixInsertion.sourceCompressedLocalProductEmbedding + ThompsonPrefixInsertion.sourceCompressedLocalProductEmbedding_injective + A + +@[simp] +private theorem sourceCompressedLocalProductApproximation_model_size + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (n : ℕ) : + ((sourceCompressedLocalProductApproximation A).model n).size = + (A.model n).size := by + rfl + +private theorem source_canonical_product_radius_crossing_density_tendsto_zero + [DecidableEq + (prefixElementaryGroup + alphaZeroPrefixCode)] + [DecidableEq + (ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1])] + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hsymmetric : ∀ g ∈ SΓ, g⁻¹ ∈ SΓ) + (hgenerates : Subgroup.closure + (SΓ : Set + (prefixElementaryGroup alphaPrefixCode)) = + ⊤) + (Q : ∀ n, Finpartition + (Finset.univ : Finset (Fin (A.model n).size))) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥SΓ => + (A.model n).action + (SourceGeneratedWordCrossing.sourceAlphaInclusion + i)) C : ℝ)) / + (A.model n).size) + atTop (𝓝 0)) + (F : Finset + (ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1])) + (k : ℕ) : + Tendsto + (fun n => + ((∑ z ∈ + CanonicalProductRadiusBadMatchedCapture.sourceProductRadiusLabels + (sourceCompressedGeneratingFinset SΓ) F k, + (partitionWordCrossing (Q n) + (((sourceCompressedLocalProductApproximation A).model n).action + z)).card : ℕ) : ℝ) / + ((sourceCompressedLocalProductApproximation A).model n).size) + atTop (𝓝 0) := by + change + Tendsto + (fun n => + ((∑ z ∈ + CanonicalProductRadiusBadMatchedCapture.sourceProductRadiusLabels + (sourceCompressedGeneratingFinset SΓ) F k, + (partitionWordCrossing (Q n) + ((A.model n).action + (ThompsonPrefixInsertion.sourceCompressedLocalProductEmbedding + z))).card : ℕ) : ℝ) / + (A.model n).size) + atTop (𝓝 0) + exact + source_compressed_local_product_ball_crossing_density_tendsto_zero + A SΓ hsymmetric hgenerates Q hboundary + (fun r => + CanonicalProductRadiusBadMatchedCapture.sourceProductRadiusLabels + (sourceCompressedGeneratingFinset SΓ) F r) + k + +end SourceProductThroughAlpha + +namespace SourceRetainedActualMatching + +open Filter Topology +open scoped BigOperators symmDiff + +private noncomputable def logarithmicComponentRank + {V : Type*} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) + (H r : ℝ) : V → ℤ := + MidrankPermutationEnergy.offsetFloorRank + (fun x => Real.log (partitionComponentSize Q x : ℝ)) + H r + +private noncomputable def retainedTransportedComponents + {V : Type*} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) (H r eta : ℝ) : Finset (Finset V) := + SourceCompressionRetainedDiscard.retainedComponents + (transportedUnivFinpartition Q T) Q T + (logarithmicComponentRank Q H r) eta + +private theorem retained_transport_component_matching_bounds + {V : Type*} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) + (H r eta : ℝ) (hH : 0 < H) + (C : Finset V) + (hC : C ∈ retainedTransportedComponents Q T H r eta) : + maximumOverlapPart Q C ∈ Q.parts ∧ + (1 - eta) * (C.card : ℝ) ≤ + ((C ∩ maximumOverlapPart Q C).card : ℝ) ∧ + ((C ∆ maximumOverlapPart Q C).card : ℝ) < + (Real.exp H - 1 + 2 * eta) * (C.card : ℝ) ∧ + (2 * (Real.exp H - 1 + 2 * eta) < 1 → + (maximumOverlapPart Q C).card < + 2 * (C ∩ maximumOverlapPart Q C).card) := by + classical + have hret : + C ∈ SourceCompressionRetainedDiscard.retainedComponents + (transportedUnivFinpartition Q T) Q T + (logarithmicComponentRank Q H r) eta := by + exact hC + obtain ⟨hpart, htarget, hoverlap, y, hy, hrank⟩ := + SourceCompressionRetainedDiscard.retainedComponents_spec + (transportedUnivFinpartition Q T) Q T + (logarithmicComponentRank Q H r) eta C hret + have hpartImage := hpart + rw [transportedUnivFinpartition_parts] at hpartImage + obtain ⟨C₀, hC₀, hmap⟩ := Finset.mem_image.mp hpartImage + have hyMap : y ∈ C₀.map T.toEmbedding := by + rw [hmap] + exact (Finset.mem_inter.mp hy).1 + obtain ⟨x, hx, hxy⟩ := Finset.mem_map.mp hyMap + have hxy' : T x = y := hxy + have hTx : + T x ∈ maximumOverlapPart Q + (C₀.map T.toEmbedding) := by + rw [hmap] + simpa only [hxy'] using (Finset.mem_inter.mp hy).2 + have hfloor : + MidrankPermutationEnergy.offsetFloorRank + (fun z : V => + Real.log (partitionComponentSize Q z : ℝ)) + H r (T x) = + MidrankPermutationEnergy.offsetFloorRank + (fun z : V => + Real.log (partitionComponentSize Q z : ℝ)) + H r x := by + have heq : + logarithmicComponentRank Q H r (T x) = + logarithmicComponentRank Q H r x := by + calc + logarithmicComponentRank Q H r (T x) = + logarithmicComponentRank Q H r y := + congrArg (logarithmicComponentRank Q H r) hxy' + _ = logarithmicComponentRank Q H r (T.symm y) := + hrank.symm + _ = logarithmicComponentRank Q H r x := by + rw [← hxy', Equiv.symm_apply_apply] + exact heq + have hsize := + SourceCompressionMatching.transported_maximumOverlapPart_card_lt_exp_mul + Q T C₀ hC₀ H r hH x hx hTx hfloor + rw [hmap] at hsize + have hcard : C.card = C₀.card := by + rw [← hmap, Finset.card_map] + rw [← hcard] at hsize + have hsymmetric := + SourceCompressionMatching.symmDiff_card_lt_of_overlap_and_exp_card + C (maximumOverlapPart Q C) H eta + hoverlap hsize + refine ⟨htarget, hoverlap, hsymmetric, ?_⟩ + intro hsmall + exact + SourceCompressionMatching.target_majority_of_overlap_and_exp_card + C (maximumOverlapPart Q C) + ((transportedUnivFinpartition Q T).nonempty_of_mem_parts hpart) + H eta hoverlap hsize hsmall + +private theorem retained_source_transport_matching_of_ambient_midrank_variance + (V : ℕ → Type*) + [∀ n, Fintype (V n)] [∀ n, Nonempty (V n)] + [∀ n, DecidableEq (V n)] + (κ : Type*) + (Q A : (n : ℕ) → Finpartition + (Finset.univ : Finset (V n))) + (T : (n : ℕ) → κ → Equiv.Perm (V n)) + (H r eta : ℕ → ℝ) + (hHpos : ∀ n, 0 < H n) + (hHzero : Tendsto H atTop (nhds 0)) + (heta0 : ∀ n, 0 ≤ eta n) + (hetazero : Tendsto eta atTop (nhds 0)) + (hvariance : Tendsto + (fun n => + (∑ C ∈ (A n).parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C + (logarithmicComponentRank (Q n) (H n) (r n)))) / + Fintype.card (V n)) + atTop (nhds 0)) + (hcross : ∀ i : κ, Tendsto + (fun n => + ((partitionWordCrossing + (A n) (T n i).symm).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0)) + (hoverlap : ∀ i : κ, Tendsto + (fun n => + ((∑ C ∈ insufficientOverlapComponents + (transportedUnivFinpartition (Q n) (T n i)) + (Q n) (eta n), C.card : ℕ) : ℝ) / + Fintype.card (V n)) + atTop (nhds 0)) : + ∀ i : κ, + (∀ n, retainedTransportedComponents + (Q n) (T n i) (H n) (r n) (eta n) ⊆ + (transportedUnivFinpartition + (Q n) (T n i)).parts) ∧ + (∀ n C, C ∈ retainedTransportedComponents + (Q n) (T n i) (H n) (r n) (eta n) → + maximumOverlapPart (Q n) C ∈ (Q n).parts) ∧ + (∀ n, eta n ≤ (1 : ℝ) / 2 → + 2 * (Real.exp (H n) - 1 + 2 * eta n) < 1 → + ∀ C, C ∈ retainedTransportedComponents + (Q n) (T n i) (H n) (r n) (eta n) → + (maximumOverlapPart (Q n) C).card < + 2 * (C ∩ maximumOverlapPart + (Q n) C).card) ∧ + Tendsto + (fun n => + (((Finset.univ : Finset (V n)) \ + matchedRetainedSupport + (retainedTransportedComponents + (Q n) (T n i) (H n) (r n) (eta n))).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0) ∧ + Tendsto + (fun n => + ((∑ C ∈ retainedTransportedComponents + (Q n) (T n i) (H n) (r n) (eta n), + (C ∆ maximumOverlapPart (Q n) C).card : + ℕ) : ℝ) / Fintype.card (V n)) + atTop (nhds 0) ∧ + (∀ n, 2 * (Real.exp (H n) - 1 + 2 * eta n) < 1 → + Set.InjOn (maximumOverlapPart (Q n)) + ((retainedTransportedComponents + (Q n) (T n i) (H n) (r n) (eta n) : + Finset (Finset (V n))) : + Set (Finset (V n)))) := by + let b : (n : ℕ) → V n → ℤ := + fun n => logarithmicComponentRank (Q n) (H n) (r n) + obtain ⟨_j, _hj, _homit, hrank⟩ := + KunCommonRankArcInvariance.exists_common_rank_invariance_of_midrank_variance + A b (fun n i => (T n i).symm) hvariance hcross + intro i + let P : (n : ℕ) → Finpartition + (Finset.univ : Finset (V n)) := + fun n => transportedUnivFinpartition (Q n) (T n i) + let R : (n : ℕ) → Finset (Finset (V n)) := + fun n => retainedTransportedComponents + (Q n) (T n i) (H n) (r n) (eta n) + have hparts (n : ℕ) : R n ⊆ (P n).parts := by + exact Finset.sdiff_subset + have htarget (n : ℕ) (C : Finset (V n)) (hC : C ∈ R n) : + maximumOverlapPart (Q n) C ∈ (Q n).parts := + (retained_transport_component_matching_bounds + (Q n) (T n i) (H n) (r n) (eta n) (hHpos n) C hC).1 + have hmajor (n : ℕ) + (_heta : eta n ≤ (1 : ℝ) / 2) + (hsmall : 2 * (Real.exp (H n) - 1 + 2 * eta n) < 1) + (C : Finset (V n)) (hC : C ∈ R n) : + (maximumOverlapPart (Q n) C).card < + 2 * (C ∩ maximumOverlapPart (Q n) C).card := + (retained_transport_component_matching_bounds + (Q n) (T n i) (H n) (r n) (eta n) (hHpos n) C hC).2.2.2 hsmall + have hbound (n : ℕ) (C : Finset (V n)) (hC : C ∈ R n) : + ((C ∆ maximumOverlapPart (Q n) C).card : ℝ) ≤ + (Real.exp (H n) - 1 + 2 * eta n) * (C.card : ℝ) := + (retained_transport_component_matching_bounds + (Q n) (T n i) (H n) (r n) (eta n) (hHpos n) C hC).2.2.1.le + have hdiscard : + Tendsto + (fun n => + (((Finset.univ : Finset (V n)) \ + matchedRetainedSupport (R n)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0) := by + exact + SourceCompressionRetainedDiscard.retained_missing_density_tendsto_zero + V P Q (fun n => T n i) b eta hetazero + (hoverlap i) (hrank i) + have hsymmetric : + Tendsto + (fun n => + ((∑ C ∈ R n, + (C ∆ maximumOverlapPart (Q n) C).card : + ℕ) : ℝ) / Fintype.card (V n)) + atTop (nhds 0) := by + have hfull (n : ℕ) : + (Finset.univ : Finset (V n)).Nonempty := + Finset.univ_nonempty + simpa only [Finset.card_univ] using + SourceCompressionMatching.symmDiff_density_tendsto_zero_of_log_rank_bounds + (V := V) (fun n => (Finset.univ : Finset (V n))) hfull + P R hparts (fun n => maximumOverlapPart (Q n)) + H eta (fun n => (hHpos n).le) heta0 hHzero hetazero + hbound + refine ⟨hparts, htarget, hmajor, hdiscard, hsymmetric, ?_⟩ + intro n hsmall + exact finpartition_dominant_matching_injOn + (P n) (R n) (hparts n) + (maximumOverlapPart (Q n)) + (fun C hC => + (retained_transport_component_matching_bounds + (Q n) (T n i) (H n) (r n) (eta n) + (hHpos n) C hC).2.2.2 hsmall) + +end SourceRetainedActualMatching + +namespace KunActualBothTransportedOverlapScales + +open Filter Topology +open scoped BigOperators + +private theorem exists_source_both_capped_overlap_scales + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (S : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure + (S : Set + (prefixElementaryGroup alphaPrefixCode)) = + ⊤) + (Q : ∀ n, Finpartition + (Finset.univ : Finset (Fin (A.model n).size))) + (gamma : ℝ) (hgamma : 0 < gamma) + (hexpand : ∀ n C, C ∈ (Q n).parts → + ∀ E : Finset (Fin (A.model n).size), E ⊆ C → + 2 * E.card ≤ C.card → + gamma * (E.card : ℝ) ≤ + (boundary + (fun i : ↥S => + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode))) E : ℝ)) + (hsource : Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥S => + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode))) C : ℝ)) / + (A.model n).size) + atTop (nhds 0)) : + ∃ eta H : ℕ → ℝ, + (∀ n, 0 < eta n) ∧ + (∀ n, eta n < 1) ∧ + Antitone eta ∧ + Tendsto eta atTop (nhds 0) ∧ + (∀ n, 0 < H n) ∧ + Antitone H ∧ + Tendsto H atTop (nhds 0) ∧ + Tendsto (fun n => eta n / H n) atTop (nhds 0) ∧ + (∀ j : Fin 2, Tendsto + (fun n => + (∑ C ∈ insufficientOverlapComponents + (transportedUnivFinpartition + (Q n) + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j))) + (Q n) (eta n), (C.card : ℝ)) / + (A.model n).size) + atTop (nhds 0)) ∧ + ∀ j : Fin 2, Tendsto + (fun n => + (∑ C ∈ + (transportedUnivFinpartition + (Q n) + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j))).parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart (Q n) C).card : ℝ))) / + (A.model n).size) + atTop (nhds 0) := by + classical + obtain ⟨eta, H, heta, hetaanti, heta0, hH, hHanti, + hH0, hratio, hoverlap, hloss, _htail⟩ := + exists_source_both_common_slow_overlap_scales + A S hsymmetric hgenerates Q gamma hgamma hexpand hsource + let capped : ℕ → ℝ := fun n => min (eta n) ((1 : ℝ) / 2) + have heventually : ∀ᶠ n in atTop, eta n < (1 : ℝ) / 2 := + heta0.eventually (gt_mem_nhds (by norm_num : (0 : ℝ) < 1 / 2)) + have heq : capped =ᶠ[atTop] eta := by + filter_upwards [heventually] with n hn + exact min_eq_left hn.le + have hcappedpositive (n : ℕ) : 0 < capped n := by + exact lt_min (heta n) (by norm_num : (0 : ℝ) < 1 / 2) + have hcappedone (n : ℕ) : capped n < 1 := by + have hhalf : capped n ≤ (1 : ℝ) / 2 := + min_le_right _ _ + linarith + have hcappedanti : Antitone capped := by + intro m n hmn + exact min_le_min (hetaanti hmn) (le_refl ((1 : ℝ) / 2)) + have hcappedzero : Tendsto capped atTop (nhds 0) := + heta0.congr' heq.symm + have hcappedratio : Tendsto + (fun n => capped n / H n) atTop (nhds 0) := by + have heqratio : + (fun n => capped n / H n) =ᶠ[atTop] + (fun n => eta n / H n) := by + filter_upwards [heq] with n hn + rw [hn] + exact hratio.congr' heqratio.symm + refine ⟨capped, H, hcappedpositive, hcappedone, hcappedanti, + hcappedzero, hH, hHanti, hH0, hcappedratio, ?_, hloss⟩ + intro j + have heqoverlap : + (fun n => + (∑ C ∈ insufficientOverlapComponents + (transportedUnivFinpartition + (Q n) + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j))) + (Q n) (capped n), (C.card : ℝ)) / + (A.model n).size) =ᶠ[atTop] + (fun n => + (∑ C ∈ insufficientOverlapComponents + (transportedUnivFinpartition + (Q n) + ((A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j))) + (Q n) (eta n), (C.card : ℝ)) / + (A.model n).size) := by + filter_upwards [heq] with n hn + rw [hn] + exact (hoverlap j).congr' heqoverlap.symm + +end KunActualBothTransportedOverlapScales + +namespace KunLiteralNineSourceCompletedCentralizerModels + +open Filter Topology +open scoped BigOperators + +private theorem sourceAmbientGeneratedWord_crossing_density_tendsto_zero + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (S : Finset + (prefixElementaryGroup ninePrefixCode)) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure + (S : Set + (prefixElementaryGroup ninePrefixCode)) = + ⊤) + (Q : ∀ n, Finpartition + (Finset.univ : Finset (Fin (A.model n).size))) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥S => + (A.model n).action + (i : prefixElementaryGroup + ninePrefixCode)) C : ℝ)) / + (A.model n).size) + atTop (𝓝 0)) + (g : prefixElementaryGroup ninePrefixCode) : + Tendsto + (fun n => + ((partitionWordCrossing (Q n) + ((A.model n).action g)).card : ℝ) / + (A.model n).size) + atTop (𝓝 0) := by + simpa only [MonoidHom.id_apply] using + SourceGeneratedWordCrossing.fixed_generated_word_crossing_density_tendsto_zero + A (MonoidHom.id _) S hsymmetric hgenerates Q hboundary g + +private theorem sourceAmbientFiniteFamily_crossing_density_tendsto_zero + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (S : Finset + (prefixElementaryGroup ninePrefixCode)) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure + (S : Set + (prefixElementaryGroup ninePrefixCode)) = + ⊤) + (Q : ∀ n, Finpartition + (Finset.univ : Finset (Fin (A.model n).size))) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥S => + (A.model n).action + (i : prefixElementaryGroup + ninePrefixCode)) C : ℝ)) / + (A.model n).size) + atTop (𝓝 0)) + (ι : Type*) [Fintype ι] + (g : ι → + prefixElementaryGroup ninePrefixCode) : + Tendsto + (fun n => + (∑ i : ι, + ((partitionWordCrossing (Q n) + ((A.model n).action (g i))).card : ℝ)) / + (A.model n).size) + atTop (𝓝 0) := by + have hsum : Tendsto + (fun n => + ∑ i : ι, + ((partitionWordCrossing (Q n) + ((A.model n).action (g i))).card : ℝ) / + (A.model n).size) + atTop (𝓝 0) := by + simpa only [Finset.sum_const_zero] using + tendsto_finsetSum (Finset.univ : Finset ι) + (fun i _ => sourceAmbientGeneratedWord_crossing_density_tendsto_zero A S hsymmetric + hgenerates Q hboundary (g i)) + simpa only [Finset.sum_div] using hsum + +private theorem sourceAmbientActualInverse_crossing_density_tendsto_zero + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (S : Finset + (prefixElementaryGroup ninePrefixCode)) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure + (S : Set + (prefixElementaryGroup ninePrefixCode)) = + ⊤) + (Q : ∀ n, Finpartition + (Finset.univ : Finset (Fin (A.model n).size))) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥S => + (A.model n).action + (i : prefixElementaryGroup + ninePrefixCode)) C : ℝ)) / + (A.model n).size) + atTop (𝓝 0)) + (g : prefixElementaryGroup ninePrefixCode) : + Tendsto + (fun n => + ((partitionWordCrossing (Q n) + (((A.model n).action g)⁻¹)).card : ℝ) / + (A.model n).size) + atTop (𝓝 0) := by + have hlabel := + sourceAmbientGeneratedWord_crossing_density_tendsto_zero + A S hsymmetric hgenerates Q hboundary (g⁻¹) + have hinverse := + KunCommonRankArcInvariance.sofic_action_inverse_normalizedHamming_tendsto_zero + A g + simpa only [Fintype.card_fin] using + SourceGeneratedWordCrossing.crossing_density_tendsto_zero_of_normalizedHamming + Q (fun n => ((A.model n).action g)⁻¹) + (fun n => (A.model n).action (g⁻¹)) + (by simpa only [Fintype.card_fin] using hlabel) + hinverse + +private theorem exists_source_common_log_rank_with_ambient_midrank_variance + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (SG : Finset + (prefixElementaryGroup ninePrefixCode)) + (QΓ QG : (n : ℕ) → + Finpartition (Finset.univ : Finset (Fin (A.model n).size))) + (γG : ℝ) + (hsymmetricG : ∀ g ∈ SG, g⁻¹ ∈ SG) + (hgeneratesG : Subgroup.closure + (SG : Set + (prefixElementaryGroup ninePrefixCode)) = + ⊤) + (hpositive : Subgroup.closure + (Set.range + (KunExactActualSourceAmbientGenerators.sourcePositiveGeneratorMap + SΓ)) = ⊤) + (hγG : 0 < γG) + (hexpandG : ∀ n C, C ∈ (QG n).parts → + ∀ E : Finset (Fin (A.model n).size), E ⊆ C → + 2 * E.card ≤ C.card → + γG * (E.card : ℝ) ≤ + (boundary + (fun i : ↥SG => + (A.model n).action + (i : prefixElementaryGroup + ninePrefixCode)) E : ℝ)) + (hboundaryΓ : Tendsto + (fun n => + (∑ C ∈ (QΓ n).parts, + (boundary + (fun i : ↥SΓ => + (A.model n).action + (KunExactActualSourceAmbientGenerators.sourceAlphaInclusion + (i : prefixElementaryGroup + alphaPrefixCode))) C : ℝ)) / + (A.model n).size) + atTop (𝓝 0)) + (hboundaryG : Tendsto + (fun n => + (∑ C ∈ (QG n).parts, + (boundary + (fun i : ↥SG => + (A.model n).action + (i : prefixElementaryGroup + ninePrefixCode)) C : ℝ)) / + (A.model n).size) + atTop (𝓝 0)) + (eta H : ℕ → ℝ) + (heta0 : ∀ n, 0 ≤ eta n) + (heta1 : ∀ n, eta n < 1) + (hH : ∀ n, 0 < H n) + (heta : Tendsto eta atTop (𝓝 0)) + (hratio : Tendsto (fun n => eta n / H n) atTop (𝓝 0)) + (hoverlap : ∀ j : Fin 2, Tendsto + (fun n => + (∑ C ∈ insufficientOverlapComponents + (transportedUnivFinpartition + (QΓ n) + ((A.model n).action + (KunExactActualSourceAmbientGenerators.sourceCompressionTable + j))) + (QΓ n) (eta n), (C.card : ℝ)) / + (A.model n).size) + atTop (𝓝 0)) + (hloss : ∀ j : Fin 2, Tendsto + (fun n => + (∑ C ∈ + (transportedUnivFinpartition + (QΓ n) + ((A.model n).action + (KunExactActualSourceAmbientGenerators.sourceCompressionTable + j))).parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart (QΓ n) C).card : ℝ))) / + (A.model n).size) + atTop (𝓝 0)) : + ∃ r : ℕ → ℝ, + (∀ n, r n ∈ Set.Ico 0 (H n)) ∧ + Tendsto + (fun n => + (∑ C ∈ (QG n).parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C + (SourceCommonOffsetMidrankEnergy.componentLogRank + (QΓ n) (H n) (r n)))) / + (A.model n).size) + atTop (𝓝 0) ∧ + (∀ j : Fin 2, Tendsto + (fun n => + ((partitionWordCrossing (QG n) + (((A.model n).action + (KunExactActualSourceAmbientGenerators.sourceCompressionTable + j))⁻¹)).card : ℝ) / + (A.model n).size) + atTop (𝓝 0)) := by + classical + let : ∀ n, Nonempty (Fin (A.model n).size) := + fun n => Fin.pos_iff_nonempty.mp (A.model n).size_pos + let σ : (n : ℕ) → ↥SΓ → Equiv.Perm (Fin (A.model n).size) := + fun n i => + (A.model n).action + (KunExactActualSourceAmbientGenerators.sourceAlphaInclusion + (i : prefixElementaryGroup + alphaPrefixCode)) + let T : (n : ℕ) → Fin 2 → Equiv.Perm (Fin (A.model n).size) := + fun n j => + (A.model n).action + (KunExactActualSourceAmbientGenerators.sourceCompressionTable + j) + have hcrossΓ : ∀ i : ↥SΓ, Tendsto + (fun n => + ((partitionWordCrossing (QΓ n) + (σ n i)).card : ℝ) / + Fintype.card (Fin (A.model n).size)) + atTop (𝓝 0) := by + intro i + exact + SourceGeneratedWordCrossing.generator_crossing_density_tendsto_zero + QΓ σ + (by simpa only [σ, Fintype.card_fin] using hboundaryΓ) + i + have haction (n : ℕ) (i : ↥SΓ ⊕ Fin 2) : + (A.model n).action + (KunExactActualSourceAmbientGenerators.sourcePositiveGeneratorMap + SΓ i) = + Sum.elim (σ n) (T n) i := by + cases i <;> rfl + have hcrossG : Tendsto + (fun n => + (∑ i : ↥SΓ ⊕ Fin 2, + ((partitionWordCrossing + (QG n) (Sum.elim (σ n) (T n) i)).card : ℝ)) / + Fintype.card (Fin (A.model n).size)) + atTop (𝓝 0) := by + simpa only [haction, Fintype.card_fin] + using sourceAmbientFiniteFamily_crossing_density_tendsto_zero + A SG hsymmetricG hgeneratesG QG hboundaryG + (↥SΓ ⊕ Fin 2) + (KunExactActualSourceAmbientGenerators.sourcePositiveGeneratorMap + SΓ) + obtain ⟨r, hr, _hdrop, hmidpoint⟩ := + exists_common_positive_component_log_rank_with_vanishing_midrank_energy + (fun n => Fin (A.model n).size) + (↥SΓ) (Fin 2) QΓ QG σ T eta H + heta0 heta1 hH heta hratio hcrossΓ + (by simpa only [T, Fintype.card_fin] using hoverlap) + (by simpa only [T, Fintype.card_fin] using hloss) + hcrossG + let b : (n : ℕ) → Fin (A.model n).size → ℤ := + fun n => + SourceCommonOffsetMidrankEnergy.componentLogRank + (QΓ n) (H n) (r n) + let f : (n : ℕ) → Fin (A.model n).size → ℝ := + fun n => + MidrankPermutationEnergy.partitionVertexMidrank + (QG n) (b n) + have hf0 : ∀ n x, 0 ≤ f n x := by + intro n x + exact componentVertexMidrank_nonneg + ((QG n).part x) (b n) x + have hf1 : ∀ n x, f n x ≤ 1 := by + intro n x + exact componentVertexMidrank_le_one + ((QG n).part x) (b n) x + have hmidpoint' : Tendsto + (fun n => + (∑ i : ↥SΓ ⊕ Fin 2, + ∑ x : Fin (A.model n).size, + (f n (Sum.elim (σ n) (T n) i x) - f n x) ^ 2) / + (A.model n).size) + atTop (𝓝 0) := by + simpa only [f, b, Fintype.card_fin] using hmidpoint + have hpositiveEnergy : Tendsto + (fun n => + (∑ i : ↥SΓ ⊕ Fin 2, + KunPositiveWordMidrankEnergy.squaredPermutationEnergy + (f n) + ((A.model n).action + (KunExactActualSourceAmbientGenerators.sourcePositiveGeneratorMap + SΓ i))) / + (A.model n).size) + atTop (𝓝 0) := by + have hpoint (n : ℕ) (i : ↥SΓ ⊕ Fin 2) : + KunPositiveWordMidrankEnergy.squaredPermutationEnergy + (f n) + ((A.model n).action + (KunExactActualSourceAmbientGenerators.sourcePositiveGeneratorMap + SΓ i)) = + ∑ x : Fin (A.model n).size, + (f n (Sum.elim (σ n) (T n) i x) - f n x) ^ 2 := by + rw [haction n i] + rfl + simpa only [hpoint] using hmidpoint' + have hgenerators := + KunPositiveWordMidrankEnergy.sum_action_energy_tendsto_zero_of_positive_generator_sum + A + (KunExactActualSourceAmbientGenerators.sourcePositiveGeneratorMap + SΓ) + hpositive f hf0 hf1 hpositiveEnergy SG + have hgeneratorSum (n : ℕ) : + (∑ g ∈ SG, + KunPositiveWordMidrankEnergy.squaredPermutationEnergy + (f n) ((A.model n).action g)) = + ∑ i : ↥SG, + KunPositiveWordMidrankEnergy.squaredPermutationEnergy + (f n) + ((A.model n).action + (i : prefixElementaryGroup + ninePrefixCode)) := by + rw [← Finset.sum_coe_sort SG] + have hsubtypeEnergy : Tendsto + (fun n => + (∑ i : ↥SG, + KunPositiveWordMidrankEnergy.squaredPermutationEnergy + (f n) + ((A.model n).action + (i : prefixElementaryGroup + ninePrefixCode))) / + (A.model n).size) + atTop (𝓝 0) := by + simpa only [hgeneratorSum] using hgenerators + have hgeneratorEnergy : Tendsto + (fun n => + (∑ i : ↥SG, ∑ x : Fin (A.model n).size, + (f n ((A.model n).action + (i : prefixElementaryGroup + ninePrefixCode) x) - f n x) ^ 2) / + Fintype.card (Fin (A.model n).size)) + atTop (𝓝 0) := by + simpa only [Fintype.card_fin, + KunPositiveWordMidrankEnergy.squaredPermutationEnergy] + using hsubtypeEnergy + have hvariance := + weighted_component_midrankVariance_tendsto_zero_of_source_half_expansion + (fun n => Fin (A.model n).size) (↥SG) QG + (fun n i => + (A.model n).action + (i : prefixElementaryGroup + ninePrefixCode)) + b γG hγG hexpandG + (by simpa only [Fintype.card_fin] using hboundaryG) + (by simpa only [f] using hgeneratorEnergy) + refine ⟨r, hr, ?_, ?_⟩ + · simpa only [b, Fintype.card_fin] using hvariance + · intro j + exact sourceAmbientActualInverse_crossing_density_tendsto_zero + A SG hsymmetricG hgeneratesG QG hboundaryG + (KunExactActualSourceAmbientGenerators.sourceCompressionTable + j) + +end KunLiteralNineSourceCompletedCentralizerModels + +open KunLiteralNineSourceCompletedCentralizerModels + +namespace KunActualFirstStageReferenceExpansion + +open Filter Topology +open scoped BigOperators + +private def componentGeneratorDisagreement + {V ι : Type*} [Fintype ι] [DecidableEq V] + (C : Finset V) + (σref σact : ι → Equiv.Perm V) : ℕ := + ∑ i : ι, (C.filter fun x => σref i x ≠ σact i x).card + +private theorem componentGeneratorDisagreement_comm + {V ι : Type*} [Fintype ι] [DecidableEq V] + (C : Finset V) + (σref σact : ι → Equiv.Perm V) : + componentGeneratorDisagreement C σref σact = + componentGeneratorDisagreement C σact σref := by + classical + unfold componentGeneratorDisagreement + apply Finset.sum_congr rfl + intro i _ + congr 1 + ext x + simp only [Finset.mem_filter] + exact and_congr_right fun _ => ne_comm + +private theorem boundary_le_boundary_add_componentGeneratorDisagreement + {V ι : Type*} [Fintype ι] [DecidableEq V] + (σref σact : ι → Equiv.Perm V) + (C E : Finset V) (hEC : E ⊆ C) : + boundary σref E ≤ + boundary σact E + + componentGeneratorDisagreement C σref σact := by + classical + unfold boundary componentGeneratorDisagreement + calc + (∑ i : ι, (E.filter fun x => σref i x ∉ E).card) ≤ + ∑ i : ι, + ((E.filter fun x => σact i x ∉ E).card + + (C.filter fun x => σref i x ≠ σact i x).card) := by + apply Finset.sum_le_sum + intro i _ + have hsubset : + (E.filter fun x => σref i x ∉ E) ⊆ + (E.filter fun x => σact i x ∉ E) ∪ + (C.filter fun x => σref i x ≠ σact i x) := by + intro x hx + obtain ⟨hxE, href⟩ := Finset.mem_filter.mp hx + by_cases hact : σact i x ∈ E + · apply Finset.mem_union_right + apply Finset.mem_filter.mpr + refine ⟨hEC hxE, ?_⟩ + intro heq + apply href + rwa [heq] + · apply Finset.mem_union_left + exact Finset.mem_filter.mpr ⟨hxE, hact⟩ + exact (Finset.card_le_card hsubset).trans + (Finset.card_union_le _ _) + _ = (∑ i : ι, (E.filter fun x => σact i x ∉ E).card) + + ∑ i : ι, + (C.filter fun x => σref i x ≠ σact i x).card := by + rw [Finset.sum_add_distrib] + +private theorem completed_actual_component_additive_expansion_of_reference + {V ι : Type*} [Fintype ι] [DecidableEq V] + (σref σact : ι → Equiv.Perm V) (C : Finset V) + (τ : ι → Equiv.Perm {x : V // x ∈ C}) + (hτ : ∀ i (x : V) (hx : x ∈ C) (_hy : σact i x ∈ C), + ((τ i ⟨x, hx⟩ : {x : V // x ∈ C}) : V) = σact i x) + (γ : ℝ) + (hexpand : ∀ E : Finset V, E ⊆ C → + 2 * E.card ≤ C.card → + γ * (E.card : ℝ) ≤ (boundary σref E : ℝ)) : + ∀ E : Finset {x : V // x ∈ C}, + γ * min (E.card : ℝ) ((C.card : ℝ) - E.card) - + ((boundary σref C : ℝ) + + 2 * (componentGeneratorDisagreement C σref σact : ℝ)) ≤ + (boundary τ E : ℝ) := by + classical + have hhalf (E : Finset {x : V // x ∈ C}) + (hE : 2 * E.card ≤ C.card) : + γ * (E.card : ℝ) - + ((boundary σref C : ℝ) + + 2 * (componentGeneratorDisagreement C σref σact : ℝ)) ≤ + (boundary τ E : ℝ) := by + let D : Finset V := + E.map (Function.Embedding.subtype (fun x : V => x ∈ C)) + have hDC : D ⊆ C := by + intro x hx + exact Finset.property_of_mem_map_subtype E hx + have hcard : D.card = E.card := by + dsimp [D] + exact Finset.card_map _ + have hhalfD : 2 * D.card ≤ C.card := by + simpa only [hcard] using hE + have hreference := hexpand D hDC hhalfD + rw [hcard] at hreference + have hchanged := + boundary_le_boundary_add_componentGeneratorDisagreement + σref σact C D hDC + have hcompleted := + KunResidualExpanderDecomposition.original_boundary_le_completed_add_component_boundary + σact C τ hτ E + have hcomponent := + boundary_le_boundary_add_componentGeneratorDisagreement + σact σref C C (Finset.Subset.refl C) + rw [componentGeneratorDisagreement_comm C σact σref] at hcomponent + have hchangedR : + (boundary σref D : ℝ) ≤ + (boundary σact D : ℝ) + + (componentGeneratorDisagreement C σref σact : ℝ) := by + exact_mod_cast hchanged + have hcompletedR : + (boundary σact D : ℝ) ≤ + (boundary τ E : ℝ) + + (boundary σact C : ℝ) := by + change + ((boundary σact + (E.map (Function.Embedding.subtype + (fun x : V => x ∈ C))) : ℕ) : ℝ) ≤ _ + exact_mod_cast hcompleted + have hcomponentR : + (boundary σact C : ℝ) ≤ + (boundary σref C : ℝ) + + (componentGeneratorDisagreement C σref σact : ℝ) := by + exact_mod_cast hcomponent + linarith + intro E + by_cases hE : 2 * E.card ≤ C.card + · have hreal : (2 : ℝ) * (E.card : ℝ) ≤ (C.card : ℝ) := by + exact_mod_cast hE + rw [min_eq_left (by linarith)] + exact hhalf E hE + · let D : Finset {x : V // x ∈ C} := Finset.univ \ E + have hcard : D.card + E.card = C.card := by + dsimp [D] + have h := + Finset.card_sdiff_add_card_eq_card (Finset.subset_univ E) + simpa only [Finset.univ_eq_attach, Finset.card_attach] using h + have hhalfD : 2 * D.card ≤ C.card := by + omega + have hsmall := hhalf D hhalfD + have hrealD : (D.card : ℝ) = (C.card : ℝ) - (E.card : ℝ) := by + have hreal : + (D.card : ℝ) + (E.card : ℝ) = (C.card : ℝ) := by + exact_mod_cast hcard + linarith + have hrealE : (C.card : ℝ) < 2 * (E.card : ℝ) := by + exact_mod_cast Nat.lt_of_not_ge hE + rw [min_eq_right (by linarith)] + rw [hrealD] at hsmall + have hcomplement : + boundary τ D = boundary τ E := by + simpa only [D] using + KunResidualExpanderDecomposition.boundary_complement τ E + rw [hcomplement] at hsmall + exact hsmall + +private theorem completedRestriction_additive_expansion_of_reference + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σref σact : ι → Equiv.Perm V) (C : Finset V) + (γ : ℝ) + (hexpand : ∀ E : Finset V, E ⊆ C → + 2 * E.card ≤ C.card → + γ * (E.card : ℝ) ≤ (boundary σref E : ℝ)) : + ∀ E : Finset {x : V // x ∈ C}, + γ * min (E.card : ℝ) ((C.card : ℝ) - E.card) - + ((boundary σref C : ℝ) + + 2 * (componentGeneratorDisagreement C σref σact : ℝ)) ≤ + (boundary + (fun i => + MatchedComponentCompletion.completedRestriction + (σact i) C) E : ℝ) := by + apply completed_actual_component_additive_expansion_of_reference + σref σact C + (fun i => + MatchedComponentCompletion.completedRestriction + (σact i) C) + · intro i x hx hy + exact MatchedComponentCompletion.completedRestriction_apply_of_mem + (σact i) C x hx hy + · exact hexpand + +private def normalizedReferenceCompletionError + {V ι : Type*} [Fintype ι] [DecidableEq V] + (C : Finset V) (σref σact : ι → Equiv.Perm V) : ℝ := + ((boundary σref C : ℝ) + + 2 * (componentGeneratorDisagreement C σref σact : ℝ)) / + (C.card : ℝ) + +private theorem normalizedReferenceCompletionError_tendsto_zero + (V : ℕ → Type*) [∀ n, DecidableEq (V n)] + (ι : Type*) [Fintype ι] + (C : (n : ℕ) → Finset (V n)) + (σref σact : (n : ℕ) → ι → Equiv.Perm (V n)) + (hboundary : Tendsto + (fun n => + (boundary (σref n) (C n) : ℝ) / + (C n).card) + atTop (nhds 0)) + (hdisagreement : Tendsto + (fun n => + (componentGeneratorDisagreement + (C n) (σref n) (σact n) : ℝ) / (C n).card) + atTop (nhds 0)) : + Tendsto + (fun n => + normalizedReferenceCompletionError (C n) (σref n) (σact n)) + atTop (nhds 0) := by + have hsum := + hboundary.add (hdisagreement.const_mul (2 : ℝ)) + simpa only [normalizedReferenceCompletionError, add_div, + mul_div_assoc, zero_add, mul_zero] using hsum + +private theorem exists_vanishing_completedRestriction_additive_expansion_of_reference + (V : ℕ → Type*) [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + (ι : Type*) [Fintype ι] + (C : (n : ℕ) → Finset (V n)) + (hC : ∀ n, (C n).Nonempty) + (σref σact : (n : ℕ) → ι → Equiv.Perm (V n)) + (γ : ℝ) + (hexpand : ∀ n, ∀ E : Finset (V n), E ⊆ C n → + 2 * E.card ≤ (C n).card → + γ * (E.card : ℝ) ≤ + (boundary (σref n) E : ℝ)) + (hboundary : Tendsto + (fun n => + (boundary (σref n) (C n) : ℝ) / + (C n).card) + atTop (nhds 0)) + (hdisagreement : Tendsto + (fun n => + (componentGeneratorDisagreement + (C n) (σref n) (σact n) : ℝ) / (C n).card) + atTop (nhds 0)) : + ∃ a : ℕ → ℝ, + (∀ n, 0 ≤ a n) ∧ + Tendsto a atTop (nhds 0) ∧ + ∀ n, ∀ E : Finset {x : V n // x ∈ C n}, + γ * min (E.card : ℝ) + ((Fintype.card {x : V n // x ∈ C n} : ℝ) - E.card) - + a n * Fintype.card {x : V n // x ∈ C n} ≤ + (boundary + (fun i => + MatchedComponentCompletion.completedRestriction + (σact n i) (C n)) E : ℝ) := by + let a : ℕ → ℝ := + fun n => normalizedReferenceCompletionError + (C n) (σref n) (σact n) + refine ⟨a, ?_, ?_, ?_⟩ + · intro n + unfold a normalizedReferenceCompletionError + apply div_nonneg + · positivity + · exact Nat.cast_nonneg _ + · exact normalizedReferenceCompletionError_tendsto_zero + V ι C σref σact hboundary hdisagreement + · intro n E + have hcard : ((C n).card : ℝ) ≠ 0 := by + exact_mod_cast Finset.card_ne_zero.mpr (hC n) + have h := + completedRestriction_additive_expansion_of_reference + (σref n) (σact n) (C n) γ (hexpand n) E + simpa only [a, normalizedReferenceCompletionError, + Fintype.card_coe, div_mul_cancel₀ _ hcard] using h + +private theorem componentGeneratorDisagreement_le_card_mul_component_bad + {V ι : Type*} [Fintype ι] [DecidableEq V] + (C B : Finset V) + (σref σact : ι → Equiv.Perm V) + (hbad : ∀ i (x : V), x ∈ C → + σref i x ≠ σact i x → x ∈ B) : + componentGeneratorDisagreement C σref σact ≤ + Fintype.card ι * (C ∩ B).card := by + classical + unfold componentGeneratorDisagreement + calc + (∑ i : ι, (C.filter fun x => σref i x ≠ σact i x).card) ≤ + ∑ _i : ι, (C ∩ B).card := by + apply Finset.sum_le_sum + intro i _ + apply Finset.card_le_card + intro x hx + obtain ⟨hxC, hdisagree⟩ := Finset.mem_filter.mp hx + exact Finset.mem_inter.mpr + ⟨hxC, hbad i x hxC hdisagree⟩ + _ = Fintype.card ι * (C ∩ B).card := by + simp only [Finset.sum_const, Finset.card_univ, smul_eq_mul] + +private theorem componentGeneratorDisagreement_density_tendsto_zero_of_component_bad + (V : ℕ → Type*) [∀ n, DecidableEq (V n)] + (ι : Type*) [Fintype ι] + (C B : (n : ℕ) → Finset (V n)) + (σref σact : (n : ℕ) → ι → Equiv.Perm (V n)) + (hbad : ∀ n i (x : V n), x ∈ C n → + σref n i x ≠ σact n i x → x ∈ B n) + (hdensity : Tendsto + (fun n => (((C n ∩ B n).card : ℝ) / (C n).card)) + atTop (nhds 0)) : + Tendsto + (fun n => + (componentGeneratorDisagreement + (C n) (σref n) (σact n) : ℝ) / (C n).card) + atTop (nhds 0) := by + have hlimit : Tendsto + (fun n => + (Fintype.card ι : ℝ) * + (((C n ∩ B n).card : ℝ) / (C n).card)) + atTop (nhds 0) := by + simpa only [mul_zero] using hdensity.const_mul (Fintype.card ι : ℝ) + apply squeeze_zero' + (Eventually.of_forall fun n => + div_nonneg (Nat.cast_nonneg _) + (Nat.cast_nonneg _)) + (Eventually.of_forall fun n => ?_) + hlimit + have hnat := + componentGeneratorDisagreement_le_card_mul_component_bad + (C n) (B n) (σref n) (σact n) (hbad n) + have hreal : + (componentGeneratorDisagreement + (C n) (σref n) (σact n) : ℝ) ≤ + (Fintype.card ι : ℝ) * + ((C n ∩ B n).card : ℝ) := by + exact_mod_cast hnat + calc + (componentGeneratorDisagreement + (C n) (σref n) (σact n) : ℝ) / (C n).card ≤ + ((Fintype.card ι : ℝ) * + ((C n ∩ B n).card : ℝ)) / (C n).card := + div_le_div_of_nonneg_right hreal (Nat.cast_nonneg _) + _ = (Fintype.card ι : ℝ) * + (((C n ∩ B n).card : ℝ) / (C n).card) := by ring + +private theorem exists_vanishing_completedRestriction_additive_expansion_of_selected_bad + (V : ℕ → Type*) [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + (ι : Type*) [Fintype ι] + (C B : (n : ℕ) → Finset (V n)) + (hC : ∀ n, (C n).Nonempty) + (σref σact : (n : ℕ) → ι → Equiv.Perm (V n)) + (γ : ℝ) + (hexpand : ∀ n, ∀ E : Finset (V n), E ⊆ C n → + 2 * E.card ≤ (C n).card → + γ * (E.card : ℝ) ≤ + (boundary (σref n) E : ℝ)) + (hbad : ∀ n i (x : V n), x ∈ C n → + σref n i x ≠ σact n i x → x ∈ B n) + (hboundary : Tendsto + (fun n => + (boundary (σref n) (C n) : ℝ) / + (C n).card) + atTop (nhds 0)) + (hbad_density : Tendsto + (fun n => + (((C n ∩ B n).card : ℝ) / (C n).card)) + atTop (nhds 0)) : + ∃ a : ℕ → ℝ, + (∀ n, 0 ≤ a n) ∧ + Tendsto a atTop (nhds 0) ∧ + ∀ n, ∀ E : Finset {x : V n // x ∈ C n}, + γ * min (E.card : ℝ) + ((Fintype.card {x : V n // x ∈ C n} : ℝ) - E.card) - + a n * Fintype.card {x : V n // x ∈ C n} ≤ + (boundary + (fun i => + MatchedComponentCompletion.completedRestriction + (σact n i) (C n)) E : ℝ) := by + apply exists_vanishing_completedRestriction_additive_expansion_of_reference + V ι C hC σref σact γ hexpand hboundary + exact componentGeneratorDisagreement_density_tendsto_zero_of_component_bad + V ι C B σref σact hbad hbad_density + +end KunActualFirstStageReferenceExpansion + +open KunActualFirstStageReferenceExpansion + +namespace SourceProductThroughAlpha + +open Filter Topology +open scoped BigOperators + +private theorem source_u_conjugated_product_generator + (g : prefixElementaryGroup + alphaPrefixCode) : + ThompsonPrefixInsertion.sourceCompressedLocalProductEmbedding + (sourceCompressionUAlphaEquiv g, 1) = + SourceBothCompressionNormalization.sourceCompressionUElement * + SourceGeneratedWordCrossing.sourceAlphaInclusion g * + (SourceBothCompressionNormalization.sourceCompressionUElement)⁻¹ := by + apply Subtype.ext + change + (sourceCompressionUAlphaEquiv g : BinaryLeavittˣ) * 1 = + compressionU * + (g : BinaryLeavittˣ) * + compressionU⁻¹ + rw [mul_one] + change + (MulAut.conj compressionU) + (g : BinaryLeavittˣ) = + compressionU * + (g : BinaryLeavittˣ) * + compressionU⁻¹ + rw [MulAut.conj_apply] + +private theorem source_u_transported_reference_half_expansion + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (QΓ : (n : ℕ) → Finpartition + (Finset.univ : Finset (Fin (A.model n).size))) + (gamma : ℝ) + (hexpand : ∀ n, ∀ C ∈ (QΓ n).parts, + ∀ E : Finset (Fin (A.model n).size), E ⊆ C → + 2 * E.card ≤ C.card → + gamma * (E.card : ℝ) ≤ + (boundary + (fun i : ↥SΓ => + (A.model n).action + (SourceGeneratedWordCrossing.sourceAlphaInclusion + i)) E : ℝ)) : + ∀ n, ∀ C ∈ + (transportedUnivFinpartition + (QΓ n) + ((A.model n).action + SourceBothCompressionNormalization.sourceCompressionUElement)).parts, + ∀ E : Finset (Fin (A.model n).size), E ⊆ C → + 2 * E.card ≤ C.card → + gamma * (E.card : ℝ) ≤ + (boundary + (fun i : ↥SΓ => + (A.model n).action + SourceBothCompressionNormalization.sourceCompressionUElement * + (A.model n).action + (SourceGeneratedWordCrossing.sourceAlphaInclusion + i) * + ((A.model n).action + SourceBothCompressionNormalization.sourceCompressionUElement)⁻¹) + E : ℝ) := by + intro n + exact + KunTransportedAmbientOverlap.transportedUnivFinpartition_half_expansion + (QΓ n) + (fun i : ↥SΓ => + (A.model n).action + (SourceGeneratedWordCrossing.sourceAlphaInclusion i)) + ((A.model n).action + SourceBothCompressionNormalization.sourceCompressionUElement) + gamma (hexpand n) + +private theorem source_u_transported_reference_boundary_density_tendsto_zero + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (QΓ : (n : ℕ) → Finpartition + (Finset.univ : Finset (Fin (A.model n).size))) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (QΓ n).parts, + (boundary + (fun i : ↥SΓ => + (A.model n).action + (SourceGeneratedWordCrossing.sourceAlphaInclusion + i)) C : ℝ)) / + (A.model n).size) + atTop (𝓝 0)) : + Tendsto + (fun n => + (∑ C ∈ + (transportedUnivFinpartition + (QΓ n) + ((A.model n).action + SourceBothCompressionNormalization.sourceCompressionUElement)).parts, + (boundary + (fun i : ↥SΓ => + (A.model n).action + SourceBothCompressionNormalization.sourceCompressionUElement * + (A.model n).action + (SourceGeneratedWordCrossing.sourceAlphaInclusion + i) * + ((A.model n).action + SourceBothCompressionNormalization.sourceCompressionUElement)⁻¹) + C : ℝ)) / + (A.model n).size) + atTop (𝓝 0) := by + have h := + KunTransportedAmbientOverlap.transported_partition_boundary_density_tendsto_zero + (V := fun n => Fin (A.model n).size) + QΓ + (fun n (i : ↥SΓ) => + (A.model n).action + (SourceGeneratedWordCrossing.sourceAlphaInclusion i)) + (fun n => + (A.model n).action + SourceBothCompressionNormalization.sourceCompressionUElement) + (by simpa only [Fintype.card_fin] using hboundary) + simpa only [Fintype.card_fin] using h + +end SourceProductThroughAlpha + +namespace KunLiteralSourceSelectedComponents + +open Filter Topology +open CanonicalProductRadiusBadMatchedCapture +open SourceProductThroughAlpha +open scoped BigOperators Pointwise + +private def sourceCompressionPermutation + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (n : ℕ) : Equiv.Perm (Fin (A.model n).size) := + (A.model n).action + SourceBothCompressionNormalization.sourceCompressionUElement + +private def sourceTransportedReferenceGenerators + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (S : Finset + (prefixElementaryGroup alphaPrefixCode)) + (n : ℕ) : ↥S → Equiv.Perm (Fin (A.model n).size) := + fun g => sourceCompressionPermutation A n * + (A.model n).action + (SourceGeneratedWordCrossing.sourceAlphaInclusion g) * + (sourceCompressionPermutation A n)⁻¹ + +private def sourceTransportedPartition + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (Q : (n : ℕ) → + Finpartition (Finset.univ : Finset (Fin (A.model n).size))) + (n : ℕ) : + Finpartition (Finset.univ : Finset (Fin (A.model n).size)) := + transportedUnivFinpartition + (Q n) (sourceCompressionPermutation A n) + +private noncomputable def sourceGeneratorFamilyConjugacyBad + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (S : Finset + (prefixElementaryGroup alphaPrefixCode)) + (n : ℕ) : Finset (Fin (A.model n).size) := + S.biUnion fun g => sourceConjugacyDisagreementBad A + SourceBothCompressionNormalization.sourceCompressionUElement + (SourceGeneratedWordCrossing.sourceAlphaInclusion g) n + +private theorem sourceGeneratorFamilyConjugacyBad_density_tendsto_zero + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (S : Finset + (prefixElementaryGroup alphaPrefixCode)) : + Tendsto + (fun n => + ((sourceGeneratorFamilyConjugacyBad A S n).card : ℝ) / + (A.model n).size) + atTop (nhds 0) := by + classical + have h := finite_union_bad_density_tendsto_zero S + (fun n => (Finset.univ : Finset (Fin (A.model n).size))) + (fun n g => sourceConjugacyDisagreementBad A + SourceBothCompressionNormalization.sourceCompressionUElement + (SourceGeneratedWordCrossing.sourceAlphaInclusion g) n) + (fun g _ => by + simpa only [Finset.univ_inter, Finset.card_univ, Fintype.card_fin] using + sourceConjugacyDisagreementBad_density_tendsto_zero A + SourceBothCompressionNormalization.sourceCompressionUElement + (SourceGeneratedWordCrossing.sourceAlphaInclusion g)) + simpa only [sourceGeneratorFamilyConjugacyBad, Finset.univ_inter, Finset.card_univ, + Fintype.card_fin] using h + +private noncomputable def sourceSelectedRadiusBad + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (S : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure + (S : Set + (prefixElementaryGroup + alphaPrefixCode)) = ⊤) + (F : Finset + (ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1])) + (n k : ℕ) : Finset (Fin (A.model n).size) := by + classical + let SK := + SourceProductThroughAlpha.sourceCompressedGeneratingFinset S + let AP := + SourceProductThroughAlpha.sourceCompressedLocalProductApproximation A + exact + CanonicalProductRadiusBadMatchedCapture.canonicalProductRadiusBad + AP SK + (SourceProductThroughAlpha.sourceCompressedGeneratingFinset_inv_mem + S hsymmetric) + (SourceProductThroughAlpha.sourceCompressedGeneratingFinset_closure + S hgenerates) + F n k ∪ sourceGeneratorFamilyConjugacyBad A S n + +end KunLiteralSourceSelectedComponents + +namespace SourceGuardedCanonicalSelection + +open Filter Topology +open scoped BigOperators Pointwise symmDiff + +private abbrev SourceK := + prefixElementaryGroup alphaZeroPrefixCode + +private abbrev SourceJ := + ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1] + +private noncomputable def guardedCanonicalProductRadiusBad + [DecidableEq SourceK] [DecidableEq SourceJ] + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hsymmetric : ∀ g ∈ SΓ, g⁻¹ ∈ SΓ) + (hgenerates : Subgroup.closure + (SΓ : Set + (prefixElementaryGroup alphaPrefixCode)) = + ⊤) + (F : Finset SourceJ) + (E : (n : ℕ) → ℕ → Finset (Fin (A.model n).size)) + (n k : ℕ) : Finset (Fin (A.model n).size) := + CanonicalProductRadiusBadMatchedCapture.canonicalProductRadiusBad + (SourceProductThroughAlpha.sourceCompressedLocalProductApproximation A) + (SourceProductThroughAlpha.sourceCompressedGeneratingFinset SΓ) + (SourceProductThroughAlpha.sourceCompressedGeneratingFinset_inv_mem + SΓ hsymmetric) + (SourceProductThroughAlpha.sourceCompressedGeneratingFinset_closure + SΓ hgenerates) + F n k ∪ E n k + +private theorem exists_source_guarded_canonical_selected_components_of_retained_matching + [DecidableEq SourceK] [DecidableEq SourceJ] + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hone : 1 ∈ SΓ) + (hsymmetric : ∀ g ∈ SΓ, g⁻¹ ∈ SΓ) + (hgenerates : Subgroup.closure + (SΓ : Set + (prefixElementaryGroup alphaPrefixCode)) = + ⊤) + (P Q : (n : ℕ) → Finpartition + (Finset.univ : Finset (Fin (A.model n).size))) + {κ : Type*} [Fintype κ] + (σ : (n : ℕ) → κ → Equiv.Perm (Fin (A.model n).size)) + (R : (n : ℕ) → Finset (Finset (Fin (A.model n).size))) + (hR : ∀ n, R n ⊆ (P n).parts) + (D : (n : ℕ) → Finset (Fin (A.model n).size) → + Finset (Fin (A.model n).size)) + (hD : ∀ n C, C ∈ R n → D n C ∈ (Q n).parts) + (H eta : ℕ → ℝ) + (hH : Tendsto H atTop (nhds 0)) + (heta : Tendsto eta atTop (nhds 0)) + (hmajor : ∀ n, + eta n ≤ (1 : ℝ) / 2 → + 2 * (Real.exp (H n) - 1 + 2 * eta n) < 1 → + ∀ C, C ∈ R n → + (D n C).card < 2 * (C ∩ D n C).card) + (hdiscard : Tendsto + (fun n => + ((((Finset.univ : Finset (Fin (A.model n).size)) \ + matchedRetainedSupport (R n)).card : ℝ) / + (A.model n).size)) + atTop (nhds 0)) + (hsymm : Tendsto + (fun n => + ((∑ C ∈ R n, (C ∆ D n C).card : ℕ) : ℝ) / + (A.model n).size) + atTop (nhds 0)) + (F : Finset SourceJ) + (E : (n : ℕ) → ℕ → Finset (Fin (A.model n).size)) + (hE : ∀ k, Tendsto + (fun n => ((E n k).card : ℝ) / (A.model n).size) + atTop (nhds 0)) + (hsource : Tendsto + (fun n => + (∑ C ∈ (Q n).parts, + (boundary + (fun i : ↥SΓ => + (A.model n).action + (SourceGeneratedWordCrossing.sourceAlphaInclusion + i)) C : ℝ)) / + (A.model n).size) + atTop (nhds 0)) + (hboundary : Tendsto + (fun n => + (∑ C ∈ (P n).parts, (boundary (σ n) C : ℝ)) / + (A.model n).size) + atTop (nhds 0)) + (N₀ : ℕ) : + ∃ (N : ℕ) (r : ℕ → ℕ) + (C : (n : ℕ) → Finset (Fin (A.model (n + N)).size)), + N₀ ≤ N ∧ + (∀ n, eta (n + N) ≤ (1 : ℝ) / 2) ∧ + (∀ n, + 2 * (Real.exp (H (n + N)) - 1 + + 2 * eta (n + N)) < 1) ∧ + Tendsto r atTop atTop ∧ + (∀ n, C n ∈ R (n + N)) ∧ + Tendsto + (fun n => + (boundary (σ (n + N)) (C n) : ℝ) / + (C n).card) + atTop (nhds 0) ∧ + Tendsto + (fun n => + (((C n ∩ matchedRadiusBad + (P (n + N)) + (CanonicalProductRadiusBadMatchedCapture.sourceProductRadiusLabels + (SourceProductThroughAlpha.sourceCompressedGeneratingFinset SΓ) + F (r n)) + (((SourceProductThroughAlpha.sourceCompressedLocalProductApproximation + A).model (n + N)).action) + (guardedCanonicalProductRadiusBad + A SΓ hsymmetric hgenerates F E (n + N) (r n))).card : ℝ) / + (C n).card)) + atTop (nhds 0) ∧ + Tendsto (fun n => (C n).card) atTop atTop := by + classical + let : Infinite SourceK := + KunActualCompressedSourceGroupFoundations.alphaZeroPrefixElementaryGroup_infinite + have hnonempty (n : ℕ) : Nonempty (Fin (A.model n).size) := + Fin.pos_iff_nonempty.mp (A.model n).size_pos + let : ∀ n, Nonempty (Fin (A.model n).size) := hnonempty + let SK : Finset SourceK := + SourceProductThroughAlpha.sourceCompressedGeneratingFinset SΓ + let Ap : SoficApproximation (SourceK × SourceJ) := + SourceProductThroughAlpha.sourceCompressedLocalProductApproximation A + let I : ℕ → Finset (SourceK × SourceJ) := fun k => + CanonicalProductRadiusBadMatchedCapture.sourceProductRadiusLabels + SK F k + let w : (n : ℕ) → SourceK × SourceJ → + Equiv.Perm (Fin (A.model n).size) := + fun n z => (Ap.model n).action z + let B : (n : ℕ) → ℕ → Finset (Fin (A.model n).size) := + fun n k => guardedCanonicalProductRadiusBad + A SΓ hsymmetric hgenerates F E n k + have hSKone : 1 ∈ SK := + SourceProductThroughAlpha.sourceCompressedGeneratingFinset_one_mem + SΓ hone + have hSKsym : ∀ g ∈ SK, g⁻¹ ∈ SK := + SourceProductThroughAlpha.sourceCompressedGeneratingFinset_inv_mem + SΓ hsymmetric + have hSKgen : Subgroup.closure (SK : Set SourceK) = ⊤ := + SourceProductThroughAlpha.sourceCompressedGeneratingFinset_closure + SΓ hgenerates + have hU (n : ℕ) : + (Finset.univ : Finset (Fin (A.model n).size)).Nonempty := + Finset.univ_nonempty + have hword (k : ℕ) : Tendsto + (fun n => + ((∑ z ∈ I k, + (partitionWordCrossing + (Q n) (w n z)).card : ℕ) : ℝ) / + (Finset.univ : Finset (Fin (A.model n).size)).card) + atTop (nhds 0) := by + simpa only [I, w, Ap, SK, Finset.card_univ, + Fintype.card_fin, + SourceProductThroughAlpha.sourceCompressedLocalProductApproximation_model_size] + using + SourceProductThroughAlpha.source_canonical_product_radius_crossing_density_tendsto_zero + A SΓ hsymmetric hgenerates Q hsource F k + have hbad (k : ℕ) : Tendsto + (fun n => + ((((Finset.univ : Finset (Fin (A.model n).size)) ∩ + B n k).card : ℝ) / + (Finset.univ : Finset (Fin (A.model n).size)).card)) + atTop (nhds 0) := by + have hcanonical := + CanonicalProductRadiusBadMatchedCapture.canonicalProductRadiusBad_density_tendsto_zero + Ap SK hSKsym hSKgen F k + have hcanon' : Tendsto + (fun n => + ((CanonicalProductRadiusBadMatchedCapture.canonicalProductRadiusBad + Ap SK hSKsym hSKgen F n k).card : ℝ) / + (A.model n).size) + atTop (nhds 0) := by + exact hcanonical + have hlimit : Tendsto + (fun n => + ((CanonicalProductRadiusBadMatchedCapture.canonicalProductRadiusBad + Ap SK hSKsym hSKgen F n k).card : ℝ) / + (A.model n).size + + ((E n k).card : ℝ) / (A.model n).size) + atTop (nhds 0) := by + simpa only [add_zero] using hcanon'.add (hE k) + refine squeeze_zero (fun n => by positivity) ?_ hlimit + intro n + have hnat := Finset.card_union_le + (CanonicalProductRadiusBadMatchedCapture.canonicalProductRadiusBad + Ap SK hSKsym hSKgen F n k) (E n k) + have hreal : + (((CanonicalProductRadiusBadMatchedCapture.canonicalProductRadiusBad + Ap SK hSKsym hSKgen F n k ∪ E n k).card : ℕ) : ℝ) ≤ + ((CanonicalProductRadiusBadMatchedCapture.canonicalProductRadiusBad + Ap SK hSKsym hSKgen F n k).card : ℝ) + + ((E n k).card : ℝ) := by + exact_mod_cast hnat + simp only [Finset.univ_inter, Finset.card_univ, Fintype.card_fin] + change + ((B n k).card : ℝ) / (A.model n).size ≤ _ + change + ((CanonicalProductRadiusBadMatchedCapture.canonicalProductRadiusBad + Ap SK hSKsym hSKgen F n k ∪ E n k).card : ℝ) / + (A.model n).size ≤ _ + calc + ((CanonicalProductRadiusBadMatchedCapture.canonicalProductRadiusBad + Ap SK hSKsym hSKgen F n k ∪ E n k).card : ℝ) / + (A.model n).size ≤ + (((CanonicalProductRadiusBadMatchedCapture.canonicalProductRadiusBad + Ap SK hSKsym hSKgen F n k).card : ℝ) + + ((E n k).card : ℝ)) / + (A.model n).size := + div_le_div_of_nonneg_right hreal (by positivity) + _ = ((CanonicalProductRadiusBadMatchedCapture.canonicalProductRadiusBad + Ap SK hSKsym hSKgen F n k).card : ℝ) / + (A.model n).size + + ((E n k).card : ℝ) / (A.model n).size := by ring + have hrealize : + ∀ n k (C : Finset (Fin (A.model n).size)), C ∈ R n → + ∀ x ∈ C, + x ∉ matchedRadiusBad + (P n) (I k) (w n) (B n k) → + ∃ f : SourceK → Fin (A.model n).size, + Set.MapsTo f (↑(SK ^ (k / 2)) : Set SourceK) + (↑C : Set (Fin (A.model n).size)) ∧ + Set.InjOn f (↑(SK ^ (k / 2)) : Set SourceK) := by + intro n k C hCR x hx hgood + have hgoodcanonical : + x ∉ matchedRadiusBad + (P n) (I k) (w n) + (CanonicalProductRadiusBadMatchedCapture.canonicalProductRadiusBad + Ap SK hSKsym hSKgen F n k) := by + intro hxcan + apply hgood + unfold matchedRadiusBad at hxcan ⊢ + rcases Finset.mem_union.mp hxcan with hxB | hxW + · apply Finset.mem_union_left + change x ∈ + CanonicalProductRadiusBadMatchedCapture.canonicalProductRadiusBad + Ap SK hSKsym hSKgen F n k ∪ E n k + exact Finset.mem_union_left _ hxB + · exact Finset.mem_union_right _ hxW + exact + canonical_source_matched_component_cayley_ball_realization + Ap SK hSKone hSKsym hSKgen F n k (P n) C + (hR n hCR) x hx hgoodcanonical + have hdiscard' : Tendsto + (fun n => + ((((Finset.univ : Finset (Fin (A.model n).size)) \ + matchedRetainedSupport (R n)).card : ℝ) / + (Finset.univ : Finset (Fin (A.model n).size)).card)) + atTop (nhds 0) := by + simpa only [Finset.card_univ, Fintype.card_fin] using hdiscard + have hsymm' : Tendsto + (fun n => + ((∑ C ∈ R n, (C ∆ D n C).card : ℕ) : ℝ) / + (Finset.univ : Finset (Fin (A.model n).size)).card) + atTop (nhds 0) := by + simpa only [Finset.card_univ, Fintype.card_fin] using hsymm + have hboundary' : Tendsto + (fun n => + (∑ C ∈ (P n).parts, (boundary (σ n) C : ℝ)) / + (Finset.univ : Finset (Fin (A.model n).size)).card) + atTop (nhds 0) := by + simpa only [Finset.card_univ, Fintype.card_fin] using hboundary + have hselected := + KunResidualRetainedSelection.exists_matched_slow_diagonal_large_components_on_source_scale_tail + SK hSKone hSKgen σ + (fun n => (Finset.univ : Finset (Fin (A.model n).size))) hU + P Q R hR D hD H eta hH heta hmajor hdiscard' hsymm' + I w hword B hbad hboundary' hrealize N₀ + simpa only [I, w, Ap, SK, B] using hselected + +end SourceGuardedCanonicalSelection + +open SourceGuardedCanonicalSelection + +namespace KunActualSourceURetainedNoPremise + +open Filter Topology +open scoped BigOperators symmDiff + +private theorem exists_actual_source_u_retained_matching + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) : + ∃ (SΓ : Finset + (prefixElementaryGroup + alphaPrefixCode)) + (QΓ : (n : ℕ) → + Finpartition (Finset.univ : Finset (Fin (A.model n).size))) + (γΓ : ℝ) + (H eta r : ℕ → ℝ) + (R : (n : ℕ) → Finset (Finset (Fin (A.model n).size))), + 1 ∈ SΓ ∧ + (∀ g ∈ SΓ, g⁻¹ ∈ SΓ) ∧ + Subgroup.closure + (SΓ : Set + (prefixElementaryGroup + alphaPrefixCode)) = ⊤ ∧ + 0 < γΓ ∧ + (∀ n, ∀ C ∈ (QΓ n).parts, + ∀ E : Finset (Fin (A.model n).size), + E ⊆ C → + 2 * E.card ≤ C.card → + γΓ * (E.card : ℝ) ≤ + (boundary + (fun i : ↥SΓ => + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode))) E : ℝ)) ∧ + Tendsto + (fun n => + (∑ C ∈ (QΓ n).parts, + (boundary + (fun i : ↥SΓ => + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode))) C : ℝ)) / + (A.model n).size) + atTop (𝓝 0) ∧ + (∀ n, 0 < H n) ∧ + Tendsto H atTop (𝓝 0) ∧ + (∀ n, 0 < eta n) ∧ + (∀ n, eta n < 1) ∧ + Tendsto eta atTop (𝓝 0) ∧ + (∀ n, r n ∈ Set.Ico 0 (H n)) ∧ + (∀ n, + R n = + SourceRetainedActualMatching.retainedTransportedComponents + (QΓ n) + ((A.model n).action + SourceBothCompressionNormalization.sourceCompressionUElement) + (H n) (r n) (eta n)) ∧ + (∀ n, + R n ⊆ + (transportedUnivFinpartition + (QΓ n) + ((A.model n).action + SourceBothCompressionNormalization.sourceCompressionUElement)).parts) ∧ + (∀ n C, C ∈ R n → + maximumOverlapPart (QΓ n) C ∈ (QΓ n).parts) ∧ + (∀ n, eta n ≤ (1 : ℝ) / 2 → + 2 * (Real.exp (H n) - 1 + 2 * eta n) < 1 → + ∀ C, C ∈ R n → + (maximumOverlapPart (QΓ n) C).card < + 2 * (C ∩ maximumOverlapPart + (QΓ n) C).card) ∧ + Tendsto + (fun n => + (((Finset.univ : Finset (Fin (A.model n).size)) \ + matchedRetainedSupport (R n)).card : ℝ) / + (A.model n).size) + atTop (𝓝 0) ∧ + Tendsto + (fun n => + ((∑ C ∈ R n, + (C ∆ maximumOverlapPart + (QΓ n) C).card : ℕ) : ℝ) / + (A.model n).size) + atTop (𝓝 0) ∧ + (∀ n, 2 * (Real.exp (H n) - 1 + 2 * eta n) < 1 → + Set.InjOn (maximumOverlapPart (QΓ n)) + ((R n : Finset (Finset (Fin (A.model n).size))) : + Set (Finset (Fin (A.model n).size)))) := by + classical + obtain ⟨SΓ, SG, QΓ, QG, γΓ, γG, _hSG, + honeΓ, hsymmetricΓ, hgeneratesΓ, + _honeG, hsymmetricG, hgeneratesG, + _hfaithful, hpositive, + hγΓ, hγG, hexpandΓ, hexpandG, + hboundaryΓ, hboundaryG⟩ := + exists_unconditional_actual_source_dual_finpartition_sequences A + have hexpandΓ' : + ∀ n, ∀ C ∈ (QΓ n).parts, + ∀ E : Finset (Fin (A.model n).size), + E ⊆ C → + 2 * E.card ≤ C.card → + γΓ * (E.card : ℝ) ≤ + (boundary + (fun i : ↥SΓ => + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode))) E : ℝ) := + hexpandΓ + have hboundaryΓ' : + Tendsto + (fun n => + (∑ C ∈ (QΓ n).parts, + (boundary + (fun i : ↥SΓ => + (A.model n).action + (SourceBothCompressionNormalization.sourceAlphaElement + (i : prefixElementaryGroup + alphaPrefixCode))) C : ℝ)) / + (A.model n).size) + atTop (𝓝 0) := + hboundaryΓ + obtain ⟨eta, H, hetapos, hetaone, _hetaanti, hetazero, + hHpos, _hHanti, hHzero, hratio, hoverlap, hloss⟩ := + KunActualBothTransportedOverlapScales.exists_source_both_capped_overlap_scales + A SΓ hsymmetricΓ hgeneratesΓ QΓ γΓ hγΓ + hexpandΓ' hboundaryΓ' + have hoverlap' : + ∀ j : Fin 2, Tendsto + (fun n => + (∑ C ∈ insufficientOverlapComponents + (transportedUnivFinpartition + (QΓ n) + ((A.model n).action + (KunExactActualSourceAmbientGenerators.sourceCompressionTable + j))) + (QΓ n) (eta n), (C.card : ℝ)) / + (A.model n).size) + atTop (𝓝 0) := + hoverlap + have hloss' : + ∀ j : Fin 2, Tendsto + (fun n => + (∑ C ∈ + (transportedUnivFinpartition + (QΓ n) + ((A.model n).action + (KunExactActualSourceAmbientGenerators.sourceCompressionTable + j))).parts, + ((C.card : ℝ) - + ((C ∩ maximumOverlapPart + (QΓ n) C).card : ℝ))) / + (A.model n).size) + atTop (𝓝 0) := + hloss + obtain ⟨r, hr, hvariance, hinverse⟩ := + exists_source_common_log_rank_with_ambient_midrank_variance + A SΓ SG QΓ QG γG + hsymmetricG hgeneratesG hpositive hγG hexpandG + hboundaryΓ hboundaryG eta H + (fun n => (hetapos n).le) hetaone hHpos + hetazero hratio hoverlap' hloss' + let : ∀ n, Nonempty (Fin (A.model n).size) := + fun n => Fin.pos_iff_nonempty.mp (A.model n).size_pos + let T : (n : ℕ) → Fin 2 → Equiv.Perm (Fin (A.model n).size) := + fun n j => + (A.model n).action + (SourceBothCompressionNormalization.sourceCompressionTable j) + have hvariance' : + Tendsto + (fun n => + (∑ C ∈ (QG n).parts, + (C.card : ℝ) * + midrankVariance + (componentRankMassList C + (SourceRetainedActualMatching.logarithmicComponentRank + (QΓ n) (H n) (r n)))) / + Fintype.card (Fin (A.model n).size)) + atTop (𝓝 0) := by + simpa only [ + SourceRetainedActualMatching.logarithmicComponentRank, + SourceCommonOffsetMidrankEnergy.componentLogRank, + SourceCommonOffsetMidrankEnergy.realComponentSize, + Fintype.card_fin] using hvariance + have hinverse' : + ∀ j : Fin 2, Tendsto + (fun n => + ((partitionWordCrossing + (QG n) (T n j).symm).card : ℝ) / + Fintype.card (Fin (A.model n).size)) + atTop (𝓝 0) := by + intro j + simpa only [T, Fintype.card_fin, Equiv.Perm.inv_def, + SourceBothCompressionNormalization.sourceCompressionTable, + SourceBothCompressionNormalization.sourceCompressionUElement, + SourceBothCompressionNormalization.sourceCompressionVElement, + KunExactActualSourceAmbientGenerators.sourceCompressionTable, + KunExactActualSourceAmbientGenerators.sourceCompressionU, + KunExactActualSourceAmbientGenerators.sourceCompressionV] + using hinverse j + have hoverlapNat : + ∀ j : Fin 2, Tendsto + (fun n => + ((∑ C ∈ insufficientOverlapComponents + (transportedUnivFinpartition + (QΓ n) (T n j)) + (QΓ n) (eta n), C.card : ℕ) : ℝ) / + Fintype.card (Fin (A.model n).size)) + atTop (𝓝 0) := by + intro j + simpa only [T, Nat.cast_sum, Fintype.card_fin] using hoverlap j + have hmatch := + SourceRetainedActualMatching.retained_source_transport_matching_of_ambient_midrank_variance + (fun n => Fin (A.model n).size) + (Fin 2) QΓ QG T H r eta hHpos hHzero + (fun n => (hetapos n).le) hetazero + hvariance' hinverse' hoverlapNat (0 : Fin 2) + have hTzero (n : ℕ) : + T n (0 : Fin 2) = + (A.model n).action + SourceBothCompressionNormalization.sourceCompressionUElement := + rfl + let R : (n : ℕ) → Finset (Finset (Fin (A.model n).size)) := + fun n => + SourceRetainedActualMatching.retainedTransportedComponents + (QΓ n) + ((A.model n).action + SourceBothCompressionNormalization.sourceCompressionUElement) + (H n) (r n) (eta n) + obtain ⟨hparts, htarget, hmajor, hdiscard, hsymmetric, hinjective⟩ := + hmatch + refine ⟨SΓ, QΓ, γΓ, H, eta, r, R, + honeΓ, hsymmetricΓ, hgeneratesΓ, hγΓ, + hexpandΓ', hboundaryΓ', hHpos, hHzero, + hetapos, hetaone, hetazero, hr, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro n + rfl + · simpa only [R, hTzero] using hparts + · simpa only [R, hTzero] using htarget + · simpa only [R, hTzero] using hmajor + · simpa only [R, hTzero, Fintype.card_fin] using hdiscard + · simpa only [R, hTzero, Fintype.card_fin] using hsymmetric + · simpa only [R, hTzero] using hinjective + +end KunActualSourceURetainedNoPremise + +namespace KunLiteralSourceSelectedComponents + +open Filter Topology +open scoped BigOperators Pointwise + +private noncomputable def sourceSelectedProductRadiusLabels + (S : Finset + (prefixElementaryGroup alphaPrefixCode)) + (F : Finset + (ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1])) + (k : ℕ) : + Finset + (prefixElementaryGroup alphaZeroPrefixCode × + ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1]) := by + classical + exact + CanonicalProductRadiusBadMatchedCapture.sourceProductRadiusLabels + (SourceProductThroughAlpha.sourceCompressedGeneratingFinset S) + F k + +private theorem exists_source_selected_components + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (F : Finset + (ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1])) : + ∃ (S : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure + (S : Set + (prefixElementaryGroup + alphaPrefixCode)) = ⊤) + (Q : (n : ℕ) → + Finpartition (Finset.univ : Finset (Fin (A.model n).size))) + (gamma : ℝ) (N : ℕ) (r : ℕ → ℕ) + (C : (n : ℕ) → Finset (Fin (A.model (n + N)).size)), + 1 ∈ S ∧ + 0 < gamma ∧ + Tendsto + (fun n => + (∑ D ∈ (Q n).parts, + (boundary + (fun i : ↥S => + (A.model n).action + (SourceGeneratedWordCrossing.sourceAlphaInclusion + i)) D : ℝ)) / + (A.model n).size) + atTop (𝓝 0) ∧ + Tendsto r atTop atTop ∧ + (∀ n, C n ∈ (sourceTransportedPartition A Q (n + N)).parts) ∧ + (∀ n, (C n).Nonempty) ∧ + (∀ n, ∀ D : Finset (Fin (A.model (n + N)).size), + D ⊆ C n → 2 * D.card ≤ (C n).card → + gamma * (D.card : ℝ) ≤ + (boundary + (sourceTransportedReferenceGenerators A S (n + N)) D : ℝ)) ∧ + Tendsto + (fun n => + (boundary + (sourceTransportedReferenceGenerators A S (n + N)) + (C n) : ℝ) / (C n).card) + atTop (𝓝 0) ∧ + Tendsto + (fun n => + (((C n ∩ matchedRadiusBad + (sourceTransportedPartition A Q (n + N)) + (sourceSelectedProductRadiusLabels S F (r n)) + (((SourceProductThroughAlpha.sourceCompressedLocalProductApproximation + A).model (n + N)).action) + (sourceSelectedRadiusBad A S + hsymmetric hgenerates F (n + N) (r n))).card : ℝ) / + (C n).card)) + atTop (𝓝 0) ∧ + Tendsto (fun n => (C n).card) atTop atTop := by + classical + obtain ⟨S, Q, gamma, H, eta, _offset, R, + hone, hsymmetric, hgenerates, hgamma, + hexpand, hsource, _hHpositive, hH, + _hetapositive, _hetaone, heta, _hoffset, _hRdef, + hR, htarget, hmajor, hdiscard, hsymm, _hinjective⟩ := + KunActualSourceURetainedNoPremise.exists_actual_source_u_retained_matching A + have hsource' : + Tendsto + (fun n => + (∑ D ∈ (Q n).parts, + (boundary + (fun i : ↥S => + (A.model n).action + (SourceGeneratedWordCrossing.sourceAlphaInclusion + i)) D : ℝ)) / + (A.model n).size) + atTop (𝓝 0) := by + exact hsource + let P : (n : ℕ) → + Finpartition (Finset.univ : Finset (Fin (A.model n).size)) := + fun n => sourceTransportedPartition A Q n + let sigma : (n : ℕ) → ↥S → Equiv.Perm (Fin (A.model n).size) := + fun n => sourceTransportedReferenceGenerators A S n + let E : (n : ℕ) → ℕ → Finset (Fin (A.model n).size) := + fun n _ => sourceGeneratorFamilyConjugacyBad A S n + have hRP : ∀ n, R n ⊆ (P n).parts := by + simpa only [P, sourceTransportedPartition, + sourceCompressionPermutation] using hR + have hE : ∀ k, Tendsto + (fun n => ((E n k).card : ℝ) / (A.model n).size) + atTop (𝓝 0) := by + intro k + simpa only [E] using + sourceGeneratorFamilyConjugacyBad_density_tendsto_zero A S + have hboundary : Tendsto + (fun n => + (∑ D ∈ (P n).parts, + (boundary (sigma n) D : ℝ)) / + (A.model n).size) + atTop (𝓝 0) := by + change Tendsto + (fun n => + (∑ D ∈ + (transportedUnivFinpartition + (Q n) + ((A.model n).action + SourceBothCompressionNormalization.sourceCompressionUElement)).parts, + (boundary + (fun i : ↥S => + (A.model n).action + SourceBothCompressionNormalization.sourceCompressionUElement * + (A.model n).action + (SourceGeneratedWordCrossing.sourceAlphaInclusion i) * + ((A.model n).action + SourceBothCompressionNormalization.sourceCompressionUElement)⁻¹) + D : ℝ)) / (A.model n).size) + atTop (𝓝 0) + exact + SourceProductThroughAlpha.source_u_transported_reference_boundary_density_tendsto_zero + A S Q hsource' + obtain ⟨N, r, C, _hN, _hetaguard, _hexpguard, + hr, hCR, hCboundary, hCbad, hCgrowth⟩ := + exists_source_guarded_canonical_selected_components_of_retained_matching + A S hone hsymmetric hgenerates + P Q sigma R hRP + (fun n D => maximumOverlapPart (Q n) D) + htarget H eta hH heta hmajor hdiscard hsymm + F E hE hsource' hboundary 0 + have hCpart (n : ℕ) : + C n ∈ (sourceTransportedPartition A Q (n + N)).parts := by + exact hRP (n + N) (hCR n) + have hCnonempty (n : ℕ) : (C n).Nonempty := + (sourceTransportedPartition A Q (n + N)).nonempty_of_mem_parts + (hCpart n) + have hexpand' : + ∀ n, ∀ D ∈ (Q n).parts, + ∀ E₀ : Finset (Fin (A.model n).size), E₀ ⊆ D → + 2 * E₀.card ≤ D.card → + gamma * (E₀.card : ℝ) ≤ + (boundary + (fun i : ↥S => + (A.model n).action + (SourceGeneratedWordCrossing.sourceAlphaInclusion + i)) E₀ : ℝ) := by + exact hexpand + have htransported := + SourceProductThroughAlpha.source_u_transported_reference_half_expansion + A S Q gamma hexpand' + refine ⟨S, hsymmetric, hgenerates, Q, gamma, N, r, C, + hone, hgamma, + hsource', hr, hCpart, hCnonempty, ?_, ?_, ?_, hCgrowth⟩ + · intro n D hDC hhalf + change gamma * (D.card : ℝ) ≤ + (boundary + (fun i : ↥S => + (A.model (n + N)).action + SourceBothCompressionNormalization.sourceCompressionUElement * + (A.model (n + N)).action + (SourceGeneratedWordCrossing.sourceAlphaInclusion i) * + ((A.model (n + N)).action + SourceBothCompressionNormalization.sourceCompressionUElement)⁻¹) + D : ℝ) + exact htransported (n + N) (C n) (hCpart n) D hDC hhalf + · simpa only [sigma] using hCboundary + · simpa only [P, E, sourceTransportedPartition, + sourceCompressionPermutation, sourceSelectedProductRadiusLabels, + SourceGuardedCanonicalSelection.guardedCanonicalProductRadiusBad, + sourceSelectedRadiusBad] using hCbad + +end KunLiteralSourceSelectedComponents + +namespace SourceProductThroughAlpha + +open scoped BigOperators + +private noncomputable def sourceCompressedGeneratorSubtypeEquiv + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) : + (↥SΓ) ≃ + (↥(sourceCompressedGeneratingFinset SΓ)) := by + classical + refine + { toFun := ?_ + invFun := ?_ + left_inv := ?_ + right_inv := ?_ } + · intro g + refine ⟨sourceCompressionUAlphaEquiv (g : + prefixElementaryGroup alphaPrefixCode), ?_⟩ + change sourceCompressionUAlphaEquiv (g : + prefixElementaryGroup alphaPrefixCode) ∈ + SΓ.image sourceCompressionUAlphaEquiv + exact Finset.mem_image.mpr ⟨g, g.property, rfl⟩ + · intro k + refine ⟨sourceCompressionUAlphaEquiv.symm (k : + prefixElementaryGroup alphaZeroPrefixCode), ?_⟩ + have hk : + (k : prefixElementaryGroup + alphaZeroPrefixCode) ∈ + SΓ.image sourceCompressionUAlphaEquiv := by + exact k.property + obtain ⟨g, hg, heq⟩ := Finset.mem_image.mp hk + rw [← heq, sourceCompressionUAlphaEquiv.symm_apply_apply] + exact hg + · intro g + apply Subtype.ext + exact sourceCompressionUAlphaEquiv.symm_apply_apply _ + · intro k + apply Subtype.ext + exact sourceCompressionUAlphaEquiv.apply_symm_apply _ + +private theorem boundary_sourceCompressedGeneratorSubtypeEquiv + {V : Type*} [DecidableEq V] + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (σ : ↥(sourceCompressedGeneratingFinset SΓ) → Equiv.Perm V) + (E : Finset V) : + boundary + (fun i : ↥SΓ => + σ (sourceCompressedGeneratorSubtypeEquiv SΓ i)) E = + boundary σ E := by + classical + unfold boundary + exact Equiv.sum_comp (sourceCompressedGeneratorSubtypeEquiv SΓ) + (fun i : ↥(sourceCompressedGeneratingFinset SΓ) => + (E.filter fun x => σ i x ∉ E).card) + +end SourceProductThroughAlpha + +namespace KunGuardedCanonicalMatchedDensity + +open Filter Topology + +private theorem matchedRadiusBad_mono_bad + {V ι : Type*} [DecidableEq V] + {U : Finset V} (P : Finpartition U) + (I : Finset ι) (w : ι → Equiv.Perm V) + {B B' : Finset V} (hB : B ⊆ B') : + matchedRadiusBad P I w B ⊆ + matchedRadiusBad P I w B' := by + intro x hx + unfold matchedRadiusBad at hx ⊢ + rcases Finset.mem_union.mp hx with hxB | hxcross + · exact Finset.mem_union_left _ (hB hxB) + · exact Finset.mem_union_right _ hxcross + +private theorem canonical_matched_density_of_guarded + (V : ℕ → Type*) [∀ n, DecidableEq (V n)] + (U : (n : ℕ) → Finset (V n)) + (P : (n : ℕ) → Finpartition (U n)) + {ι : Type*} (I : ℕ → Finset ι) + (w : (n : ℕ) → ι → Equiv.Perm (V n)) + (B E C : (n : ℕ) → Finset (V n)) + (hguarded : Tendsto + (fun n => + (((C n ∩ matchedRadiusBad + (P n) (I n) (w n) (B n ∪ E n)).card : ℝ) / + (C n).card)) + atTop (nhds 0)) : + Tendsto + (fun n => + (((C n ∩ matchedRadiusBad + (P n) (I n) (w n) (B n)).card : ℝ) / + (C n).card)) + atTop (nhds 0) := by + refine squeeze_zero (fun n => by positivity) ?_ hguarded + intro n + have hsubset : + C n ∩ matchedRadiusBad + (P n) (I n) (w n) (B n) ⊆ + C n ∩ matchedRadiusBad + (P n) (I n) (w n) (B n ∪ E n) := by + intro x hx + obtain ⟨hxC, hxB⟩ := Finset.mem_inter.mp hx + exact Finset.mem_inter.mpr + ⟨hxC, matchedRadiusBad_mono_bad + (P n) (I n) (w n) + (Finset.subset_union_left : B n ⊆ B n ∪ E n) hxB⟩ + have hcard : + ((C n ∩ matchedRadiusBad + (P n) (I n) (w n) (B n)).card : ℝ) ≤ + (C n ∩ matchedRadiusBad + (P n) (I n) (w n) (B n ∪ E n)).card := by + exact_mod_cast Finset.card_le_card hsubset + exact div_le_div_of_nonneg_right hcard (by positivity) + +end KunGuardedCanonicalMatchedDensity + +namespace KunActualCanonicalSelectedPruning + +open Filter Topology +open MatchedComponentCompletion + +private theorem exists_actual_uniformly_expanding_pruned_selected_components + {K J : Type*} [Group K] [Group J] + (A : SoficApproximation (K × J)) + (S : Finset K) + (ν : ℕ → ℕ) + (Q : (n : ℕ) → Finpartition + (Finset.univ : Finset (Fin (A.model (ν n)).size))) + (C : (n : ℕ) → Finset (Fin (A.model (ν n)).size)) + (hC : ∀ n, C n ∈ (Q n).parts) + (hlarge : Tendsto (fun n => (C n).card) atTop atTop) + (γ : ℝ) (hγ : 0 < γ) + (a : ℕ → ℝ) + (ha : Tendsto a atTop (nhds 0)) + (hadd : ∀ n, + ∀ E : Finset {x : Fin (A.model (ν n)).size // x ∈ C n}, + γ * min (E.card : ℝ) + ((Fintype.card + {x : Fin (A.model (ν n)).size // x ∈ C n} : ℝ) - + E.card) - + a n * Fintype.card + {x : Fin (A.model (ν n)).size // x ∈ C n} ≤ + (boundary + (fun i : ↥S => + completedRestriction + ((A.model (ν n)).action ((i : K), (1 : J))) + (C n)) E : ℝ)) : + ∃ (N : ℕ) + (D : (n : ℕ) → Finset + {x : Fin (A.model (ν (n + N))).size // x ∈ C (n + N)}) + (τ : (n : ℕ) → ↥S → Equiv.Perm + {x : {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)} // + x ∈ (Finset.univ \ D n : + Finset {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)})}), + (∀ n, + (Finset.univ \ D n : + Finset {x : Fin (A.model (ν (n + N))).size // + x ∈ C (n + N)}).Nonempty) ∧ + Tendsto + (fun n => ((D n).card : ℝ) / (C (n + N)).card) + atTop (nhds 0) ∧ + Tendsto + (fun n => + (Finset.univ \ D n : + Finset {x : Fin (A.model (ν (n + N))).size // + x ∈ C (n + N)}).card) + atTop atTop ∧ + (∀ n (i : ↥S) + (x : {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)}) + (hx : x ∈ (Finset.univ \ D n : + Finset {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)})) + (_hi : completedRestriction + ((A.model (ν (n + N))).action ((i : K), (1 : J))) + (C (n + N)) x ∈ + (Finset.univ \ D n : + Finset {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)})), + ((τ n i ⟨x, hx⟩ : + {z : {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)} // + z ∈ (Finset.univ \ D n : + Finset {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)})}) : + {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)}) = + completedRestriction + ((A.model (ν (n + N))).action ((i : K), (1 : J))) + (C (n + N)) x) ∧ + (∀ n, + ∀ E : Finset + {x : {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)} // + x ∈ (Finset.univ \ D n : + Finset {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)})}, + (γ / 2) * min (E.card : ℝ) + ((Fintype.card + {x : {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)} // + x ∈ (Finset.univ \ D n : + Finset {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)})} : ℝ) - E.card) ≤ + (boundary (τ n) E : ℝ)) := by + classical + let ell : ℝ := γ / 2 + have hgap : ell < γ := by + dsimp [ell] + linarith + have hgapPositive : 0 < γ - ell := sub_pos.mpr hgap + let c : ℝ := + 2 * (2 * (γ - ell) + (Fintype.card ↥S : ℝ)) + have hc : 0 < c := by + dsimp [c] + have hcard : (0 : ℝ) ≤ Fintype.card ↥S := by + exact Nat.cast_nonneg _ + nlinarith + have htarget : 0 < (γ - ell) ^ 2 / c := + div_pos (sq_pos_of_pos hgapPositive) hc + have hsmallEvent : ∀ᶠ n in atTop, + a n < (γ - ell) ^ 2 / c := + ha.eventually (gt_mem_nhds htarget) + obtain ⟨N, hN⟩ := eventually_atTop.1 hsmallEvent + have hsmall (n : ℕ) : + 2 * a (n + N) * + (2 * (γ - ell) + (Fintype.card ↥S : ℝ)) ≤ + (γ - ell) ^ 2 := by + have hratio : a (n + N) < (γ - ell) ^ 2 / c := + hN (n + N) (by omega) + have hbound : a (n + N) * c < (γ - ell) ^ 2 := + (lt_div_iff₀ hc).mp hratio + calc + 2 * a (n + N) * + (2 * (γ - ell) + (Fintype.card ↥S : ℝ)) = + a (n + N) * c := by + dsimp [c] + ring + _ ≤ (γ - ell) ^ 2 := hbound.le + have hstage (n : ℕ) : + ∃ (D : Finset + {x : Fin (A.model (ν (n + N))).size // + x ∈ C (n + N)}) + (τ : ↥S → Equiv.Perm + {x : {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)} // + x ∈ (Finset.univ \ D : + Finset {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)})}), + 2 * D.card ≤ (C (n + N)).card ∧ + (D.card : ℝ) ≤ + a (n + N) * (C (n + N)).card / (γ - ell) ∧ + (∀ (i : ↥S) + (x : {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)}) + (hx : x ∈ (Finset.univ \ D : + Finset {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)})) + (_hi : completedRestriction + ((A.model (ν (n + N))).action ((i : K), (1 : J))) + (C (n + N)) x ∈ + (Finset.univ \ D : + Finset {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)})), + ((τ i ⟨x, hx⟩ : + {z : {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)} // + z ∈ (Finset.univ \ D : + Finset {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)})}) : + {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)}) = + completedRestriction + ((A.model (ν (n + N))).action ((i : K), (1 : J))) + (C (n + N)) x) ∧ + (∀ E : Finset + {x : {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)} // + x ∈ (Finset.univ \ D : + Finset {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)})}, + ell * min (E.card : ℝ) + ((Fintype.card + {x : {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)} // + x ∈ (Finset.univ \ D : + Finset {y : Fin (A.model (ν (n + N))).size // + y ∈ C (n + N)})} : ℝ) - E.card) ≤ + (boundary τ E : ℝ)) := by + simpa only [Fintype.card_coe] using + KunCompletedPrunedComponent.exists_completed_pruned_expander + (fun i : ↥S => + completedRestriction + ((A.model (ν (n + N))).action ((i : K), (1 : J))) + (C (n + N))) + γ ell (a (n + N)) hgap (hadd (n + N)) (hsmall n) + choose D τ hhalf hbound hagree hexpand using hstage + have hnonempty (n : ℕ) : + (Finset.univ \ D n : + Finset {x : Fin (A.model (ν (n + N))).size // + x ∈ C (n + N)}).Nonempty := by + have hCpositive : 0 < (C (n + N)).card := + ((Q (n + N)).nonempty_of_mem_parts (hC (n + N))).card_pos + have hpositive : + 0 < (Finset.univ \ D n : + Finset {x : Fin (A.model (ν (n + N))).size // + x ∈ C (n + N)}).card := by + rw [Finset.card_sdiff_of_subset (Finset.subset_univ (D n)), + Finset.card_univ, Fintype.card_coe] + have hh := hhalf n + omega + exact Finset.card_pos.mp hpositive + have hshift : Tendsto (fun n : ℕ => n + N) atTop atTop := + tendsto_add_atTop_nat N + have haupper : Tendsto + (fun n => a (n + N) / (γ - ell)) + atTop (nhds 0) := by + simpa only [Function.comp_def, zero_div] using + (ha.comp hshift).div_const (γ - ell) + have hdeleted : Tendsto + (fun n => ((D n).card : ℝ) / (C (n + N)).card) + atTop (nhds 0) := by + apply squeeze_zero + (fun n => by positivity) + (fun n => ?_) + haupper + have hCpositive : (0 : ℝ) < (C (n + N)).card := by + exact_mod_cast + ((Q (n + N)).nonempty_of_mem_parts (hC (n + N))).card_pos + calc + ((D n).card : ℝ) / (C (n + N)).card ≤ + (a (n + N) * (C (n + N)).card / + (γ - ell)) / (C (n + N)).card := + div_le_div_of_nonneg_right (hbound n) hCpositive.le + _ = a (n + N) / (γ - ell) := by + field_simp [hCpositive.ne', hgapPositive.ne'] + have hshiftlarge : + Tendsto (fun n => (C (n + N)).card) atTop atTop := by + simpa only [Function.comp_def] using hlarge.comp hshift + have hzlarge : Tendsto + (fun n => + (Finset.univ \ D n : + Finset {x : Fin (A.model (ν (n + N))).size // + x ∈ C (n + N)}).card) + atTop atTop := by + apply MatchedComponentExitBudget.pruned_component_card_tendsto_atTop + (fun n => {x : Fin (A.model (ν (n + N))).size // + x ∈ C (n + N)}) D + · simpa only [Fintype.card_coe] using hshiftlarge + · simpa only [Fintype.card_coe] using hdeleted + refine ⟨N, D, τ, hnonempty, hdeleted, hzlarge, + hagree, ?_⟩ + simpa only [ell] using hexpand + +end KunActualCanonicalSelectedPruning + +namespace KunActualCanonicalPrunedSourceBadDensity + +open Filter Topology +open MatchedComponentCompletion +open CanonicalProductRadiusBadMatchedCapture + +private theorem pruned_sourceCompletionBad_density_tendsto_zero_of_canonical_matched + {K J : Type*} [Group K] [Group J] + [DecidableEq K] [DecidableEq J] + (A : SoficApproximation (K × J)) + (S : Finset K) + (hsymmetric : ∀ a ∈ S, a⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set K) = ⊤) + (F : Finset J) (ν : ℕ → ℕ) + (Q : (n : ℕ) → Finpartition + (Finset.univ : Finset (Fin (A.model (ν n)).size))) + (C : (n : ℕ) → Finset (Fin (A.model (ν n)).size)) + (hC : ∀ n, C n ∈ (Q n).parts) + (r : ℕ → ℕ) + (hmatched : Tendsto + (fun n => + (((C n ∩ matchedRadiusBad + (Q n) (sourceProductRadiusLabels S F (r n)) + ((A.model (ν n)).action) + (canonicalProductRadiusBad + A S hsymmetric hgenerates F (ν n) (r n))).card : ℝ) / + (C n).card)) + atTop (𝓝 0)) + (D : (n : ℕ) → Finset + {x : Fin (A.model (ν n)).size // x ∈ C n}) + (hZ : ∀ n, + (Finset.univ \ D n : + Finset {x : Fin (A.model (ν n)).size // x ∈ C n}).Nonempty) + (hdeleted : Tendsto + (fun n => ((D n).card : ℝ) / (C n).card) + atTop (𝓝 0)) : + Tendsto + (fun n => + ((sourceCompletionBad + (fun i : ↥S => + completedRestriction + ((A.model (ν n)).action ((i : K), (1 : J))) (C n)) + (fun j : J => + completedRestriction + ((A.model (ν n)).action ((1 : K), j)) (C n)) + F (Finset.univ \ D n)).card : ℝ) / + (Finset.univ \ D n : + Finset {x : Fin (A.model (ν n)).size // x ∈ C n}).card) + atTop (𝓝 0) := by + apply + pruned_sourceCompletionBad_density_tendsto_zero_of_matchedRadius + (fun n => Fin (A.model (ν n)).size) + (fun n (i : ↥S) => (A.model (ν n)).action ((i : K), (1 : J))) + (fun n (j : J) => (A.model (ν n)).action ((1 : K), j)) + F + (fun n => (Finset.univ : Finset (Fin (A.model (ν n)).size))) + C Q + (fun k => sourceProductRadiusLabels S F k) + (fun n => (A.model (ν n)).action) + r + (fun n k => canonicalProductRadiusBad + A S hsymmetric hgenerates F (ν n) k) + D + · intro n + exact sourceCompletionBad_subset_canonical_matchedRadiusBad + A S hsymmetric hgenerates F (ν n) (r n) + (Q n) (C n) (hC n) + · exact hmatched + · exact hZ + · exact hdeleted + +end KunActualCanonicalPrunedSourceBadDensity + +open KunActualCanonicalPrunedSourceBadDensity + +namespace KunActualTwicePrunedFirstFactorRootBad + +open Filter Topology +open MatchedComponentCompletion +open MatchedComponentExitBudget +open KunActualSoficRootRadius +open CanonicalProductRadiusBadMatchedCapture +open CompletedSourceFinalGeneratorTransfer +open scoped BigOperators Pointwise + +private noncomputable def restrictionMultiplicationBad + {V : Type*} [DecidableEq V] + (p q r : Equiv.Perm V) (Z : Finset V) : Finset V := + Z.filter (fun x => q x ∉ Z ∨ r x ∉ Z ∨ r x ≠ p (q x)) + +private theorem completedRestriction_mul_of_not_mem_restrictionMultiplicationBad + {V : Type*} [Fintype V] [DecidableEq V] + (p q r : Equiv.Perm V) (Z : Finset V) + (x : {v : V // v ∈ Z}) + (hx : (x : V) ∉ restrictionMultiplicationBad p q r Z) : + completedRestriction r Z x = + (completedRestriction p Z * completedRestriction q Z) x := by + classical + have hgood : ¬ (q (x : V) ∉ Z ∨ r (x : V) ∉ Z ∨ + r (x : V) ≠ p (q (x : V))) := by + intro h + exact hx (Finset.mem_filter.mpr ⟨x.property, h⟩) + have hq : q (x : V) ∈ Z := by + by_contra hn + exact hgood (Or.inl hn) + have hr : r (x : V) ∈ Z := by + by_contra hn + exact hgood (Or.inr (Or.inl hn)) + have hmul : r (x : V) = p (q (x : V)) := by + by_contra hn + exact hgood (Or.inr (Or.inr hn)) + have hpq : p (q (x : V)) ∈ Z := hmul ▸ hr + have hqvalue : + ((completedRestriction q Z x : {v : V // v ∈ Z}) : V) = + q (x : V) := + completedRestriction_apply_of_mem q Z x x.property hq + apply Subtype.ext + change + ((completedRestriction r Z x : {v : V // v ∈ Z}) : V) = + ((completedRestriction p Z + (completedRestriction q Z x) : {v : V // v ∈ Z}) : V) + calc + ((completedRestriction r Z x : {v : V // v ∈ Z}) : V) = + r (x : V) := + completedRestriction_apply_of_mem r Z x x.property hr + _ = p (q (x : V)) := hmul + _ = p ((completedRestriction q Z x : {v : V // v ∈ Z}) : V) := by + rw [hqvalue] + _ = ((completedRestriction p Z + (completedRestriction q Z x) : {v : V // v ∈ Z}) : V) := by + symm + apply completedRestriction_apply_of_mem + change p ((completedRestriction q Z x : {v : V // v ∈ Z}) : V) ∈ Z + rw [hqvalue] + exact hpq + +private theorem completedRestriction_mul_distance_le_failure_add_deleted + {V : Type*} [Fintype V] [DecidableEq V] + (p q r : Equiv.Perm V) (Z : Finset V) : + permutationDistance + (completedRestriction r Z) + (completedRestriction p Z * completedRestriction q Z) ≤ + (Finset.univ.filter fun x : V => r x ≠ p (q x)).card + + 2 * (Finset.univ \ Z).card := by + classical + let B : Finset V := restrictionMultiplicationBad p q r Z + let E₁ : Finset V := Z.filter fun x => q x ∉ Z + let E₂ : Finset V := Z.filter fun x => r x ∉ Z + let E₃ : Finset V := Finset.univ.filter fun x : V => r x ≠ p (q x) + have hsubset : B ⊆ E₁ ∪ E₂ ∪ E₃ := by + intro x hx + have hx' := Finset.mem_filter.mp hx + rcases hx'.2 with hq | hr | hmul + · exact Finset.mem_union_left _ + (Finset.mem_union_left _ (Finset.mem_filter.mpr ⟨hx'.1, hq⟩)) + · exact Finset.mem_union_left _ + (Finset.mem_union_right _ (Finset.mem_filter.mpr ⟨hx'.1, hr⟩)) + · exact Finset.mem_union_right _ + (Finset.mem_filter.mpr ⟨Finset.mem_univ _, hmul⟩) + have hB : + B.card ≤ E₁.card + E₂.card + E₃.card := by + calc + B.card ≤ (E₁ ∪ E₂ ∪ E₃).card := Finset.card_le_card hsubset + _ ≤ (E₁ ∪ E₂).card + E₃.card := Finset.card_union_le _ _ + _ ≤ (E₁.card + E₂.card) + E₃.card := by + gcongr + exact Finset.card_union_le _ _ + have hdist : + permutationDistance + (completedRestriction r Z) + (completedRestriction p Z * completedRestriction q Z) ≤ B.card := by + calc + permutationDistance + (completedRestriction r Z) + (completedRestriction p Z * completedRestriction q Z) ≤ + (subtypeBad Z B).card := + permutationDistance_le_subtypeBad Z B _ _ + (fun x hx => + completedRestriction_mul_of_not_mem_restrictionMultiplicationBad + p q r Z x hx) + _ = (Z ∩ B).card := card_subtypeBad Z B + _ ≤ B.card := Finset.card_le_card Finset.inter_subset_right + have hE₁ : E₁.card ≤ (Finset.univ \ Z).card := + card_permutation_exit_le_deleted q Z + have hE₂ : E₂.card ≤ (Finset.univ \ Z).card := + card_permutation_exit_le_deleted r Z + change + permutationDistance + (completedRestriction r Z) + (completedRestriction p Z * completedRestriction q Z) ≤ + E₃.card + 2 * (Finset.univ \ Z).card + omega + +private theorem firstFactor_completed_mul_distance_le_canonical_matched + {K J : Type*} [Group K] [Group J] + [DecidableEq K] [DecidableEq J] + (A : SoficApproximation (K × J)) + (S : Finset K) + (hsymmetric : ∀ a ∈ S, a⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set K) = ⊤) + (F : Finset J) (n k : ℕ) + {U : Finset (Fin (A.model n).size)} + (Q : Finpartition U) + (C : Finset (Fin (A.model n).size)) + (hC : C ∈ Q.parts) + (a g : K) + (ha : a ∈ S ^ k) (hg : g ∈ S ^ k) + (hag : a * g ∈ S ^ k) : + permutationDistance + (completedRestriction + ((A.model n).action (a * g, (1 : J))) C) + (completedRestriction + ((A.model n).action (a, (1 : J))) C * + completedRestriction + ((A.model n).action (g, (1 : J))) C) ≤ + (C ∩ matchedRadiusBad + Q (sourceProductRadiusLabels S F k) + ((A.model n).action) + (canonicalProductRadiusBad A S hsymmetric hgenerates F n k)).card := by + classical + let B := matchedRadiusBad + Q (sourceProductRadiusLabels S F k) + ((A.model n).action) + (canonicalProductRadiusBad A S hsymmetric hgenerates F n k) + calc + permutationDistance + (completedRestriction + ((A.model n).action (a * g, (1 : J))) C) + (completedRestriction + ((A.model n).action (a, (1 : J))) C * + completedRestriction + ((A.model n).action (g, (1 : J))) C) ≤ + (subtypeBad C B).card := by + apply permutationDistance_le_subtypeBad C B + intro x hx + apply completedRestriction_mul_of_not_mem_restrictionMultiplicationBad + ((A.model n).action (a, (1 : J))) + ((A.model n).action (g, (1 : J))) + ((A.model n).action (a * g, (1 : J))) C x + intro hfailure + have hbad := (Finset.mem_filter.mp hfailure).2 + have hnotcross (b : K) (hb : b ∈ S ^ k) : + (x : Fin (A.model n).size) ∉ + partitionWordCrossing + Q ((A.model n).action (b, (1 : J))) := by + intro hcross + apply hx + apply Finset.mem_union_right + exact Finset.mem_biUnion.mpr + ⟨(b, (1 : J)), + firstFactor_mem_sourceProductRadiusLabels S F k hb, + hcross⟩ + rcases hbad with hq | hr | hmul + · exact hnotcross g hg + (component_exit_mem_partitionWordCrossing + Q C hC ((A.model n).action (g, (1 : J))) + x.property hq) + · exact hnotcross (a * g) hag + (component_exit_mem_partitionWordCrossing + Q C hC ((A.model n).action (a * g, (1 : J))) + x.property hr) + · have hnotroot : + (x : Fin (A.model n).size) ∉ + finiteRootBad (A.model n) + (sourceProductRadiusLabels S F k) := by + intro hroot + apply hx + apply Finset.mem_union_left + exact Finset.mem_union_right _ hroot + have hroot := finiteRootBad_multiplicative + (A.model n) (sourceProductRadiusLabels S F k) + (firstFactor_mem_sourceProductRadiusLabels S F k ha) + (firstFactor_mem_sourceProductRadiusLabels S F k hg) + hnotroot + apply hmul + simpa only [Prod.mk_mul_mk, mul_one, Equiv.Perm.mul_apply] using hroot + _ = (C ∩ matchedRadiusBad + Q (sourceProductRadiusLabels S F k) + ((A.model n).action) + (canonicalProductRadiusBad A S hsymmetric hgenerates F n k)).card := + card_subtypeBad C B + +private theorem density_relative_survivors + (V : ℕ → Type*) [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + (D : (n : ℕ) → Finset (V n)) + (hZ : ∀ n, (Finset.univ \ D n : Finset (V n)).Nonempty) + (hdeleted : Tendsto + (fun n => ((D n).card : ℝ) / Fintype.card (V n)) + atTop (nhds 0)) + (b : ℕ → ℕ) + (hb : Tendsto + (fun n => (b n : ℝ) / Fintype.card (V n)) + atTop (nhds 0)) : + Tendsto + (fun n => (b n : ℝ) / + (Finset.univ \ D n : Finset (V n)).card) + atTop (nhds 0) := by + have hcover := surviving_card_ratio_tendsto_one V D hZ hdeleted + have hquotient : Tendsto + ((fun n => (b n : ℝ) / Fintype.card (V n)) / + (fun n => + ((Finset.univ \ D n : Finset (V n)).card : ℝ) / + Fintype.card (V n))) + atTop (nhds 0) := by + simpa only [zero_div] using + hb.div hcover (by norm_num : (1 : ℝ) ≠ 0) + convert hquotient using 1 + funext n + have hN : Fintype.card (V n) ≠ 0 := by + obtain ⟨x, _⟩ := hZ n + exact Finset.card_ne_zero.mpr + (show (Finset.univ : Finset (V n)).Nonempty from + ⟨x, Finset.mem_univ x⟩) + have hNreal : (Fintype.card (V n) : ℝ) ≠ 0 := by + exact_mod_cast hN + have hZreal : + ((Finset.univ \ D n : Finset (V n)).card : ℝ) ≠ 0 := by + exact_mod_cast Finset.card_ne_zero.mpr (hZ n) + change + (b n : ℝ) / (Finset.univ \ D n : Finset (V n)).card = + ((b n : ℝ) / Fintype.card (V n)) / + (((Finset.univ \ D n : Finset (V n)).card : ℝ) / + Fintype.card (V n)) + field_simp [hNreal, hZreal] + +private theorem twiceCompleted_firstFactor_mul_normalizedHamming_tendsto_zero_of_canonical_matched + {K J : Type*} [Group K] [Group J] + [DecidableEq K] [DecidableEq J] + (A : SoficApproximation (K × J)) + (S : Finset K) (hone : 1 ∈ S) + (hsymmetric : ∀ a ∈ S, a⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set K) = ⊤) + (F : Finset J) (ν : ℕ → ℕ) + (Q : (n : ℕ) → Finpartition + (Finset.univ : Finset (Fin (A.model (ν n)).size))) + (C : (n : ℕ) → Finset (Fin (A.model (ν n)).size)) + (hC : ∀ n, C n ∈ (Q n).parts) + (r : ℕ → ℕ) (hr : Tendsto r atTop atTop) + (hmatched : Tendsto + (fun n => + (((C n ∩ matchedRadiusBad + (Q n) (sourceProductRadiusLabels S F (r n)) + ((A.model (ν n)).action) + (canonicalProductRadiusBad + A S hsymmetric hgenerates F (ν n) (r n))).card : ℝ) / + (C n).card)) + atTop (nhds 0)) + (D : (n : ℕ) → Finset + {x : Fin (A.model (ν n)).size // x ∈ C n}) + (hZ : ∀ n, + (Finset.univ \ D n : + Finset {x : Fin (A.model (ν n)).size // x ∈ C n}).Nonempty) + (hdeleted : Tendsto + (fun n => ((D n).card : ℝ) / (C n).card) + atTop (nhds 0)) + (a g : K) : + Tendsto + (fun n => + normalizedHamming + (completedRestriction + (completedRestriction + ((A.model (ν n)).action (a * g, (1 : J))) (C n)) + (Finset.univ \ D n)) + (completedRestriction + (completedRestriction + ((A.model (ν n)).action (a, (1 : J))) (C n)) + (Finset.univ \ D n) * + completedRestriction + (completedRestriction + ((A.model (ν n)).action (g, (1 : J))) (C n)) + (Finset.univ \ D n))) + atTop (nhds 0) := by + classical + let W : ℕ → Type := fun n => + {x : Fin (A.model (ν n)).size // x ∈ C n} + let Z : (n : ℕ) → Finset (W n) := fun n => Finset.univ \ D n + let B : ℕ → ℕ := fun n => + (C n ∩ matchedRadiusBad + (Q n) (sourceProductRadiusLabels S F (r n)) + ((A.model (ν n)).action) + (canonicalProductRadiusBad + A S hsymmetric hgenerates F (ν n) (r n))).card + have hdeletedW : Tendsto + (fun n => ((D n).card : ℝ) / Fintype.card (W n)) + atTop (nhds 0) := by + simpa only [W, Fintype.card_coe] using hdeleted + have hBW : Tendsto + (fun n => (B n : ℝ) / Fintype.card (W n)) + atTop (nhds 0) := by + simpa only [B, W, Fintype.card_coe] using hmatched + have hBfinal : Tendsto + (fun n => (B n : ℝ) / (Z n).card) + atTop (nhds 0) := by + exact density_relative_survivors W D hZ hdeletedW B hBW + have hDfinal : Tendsto + (fun n => ((D n).card : ℝ) / (Z n).card) + atTop (nhds 0) := by + exact deleted_density_relative_survivors W D hZ hdeletedW + have hupper : Tendsto + (fun n => (B n : ℝ) / (Z n).card + + 2 * ((D n).card : ℝ) / (Z n).card) + atTop (nhds 0) := by + convert hBfinal.add (hDfinal.const_mul 2) using 1 <;> + simp [mul_div_assoc] + let w : K → List ↥S := + symmetricGeneratorWord S hsymmetric hgenerates + have hw : ∀ b : K, ((w b).map fun i : ↥S => (i : K)).prod = b := + symmetricGeneratorWord_prod S hsymmetric hgenerates + have hlarge : ∀ᶠ n in atTop, + max (w a).length (max (w g).length (w (a * g)).length) ≤ r n := + Filter.tendsto_atTop.1 hr _ + apply squeeze_zero' + (Filter.Eventually.of_forall fun n => + normalizedHamming_nonneg _ _) + ?_ hupper + filter_upwards [hlarge] with n hn + have ha : a ∈ S ^ r n := + mem_generator_pow_of_chosen_word_length S hone w hw + (by omega) + have hg : g ∈ S ^ r n := + mem_generator_pow_of_chosen_word_length S hone w hw + (by omega) + have hag : a * g ∈ S ^ r n := + mem_generator_pow_of_chosen_word_length S hone w hw + (by omega) + let p : Equiv.Perm (W n) := + completedRestriction ((A.model (ν n)).action (a, (1 : J))) (C n) + let q : Equiv.Perm (W n) := + completedRestriction ((A.model (ν n)).action (g, (1 : J))) (C n) + let s : Equiv.Perm (W n) := + completedRestriction ((A.model (ν n)).action (a * g, (1 : J))) (C n) + have hfirst : + permutationDistance s (p * q) ≤ B n := by + exact firstFactor_completed_mul_distance_le_canonical_matched + A S hsymmetric hgenerates F (ν n) (r n) + (Q n) (C n) (hC n) a g ha hg hag + have hfailure : + (Finset.univ.filter fun x : W n => + s x ≠ p (q x)).card ≤ B n := by + calc + (Finset.univ.filter fun x : W n => + s x ≠ p (q x)).card = + permutationDistance s (p * q) := by + unfold permutationDistance hammingDist + congr 1 + _ ≤ B n := hfirst + have hdist := completedRestriction_mul_distance_le_failure_add_deleted + p q s (Z n) + have hcomplement : + (Finset.univ \ Z n : Finset (W n)) = D n := by + ext x + simp only [Finset.mem_sdiff, Finset.mem_univ, true_and, Decidable.not_not, Z] + have hnat : + permutationDistance + (completedRestriction s (Z n)) + (completedRestriction p (Z n) * + completedRestriction q (Z n)) ≤ + B n + 2 * (D n).card := by + rw [hcomplement] at hdist + omega + have hreal : + (permutationDistance + (completedRestriction s (Z n)) + (completedRestriction p (Z n) * + completedRestriction q (Z n)) : ℝ) ≤ + (B n : ℝ) + 2 * (D n).card := by + exact_mod_cast hnat + have hnormalized := div_le_div_of_nonneg_right hreal + (show (0 : ℝ) ≤ ((Z n).card : ℝ) by positivity) + change + normalizedHamming + (completedRestriction s (Z n)) + (completedRestriction p (Z n) * + completedRestriction q (Z n)) ≤ + (B n : ℝ) / (Z n).card + + 2 * ((D n).card : ℝ) / (Z n).card + simpa only [normalizedHamming, Equiv.Perm.coe_mul, Function.comp_apply, Fintype.card_coe, + mul_div_assoc, + permutationDistance, add_div] using hnormalized + +end KunActualTwicePrunedFirstFactorRootBad + +open KunActualTwicePrunedFirstFactorRootBad + +namespace KunActualSelectedPrunedSourceFiniteModelBridge + +open Filter Topology +open MatchedComponentCompletion +open KunActualSoficRootRadius +open scoped BigOperators Pointwise + +private theorem completed_generator_one_of_internal_agreement + {G : Type} [Group G] (S : Finset G) + {W : Type} + (σ : ↥S → Equiv.Perm W) (Z : Finset W) + (τ : ↥S → Equiv.Perm {x : W // x ∈ Z}) + (hagrees : ∀ i (x : W) (hx : x ∈ Z) + (_hi : σ i x ∈ Z), + ((τ i ⟨x, hx⟩ : {x : W // x ∈ Z}) : W) = σ i x) + (hidentity : ∀ i : ↥S, (i : G) = 1 → σ i = 1) + (i : ↥S) (hi : (i : G) = 1) : τ i = 1 := by + have hσ : σ i = 1 := hidentity i hi + ext x + have hinside : σ i (x : W) ∈ Z := by + rw [hσ] + exact x.property + simpa only [Equiv.Perm.coe_one, id_eq, SetLike.coe_eq_coe, Subtype.coe_eta, hσ] using + hagrees i (x : W) x.property hinside + +private theorem nonempty_expandingCentralizerFiniteModel_of_actual_selected_pruned_source + {G J : Type} [Group G] [Group J] + (P : KazhdanPair.{0, 0} G) + (S : Finset G) (honeS : 1 ∈ S) + (hcover : P.generators ⊆ S) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) + (F : Finset J) + (W : ℕ → Type) + [∀ n, Finite (W n)] [∀ n, DecidableEq (W n)] + (σ : (n : ℕ) → ↥S → Equiv.Perm (W n)) + (hσone : ∀ n (i : ↥S), (i : G) = 1 → σ n i = 1) + (p : (n : ℕ) → J → Equiv.Perm (W n)) + (hp : ∀ n, p n 1 = 1) + (Z : (n : ℕ) → Finset (W n)) + (hZ : ∀ n, (Z n).Nonempty) + (hlarge : Tendsto (fun n => (Z n).card) atTop atTop) + (τ : (n : ℕ) → ↥S → + Equiv.Perm {x : W n // x ∈ Z n}) + (hτ : ∀ n i (x : W n) (hx : x ∈ Z n) + (_hi : σ n i x ∈ Z n), + ((τ n i ⟨x, hx⟩ : + {x : W n // x ∈ Z n}) : W n) = σ n i x) + (ρ : (n : ℕ) → G → + Equiv.Perm {x : W n // x ∈ Z n}) + (hρone : ∀ n, ρ n 1 = 1) + (hρmul : ∀ a g : G, + Tendsto + (fun n => normalizedHamming + (ρ n (a * g)) (ρ n a * ρ n g)) + atTop (𝓝 0)) + (hρgenerator : ∀ i : ↥S, + Tendsto + (fun n => normalizedHamming + (τ n i) (ρ n (i : G))) + atTop (𝓝 0)) + (ell : ℝ) (hell : 0 < ell) + (hexp : ∀ n, ∀ E : Finset {x : W n // x ∈ Z n}, + ell * min (E.card : ℝ) + ((Fintype.card {x : W n // x ∈ Z n} : ℝ) - E.card) ≤ + (boundary (τ n) E : ℝ)) + (hbad : Tendsto + (fun n => + ((MatchedComponentCompletion.sourceCompletionBad + (σ n) (p n) F (Z n)).card : ℝ) / (Z n).card) + atTop (𝓝 0)) : + Nonempty (ExpandingCentralizerFiniteModel J F) := by + classical + let : ∀ n, Fintype (W n) := fun n => Fintype.ofFinite (W n) + let V : ℕ → Type := fun n => {x : W n // x ∈ Z n} + let (n : ℕ) : Nonempty (V n) := + ⟨⟨(hZ n).choose, (hZ n).choose_spec⟩⟩ + let w : G → List ↥S := + KunActualSoficRootRadius.symmetricGeneratorWord + S hsymmetric hgenerates + have hw (g : G) : + ((w g).map fun i : ↥S => (i : G)).prod = g := by + exact KunActualSoficRootRadius.symmetricGeneratorWord_prod + S hsymmetric hgenerates g + let φ : (n : ℕ) → G → Equiv.Perm (V n) := + fun n g => ((w g).map (τ n)).prod + have hφone (n : ℕ) : φ n 1 = 1 := by + simp only [symmetricGeneratorWord_one, List.map_nil, List.prod_nil, φ, w] + have hφgenerator (n : ℕ) (i : ↥S) : + φ n (i : G) = τ n i := by + by_cases hi : (i : G) = 1 + · have hτone : τ n i = 1 := + completed_generator_one_of_internal_agreement + S (σ n) (Z n) (τ n) (hτ n) (hσone n) i hi + simp only [hi, symmetricGeneratorWord_one, List.map_nil, List.prod_nil, hτone, φ, w] + · simp only [KunActualSoficRootRadius.symmetricGeneratorWord_generator S hsymmetric + hgenerates i hi, + List.map_cons, List.map_nil, List.prod_cons, List.prod_nil, mul_one, φ, w] + have hφmul (a g : G) : + Tendsto + (fun n => normalizedHamming + (φ n (a * g)) (φ n a * φ n g)) + atTop (𝓝 0) := by + simpa only [CompletedChosenWordLocalRoot.chosenWordEvaluation] using + CompletedChosenWordLocalRoot.chosenWordEvaluation_multiplicative_tendsto V ρ hρone + hρmul + (fun i : ↥S => (i : G)) w hw τ hρgenerator a g + let root : (n : ℕ) → ℕ → Finset (V n) := + fun n k => + CompletedPrescribedSpectralRadiusSchedule.fixedRadiusRootBad + (φ n) S k + have hroot (k : ℕ) : + Tendsto + (fun n => ((root n k).card : ℝ) / Fintype.card (V n)) + atTop (𝓝 0) := by + exact + CompletedPrescribedSpectralRadiusSchedule.fixedRadiusRootBad_density_tendsto_zero + V φ S hφmul k + let source : (n : ℕ) → Finset (V n) := + fun n => MatchedComponentCompletion.subtypeBad + (Z n) + (MatchedComponentCompletion.sourceCompletionBad + (σ n) (p n) F (Z n)) + have hsource : + Tendsto + (fun n => ((source n).card : ℝ) / Fintype.card (V n)) + atTop (𝓝 0) := by + simpa [source, V, + MatchedComponentCompletion.card_subtype_sourceCompletionBad, + Fintype.card_coe] using hbad + have hVpositive (n : ℕ) : 0 < Fintype.card (V n) := by + simpa [V, Fintype.card_coe] using (hZ n).card_pos + have hVlarge : + Tendsto (fun n => Fintype.card (V n)) atTop atTop := by + simpa [V, Fintype.card_coe] using hlarge + let δ : ℕ → ℝ := fun j => 1 / ((j : ℝ) + 1) + have hδpositive (j : ℕ) : 0 < δ j := by + dsimp [δ] + positivity + have hδ : Tendsto δ atTop (𝓝 0) := by + simpa [δ] using + (tendsto_one_div_add_atTop_nhds_zero_nat (𝕜 := ℝ)) + let d : ℕ := S.card + have hd : 0 < d := by + dsimp [d] + exact Finset.card_pos.mpr ⟨1, honeS⟩ + let q : ℝ := + KunThomInvariantOrthogonal.kazhdanMarkovContractionFactor P S + have hq : q < 1 := by + exact KunThomInvariantOrthogonal.kazhdanMarkovContractionFactor_lt_one + P S ⟨1, honeS⟩ + let α : ℕ → ℝ := + fun j => ell * δ j / (2 * (ell + 8 * (d : ℝ))) + have hα (j : ℕ) : 0 < α j := by + dsimp [α] + have hdreal : (0 : ℝ) < d := by exact_mod_cast hd + positivity + let spectral (j : ℕ) := + KunUniformCompletedRootRadiusImprovement.exists_uniform_radius_hasAlmostCentralizerImprovement + P S honeS hcover hsymmetric w ell (α j) hell (hα j) + let radius : ℕ → ℕ := fun j => (spectral j).choose + have hspectral (j : ℕ) := (spectral j).choose_spec + let R : ℕ → ℕ := fun j => max j (radius j) + have hR (j : ℕ) : j ≤ R j := le_max_left _ _ + obtain ⟨m, rootError, t, hm, hRm, hδm, hrelative, + hrootError, hrootlower, hrootlimit, htdef, htpositive, + htroot, htsource, htrooterror, htlimit, htarget, + hsmall, hslow⟩ := + exists_prescribed_radius_union_source_completed_tolerance + V hVpositive hVlarge root source hroot hsource + δ hδpositive hδ R hR d hd ell q hell hq + let pZ : (n : ℕ) → J → Equiv.Perm (V n) := + fun n j => MatchedComponentCompletion.completedRestriction + (p n j) (Z n) + have hpZ (n : ℕ) : pZ n 1 = 1 := by + dsimp [pZ] + rw [hp n, + MatchedComponentCompletion.completedRestriction_one] + have hsourcebudget (n : ℕ) : + 2 * Fintype.card (↥S) * + (MatchedComponentCompletion.sourceCompletionBad + (σ n) (p n) F (Z n)).card ≤ t n := by + have hbudget := htsource n + change + 2 * S.card * + (MatchedComponentCompletion.subtypeBad + (Z n) + (MatchedComponentCompletion.sourceCompletionBad + (σ n) (p n) F (Z n))).card ≤ t n at hbudget + rw [MatchedComponentCompletion.card_subtype_sourceCompletionBad] + at hbudget + simpa only [Fintype.card_coe] using hbudget + have htable := + eventually_completed_sourceCentralizer_table_of_bad_density + W σ p F Z hZ hbad τ hτ t hsourcebudget + have hdefect : ∀ᶠ n in atTop, + ∀ j ∈ CompressionCriterion.productTrackedTable F, + permutationCommutationDefect + (τ n) (pZ n j) ≤ t n := by + filter_upwards [htable] with n hn + simpa only using hn.2.2 + have hmulJ : ∀ᶠ n in atTop, + ∀ a ∈ F, ∀ b ∈ F, + 5 * permutationDistance + (pZ n (a * b)) (pZ n a * pZ n b) ≤ + Fintype.card (V n) := by + filter_upwards [htable] with n hn + simpa [pZ, V] using hn.1 + have hsepJ : ∀ᶠ n in atTop, + ∀ a ∈ F, ∀ b ∈ F, a ≠ b → + Fintype.card (V n) < + 5 * permutationDistance (pZ n a) (pZ n b) := by + filter_upwards [htable] with n hn + simpa [pZ, V] using hn.2.1 + have himprove : ∀ᶠ n in atTop, + HasAlmostCentralizerImprovement (τ n) (t n) := by + filter_upwards [hslow] with n hn + apply hspectral (m n) (V n) (τ n) (φ n) (t n) + (root n (R (m n)) ∪ source n) + · intro g + rfl + · exact hφone n + · exact hφgenerator n + · exact hexp n + · simpa only [one_div] using hn + · right + refine ⟨by exact_mod_cast htpositive n, ?_, ?_, ?_⟩ + · simpa only using htarget n + · have hbudget : + 2 * d * (root n (R (m n)) ∪ source n).card ≤ t n := by + rw [htdef n] + omega + exact_mod_cast hbudget + · intro a g hlength x hx + have hxroot : x ∉ root n (R (m n)) := by + intro hxroot + exact hx (Finset.mem_union_left _ hxroot) + have hradius : radius (m n) ≤ R (m n) := by + exact le_max_right _ _ + exact + CompletedPrescribedSpectralRadiusSchedule.fixedRadiusRootBad_rooted + S honeS w hw (φ n) (R (m n)) a g + (hlength.trans hradius) x hxroot + exact + nonempty_expandingCentralizerFiniteModel_of_selected_completed_sequence + F V (↥S) τ pZ hpZ t ell hell hdefect + (Filter.Eventually.of_forall hexp) + hsmall himprove hmulJ hsepJ + +end KunActualSelectedPrunedSourceFiniteModelBridge + +open KunActualSelectedPrunedSourceFiniteModelBridge + +namespace KunActualCanonicalSelectedFiniteModelComposition + +open Filter Topology +open MatchedComponentCompletion +open CanonicalProductRadiusBadMatchedCapture + +private theorem nonempty_expandingCentralizerFiniteModel_of_canonical_selected_additive + {K J : Type} [Group K] [Group J] + [DecidableEq K] [DecidableEq J] + (A : SoficApproximation (K × J)) + (P : KazhdanPair.{0, 0} K) + (S : Finset K) (hone : 1 ∈ S) + (hcover : P.generators ⊆ S) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set K) = ⊤) + (F : Finset J) (ν : ℕ → ℕ) + (Q : (n : ℕ) → Finpartition + (Finset.univ : Finset (Fin (A.model (ν n)).size))) + (C : (n : ℕ) → Finset (Fin (A.model (ν n)).size)) + (hC : ∀ n, C n ∈ (Q n).parts) + (r : ℕ → ℕ) (hr : Tendsto r atTop atTop) + (hmatched : Tendsto + (fun n => + (((C n ∩ matchedRadiusBad + (Q n) (sourceProductRadiusLabels S F (r n)) + ((A.model (ν n)).action) + (canonicalProductRadiusBad + A S hsymmetric hgenerates F (ν n) (r n))).card : ℝ) / + (C n).card)) + atTop (𝓝 0)) + (hlarge : Tendsto (fun n => (C n).card) atTop atTop) + (γ : ℝ) (hγ : 0 < γ) + (a : ℕ → ℝ) (ha : Tendsto a atTop (𝓝 0)) + (hadd : ∀ n, + ∀ E : Finset {x : Fin (A.model (ν n)).size // x ∈ C n}, + γ * min (E.card : ℝ) + ((Fintype.card + {x : Fin (A.model (ν n)).size // x ∈ C n} : ℝ) - + E.card) - + a n * Fintype.card + {x : Fin (A.model (ν n)).size // x ∈ C n} ≤ + (boundary + (fun i : ↥S => + completedRestriction + ((A.model (ν n)).action ((i : K), (1 : J))) + (C n)) E : ℝ)) : + Nonempty (ExpandingCentralizerFiniteModel J F) := by + classical + obtain ⟨N, D, τ, hZ, hdeleted, hZlarge, hagrees, hexp⟩ := + KunActualCanonicalSelectedPruning.exists_actual_uniformly_expanding_pruned_selected_components + A S ν Q C hC hlarge γ hγ a ha hadd + let ν' : ℕ → ℕ := fun n => ν (n + N) + let Q' : (n : ℕ) → Finpartition + (Finset.univ : Finset (Fin (A.model (ν' n)).size)) := + fun n => Q (n + N) + let C' : (n : ℕ) → Finset (Fin (A.model (ν' n)).size) := + fun n => C (n + N) + let r' : ℕ → ℕ := fun n => r (n + N) + have hshift : Tendsto (fun n : ℕ => n + N) atTop atTop := + tendsto_add_atTop_nat N + have hC' (n : ℕ) : C' n ∈ (Q' n).parts := hC (n + N) + have hr' : Tendsto r' atTop atTop := by + exact hr.comp hshift + have hmatched' : Tendsto + (fun n => + (((C' n ∩ matchedRadiusBad + (Q' n) (sourceProductRadiusLabels S F (r' n)) + ((A.model (ν' n)).action) + (canonicalProductRadiusBad + A S hsymmetric hgenerates F (ν' n) (r' n))).card : ℝ) / + (C' n).card)) + atTop (𝓝 0) := by + exact hmatched.comp hshift + let W : ℕ → Type := + fun n => {x : Fin (A.model (ν' n)).size // x ∈ C' n} + let Z : (n : ℕ) → Finset (W n) := + fun n => Finset.univ \ D n + let σ : (n : ℕ) → ↥S → Equiv.Perm (W n) := + fun n i => completedRestriction + ((A.model (ν' n)).action ((i : K), (1 : J))) (C' n) + let p : (n : ℕ) → J → Equiv.Perm (W n) := + fun n j => completedRestriction + ((A.model (ν' n)).action ((1 : K), j)) (C' n) + let ρ : (n : ℕ) → K → + Equiv.Perm {x : W n // x ∈ Z n} := + fun n g => completedRestriction + (completedRestriction + ((A.model (ν' n)).action (g, (1 : J))) (C' n)) + (Z n) + have hσone (n : ℕ) (i : ↥S) (hi : (i : K) = 1) : + σ n i = 1 := by + dsimp [σ] + rw [hi] + change completedRestriction + ((A.model (ν' n)).action (1 : K × J)) (C' n) = 1 + rw [(A.model (ν' n)).map_one, completedRestriction_one] + have hp (n : ℕ) : p n 1 = 1 := by + dsimp [p] + change completedRestriction + ((A.model (ν' n)).action (1 : K × J)) (C' n) = 1 + rw [(A.model (ν' n)).map_one, completedRestriction_one] + have hρone (n : ℕ) : ρ n 1 = 1 := by + dsimp [ρ] + change completedRestriction + (completedRestriction + ((A.model (ν' n)).action (1 : K × J)) (C' n)) + (Z n) = 1 + rw [(A.model (ν' n)).map_one, + completedRestriction_one, completedRestriction_one] + have hρmul (b g : K) : + Tendsto + (fun n => normalizedHamming + (ρ n (b * g)) (ρ n b * ρ n g)) + atTop (𝓝 0) := by + exact + twiceCompleted_firstFactor_mul_normalizedHamming_tendsto_zero_of_canonical_matched + A S hone hsymmetric hgenerates F ν' Q' C' hC' + r' hr' hmatched' D hZ hdeleted b g + have hagrees' : ∀ n (i : ↥S) + (x : {y : W n // y ∈ Z n}), + completedRestriction + ((A.model (ν' n)).action ((i : K), (1 : J))) + (C' n) x.val ∈ Z n → + (τ n i x).val = + completedRestriction + ((A.model (ν' n)).action ((i : K), (1 : J))) + (C' n) x.val := by + intro n i x hx + exact hagrees n i x.val x.property hx + have hρgenerator (i : ↥S) : + Tendsto + (fun n => normalizedHamming + (τ n i) (ρ n (i : K))) + atTop (𝓝 0) := by + exact + twiceCompleted_sourceGenerator_normalizedHamming_tendsto_zero + (fun n => Fin (A.model (ν' n)).size) + (fun n (j : ↥S) => + (A.model (ν' n)).action ((j : K), (1 : J))) + (fun n (g : K) => + (A.model (ν' n)).action (g, (1 : J))) + (fun j : ↥S => (j : K)) C' D τ + (fun _ _ => rfl) hagrees' hZ hdeleted i + have hsource : Tendsto + (fun n => + ((sourceCompletionBad (σ n) (p n) F (Z n)).card : ℝ) / + (Z n).card) + atTop (𝓝 0) := by + exact + pruned_sourceCompletionBad_density_tendsto_zero_of_canonical_matched + A S hsymmetric hgenerates F ν' Q' C' hC' + r' hmatched' D hZ hdeleted + have hhalf : 0 < γ / 2 := by positivity + exact + nonempty_expandingCentralizerFiniteModel_of_actual_selected_pruned_source + P S hone hcover hsymmetric hgenerates F W σ hσone + p hp Z hZ hZlarge τ hagrees ρ hρone hρmul hρgenerator + (γ / 2) hhalf hexp hsource + +end KunActualCanonicalSelectedFiniteModelComposition + +open KunActualCanonicalSelectedFiniteModelComposition + +namespace KunLiteralSourceSelectedComponents + +private theorem sourceTransportedReferenceGenerator_disagreement_mem + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (SΓ : Finset + (prefixElementaryGroup alphaPrefixCode)) + (n : ℕ) (i : ↥SΓ) (x : Fin (A.model n).size) + (h : sourceTransportedReferenceGenerators A SΓ n i x ≠ + ((SourceProductThroughAlpha.sourceCompressedLocalProductApproximation A).model + n).action + (SourceProductThroughAlpha.sourceCompressionUAlphaEquiv + (i : prefixElementaryGroup alphaPrefixCode), + 1) x) : + x ∈ sourceGeneratorFamilyConjugacyBad A SΓ n := by + classical + unfold sourceGeneratorFamilyConjugacyBad + apply Finset.mem_biUnion.mpr + refine ⟨(i : prefixElementaryGroup + alphaPrefixCode), i.property, ?_⟩ + unfold sourceConjugacyDisagreementBad + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ x, ?_⟩ + change + (A.model n).action + (SourceBothCompressionNormalization.sourceCompressionUElement * + SourceGeneratedWordCrossing.sourceAlphaInclusion + (i : prefixElementaryGroup + alphaPrefixCode) * + SourceBothCompressionNormalization.sourceCompressionUElement⁻¹) x ≠ + sourceTransportedReferenceGenerators A SΓ n i x + rw [← SourceProductThroughAlpha.source_u_conjugated_product_generator] + exact Ne.symm h + +end KunLiteralSourceSelectedComponents + +namespace KunActualSourceSelectedCompletedGeneratorExpansion + +open Filter Topology +open scoped BigOperators + +private theorem exists_vanishing_completed_first_factor_additive_expansion_of_selected_source + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (S : Finset + (prefixElementaryGroup alphaPrefixCode)) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure + (S : Set + (prefixElementaryGroup + alphaPrefixCode)) = ⊤) + (Q : (n : ℕ) → + Finpartition (Finset.univ : Finset (Fin (A.model n).size))) + (F : Finset + (ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1])) + (N : ℕ) (r : ℕ → ℕ) + (C : (n : ℕ) → Finset (Fin (A.model (n + N)).size)) + (gamma : ℝ) + (hC : ∀ n, (C n).Nonempty) + (hexpand : ∀ n, ∀ D : Finset (Fin (A.model (n + N)).size), + D ⊆ C n → 2 * D.card ≤ (C n).card → + gamma * (D.card : ℝ) ≤ + (boundary + (KunLiteralSourceSelectedComponents.sourceTransportedReferenceGenerators + A S (n + N)) D : ℝ)) + (hboundary : Tendsto + (fun n => + (boundary + (KunLiteralSourceSelectedComponents.sourceTransportedReferenceGenerators + A S (n + N)) (C n) : ℝ) / (C n).card) + atTop (nhds 0)) + (hguarded : Tendsto + (fun n => + (((C n ∩ matchedRadiusBad + (KunLiteralSourceSelectedComponents.sourceTransportedPartition + A Q (n + N)) + (KunLiteralSourceSelectedComponents.sourceSelectedProductRadiusLabels + S F (r n)) + (((SourceProductThroughAlpha.sourceCompressedLocalProductApproximation + A).model (n + N)).action) + (KunLiteralSourceSelectedComponents.sourceSelectedRadiusBad + A S hsymmetric hgenerates F (n + N) (r n))).card : ℝ) / + (C n).card)) + atTop (nhds 0)) : + ∃ a : ℕ → ℝ, + (∀ n, 0 ≤ a n) ∧ + Tendsto a atTop (nhds 0) ∧ + ∀ n, ∀ E : Finset + {x : Fin (A.model (n + N)).size // x ∈ C n}, + gamma * min (E.card : ℝ) + ((Fintype.card + {x : Fin (A.model (n + N)).size // x ∈ C n} : ℝ) - + E.card) - + a n * Fintype.card + {x : Fin (A.model (n + N)).size // x ∈ C n} ≤ + (boundary + (fun i : + ↥(SourceProductThroughAlpha.sourceCompressedGeneratingFinset + S) => + MatchedComponentCompletion.completedRestriction + (((SourceProductThroughAlpha.sourceCompressedLocalProductApproximation + A).model (n + N)).action + ((i : prefixElementaryGroup + alphaZeroPrefixCode), 1)) + (C n)) E : ℝ) := by + classical + have hbad_density : Tendsto + (fun n => + (((C n ∩ + KunLiteralSourceSelectedComponents.sourceGeneratorFamilyConjugacyBad + A S (n + N)).card : ℝ) / (C n).card)) + atTop (nhds 0) := by + refine squeeze_zero (fun n => by positivity) (fun n => ?_) hguarded + apply div_le_div_of_nonneg_right _ (by positivity) + exact_mod_cast Finset.card_le_card (by + intro x hx + obtain ⟨hxC, hxE⟩ := Finset.mem_inter.mp hx + apply Finset.mem_inter.mpr + refine ⟨hxC, ?_⟩ + unfold matchedRadiusBad + apply Finset.mem_union_left + change x ∈ + CanonicalProductRadiusBadMatchedCapture.canonicalProductRadiusBad + (SourceProductThroughAlpha.sourceCompressedLocalProductApproximation A) + (SourceProductThroughAlpha.sourceCompressedGeneratingFinset S) + (SourceProductThroughAlpha.sourceCompressedGeneratingFinset_inv_mem + S hsymmetric) + (SourceProductThroughAlpha.sourceCompressedGeneratingFinset_closure + S hgenerates) + F (n + N) (r n) ∪ + KunLiteralSourceSelectedComponents.sourceGeneratorFamilyConjugacyBad + A S (n + N) + exact Finset.mem_union_right _ hxE) + obtain ⟨a, ha_nonnegative, ha_zero, ha_expand⟩ := + exists_vanishing_completedRestriction_additive_expansion_of_selected_bad + (fun n => Fin (A.model (n + N)).size) + (↥S) C + (fun n => + KunLiteralSourceSelectedComponents.sourceGeneratorFamilyConjugacyBad + A S (n + N)) + hC + (fun n => + KunLiteralSourceSelectedComponents.sourceTransportedReferenceGenerators + A S (n + N)) + (fun n (i : ↥S) => + ((SourceProductThroughAlpha.sourceCompressedLocalProductApproximation + A).model (n + N)).action + (SourceProductThroughAlpha.sourceCompressionUAlphaEquiv + (i : prefixElementaryGroup + alphaPrefixCode), 1)) + gamma hexpand + (fun n i x _hx hdis => + KunLiteralSourceSelectedComponents.sourceTransportedReferenceGenerator_disagreement_mem + A S (n + N) i x hdis) + hboundary hbad_density + refine ⟨a, ha_nonnegative, ha_zero, ?_⟩ + intro n E + have h := ha_expand n E + have hreindex : + boundary + (fun i : ↥S => + MatchedComponentCompletion.completedRestriction + (((SourceProductThroughAlpha.sourceCompressedLocalProductApproximation + A).model (n + N)).action + (SourceProductThroughAlpha.sourceCompressionUAlphaEquiv + (i : prefixElementaryGroup + alphaPrefixCode), 1)) + (C n)) E = + boundary + (fun i : + ↥(SourceProductThroughAlpha.sourceCompressedGeneratingFinset + S) => + MatchedComponentCompletion.completedRestriction + (((SourceProductThroughAlpha.sourceCompressedLocalProductApproximation + A).model (n + N)).action + ((i : prefixElementaryGroup + alphaZeroPrefixCode), 1)) + (C n)) E := by + exact + SourceProductThroughAlpha.boundary_sourceCompressedGeneratorSubtypeEquiv + S + (fun i : + ↥(SourceProductThroughAlpha.sourceCompressedGeneratingFinset + S) => + MatchedComponentCompletion.completedRestriction + (((SourceProductThroughAlpha.sourceCompressedLocalProductApproximation + A).model (n + N)).action + ((i : prefixElementaryGroup + alphaZeroPrefixCode), 1)) + (C n)) + E + exact h.trans_eq (congrArg (fun t : ℕ => (t : ℝ)) hreindex) + +end KunActualSourceSelectedCompletedGeneratorExpansion + +open KunActualSourceSelectedCompletedGeneratorExpansion + +namespace KunLiteralNineSourceFiniteModels + +open Filter Topology +open CanonicalProductRadiusBadMatchedCapture +open scoped BigOperators Pointwise + +private theorem source_ambient_nonempty_expandingCentralizerFiniteModel + (A : SoficApproximation + (prefixElementaryGroup ninePrefixCode)) + (F : Finset + (ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1])) : + Nonempty + (ExpandingCentralizerFiniteModel + (ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1]) F) := by + classical + obtain ⟨S, hsymmetric, hgenerates, Q, gamma, N, r, C, + hone, hgamma, _hsource, hr, hC, hCnonempty, + hexpand, hboundary, hguarded, hlarge⟩ := + KunLiteralSourceSelectedComponents.exists_source_selected_components + A F + let K : Type := + prefixElementaryGroup alphaZeroPrefixCode + let J : Type := + ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1] + let AP : SoficApproximation (K × J) := + SourceProductThroughAlpha.sourceCompressedLocalProductApproximation + A + let SK : Finset K := + SourceProductThroughAlpha.sourceCompressedGeneratingFinset S + have hSKone : 1 ∈ SK := + SourceProductThroughAlpha.sourceCompressedGeneratingFinset_one_mem + S hone + have hSKsymmetric : ∀ k ∈ SK, k⁻¹ ∈ SK := + SourceProductThroughAlpha.sourceCompressedGeneratingFinset_inv_mem + S hsymmetric + have hSKgenerates : Subgroup.closure (SK : Set K) = ⊤ := + SourceProductThroughAlpha.sourceCompressedGeneratingFinset_closure + S hgenerates + have hpair : ∃ P : KazhdanPair.{0, 0} K, + P.generators = SK := + SourceProductThroughAlpha.exists_sourceCompressedKazhdanPair_with_same_generators + S hsymmetric hgenerates + obtain ⟨PK, hPK⟩ := hpair + have hcover : PK.generators ⊆ SK := by + rw [hPK] + let ν : ℕ → ℕ := fun n => n + N + let QK : (n : ℕ) → Finpartition + (Finset.univ : Finset (Fin (AP.model (ν n)).size)) := + fun n => + KunLiteralSourceSelectedComponents.sourceTransportedPartition + A Q (n + N) + have hCK (n : ℕ) : C n ∈ (QK n).parts := hC n + have hbad_eq (n : ℕ) : + KunLiteralSourceSelectedComponents.sourceSelectedRadiusBad + A S hsymmetric hgenerates F (n + N) (r n) = + canonicalProductRadiusBad + AP SK hSKsymmetric hSKgenerates F (ν n) (r n) ∪ + KunLiteralSourceSelectedComponents.sourceGeneratorFamilyConjugacyBad + A S (n + N) := by + rfl + have hlabel_eq (n : ℕ) : + KunLiteralSourceSelectedComponents.sourceSelectedProductRadiusLabels + S F (r n) = + sourceProductRadiusLabels SK F (r n) := by + rfl + have hguarded' : + Tendsto + (fun n => + (((C n ∩ matchedRadiusBad + (QK n) + (sourceProductRadiusLabels SK F (r n)) + ((AP.model (ν n)).action) + (canonicalProductRadiusBad + AP SK hSKsymmetric hSKgenerates F (ν n) (r n) ∪ + KunLiteralSourceSelectedComponents.sourceGeneratorFamilyConjugacyBad + A S (n + N))).card : ℝ) / + (C n).card)) + atTop (𝓝 0) := by + have hguarded_eq := hguarded + simp_rw [hbad_eq, hlabel_eq] at hguarded_eq + convert hguarded_eq using 1 + funext n + simp only [QK, AP, ν] + congr 2 + have hcanonical : + Tendsto + (fun n => + (((C n ∩ matchedRadiusBad + (QK n) + (sourceProductRadiusLabels SK F (r n)) + ((AP.model (ν n)).action) + (canonicalProductRadiusBad + AP SK hSKsymmetric hSKgenerates F (ν n) (r n))).card : ℝ) / + (C n).card)) + atTop (𝓝 0) := by + exact KunGuardedCanonicalMatchedDensity.canonical_matched_density_of_guarded + (fun n => Fin (AP.model (ν n)).size) + (fun n => (Finset.univ : Finset (Fin (AP.model (ν n)).size))) + QK + (fun n => sourceProductRadiusLabels SK F (r n)) + (fun n => (AP.model (ν n)).action) + (fun n => canonicalProductRadiusBad + AP SK hSKsymmetric hSKgenerates F (ν n) (r n)) + (fun n => + KunLiteralSourceSelectedComponents.sourceGeneratorFamilyConjugacyBad + A S (n + N)) + C hguarded' + obtain ⟨a, _ha_nonnegative, ha, hadd⟩ := + exists_vanishing_completed_first_factor_additive_expansion_of_selected_source + A S hsymmetric hgenerates Q F N r C gamma + hCnonempty hexpand hboundary hguarded + exact + nonempty_expandingCentralizerFiniteModel_of_canonical_selected_additive + AP PK SK hSKone hcover hSKsymmetric hSKgenerates F + ν QK C hCK r hr hcanonical hlarge gamma hgamma a ha hadd + +end KunLiteralNineSourceFiniteModels + +open SourceTopLevelCompression +open KunLiteralNineSourceFiniteModels + +private theorem sourceLocalPrefixTranspositionGroup_lef_of_sofic : + Sofic + (prefixElementaryGroup ninePrefixCode) → + LEF + (ThompsonPrefixInsertion.localPrefixTranspositionGroup + [0, 0, 0, 1]) := by + intro hsource + exact sourceLocalPrefixTranspositionGroup_lef_of_source_finite_models + (fun A _ F => + source_ambient_nonempty_expandingCentralizerFiniteModel A F) + hsource + +private theorem ninePrefixElementaryGroup_not_sofic : + ¬ Sofic + (prefixElementaryGroup ninePrefixCode) := by + intro hsource + exact sourceLocalPrefixTranspositionGroup_notLEF + (sourceLocalPrefixTranspositionGroup_lef_of_sofic hsource) + +private theorem binaryLeavittElementaryGroup_not_sofic : + ¬ Sofic (binaryLeavittElementaryGroup 9) := by + intro hsofic + let : Sofic + (binaryLeavittElementaryGroup 9) := hsofic + exact ninePrefixElementaryGroup_not_sofic + (sofic_of_injective + ninePrefixElementaryGroupEquiv.symm.toMonoidHom + ninePrefixElementaryGroupEquiv.symm.injective) + +/-- There exists a finitely presented group that is not sofic. -/ +public +theorem exists_finitelyPresented_nonsofic_group : + ∃ (G : Type) (_ : Group G), + Group.IsFinitelyPresented G ∧ ¬ Sofic G := by + exact exists_finitelyPresented_not_sofic_of_not_sofic + binaryLeavittElementaryGroup_not_sofic + +end SoficGroups + +end diff --git a/LeanPool/NonSoficGroup/Foundations.lean b/LeanPool/NonSoficGroup/Foundations.lean new file mode 100644 index 000000000..f6ce32bbe --- /dev/null +++ b/LeanPool/NonSoficGroup/Foundations.lean @@ -0,0 +1,9888 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +module + +public import Mathlib.Algebra.Field.ZMod +public import Mathlib.Algebra.RingQuot +public import Mathlib.Analysis.InnerProductSpace.Defs +public import Mathlib.Analysis.SpecialFunctions.Log.Basic +public import Mathlib.CategoryTheory.Category.Basic +public import Mathlib.GroupTheory.FinitelyPresentedGroup +public import Mathlib.InformationTheory.Hamming +public import Mathlib.LinearAlgebra.Matrix.Reindex +public import Mathlib.Order.Partition.Finpartition +public import Mathlib.RingTheory.FiniteType +import Mathlib.Algebra.Group.MinimalAxioms +import Mathlib.Algebra.Order.Floor.Extended +import Mathlib.Algebra.Order.Interval.Basic +import Mathlib.Algebra.Order.Ring.Star +import Mathlib.Algebra.Order.Star.Real +import Mathlib.Data.Finsupp.Encodable +import Mathlib.Data.NNRat.Floor +import Mathlib.Data.Nat.Choose.Multinomial +import Mathlib.Data.Set.FiniteExhaustion +import Mathlib.LinearAlgebra.Matrix.Unique +import Mathlib.NumberTheory.Chebyshev +import Mathlib.NumberTheory.Height.NumberField +import Mathlib.NumberTheory.Height.Projectivization +import Mathlib.Order.CompletePartialOrder +import Mathlib.RingTheory.PiTensorProduct +import Mathlib.RingTheory.Radical.NatInt +import Mathlib.RingTheory.TotallySplit +import Mathlib.SetTheory.Cardinal.Free +import Mathlib.Tactic.ENatToNat +import Mathlib.Tactic.NormNum.Irrational +import Mathlib.Tactic.NormNum.IsCoprime +import Mathlib.Tactic.NormNum.IsSquare +import Mathlib.Tactic.NormNum.LegendreSymbol +import Mathlib.Tactic.NormNum.ModEq +import Mathlib.Tactic.NormNum.NatFib +import Mathlib.Tactic.NormNum.NatLog +import Mathlib.Tactic.NormNum.NatSqrt +import Mathlib.Tactic.NormNum.Ordinal +import Mathlib.Tactic.NormNum.Parity +import Mathlib.Tactic.NormNum.Prime +import Mathlib.Tactic.NormNum.RealSqrt +import Mathlib.Tactic.Polynomial.Basic +import Mathlib.Tactic.ReduceModChar +import Mathlib.Topology.Separation.CompletelyRegular +import Mathlib.Topology.Sheaves.Init +import Std.Tactic.BVDecide.Normalize.Prop + +/-! +# Foundations for the non-sofic group construction + +This file develops the finite-permutation, property-T, Leavitt-algebra, and +prefix-action infrastructure used by the construction. +-/ + +noncomputable section + +namespace SoficGroups + +section + +open Filter Topology + +universe u v w + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +abbrev UnitaryRepresentation (G : Type u) (H : Type v) [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] := + G →* (H ≃ₗᵢ[ℂ] H) + +open scoped Pointwise commutatorElement symmDiff + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +structure KazhdanPair (G : Type u) [Group G] where + /-- Internal interface connecting the split non-sofic proof modules. -/ + generators : Finset G + /-- Internal interface connecting the split non-sofic proof modules. -/ + kazhdanConstant : ℝ + positive : 0 < kazhdanConstant + invariant : + ∀ (H : Type v) [NormedAddCommGroup H] [InnerProductSpace ℂ H] + [CompleteSpace H] (π : UnitaryRepresentation G H) (ξ : H), + ‖ξ‖ = 1 → + (∀ g ∈ generators, ‖π g ξ - ξ‖ < kazhdanConstant) → + ∃ η : H, η ≠ 0 ∧ ∀ g : G, π g η = η + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +class HasPropertyT (G : Type u) [Group G] : Prop where + exists_kazhdanPair : Nonempty (KazhdanPair.{u, v} G) + +public +theorem hasPropertyT_of_mulEquiv {G : Type u} {G' : Type w} + [Group G] [Group G'] (e : G ≃* G') + [HasPropertyT.{u, v} G] : HasPropertyT.{w, v} G' := by + classical + obtain ⟨P⟩ := HasPropertyT.exists_kazhdanPair (G := G) + refine ⟨⟨{ + generators := P.generators.image e + kazhdanConstant := P.kazhdanConstant + positive := P.positive + invariant := ?_ + }⟩⟩ + intro H _ _ _ π ξ hξ hξ' + obtain ⟨η, hη, hη'⟩ := P.invariant H (π.comp e.toMonoidHom) ξ hξ (by + intro g hg + exact hξ' (e g) (Finset.mem_image.mpr ⟨g, hg, rfl⟩)) + refine ⟨η, hη, ?_⟩ + intro g + obtain ⟨g, rfl⟩ := e.surjective g + exact hη' g + +/-- The proportion of points on which two finite permutations differ. -/ +public +def normalizedHamming {Y : Type*} [Fintype Y] [DecidableEq Y] + (p q : Equiv.Perm Y) : ℝ := + (hammingDist (fun y => p y) (fun y => q y) : ℝ) / Fintype.card Y + +@[simp] +public +theorem normalizedHamming_self {Y : Type*} [Fintype Y] [DecidableEq Y] + (p : Equiv.Perm Y) : normalizedHamming p p = 0 := by + simp only [normalizedHamming, hammingDist_self, CharP.cast_eq_zero, zero_div] + +public +theorem normalizedHamming_comm {Y : Type*} [Fintype Y] [DecidableEq Y] + (p q : Equiv.Perm Y) : normalizedHamming p q = normalizedHamming q p := by + simp only [normalizedHamming, hammingDist_comm] + +public +theorem normalizedHamming_nonneg {Y : Type*} [Fintype Y] [DecidableEq Y] + (p q : Equiv.Perm Y) : 0 ≤ normalizedHamming p q := by + unfold normalizedHamming + positivity + +public +theorem normalizedHamming_triangle {Y : Type*} [Fintype Y] [DecidableEq Y] + (p q r : Equiv.Perm Y) : + normalizedHamming p r ≤ normalizedHamming p q + normalizedHamming q r := by + have h := hammingDist_triangle (fun y => p y) (fun y => q y) (fun y => r y) + unfold normalizedHamming + rw [← add_div] + apply div_le_div_of_nonneg_right + · exact_mod_cast h + · positivity + +private theorem normalizedHamming_le_one {Y : Type*} [Fintype Y] [DecidableEq Y] + (p q : Equiv.Perm Y) : normalizedHamming p q ≤ 1 := by + have hcard : + hammingDist (fun y => p y) (fun y => q y) ≤ Fintype.card Y := + hammingDist_le_card_fintype + unfold normalizedHamming + calc + (hammingDist (fun y => p y) (fun y => q y) : ℝ) / Fintype.card Y ≤ + (Fintype.card Y : ℝ) / Fintype.card Y := by + apply div_le_div_of_nonneg_right + · exact_mod_cast hcard + · positivity + _ ≤ 1 := by + by_cases h : Fintype.card Y = 0 <;> simp [h] + +public +theorem normalizedHamming_mul_left {Y : Type*} [Fintype Y] [DecidableEq Y] + (s p q : Equiv.Perm Y) : + normalizedHamming (s * p) (s * q) = normalizedHamming p q := by + have hdist : + hammingDist (fun y => s (p y)) (fun y => s (q y)) = + hammingDist (fun y => p y) (fun y => q y) := + hammingDist_comp (fun (_ : Y) (z : Y) => s z) (fun _ => s.injective) + simp only [normalizedHamming, Equiv.Perm.mul_apply, hdist] + +public +theorem normalizedHamming_mul_right {Y : Type*} [Fintype Y] [DecidableEq Y] + (s p q : Equiv.Perm Y) : + normalizedHamming (p * s) (q * s) = normalizedHamming p q := by + have hdist : + hammingDist (fun y => (p * s) y) (fun y => (q * s) y) = + hammingDist (fun y => p y) (fun y => q y) := by + unfold hammingDist + apply Finset.card_bij (fun y _ => s y) + · intro y hy + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + simpa only [Equiv.Perm.mul_apply] using (Finset.mem_filter.mp hy).2 + · intro y hy z hz h + exact s.injective h + · intro y hy + refine ⟨s.symm y, ?_, by simp only [Equiv.apply_symm_apply]⟩ + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + simpa only [Equiv.Perm.mul_apply, Equiv.apply_symm_apply] using + (Finset.mem_filter.mp hy).2 + unfold normalizedHamming + exact congrArg + (fun k : ℕ => (k : ℝ) / (Fintype.card Y : ℝ)) hdist + +/-- A finite permutation-valued approximation to a group action. -/ +public +structure PermutationModel (G : Type*) [Group G] where + /-- The cardinality of the finite model. -/ + size : ℕ + /-- The model is nonempty. -/ + size_pos : 0 < size + /-- The permutation assigned to each group element. -/ + action : G → Equiv.Perm (Fin size) + /-- The identity is assigned the identity permutation. -/ + map_one : action 1 = 1 + +/-- Multiplication and separation hold on a prescribed finite set. -/ +public +structure GoodOn {G : Type*} [Group G] + (M : PermutationModel G) (F : Finset G) (ε : ℝ) : Prop where + /-- The model is approximately multiplicative on the prescribed set. -/ + multiplicative : ∀ g ∈ F, ∀ h ∈ F, + normalizedHamming (M.action (g * h)) (M.action g * M.action h) < ε + /-- Nonidentity elements in the prescribed set stay far from the identity permutation. -/ + separated : ∀ g ∈ F, g ≠ 1 → + 1 - ε < normalizedHamming (M.action g) 1 + +private theorem GoodOn.mono {G : Type*} [Group G] {M : PermutationModel G} + {F F' : Finset G} {ε : ℝ} (h : GoodOn M F' ε) (hF : F ⊆ F') : + GoodOn M F ε where + multiplicative g hg k hk := h.multiplicative g (hF hg) k (hF hk) + separated g hg hne := h.separated g (hF hg) hne + +/-- A group admitting arbitrarily accurate finite permutation models. -/ +public +class Sofic (G : Type*) [Group G] : Prop where + /-- Every finite set has a permutation model at every error strictly between zero and one. -/ + approximation : ∀ (F : Finset G) (ε : ℝ), 0 < ε → ε < 1 → + ∃ M : PermutationModel G, GoodOn M F ε + +private theorem normalizedHamming_permCongr + {X Y : Type*} [Fintype X] [DecidableEq X] + [Fintype Y] [DecidableEq Y] (e : X ≃ Y) (p q : Equiv.Perm X) : + normalizedHamming (e.permCongr p) (e.permCongr q) = + normalizedHamming p q := by + have hdist : + hammingDist (fun y => e.permCongr p y) (fun y => e.permCongr q y) = + hammingDist (fun x => p x) (fun x => q x) := by + unfold hammingDist + apply Finset.card_equiv e.symm + intro y + simp only [Equiv.permCongr_apply, ne_eq, e.injective.eq_iff, Finset.mem_filter, Finset.mem_univ, + true_and] + unfold normalizedHamming + rw [hdist, ← Fintype.card_congr e] + +private theorem hammingDist_prodCongr_refl_left + {X Y : Type*} [Fintype X] [DecidableEq X] + [Fintype Y] [DecidableEq Y] (p q : Equiv.Perm Y) : + hammingDist + (fun z : X × Y => ((Equiv.refl X).prodCongr p) z) + (fun z : X × Y => ((Equiv.refl X).prodCongr q) z) = + Fintype.card X * hammingDist (fun y => p y) (fun y => q y) := by + classical + change + (Finset.univ.filter fun z : X × Y => + (z.1, p z.2) ≠ (z.1, q z.2)).card = + Fintype.card X * + (Finset.univ.filter fun y : Y => p y ≠ q y).card + have hfilter : + (Finset.univ.filter fun z : X × Y => + (z.1, p z.2) ≠ (z.1, q z.2)) = + (Finset.univ : Finset X) ×ˢ + (Finset.univ.filter fun y : Y => p y ≠ q y) := by + ext z + simp only [ne_eq, Prod.mk.injEq, true_and, Finset.mem_filter, Finset.mem_univ, + Finset.mem_product] + rw [hfilter, Finset.card_product] + rfl + +private theorem normalizedHamming_prodCongr_refl_left + {X Y : Type*} [Fintype X] [DecidableEq X] + [Fintype Y] [DecidableEq Y] (hX : Fintype.card X ≠ 0) + (p q : Equiv.Perm Y) : + normalizedHamming + ((Equiv.refl X).prodCongr p) ((Equiv.refl X).prodCongr q) = + normalizedHamming p q := by + unfold normalizedHamming + rw [hammingDist_prodCongr_refl_left, Fintype.card_prod, Nat.cast_mul, + Nat.cast_mul] + exact mul_div_mul_left _ _ (by exact_mod_cast hX) + +private def amplifyModel {G : Type*} [Group G] + (M : PermutationModel G) (k : ℕ) (hk : 0 < k) : PermutationModel G where + size := k * M.size + size_pos := Nat.mul_pos hk M.size_pos + action g := finProdFinEquiv.permCongr + ((Equiv.refl (Fin k)).prodCongr (M.action g)) + map_one := by + ext x + simp only [Equiv.prodCongr, Equiv.coe_refl, M.map_one, Equiv.Perm.coe_one, Prod.map_id, + Equiv.refl_symm, + Equiv.permCongr_apply, finProdFinEquiv_symm_apply, Equiv.coe_fn_mk, id_eq, + finProdFinEquiv_apply_val, + Fin.coe_modNat, Fin.coe_divNat, Nat.mod_add_div] + +private theorem amplifyModel_normalizedHamming + {G : Type*} [Group G] (M : PermutationModel G) + (k : ℕ) (hk : 0 < k) (g h : G) : + normalizedHamming ((amplifyModel M k hk).action g) + ((amplifyModel M k hk).action h) = + normalizedHamming (M.action g) (M.action h) := by + change normalizedHamming + (finProdFinEquiv.permCongr + ((Equiv.refl (Fin k)).prodCongr (M.action g))) + (finProdFinEquiv.permCongr + ((Equiv.refl (Fin k)).prodCongr (M.action h))) = _ + rw [normalizedHamming_permCongr] + apply normalizedHamming_prodCongr_refl_left + simpa only [Fintype.card_fin, ne_eq] using hk.ne' + +private theorem amplifyModel_multiplicative_distance + {G : Type*} [Group G] (M : PermutationModel G) + (k : ℕ) (hk : 0 < k) (g h : G) : + normalizedHamming + ((amplifyModel M k hk).action (g * h)) + ((amplifyModel M k hk).action g * + (amplifyModel M k hk).action h) = + normalizedHamming (M.action (g * h)) + (M.action g * M.action h) := by + have hprod (p q : Equiv.Perm (Fin M.size)) : + ((Equiv.refl (Fin k)).prodCongr p) * + ((Equiv.refl (Fin k)).prodCongr q) = + (Equiv.refl (Fin k)).prodCongr (p * q) := by + apply Equiv.ext + intro z + exact Prod.ext rfl rfl + change + normalizedHamming + (finProdFinEquiv.permCongr + ((Equiv.refl (Fin k)).prodCongr (M.action (g * h)))) + (finProdFinEquiv.permCongr + ((Equiv.refl (Fin k)).prodCongr (M.action g)) * + finProdFinEquiv.permCongr + ((Equiv.refl (Fin k)).prodCongr (M.action h))) = _ + rw [← Equiv.permCongr_mul, normalizedHamming_permCongr, hprod] + apply normalizedHamming_prodCongr_refl_left + simpa only [Fintype.card_fin, ne_eq] using hk.ne' + +private theorem amplifyModel_separation_distance + {G : Type*} [Group G] (M : PermutationModel G) + (k : ℕ) (hk : 0 < k) (g : G) : + normalizedHamming ((amplifyModel M k hk).action g) 1 = + normalizedHamming (M.action g) 1 := by + calc + normalizedHamming ((amplifyModel M k hk).action g) 1 = + normalizedHamming ((amplifyModel M k hk).action g) + ((amplifyModel M k hk).action 1) := by + rw [PermutationModel.map_one] + _ = normalizedHamming (M.action g) (M.action 1) := + amplifyModel_normalizedHamming M k hk g 1 + _ = normalizedHamming (M.action g) 1 := by rw [M.map_one] + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +structure SoficApproximation (G : Type*) [Group G] where + /-- Internal interface connecting the split non-sofic proof modules. -/ + model : ℕ → PermutationModel G + multiplicative : ∀ g h : G, + Tendsto + (fun n => normalizedHamming + ((model n).action (g * h)) ((model n).action g * (model n).action h)) + atTop (𝓝 0) + separated : ∀ g : G, g ≠ 1 → + Tendsto + (fun n => normalizedHamming ((model n).action g) 1) + atTop (𝓝 1) + +private def pullbackPermutationModel {G H : Type*} [Group G] [Group H] + (f : H →* G) (M : PermutationModel G) : PermutationModel H where + size := M.size + size_pos := M.size_pos + action h := M.action (f h) + map_one := by simpa only [map_one] using M.map_one + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def pullbackSoficApproximation {G H : Type*} [Group G] [Group H] + (f : H →* G) (hf : Function.Injective f) + (A : SoficApproximation G) : SoficApproximation H where + model n := pullbackPermutationModel f (A.model n) + multiplicative g h := by + convert A.multiplicative (f g) (f h) using 1 + funext n + change + normalizedHamming ((A.model n).action (f (g * h))) + ((A.model n).action (f g) * (A.model n).action (f h)) = + normalizedHamming ((A.model n).action (f g * f h)) + ((A.model n).action (f g) * (A.model n).action (f h)) + rw [map_mul] + separated g hg := by + have hfg : f g ≠ 1 := by + intro he + apply hg + apply hf + simpa only [map_one] using he + convert A.separated (f g) hfg using 1 + funext n + rfl + +private theorem nonempty_soficApproximation_of_sofic + (G : Type*) [Group G] [Countable G] [Sofic G] : + Nonempty (SoficApproximation G) := by + classical + let K : Set.FiniteExhaustion (Set.univ : Set G) := + Set.countable_univ.finiteExhaustion + let F : ℕ → Finset G := fun n => (K.finite n).toFinset + let ε : ℕ → ℝ := fun n => 1 / ((n : ℝ) + 2) + have hε_pos (n : ℕ) : 0 < ε n := by + dsimp [ε] + positivity + have hε_lt (n : ℕ) : ε n < 1 := by + dsimp [ε] + have hn : 0 ≤ (n : ℝ) := Nat.cast_nonneg n + rw [div_lt_one (by linarith : (0 : ℝ) < n + 2)] + linarith + have hε_lim : Tendsto ε atTop (𝓝 0) := by + simpa [ε, Function.comp_def, Nat.cast_add, Nat.cast_one, add_assoc, + one_add_one_eq_two] using + (tendsto_one_div_add_atTop_nhds_zero_nat (𝕜 := ℝ)).comp + (tendsto_add_atTop_nat 1) + have hmem (g : G) : ∀ᶠ n in atTop, g ∈ F n := by + have hg : g ∈ ⋃ n, K n := by + rw [K.iUnion_eq] + exact Set.mem_univ g + obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hg + filter_upwards [eventually_ge_atTop i] with n hn + exact (K.finite n).mem_toFinset.mpr (K.mono hn hi) + have hchoose (n : ℕ) : ∃ M : PermutationModel G, GoodOn M (F n) (ε n) := + Sofic.approximation (F n) (ε n) (hε_pos n) (hε_lt n) + let M : ℕ → PermutationModel G := fun n => (hchoose n).choose + have hgood (n : ℕ) : GoodOn (M n) (F n) (ε n) := + (hchoose n).choose_spec + refine ⟨{ + model := M + multiplicative := ?_ + separated := ?_ + }⟩ + · intro g h + refine squeeze_zero' (Eventually.of_forall fun n => + normalizedHamming_nonneg _ _) ?_ hε_lim + filter_upwards [hmem g, hmem h] with n hg hh + exact (hgood n).multiplicative g hg h hh |>.le + · intro g hg + apply tendsto_of_tendsto_of_tendsto_of_le_of_le' + (by simpa only [sub_zero] using (tendsto_const_nhds.sub hε_lim)) + tendsto_const_nhds + · filter_upwards [hmem g] with n hn + exact ((hgood n).separated g hn hg).le + · exact Eventually.of_forall fun n => + normalizedHamming_le_one _ _ + +private def amplifyApproximation {G : Type*} [Group G] + (A : SoficApproximation G) : SoficApproximation G where + model n := amplifyModel (A.model n) (n + 1) (Nat.zero_lt_succ n) + multiplicative g h := by + simpa only [amplifyModel_multiplicative_distance] using + A.multiplicative g h + separated g hg := by + simpa only [amplifyModel_separation_distance] using + A.separated g hg + +private theorem amplifyApproximation_size_tendsto + {G : Type*} [Group G] (A : SoficApproximation G) : + Tendsto (fun n => (amplifyApproximation A).model n |>.size) + atTop atTop := by + apply tendsto_atTop_mono (f := fun n : ℕ => n + 1) + (g := fun n => (amplifyApproximation A).model n |>.size) + · intro n + change n + 1 ≤ (n + 1) * (A.model n).size + exact Nat.le_mul_of_pos_right _ (A.model n).size_pos + · exact tendsto_add_atTop_nat 1 + +public +theorem exists_soficApproximation_size_tendsto + (G : Type*) [Group G] [Countable G] [Sofic G] : + ∃ A : SoficApproximation G, + Tendsto (fun n => (A.model n).size) atTop atTop := by + obtain ⟨A⟩ := nonempty_soficApproximation_of_sofic G + exact ⟨amplifyApproximation A, amplifyApproximation_size_tendsto A⟩ + +public +theorem sofic_of_injective {G H : Type*} [Group G] [Group H] + [Sofic G] (f : H →* G) (hf : Function.Injective f) : Sofic H := by + classical + constructor + intro F ε hε hε' + obtain ⟨M, hM⟩ := Sofic.approximation (F.image f) ε hε hε' + let N : PermutationModel H := + { size := M.size + size_pos := M.size_pos + action := fun g => M.action (f g) + map_one := by simpa only [map_one] using M.map_one } + refine ⟨N, ?_⟩ + constructor + · intro g hg h hh + simpa [N] using hM.multiplicative + (f g) (Finset.mem_image_of_mem f hg) + (f h) (Finset.mem_image_of_mem f hh) + · intro g hg hne + apply hM.separated (f g) (Finset.mem_image_of_mem f hg) + intro he + apply hne + apply hf + simpa only [map_one] using he + +private theorem exists_finite_obstruction {G : Type*} [Group G] (hG : ¬ Sofic G) : + ∃ (F : Finset G) (ε : ℝ), 1 ∈ F ∧ 0 < ε ∧ ε < 1 ∧ + ∀ M : PermutationModel G, ¬ GoodOn M F ε := by + classical + have hex : ∃ (F : Finset G) (ε : ℝ), 0 < ε ∧ ε < 1 ∧ + ∀ M : PermutationModel G, ¬ GoodOn M F ε := by + by_contra h + apply hG + constructor + intro F ε hε hε' + by_contra hmodel + apply h + exact ⟨F, ε, hε, hε', fun M hM => hmodel ⟨M, hM⟩⟩ + obtain ⟨F, ε, hε, hε', hF⟩ := hex + refine ⟨insert 1 F, ε, Finset.mem_insert_self _ _, hε, hε', ?_⟩ + intro M hM + exact hF M (hM.mono (Finset.subset_insert _ _)) + +private noncomputable def multiplicationTable {G : Type*} [Group G] + (F : Finset G) : Finset G := by + classical + exact F ∪ (F.product F).image (fun x : G × G => x.1 * x.2) + +private theorem mem_multiplicationTable_of_mem {G : Type*} [Group G] + {F : Finset G} {g : G} (hg : g ∈ F) : g ∈ multiplicationTable F := by + classical + simp only [multiplicationTable, Finset.product_eq_sprod, Finset.mem_union, hg, Finset.mem_image, + Finset.mem_product, Prod.exists, true_or] + +private theorem mul_mem_multiplicationTable {G : Type*} [Group G] + {F : Finset G} {g h : G} (hg : g ∈ F) (hh : h ∈ F) : + g * h ∈ multiplicationTable F := by + classical + change g * h ∈ F ∪ (F.product F).image (fun x : G × G => x.1 * x.2) + apply Finset.mem_union_right + exact Finset.mem_image.mpr + ⟨(g, h), Finset.mem_product.mpr ⟨hg, hh⟩, rfl⟩ + +private noncomputable def tableRelators {G : Type*} [Group G] + (F : Finset G) (h₁ : 1 ∈ F) : + Finset (FreeGroup ↥(multiplicationTable F)) := by + classical + let oneGenerator : ↥(multiplicationTable F) := + ⟨1, mem_multiplicationTable_of_mem h₁⟩ + let word (x : ↥F × ↥F) : FreeGroup ↥(multiplicationTable F) := + FreeGroup.of ⟨x.1.1, mem_multiplicationTable_of_mem x.1.2⟩ * + FreeGroup.of ⟨x.2.1, mem_multiplicationTable_of_mem x.2.2⟩ * + (FreeGroup.of + ⟨x.1.1 * x.2.1, mul_mem_multiplicationTable x.1.2 x.2.2⟩)⁻¹ + exact {FreeGroup.of oneGenerator} ∪ (F.attach.product F.attach).image word + +private abbrev tableGroup {G : Type*} [Group G] + (F : Finset G) (h₁ : 1 ∈ F) : Type _ := + PresentedGroup (tableRelators F h₁ : Set (FreeGroup ↥(multiplicationTable F))) + +private noncomputable def tableGenerator {G : Type*} [Group G] + (F : Finset G) (h₁ : 1 ∈ F) (g : ↥(multiplicationTable F)) : + tableGroup F h₁ := + PresentedGroup.of g + +private theorem tableGenerator_one {G : Type*} [Group G] + (F : Finset G) (h₁ : 1 ∈ F) : + tableGenerator F h₁ ⟨1, mem_multiplicationTable_of_mem h₁⟩ = 1 := by + classical + change PresentedGroup.mk _ (FreeGroup.of _) = 1 + apply PresentedGroup.one_of_mem + change FreeGroup.of _ ∈ tableRelators F h₁ + simp only [tableRelators, Finset.product_eq_sprod, Finset.singleton_union, Finset.mem_insert, + Finset.mem_image, Finset.mem_product, Finset.mem_attach, and_self, true_and, Prod.exists, + Subtype.exists, true_or] + +private theorem tableGenerator_mul {G : Type*} [Group G] + (F : Finset G) (h₁ : 1 ∈ F) {g h : G} (hg : g ∈ F) (hh : h ∈ F) : + tableGenerator F h₁ ⟨g, mem_multiplicationTable_of_mem hg⟩ * + tableGenerator F h₁ ⟨h, mem_multiplicationTable_of_mem hh⟩ = + tableGenerator F h₁ ⟨g * h, mul_mem_multiplicationTable hg hh⟩ := by + classical + have hrel : + (FreeGroup.of ⟨g, mem_multiplicationTable_of_mem hg⟩ * + FreeGroup.of ⟨h, mem_multiplicationTable_of_mem hh⟩) * + (FreeGroup.of ⟨g * h, mul_mem_multiplicationTable hg hh⟩)⁻¹ ∈ + (tableRelators F h₁ : Set (FreeGroup ↥(multiplicationTable F))) := by + change _ ∈ tableRelators F h₁ + rw [tableRelators] + apply Finset.mem_union_right + apply Finset.mem_image.mpr + refine ⟨(⟨g, hg⟩, ⟨h, hh⟩), ?_, rfl⟩ + simp only [Finset.product_eq_sprod, Finset.mem_product, Finset.mem_attach, and_self] + simpa only [tableGenerator, PresentedGroup.of, map_mul] using + PresentedGroup.mk_eq_mk_of_mul_inv_mem hrel + +private noncomputable def tableEvaluation {G : Type*} [Group G] + (F : Finset G) (h₁ : 1 ∈ F) : tableGroup F h₁ →* G := by + classical + apply PresentedGroup.toGroup (f := fun g : ↥(multiplicationTable F) => g.1) + intro r hr + change r ∈ tableRelators F h₁ at hr + simp only [tableRelators, Finset.mem_union, Finset.mem_singleton, + Finset.mem_image] at hr + rcases hr with rfl | ⟨⟨g, h⟩, _, rfl⟩ + · simp only [FreeGroup.lift_apply_of] + · simp only [map_mul, FreeGroup.lift_apply_of, map_inv, mul_inv_rev, mul_mul_inv_mul_cancel, + mul_inv_cancel] + +@[simp] +private theorem tableEvaluation_generator {G : Type*} [Group G] + (F : Finset G) (h₁ : 1 ∈ F) (g : ↥(multiplicationTable F)) : + tableEvaluation F h₁ (tableGenerator F h₁ g) = g.1 := by + change PresentedGroup.toGroup _ (PresentedGroup.of g) = g.1 + exact PresentedGroup.toGroup.of _ + +private theorem tableGenerator_ne_one {G : Type*} [Group G] + (F : Finset G) (h₁ : 1 ∈ F) {g : G} (hg : g ∈ F) (hne : g ≠ 1) : + tableGenerator F h₁ ⟨g, mem_multiplicationTable_of_mem hg⟩ ≠ 1 := by + intro h + apply hne + simpa only [tableEvaluation_generator, map_one] using congrArg (tableEvaluation F h₁) h + +private theorem tableGroup_finitelyPresented {G : Type*} [Group G] + (F : Finset G) (h₁ : 1 ∈ F) : + Group.IsFinitelyPresented (tableGroup F h₁) := + inferInstance + +private noncomputable def tableTestSet {G : Type*} [Group G] + (F : Finset G) (h₁ : 1 ∈ F) : Finset (tableGroup F h₁) := by + classical + exact F.attach.image fun g => + tableGenerator F h₁ ⟨g.1, mem_multiplicationTable_of_mem g.2⟩ + +private theorem tableGenerator_mem_tableTestSet {G : Type*} [Group G] + (F : Finset G) (h₁ : 1 ∈ F) {g : G} (hg : g ∈ F) : + tableGenerator F h₁ ⟨g, mem_multiplicationTable_of_mem hg⟩ ∈ + tableTestSet F h₁ := by + classical + change _ ∈ F.attach.image _ + exact Finset.mem_image.mpr ⟨⟨g, hg⟩, Finset.mem_attach _ _, rfl⟩ + +private noncomputable def pullbackTableModel {G : Type*} [Group G] + (F : Finset G) (h₁ : 1 ∈ F) + (M : PermutationModel (tableGroup F h₁)) : PermutationModel G := by + classical + refine + { size := M.size + size_pos := M.size_pos + action := fun g => if hg : g ∈ multiplicationTable F then + M.action (tableGenerator F h₁ ⟨g, hg⟩) else 1 + map_one := ?_ } + simp only [mem_multiplicationTable_of_mem h₁, ↓reduceDIte, tableGenerator_one F h₁, M.map_one] + +private theorem pullbackTableModel_action_of_mem {G : Type*} [Group G] + (F : Finset G) (h₁ : 1 ∈ F) + (M : PermutationModel (tableGroup F h₁)) + {g : G} (hg : g ∈ multiplicationTable F) : + (pullbackTableModel F h₁ M).action g = + M.action (tableGenerator F h₁ ⟨g, hg⟩) := by + classical + simp only [pullbackTableModel, dite_eq_left hg] + +private theorem goodOn_pullbackTableModel {G : Type*} [Group G] + (F : Finset G) (h₁ : 1 ∈ F) {ε : ℝ} + (M : PermutationModel (tableGroup F h₁)) + (hM : GoodOn M (tableTestSet F h₁) ε) : + GoodOn (pullbackTableModel F h₁ M) F ε := by + constructor + · intro g hg h hh + have htest := hM.multiplicative + (tableGenerator F h₁ ⟨g, mem_multiplicationTable_of_mem hg⟩) + (tableGenerator_mem_tableTestSet F h₁ hg) + (tableGenerator F h₁ ⟨h, mem_multiplicationTable_of_mem hh⟩) + (tableGenerator_mem_tableTestSet F h₁ hh) + change normalizedHamming + ((pullbackTableModel F h₁ M).action (g * h)) + ((pullbackTableModel F h₁ M).action g * + (pullbackTableModel F h₁ M).action h) < ε + rw [pullbackTableModel_action_of_mem F h₁ M + (mul_mem_multiplicationTable hg hh), + pullbackTableModel_action_of_mem F h₁ M + (mem_multiplicationTable_of_mem hg), + pullbackTableModel_action_of_mem F h₁ M + (mem_multiplicationTable_of_mem hh), + ← tableGenerator_mul F h₁ hg hh] + exact htest + · intro g hg hne + have htest := hM.separated + (tableGenerator F h₁ ⟨g, mem_multiplicationTable_of_mem hg⟩) + (tableGenerator_mem_tableTestSet F h₁ hg) + (tableGenerator_ne_one F h₁ hg hne) + change 1 - ε < normalizedHamming + ((pullbackTableModel F h₁ M).action g) 1 + rw [pullbackTableModel_action_of_mem F h₁ M + (mem_multiplicationTable_of_mem hg)] + exact htest + +private theorem tableGroup_not_sofic_of_obstruction {G : Type*} [Group G] + (F : Finset G) (h₁ : 1 ∈ F) (ε : ℝ) + (hε : 0 < ε) (hε' : ε < 1) + (hbad : ∀ M : PermutationModel G, ¬ GoodOn M F ε) : + ¬ Sofic (tableGroup F h₁) := by + intro hsofic + obtain ⟨M, hM⟩ := hsofic.approximation (tableTestSet F h₁) ε hε hε' + exact hbad (pullbackTableModel F h₁ M) + (goodOn_pullbackTableModel F h₁ M hM) + +private theorem exists_nonsofic_finite_table {G : Type u} [Group G] + (hG : ¬ Sofic G) : + ∃ (F : Finset G) (h₁ : 1 ∈ F), + Group.IsFinitelyPresented (tableGroup F h₁) ∧ + ¬ Sofic (tableGroup F h₁) := by + obtain ⟨F, ε, h₁, hε, hε', hbad⟩ := exists_finite_obstruction hG + exact ⟨F, h₁, tableGroup_finitelyPresented F h₁, + tableGroup_not_sofic_of_obstruction F h₁ ε hε hε' hbad⟩ + +public +theorem exists_finitelyPresented_not_sofic_of_not_sofic + {G : Type u} [Group G] (hG : ¬ Sofic G) : + ∃ (H : Type u) (_ : Group H), + Group.IsFinitelyPresented H ∧ ¬ Sofic H := by + obtain ⟨F, h₁, hfp, hn⟩ := exists_nonsofic_finite_table hG + exact ⟨tableGroup F h₁, inferInstance, hfp, hn⟩ + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +structure LocalMultiplicativeOn {G : Type u} {H : Type v} + [Group G] [Group H] (s : Finset G) (f : G → H) : Prop where + map_one : f 1 = 1 + map_mul : ∀ x ∈ s, ∀ y ∈ s, f (x * y) = f x * f y + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +class LEF (G : Type u) [Group G] : Prop where + approximate : ∀ s : Finset G, ∃ (n : ℕ) (f : G → Equiv.Perm (Fin n)), + Set.InjOn f (s : Set G) ∧ LocalMultiplicativeOn s f + +namespace LocalMultiplicativeOn + +variable {G : Type u} {H : Type v} [Group G] [Group H] + +public +theorem mono {s t : Finset G} {f : G → H} + (h : LocalMultiplicativeOn t f) (hst : s ⊆ t) : LocalMultiplicativeOn s f where + map_one := h.map_one + map_mul x hx y hy := h.map_mul x (hst hx) y (hst hy) + +private theorem map_inv_of_mem {s : Finset G} {f : G → H} + (h : LocalMultiplicativeOn s f) {x : G} (hx : x ∈ s) (hi : x⁻¹ ∈ s) : + f x⁻¹ = (f x)⁻¹ := by + have hm := h.map_mul x hx x⁻¹ hi + rw [mul_inv_cancel, h.map_one] at hm + exact eq_inv_of_mul_eq_one_right hm.symm + +end LocalMultiplicativeOn + +public +theorem exists_local_word_control {α : Type u} {G : Type v} [Group G] + (φ : FreeGroup α →* G) (z : FreeGroup α) : + ∃ s : Finset G, ∀ (H : Type w) [Group H] (f : G → H), + LocalMultiplicativeOn s f → + FreeGroup.lift (fun a => f (φ (FreeGroup.of a))) z = f (φ z) := by + classical + refine FreeGroup.induction_on z ?_ ?_ ?_ ?_ + · refine ⟨∅, ?_⟩ + intro H _ f hf + simp only [map_one, hf.map_one] + · intro a + refine ⟨∅, ?_⟩ + intro H _ f _ + simp only [FreeGroup.lift_apply_of] + · intro a _ + refine ⟨{φ (FreeGroup.of a), (φ (FreeGroup.of a))⁻¹}, ?_⟩ + intro H _ f hf + simp only [map_inv, FreeGroup.lift_apply_of] + exact (hf.map_inv_of_mem (by simp only [Finset.mem_insert, Finset.mem_singleton, true_or]) (by + simp only [Finset.mem_insert, Finset.mem_singleton, or_true])).symm + · intro x y hx hy + obtain ⟨sx, hx⟩ := hx + obtain ⟨sy, hy⟩ := hy + refine ⟨insert (φ x) (insert (φ y) (sx ∪ sy)), ?_⟩ + intro H _ f hf + have hsx : sx ⊆ insert (φ x) (insert (φ y) (sx ∪ sy)) := by + intro a ha + simp only [Finset.mem_insert, Finset.mem_union, ha, true_or, or_true] + have hsy : sy ⊆ insert (φ x) (insert (φ y) (sx ∪ sy)) := by + intro a ha + simp only [Finset.mem_insert, Finset.mem_union, ha, or_true] + calc + FreeGroup.lift (fun a => f (φ (FreeGroup.of a))) (x * y) = + FreeGroup.lift (fun a => f (φ (FreeGroup.of a))) x * + FreeGroup.lift (fun a => f (φ (FreeGroup.of a))) y := map_mul _ _ _ + _ = f (φ x) * f (φ y) := + congrArg₂ (· * ·) (hx H f (hf.mono hsx)) (hy H f (hf.mono hsy)) + _ = f (φ x * φ y) := + (hf.map_mul (φ x) (by simp only [Finset.mem_insert, Finset.mem_union, true_or]) (φ y) (by + simp only [Finset.mem_insert, Finset.mem_union, true_or, or_true])).symm + _ = f (φ (x * y)) := by rw [map_mul] + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def boundary {V ι : Type*} [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (A : Finset V) : ℕ := + ∑ i : ι, (A.filter fun x => σ i x ∉ A).card + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def agreementSet {V : Type*} [Fintype V] [DecidableEq V] + (c c' : Equiv.Perm V) : Finset V := + Finset.univ.filter (fun x => c x = c' x) + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def permutationCommutationDefect {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (c : Equiv.Perm V) : ℕ := + ∑ i : ι, (Finset.univ.filter fun x => c (σ i x) ≠ σ i (c x)).card + +public +theorem agreementSet_card_add_hammingDist {V : Type*} + [Fintype V] [DecidableEq V] (c c' : Equiv.Perm V) : + (agreementSet c c').card + + hammingDist (fun x => c x) (fun x => c' x) = Fintype.card V := by + simpa only [agreementSet, hammingDist, ne_eq, Finset.card_univ] using + (Finset.card_filter_add_card_filter_not (s := (Finset.univ : Finset V)) (fun x => c x = c' x)) + +private theorem boundary_agreementSet_le_commutationDefect {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (c c' : Equiv.Perm V) : + boundary σ (agreementSet c c') ≤ + permutationCommutationDefect σ c + + permutationCommutationDefect σ c' := by + classical + unfold boundary permutationCommutationDefect + rw [← Finset.sum_add_distrib] + apply Finset.sum_le_sum + intro i _ + let B : Finset V := + Finset.univ.filter fun x => c (σ i x) ≠ σ i (c x) + let B' : Finset V := + Finset.univ.filter fun x => c' (σ i x) ≠ σ i (c' x) + have hsub : + (agreementSet c c').filter (fun x => σ i x ∉ agreementSet c c') ⊆ + B ∪ B' := by + intro x hx + have hx' := Finset.mem_filter.mp hx + have hagree : c x = c' x := + (Finset.mem_filter.mp hx'.1).2 + have hdisagree : c (σ i x) ≠ c' (σ i x) := by + intro heq + exact hx'.2 (Finset.mem_filter.mpr ⟨Finset.mem_univ _, heq⟩) + by_cases hc : c (σ i x) = σ i (c x) + · apply Finset.mem_union_right + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + intro hc' + apply hdisagree + calc + c (σ i x) = σ i (c x) := hc + _ = σ i (c' x) := congrArg (σ i) hagree + _ = c' (σ i x) := hc'.symm + · apply Finset.mem_union_left + exact Finset.mem_filter.mpr ⟨Finset.mem_univ _, hc⟩ + exact (Finset.card_le_card hsub).trans (Finset.card_union_le B B') + +private theorem hamming_dichotomy_of_expansion {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (h : ℝ) + (hexp : ∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ)) + (c c' : Equiv.Perm V) : + h * (hammingDist (fun x => c x) (fun x => c' x) : ℝ) ≤ + (permutationCommutationDefect σ c + + permutationCommutationDefect σ c' : ℕ) ∨ + h * ((Fintype.card V : ℝ) - + hammingDist (fun x => c x) (fun x => c' x)) ≤ + (permutationCommutationDefect σ c + + permutationCommutationDefect σ c' : ℕ) := by + have hcard := agreementSet_card_add_hammingDist c c' + have hcard' : + ((agreementSet c c').card : ℝ) + + (hammingDist (fun x => c x) (fun x => c' x) : ℝ) = + Fintype.card V := by + exact_mod_cast hcard + have hboundary := boundary_agreementSet_le_commutationDefect σ c c' + have hboundary' : + (boundary σ (agreementSet c c') : ℝ) ≤ + (permutationCommutationDefect σ c + + permutationCommutationDefect σ c' : ℕ) := by + exact_mod_cast hboundary + have hcut := (hexp (agreementSet c c')).trans hboundary' + by_cases hhalf : + ((agreementSet c c').card : ℝ) ≤ + (Fintype.card V : ℝ) - (agreementSet c c').card + · right + rw [min_eq_left hhalf] at hcut + have hident : + (Fintype.card V : ℝ) - + hammingDist (fun x => c x) (fun x => c' x) = + (agreementSet c c').card := by + linarith [hcard'] + simpa only [hident, Nat.cast_add, ge_iff_le] using hcut + · left + rw [min_eq_right (le_of_not_ge hhalf)] at hcut + have hident : + (Fintype.card V : ℝ) - (agreementSet c c').card = + hammingDist (fun x => c x) (fun x => c' x) := by + linarith [hcard'] + simpa only [Nat.cast_add, ge_iff_le, hident] using hcut + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def inducedBoundary {V ι : Type*} [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (B E : Finset V) : ℕ := + ∑ i : ι, (E.filter fun x => σ i x ∉ B ∧ σ i x ∉ E).card + +private theorem boundary_union_le {V ι : Type*} [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (B E : Finset V) : + boundary σ (B ∪ E) ≤ boundary σ B + inducedBoundary σ B E := by + classical + unfold boundary inducedBoundary + rw [← Finset.sum_add_distrib] + refine Finset.sum_le_sum fun i _ => ?_ + apply le_trans (Finset.card_le_card ?_) (Finset.card_union_le _ _) + intro x hx + simp only [Finset.mem_filter, Finset.mem_union] at hx ⊢ + rcases hx with ⟨hxB | hxE, hout⟩ + · exact Or.inl ⟨hxB, fun h => hout (Or.inl h)⟩ + · exact Or.inr + ⟨hxE, fun h => hout (Or.inl h), fun h => hout (Or.inr h)⟩ + +private theorem boundary_le_induced_add_deleted {V ι : Type*} + [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (B E : Finset V) : + boundary σ E ≤ inducedBoundary σ B E + Fintype.card ι * B.card := by + classical + unfold boundary inducedBoundary + calc + (∑ i : ι, (E.filter fun x => σ i x ∉ E).card) + ≤ ∑ i : ι, + ((E.filter fun x => σ i x ∉ B ∧ σ i x ∉ E).card + B.card) := by + refine Finset.sum_le_sum fun i _ => ?_ + have hpre : (E.filter fun x => σ i x ∈ B).card ≤ B.card := by + rw [← Finset.card_map (σ i).toEmbedding] + apply Finset.card_le_card + intro y hy + obtain ⟨x, hx, rfl⟩ := Finset.mem_map.mp hy + exact (Finset.mem_filter.mp hx).2 + have hsub : + (E.filter fun x => σ i x ∉ E) ⊆ + (E.filter fun x => σ i x ∉ B ∧ σ i x ∉ E) ∪ + (E.filter fun x => σ i x ∈ B) := by + intro x hx + obtain ⟨hxE, hout⟩ := Finset.mem_filter.mp hx + by_cases hB : σ i x ∈ B + · exact Finset.mem_union_right _ (Finset.mem_filter.mpr ⟨hxE, hB⟩) + · exact Finset.mem_union_left _ + (Finset.mem_filter.mpr ⟨hxE, hB, hout⟩) + exact (Finset.card_le_card hsub).trans + ((Finset.card_union_le _ _).trans (Nat.add_le_add_left hpre _)) + _ = (∑ i : ι, (E.filter fun x => σ i x ∉ B ∧ σ i x ∉ E).card) + + Fintype.card ι * B.card := by simp only [Finset.sum_add_distrib, Finset.sum_const, + Finset.card_univ, + smul_eq_mul] + +private theorem maximal_bad_cut_induced_lower {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (B E : Finset V) (ell : ℝ) + (hB : (boundary σ B : ℝ) ≤ ell * (B.card : ℝ)) + (hmax : ∀ A : Finset V, + 2 * A.card ≤ Fintype.card V → + (boundary σ A : ℝ) < ell * (A.card : ℝ) → A.card ≤ B.card) + (hdisj : Disjoint B E) (hne : E.Nonempty) + (hhalf : 2 * (B ∪ E).card ≤ Fintype.card V) : + ell * (E.card : ℝ) ≤ (inducedBoundary σ B E : ℝ) := by + classical + by_contra h + have hE : (inducedBoundary σ B E : ℝ) < ell * (E.card : ℝ) := + lt_of_not_ge h + have hcut : (boundary σ (B ∪ E) : ℝ) ≤ + (boundary σ B : ℝ) + (inducedBoundary σ B E : ℝ) := by + exact_mod_cast boundary_union_le σ B E + have hcard : ((B ∪ E).card : ℝ) = (B.card : ℝ) + (E.card : ℝ) := by + exact_mod_cast Finset.card_union_of_disjoint hdisj + have hbad : (boundary σ (B ∪ E) : ℝ) < ell * ((B ∪ E).card : ℝ) := by + rw [hcard] + nlinarith + have hsize := hmax (B ∪ E) hhalf hbad + have hepos : 0 < E.card := Finset.card_pos.mpr hne + have hnat := Finset.card_union_of_disjoint hdisj + omega + +private theorem bad_cut_card_bound {γ ell a : ℝ} {N b q : ℕ} + (hgap : ell < γ) + (hadd : γ * (b : ℝ) - a * (N : ℝ) ≤ (q : ℝ)) + (hbad : (q : ℝ) ≤ ell * (b : ℝ)) : + (b : ℝ) ≤ a * (N : ℝ) / (γ - ell) := by + apply (le_div_iff₀ (sub_pos.mpr hgap)).2 + nlinarith + +private theorem large_cut_lower {γ ell a d N b e q : ℝ} + (hgap : ell < γ) (hd : 0 ≤ d) (hN : 0 ≤ N) + (hdeleted : (γ - ell) * b ≤ a * N) + (hsmall : 2 * a * (2 * (γ - ell) + d) ≤ (γ - ell) ^ 2) + (hlarge : N / 2 - b < e) + (hcut : γ * e - a * N - d * b ≤ q) : + ell * e ≤ q := by + have hδ : 0 < γ - ell := sub_pos.mpr hgap + have hδd : 0 ≤ (γ - ell) + d := by linarith + have hscaledDeleted := mul_le_mul_of_nonneg_left hdeleted hδd + have hscaledSmall := mul_le_mul_of_nonneg_right hsmall hN + have hscaledLarge := mul_lt_mul_of_pos_left hlarge hδ + nlinarith + +private theorem prune_permutation_multigraph {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (γ ell a : ℝ) (B : Finset V) + (hgap : ell < γ) + (hadd : ∀ A : Finset V, + γ * min (A.card : ℝ) ((Fintype.card V : ℝ) - (A.card : ℝ)) - + a * (Fintype.card V : ℝ) ≤ (boundary σ A : ℝ)) + (hBhalf : 2 * B.card ≤ Fintype.card V) + (hB : (boundary σ B : ℝ) ≤ ell * (B.card : ℝ)) + (hmax : ∀ A : Finset V, + 2 * A.card ≤ Fintype.card V → + (boundary σ A : ℝ) < ell * (A.card : ℝ) → A.card ≤ B.card) + (hsmall : + 2 * a * (2 * (γ - ell) + (Fintype.card ι : ℝ)) ≤ (γ - ell) ^ 2) + (E : Finset V) (hdisj : Disjoint B E) + (hEhalf : 2 * E.card ≤ Fintype.card V - B.card) : + ell * (E.card : ℝ) ≤ (inducedBoundary σ B E : ℝ) := by + classical + rcases E.eq_empty_or_nonempty with rfl | hne + · simp only [Finset.card_empty, CharP.cast_eq_zero, mul_zero, inducedBoundary, + Finset.notMem_empty, + not_false_eq_true, and_true, Finset.filter_empty, Finset.sum_const_zero, Std.le_refl] + by_cases hunion : 2 * (B ∪ E).card ≤ Fintype.card V + · exact maximal_bad_cut_induced_lower σ B E ell hB hmax hdisj hne hunion + have hBhalfReal : + (B.card : ℝ) ≤ (Fintype.card V : ℝ) - (B.card : ℝ) := by + have hcast : 2 * (B.card : ℝ) ≤ (Fintype.card V : ℝ) := by + exact_mod_cast hBhalf + linarith + have haddB := hadd B + rw [min_eq_left hBhalfReal] at haddB + have hdeleted : + (γ - ell) * (B.card : ℝ) ≤ a * (Fintype.card V : ℝ) := by + linarith + have hEhalfNat : 2 * E.card ≤ Fintype.card V := + hEhalf.trans (Nat.sub_le _ _) + have hEhalfReal : + (E.card : ℝ) ≤ (Fintype.card V : ℝ) - (E.card : ℝ) := by + have hcast : 2 * (E.card : ℝ) ≤ (Fintype.card V : ℝ) := by + exact_mod_cast hEhalfNat + linarith + have haddE := hadd E + rw [min_eq_left hEhalfReal] at haddE + have hremoval : + (boundary σ E : ℝ) ≤ (inducedBoundary σ B E : ℝ) + + (Fintype.card ι : ℝ) * (B.card : ℝ) := by + exact_mod_cast boundary_le_induced_add_deleted σ B E + have hcut : + γ * (E.card : ℝ) - a * (Fintype.card V : ℝ) - + (Fintype.card ι : ℝ) * (B.card : ℝ) ≤ + (inducedBoundary σ B E : ℝ) := by + linarith + have hcard := Finset.card_union_of_disjoint hdisj + have hlargeNat : Fintype.card V < 2 * (B.card + E.card) := by + simpa only [hcard] using Nat.lt_of_not_ge hunion + have hlargeCast : + (Fintype.card V : ℝ) < 2 * ((B.card : ℝ) + (E.card : ℝ)) := by + exact_mod_cast hlargeNat + have hlarge : + (Fintype.card V : ℝ) / 2 - (B.card : ℝ) < (E.card : ℝ) := by + linarith + exact large_cut_lower hgap (Nat.cast_nonneg _) (Nat.cast_nonneg _) + hdeleted hsmall hlarge hcut + +private theorem exists_maximal_bad_cut {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (ell : ℝ) : + ∃ B : Finset V, + 2 * B.card ≤ Fintype.card V ∧ + (boundary σ B : ℝ) ≤ ell * (B.card : ℝ) ∧ + ∀ A : Finset V, + 2 * A.card ≤ Fintype.card V → + (boundary σ A : ℝ) < ell * (A.card : ℝ) → A.card ≤ B.card := by + classical + let candidates : Finset (Finset V) := + Finset.univ.powerset.filter fun A => + 2 * A.card ≤ Fintype.card V ∧ + (boundary σ A : ℝ) < ell * (A.card : ℝ) + by_cases hnonempty : candidates.Nonempty + · obtain ⟨B, hBmem, hmax⟩ := + Finset.exists_max_image candidates Finset.card hnonempty + have hprops : + 2 * B.card ≤ Fintype.card V ∧ + (boundary σ B : ℝ) < ell * (B.card : ℝ) := by + have hmem : B ∈ Finset.univ.powerset.filter fun A => + 2 * A.card ≤ Fintype.card V ∧ + (boundary σ A : ℝ) < ell * (A.card : ℝ) := by + simpa only [candidates] using hBmem + exact (Finset.mem_filter.mp hmem).2 + refine ⟨B, hprops.1, hprops.2.le, ?_⟩ + intro A hhalf hbad + apply hmax A + simp only [Finset.powerset_univ, Finset.mem_filter, Finset.mem_univ, hhalf, hbad, and_self, + candidates] + · refine ⟨∅, by simp only [Finset.card_empty, mul_zero, zero_le], by simp only [boundary, + Finset.notMem_empty, not_false_eq_true, Finset.filter_empty, Finset.card_empty, + Finset.sum_const_zero, CharP.cast_eq_zero, mul_zero, Std.le_refl], ?_⟩ + intro A hhalf hbad + exfalso + apply hnonempty + refine ⟨A, ?_⟩ + simp only [Finset.powerset_univ, Finset.mem_filter, Finset.mem_univ, hhalf, hbad, and_self, + candidates] + +public +theorem exists_pruned_expander {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (γ ell a : ℝ) + (hgap : ell < γ) + (hadd : ∀ A : Finset V, + γ * min (A.card : ℝ) ((Fintype.card V : ℝ) - (A.card : ℝ)) - + a * (Fintype.card V : ℝ) ≤ (boundary σ A : ℝ)) + (hsmall : + 2 * a * (2 * (γ - ell) + (Fintype.card ι : ℝ)) ≤ (γ - ell) ^ 2) : + ∃ B : Finset V, + 2 * B.card ≤ Fintype.card V ∧ + (B.card : ℝ) ≤ a * (Fintype.card V : ℝ) / (γ - ell) ∧ + ∀ E : Finset V, Disjoint B E → + 2 * E.card ≤ Fintype.card V - B.card → + ell * (E.card : ℝ) ≤ (inducedBoundary σ B E : ℝ) := by + classical + obtain ⟨B, hhalf, hB, hmax⟩ := exists_maximal_bad_cut σ ell + refine ⟨B, hhalf, ?_, ?_⟩ + · have hhalfReal : + (B.card : ℝ) ≤ (Fintype.card V : ℝ) - (B.card : ℝ) := by + have hcast : 2 * (B.card : ℝ) ≤ (Fintype.card V : ℝ) := by + exact_mod_cast hhalf + linarith + have hlow := hadd B + rw [min_eq_left hhalfReal] at hlow + exact bad_cut_card_bound hgap hlow hB + · intro E hdisj hEhalf + exact prune_permutation_multigraph σ γ ell a B hgap hadd hhalf hB + hmax hsmall E hdisj hEhalf + +private theorem disjoint_dominant_intersections_false {V : Type*} [DecidableEq V] + (P Q D : Finset V) (hdisj : Disjoint P Q) + (hP : D.card < 2 * (P ∩ D).card) + (hQ : D.card < 2 * (Q ∩ D).card) : False := by + have hparts : Disjoint (P ∩ D) (Q ∩ D) := by + exact Finset.disjoint_of_subset_left (Finset.inter_subset_left) + (Finset.disjoint_of_subset_right (Finset.inter_subset_left) hdisj) + have hsub : (P ∩ D) ∪ (Q ∩ D) ⊆ D := by + intro x hx + rcases Finset.mem_union.mp hx with hx | hx + · exact (Finset.mem_inter.mp hx).2 + · exact (Finset.mem_inter.mp hx).2 + have hcard := Finset.card_le_card hsub + rw [Finset.card_union_of_disjoint hparts] at hcard + omega + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def matchedRetainedSupport {V : Type*} [DecidableEq V] + (R : Finset (Finset V)) : Finset V := + R.biUnion id + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def matchedCore {V : Type*} [DecidableEq V] + (R : Finset (Finset V)) (D : Finset V → Finset V) : Finset V := + R.biUnion fun C => C ∩ D C + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def partitionWordCrossing {V : Type*} [DecidableEq V] + {U : Finset V} (P : Finpartition U) (w : Equiv.Perm V) : Finset V := + U.filter (fun x => w x ∉ P.part x) + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def matchedWordPreimageBad {V : Type*} [DecidableEq V] + (U : Finset V) (R : Finset (Finset V)) + (D : Finset V → Finset V) (w : Equiv.Perm V) : Finset V := + U.filter (fun x => w x ∈ U \ matchedCore R D) + +public +theorem finpartition_dominant_matching_injOn + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (R : Finset (Finset V)) + (hR : R ⊆ P.parts) (D : Finset V → Finset V) + (hmajor : ∀ C ∈ R, (D C).card < 2 * (C ∩ D C).card) : + Set.InjOn D (R : Set (Finset V)) := by + intro C hC E hE heq + have hCR : C ∈ R := hC + have hER : E ∈ R := hE + by_contra hne + exact disjoint_dominant_intersections_false C E (D C) + (P.disjoint (hR hCR) (hR hER) hne) + (hmajor C hCR) + (by simpa only [heq] using hmajor E hER) + +public +theorem matchedRetainedSupport_subset + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (R : Finset (Finset V)) + (hR : R ⊆ P.parts) : + matchedRetainedSupport R ⊆ U := by + intro x hx + obtain ⟨C, hC, hxC⟩ := Finset.mem_biUnion.mp hx + exact P.subset (hR hC) (by simpa only [id_eq] using hxC) + +private theorem matchedCore_subset_retainedSupport + {V : Type*} [DecidableEq V] + (R : Finset (Finset V)) (D : Finset V → Finset V) : + matchedCore R D ⊆ matchedRetainedSupport R := by + intro x hx + obtain ⟨C, hC, hxC⟩ := Finset.mem_biUnion.mp hx + exact Finset.mem_biUnion.mpr + ⟨C, hC, by simpa only [id_eq] using (Finset.mem_inter.mp hxC).1⟩ + +private theorem matchedCore_subset + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (R : Finset (Finset V)) + (hR : R ⊆ P.parts) (D : Finset V → Finset V) : + matchedCore R D ⊆ U := + (matchedCore_subset_retainedSupport R D).trans + (matchedRetainedSupport_subset P R hR) + +public +theorem matchedRetainedSupport_card + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (R : Finset (Finset V)) + (hR : R ⊆ P.parts) : + (matchedRetainedSupport R).card = ∑ C ∈ R, C.card := by + unfold matchedRetainedSupport + apply Finset.card_biUnion + intro C hC E hE hne + exact P.disjoint (hR hC) (hR hE) hne + +private theorem matchedCore_card + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (R : Finset (Finset V)) + (hR : R ⊆ P.parts) (D : Finset V → Finset V) : + (matchedCore R D).card = ∑ C ∈ R, (C ∩ D C).card := by + unfold matchedCore + apply Finset.card_biUnion + intro C hC E hE hne + exact (P.disjoint (hR hC) (hR hE) hne).mono + Finset.inter_subset_left Finset.inter_subset_left + +public +theorem matchedCore_missing_card + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (R : Finset (Finset V)) + (hR : R ⊆ P.parts) (D : Finset V → Finset V) : + (U \ matchedCore R D).card = + (U \ matchedRetainedSupport R).card + + ∑ C ∈ R, (C \ D C).card := by + have hcore := Finset.card_sdiff_add_card_eq_card + (matchedCore_subset P R hR D) + have hret := Finset.card_sdiff_add_card_eq_card + (matchedRetainedSupport_subset P R hR) + have hsplit : + (∑ C ∈ R, (C \ D C).card) + (matchedCore R D).card = + (matchedRetainedSupport R).card := by + rw [matchedCore_card P R hR D, matchedRetainedSupport_card P R hR] + rw [← Finset.sum_add_distrib] + exact Finset.sum_congr rfl fun C _ => + Finset.card_sdiff_add_card_inter C (D C) + omega + +private theorem matchedCore_missing_card_le_symmDiff + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (R : Finset (Finset V)) + (hR : R ⊆ P.parts) (D : Finset V → Finset V) : + (U \ matchedCore R D).card ≤ + (U \ matchedRetainedSupport R).card + + ∑ C ∈ R, (C ∆ D C).card := by + rw [matchedCore_missing_card P R hR D] + exact Nat.add_le_add_left + (Finset.sum_le_sum fun C _ => + Finset.card_le_card (Finset.symmDiff_subset_sdiff (s := C) (t := D C))) _ + +private theorem matched_partition_part_eq_of_target_part_eq + {V : Type*} [DecidableEq V] {U : Finset V} + (P Q : Finpartition U) (R : Finset (Finset V)) + (hR : R ⊆ P.parts) (D : Finset V → Finset V) + (hD : ∀ C ∈ R, D C ∈ Q.parts) + (hinj : Set.InjOn D (R : Set (Finset V))) + {x y : V} (hx : x ∈ matchedCore R D) + (hy : y ∈ matchedCore R D) + (hpart : Q.part x = Q.part y) : + P.part x = P.part y := by + obtain ⟨C, hC, hxC⟩ := Finset.mem_biUnion.mp hx + obtain ⟨E, hE, hyE⟩ := Finset.mem_biUnion.mp hy + have hxparts := Finset.mem_inter.mp hxC + have hyparts := Finset.mem_inter.mp hyE + have hQx : Q.part x = D C := + Q.part_eq_of_mem (hD C hC) hxparts.2 + have hQy : Q.part y = D E := + Q.part_eq_of_mem (hD E hE) hyparts.2 + have hCE : C = E := hinj hC hE (hQx.symm.trans (hpart.trans hQy)) + calc + P.part x = C := P.part_eq_of_mem (hR hC) hxparts.1 + _ = E := hCE + _ = P.part y := (P.part_eq_of_mem (hR hE) hyparts.1).symm + +public +theorem matchedWordPreimageBad_card_le + {V : Type*} [DecidableEq V] + (U : Finset V) (R : Finset (Finset V)) + (D : Finset V → Finset V) (w : Equiv.Perm V) : + (matchedWordPreimageBad U R D w).card ≤ + (U \ matchedCore R D).card := by + apply Finset.card_le_card_of_injOn w + · intro x hx + exact (Finset.mem_filter.mp hx).2 + · intro x _ y _ hxy + exact w.injective hxy + +private theorem partitionWordCrossing_subset_target_or_unmatched + {V : Type*} [DecidableEq V] {U : Finset V} + (P Q : Finpartition U) (R : Finset (Finset V)) + (hR : R ⊆ P.parts) (D : Finset V → Finset V) + (hD : ∀ C ∈ R, D C ∈ Q.parts) + (hinj : Set.InjOn D (R : Set (Finset V))) + (w : Equiv.Perm V) : + partitionWordCrossing P w ⊆ + partitionWordCrossing Q w ∪ + (U \ matchedCore R D) ∪ matchedWordPreimageBad U R D w := by + intro x hx + obtain ⟨hxU, hxP⟩ := Finset.mem_filter.mp hx + by_cases hxcore : x ∈ matchedCore R D + · by_cases hxQ : w x ∈ Q.part x + · have hwU : w x ∈ U := Q.part_subset x hxQ + by_cases hwcore : w x ∈ matchedCore R D + · have hQpart : Q.part x = Q.part (w x) := + (Q.part_eq_of_mem (Q.part_mem.mpr hxU) hxQ).symm + have hPpart := matched_partition_part_eq_of_target_part_eq + P Q R hR D hD hinj hxcore hwcore hQpart + exfalso + apply hxP + rw [hPpart] + exact P.mem_part hwU + · exact Finset.mem_union_right _ + (Finset.mem_filter.mpr + ⟨hxU, Finset.mem_sdiff.mpr ⟨hwU, hwcore⟩⟩) + · exact Finset.mem_union_left _ + (Finset.mem_union_left _ (Finset.mem_filter.mpr ⟨hxU, hxQ⟩)) + · exact Finset.mem_union_left _ + (Finset.mem_union_right _ (Finset.mem_sdiff.mpr ⟨hxU, hxcore⟩)) + +private theorem partitionWordCrossing_card_le_target_add_unmatched + {V : Type*} [DecidableEq V] {U : Finset V} + (P Q : Finpartition U) (R : Finset (Finset V)) + (hR : R ⊆ P.parts) (D : Finset V → Finset V) + (hD : ∀ C ∈ R, D C ∈ Q.parts) + (hinj : Set.InjOn D (R : Set (Finset V))) + (w : Equiv.Perm V) : + (partitionWordCrossing P w).card ≤ + (partitionWordCrossing Q w).card + + 2 * (U \ matchedCore R D).card := by + have hsub := Finset.card_le_card + (partitionWordCrossing_subset_target_or_unmatched + P Q R hR D hD hinj w) + have hfirst := Finset.card_union_le + (partitionWordCrossing Q w) (U \ matchedCore R D) + have hsecond := Finset.card_union_le + (partitionWordCrossing Q w ∪ (U \ matchedCore R D)) + (matchedWordPreimageBad U R D w) + have hpre := matchedWordPreimageBad_card_le U R D w + omega + +private theorem matchedCore_missing_density_tendsto_zero + {V : ℕ → Type*} [∀ n, DecidableEq (V n)] + (U : ∀ n, Finset (V n)) (P : ∀ n, Finpartition (U n)) + (R : ∀ n, Finset (Finset (V n))) + (hR : ∀ n, R n ⊆ (P n).parts) + (D : ∀ n, Finset (V n) → Finset (V n)) + (hdiscard : Tendsto + (fun n => (((U n \ matchedRetainedSupport (R n)).card : ℝ) / + (U n).card)) atTop (𝓝 0)) + (hsymm : Tendsto + (fun n => + ((∑ C ∈ R n, (C ∆ D n C).card : ℕ) : ℝ) / (U n).card) + atTop (𝓝 0)) : + Tendsto + (fun n => (((U n \ matchedCore (R n) (D n)).card : ℝ) / + (U n).card)) atTop (𝓝 0) := by + have hsum : Tendsto + (fun n => + ((U n \ matchedRetainedSupport (R n)).card : ℝ) / (U n).card + + ((∑ C ∈ R n, (C ∆ D n C).card : ℕ) : ℝ) / (U n).card) + atTop (𝓝 0) := by + simpa only [zero_add] using hdiscard.add hsymm + refine squeeze_zero (fun n => by positivity) ?_ hsum + intro n + have hcard : + ((U n \ matchedCore (R n) (D n)).card : ℝ) ≤ + (U n \ matchedRetainedSupport (R n)).card + + ((∑ C ∈ R n, (C ∆ D n C).card : ℕ) : ℝ) := by + exact_mod_cast matchedCore_missing_card_le_symmDiff + (P n) (R n) (hR n) (D n) + calc + ((U n \ matchedCore (R n) (D n)).card : ℝ) / (U n).card ≤ + (((U n \ matchedRetainedSupport (R n)).card : ℝ) + + ((∑ C ∈ R n, (C ∆ D n C).card : ℕ) : ℝ)) / (U n).card := + div_le_div_of_nonneg_right hcard (by positivity) + _ = ((U n \ matchedRetainedSupport (R n)).card : ℝ) / (U n).card + + ((∑ C ∈ R n, (C ∆ D n C).card : ℕ) : ℝ) / (U n).card := by + ring + +private theorem permutation_increment_sum_eq_zero + {α : Type*} [Fintype α] (p : Equiv.Perm α) (f : α → ℝ) : + ∑ x, (f (p x) - f x) = 0 := by + rw [Finset.sum_sub_distrib, Equiv.sum_comp p f] + exact sub_self _ + +private theorem permutation_squared_increment_le_twice_decreasing + {α : Type*} [Fintype α] (p : Equiv.Perm α) (f : α → ℝ) + (hf_nonneg : ∀ x, 0 ≤ f x) + (hf_le_one : ∀ x, f x ≤ 1) : + ∑ x, (f (p x) - f x) ^ 2 ≤ + 2 * ((Finset.univ.filter fun x => f (p x) < f x).card : ℝ) := by + classical + let d : α → ℝ := fun x => f (p x) - f x + let B : Finset α := Finset.univ.filter fun x => d x < 0 + let C : Finset α := Finset.univ.filter fun x => ¬ d x < 0 + have hsum : ∑ x, d x = 0 := + permutation_increment_sum_eq_zero p f + have hlower (x : α) : -1 ≤ d x := by + dsimp [d] + linarith [hf_nonneg (p x), hf_le_one x] + have hupper (x : α) : d x ≤ 1 := by + dsimp [d] + linarith [hf_le_one (p x), hf_nonneg x] + have hsplit : B.sum d + C.sum d = 0 := by + calc + B.sum d + C.sum d = ∑ x, d x := by + simpa only [not_lt, B, C] using Finset.sum_filter_add_sum_filter_not Finset.univ (fun x : α + => d x < 0) d + _ = 0 := hsum + have habs_bad : B.sum (fun x => |d x|) = -(B.sum d) := by + rw [← Finset.sum_neg_distrib] + apply Finset.sum_congr rfl + intro x hx + have hneg : d x < 0 := (Finset.mem_filter.mp hx).2 + exact abs_of_neg hneg + have habs_good : C.sum (fun x => |d x|) = C.sum d := by + apply Finset.sum_congr rfl + intro x hx + have hnonneg : 0 ≤ d x := + le_of_not_gt (Finset.mem_filter.mp hx).2 + exact abs_of_nonneg hnonneg + have habs_split : + B.sum (fun x => |d x|) + C.sum (fun x => |d x|) = + ∑ x, |d x| := by + simpa [B, C] using + Finset.sum_filter_add_sum_filter_not Finset.univ + (fun x : α => d x < 0) (fun x => |d x|) + have habs_total : (∑ x, |d x|) = -2 * B.sum d := by + rw [← habs_split, habs_bad, habs_good] + linarith + have hbad : -(B.sum d) ≤ (B.card : ℝ) := by + calc + -(B.sum d) = B.sum (fun x => -d x) := by + simp only [Finset.sum_neg_distrib] + _ ≤ B.sum (fun _ => (1 : ℝ)) := by + apply Finset.sum_le_sum + intro x _ + linarith [hlower x] + _ = (B.card : ℝ) := by simp only [Finset.sum_const, nsmul_eq_mul, mul_one] + have hsquare : (∑ x, d x ^ 2) ≤ ∑ x, |d x| := by + apply Finset.sum_le_sum + intro x _ + by_cases h : 0 ≤ d x + · rw [abs_of_nonneg h] + nlinarith [hupper x] + · have hneg : d x < 0 := lt_of_not_ge h + rw [abs_of_neg hneg] + nlinarith [hlower x] + rw [habs_total] at hsquare + have hfinal : (∑ x, d x ^ 2) ≤ 2 * (B.card : ℝ) := by + linarith + simpa [d, B, sub_neg] using hfinal + +public +theorem exists_completion_of_internal_permutation {V : Type*} + [Finite V] + (p : Equiv.Perm V) (Z : Finset V) : + ∃ q : Equiv.Perm {x : V // x ∈ Z}, + ∀ (x : V) (hx : x ∈ Z) (_hp : p x ∈ Z), + (q ⟨x, hx⟩ : V) = p x := by + classical + let : Fintype V := Fintype.ofFinite V + let A := {x : V // x ∈ Z ∧ p x ∈ Z} + let f : A → {x : V // x ∈ Z} := fun x => ⟨x.1, x.2.1⟩ + let g : A → {x : V // x ∈ Z} := fun x => ⟨p x.1, x.2.2⟩ + have hf : Function.Injective f := by + intro x y h + apply Subtype.ext + exact congrArg (fun z : {x : V // x ∈ Z} => (z : V)) h + have hg : Function.Injective g := by + intro x y h + apply Subtype.ext + exact p.injective + (congrArg (fun z : {x : V // x ∈ Z} => (z : V)) h) + obtain ⟨q, hq⟩ := Equiv.Perm.exists_extending_pair f g hf hg + refine ⟨q, ?_⟩ + intro x hx hp + have h := hq (⟨x, hx, hp⟩ : A) + exact congrArg (fun z : {x : V // x ∈ Z} => (z : V)) h + +private def diagonalRadius (e : ℕ → ℕ → ℝ) (n : ℕ) : ℕ := by + classical + exact Nat.findGreatest + (fun k => e n k < 1 / ((k : ℝ) + 1)) n + +private theorem diagonalRadius_tendsto_atTop (e : ℕ → ℕ → ℝ) + (he : ∀ k, Tendsto (fun n => e n k) atTop (𝓝 0)) : + Tendsto (diagonalRadius e) atTop atTop := by + classical + apply Filter.tendsto_atTop.2 + intro k + have htol : (0 : ℝ) < 1 / ((k : ℝ) + 1) := by + positivity + have herr : ∀ᶠ n in atTop, e n k < 1 / ((k : ℝ) + 1) := + (he k).eventually (gt_mem_nhds htol) + filter_upwards [eventually_ge_atTop k, herr] with n hn hn' + exact Nat.le_findGreatest hn hn' + +private theorem diagonalRadius_eventually_error_lt (e : ℕ → ℕ → ℝ) + (he : ∀ k, Tendsto (fun n => e n k) atTop (𝓝 0)) : + ∀ᶠ n in atTop, + e n (diagonalRadius e n) < + 1 / ((diagonalRadius e n : ℝ) + 1) := by + classical + have htol : (0 : ℝ) < 1 / ((0 : ℝ) + 1) := by + norm_num + have herr : ∀ᶠ n in atTop, + e n 0 < 1 / ((0 : ℝ) + 1) := + (he 0).eventually (gt_mem_nhds htol) + filter_upwards [herr] with n hn + change + (fun k : ℕ => e n k < 1 / ((k : ℝ) + 1)) + (Nat.findGreatest (fun k => e n k < 1 / ((k : ℝ) + 1)) n) + exact Nat.findGreatest_spec + (P := fun k => e n k < 1 / ((k : ℝ) + 1)) + (Nat.zero_le n) (by simpa only [CharP.cast_eq_zero, zero_add, ne_eq, one_ne_zero, + not_false_eq_true, div_self] using hn) + +private theorem diagonalRadius_error_tendsto_zero (e : ℕ → ℕ → ℝ) + (hnonneg : ∀ n k, 0 ≤ e n k) + (he : ∀ k, Tendsto (fun n => e n k) atTop (𝓝 0)) : + Tendsto (fun n => e n (diagonalRadius e n)) atTop (𝓝 0) := by + have hbound : ∀ᶠ n in atTop, + e n (diagonalRadius e n) ≤ + 1 / ((diagonalRadius e n : ℝ) + 1) := + (diagonalRadius_eventually_error_lt e he).mono fun _ h => h.le + have hlimit : Tendsto + (fun n => 1 / ((diagonalRadius e n : ℝ) + 1)) atTop (𝓝 0) := by + simpa only [Function.comp_def] using + (tendsto_one_div_add_atTop_nhds_zero_nat (𝕜 := ℝ)).comp + (diagonalRadius_tendsto_atTop e he) + exact squeeze_zero' + (Eventually.of_forall fun n => hnonneg n (diagonalRadius e n)) + hbound hlimit + +public +theorem exists_diverging_radius_with_vanishing_diagonal_error + (e : ℕ → ℕ → ℝ) (hnonneg : ∀ n k, 0 ≤ e n k) + (he : ∀ k, Tendsto (fun n => e n k) atTop (𝓝 0)) : + ∃ r : ℕ → ℕ, + Tendsto r atTop atTop ∧ + Tendsto (fun n => e n (r n)) atTop (𝓝 0) := + ⟨diagonalRadius e, diagonalRadius_tendsto_atTop e he, + diagonalRadius_error_tendsto_zero e hnonneg he⟩ + +public +theorem finite_union_bad_density_tendsto_zero + {α : ℕ → Type*} [∀ n, DecidableEq (α n)] + {ι : Type*} (I : Finset ι) + (V : ∀ n, Finset (α n)) (B : ∀ n, ι → Finset (α n)) + (hbad : ∀ i ∈ I, Tendsto + (fun n => (((V n ∩ B n i).card : ℝ) / (V n).card)) + atTop (𝓝 0)) : + Tendsto + (fun n => + (((V n ∩ I.biUnion (B n)).card : ℝ) / (V n).card)) + atTop (𝓝 0) := by + classical + have hsum : Tendsto + (fun n => + ∑ i ∈ I, (((V n ∩ B n i).card : ℝ) / (V n).card)) + atTop (𝓝 0) := by + induction I using Finset.induction_on with + | empty => + simp only [Finset.sum_empty, tendsto_const_nhds_iff] + | @insert i I hi ih => + have hfirst := hbad i (Finset.mem_insert_self i I) + have hrest := ih (fun j hj => + hbad j (Finset.mem_insert_of_mem hj)) + simpa only [hi, not_false_eq_true, Finset.sum_insert, add_zero] using hfirst.add hrest + refine squeeze_zero (fun n => by positivity) ?_ hsum + intro n + have hcard : + ((V n ∩ I.biUnion (B n)).card : ℝ) ≤ + ∑ i ∈ I, ((V n ∩ B n i).card : ℝ) := by + rw [Finset.inter_biUnion] + exact_mod_cast + (Finset.card_biUnion_le + (s := I) (t := fun i => V n ∩ B n i)) + calc + ((V n ∩ I.biUnion (B n)).card : ℝ) / (V n).card ≤ + (∑ i ∈ I, ((V n ∩ B n i).card : ℝ)) / (V n).card := + div_le_div_of_nonneg_right hcard (by positivity) + _ = ∑ i ∈ I, (((V n ∩ B n i).card : ℝ) / (V n).card) := + Finset.sum_div _ _ _ + +public +theorem sum_card_inter_partition {α : Type*} [DecidableEq α] + {U : Finset α} (P : Finpartition U) (B : Finset α) : + ∑ C ∈ P.parts, (C ∩ B).card = (U ∩ B).card := by + have hdis : + (P.parts : Set (Finset α)).PairwiseDisjoint + (fun C : Finset α => C ∩ B) := by + intro C hC D hD hne + exact (P.disjoint hC hD hne).mono + Finset.inter_subset_left Finset.inter_subset_left + have hunion : + P.parts.biUnion (fun C => C ∩ B) = U ∩ B := by + ext x + simp only [Finset.mem_biUnion, Finset.mem_inter, ← P.biUnion_parts, id_eq] + aesop + calc + ∑ C ∈ P.parts, (C ∩ B).card = + (P.parts.biUnion fun C => C ∩ B).card := + (Finset.card_biUnion hdis).symm + _ = (U ∩ B).card := congrArg Finset.card hunion + +public +theorem retained_bad_density_tendsto_zero + {α : ℕ → Type*} [∀ n, DecidableEq (α n)] + (V U B : ∀ n, Finset (α n)) + (hV : ∀ n, (V n).Nonempty) (hU : ∀ n, (U n).Nonempty) + (hUV : ∀ n, U n ⊆ V n) + (hcover : Tendsto + (fun n => ((U n).card : ℝ) / (V n).card) atTop (𝓝 1)) + (hbad : Tendsto + (fun n => (((V n ∩ B n).card : ℝ) / (V n).card)) + atTop (𝓝 0)) : + Tendsto (fun n => (((U n ∩ B n).card : ℝ) / (U n).card)) + atTop (𝓝 0) := by + have hhalf : ∀ᶠ n in atTop, + (1 / 2 : ℝ) ≤ ((U n).card : ℝ) / (V n).card := + (hcover.eventually (lt_mem_nhds (by norm_num : (1 / 2 : ℝ) < 1))).mono + fun _ h => h.le + refine squeeze_zero' (Eventually.of_forall fun n => by positivity) ?_ + (by simpa only [mul_zero] using + (tendsto_const_nhds.mul hbad : + Tendsto (fun n => (2 : ℝ) * (((V n ∩ B n).card : ℝ) / (V n).card)) atTop (𝓝 ((2 : ℝ) * + 0)))) + filter_upwards [hhalf] with n hn + have hv : (0 : ℝ) < (V n).card := by + exact_mod_cast (hV n).card_pos + have hu : (0 : ℝ) < (U n).card := by + exact_mod_cast (hU n).card_pos + have hmass : ((V n).card : ℝ) ≤ 2 * (U n).card := by + have h := (le_div_iff₀ hv).1 hn + linarith + have hbadcard : + ((U n ∩ B n).card : ℝ) ≤ (V n ∩ B n).card := by + exact_mod_cast Finset.card_le_card + (Finset.inter_subset_inter_right (hUV n) : + U n ∩ B n ⊆ V n ∩ B n) + calc + ((U n ∩ B n).card : ℝ) / (U n).card ≤ + ((V n ∩ B n).card : ℝ) / (U n).card := + div_le_div_of_nonneg_right hbadcard hu.le + _ ≤ 2 * (((V n ∩ B n).card : ℝ) / (V n).card) := by + rw [← mul_div_assoc] + apply (div_le_div_iff₀ hu hv).2 + simpa only [mul_comm, mul_left_comm] using + (mul_le_mul_of_nonneg_left hmass (Nat.cast_nonneg (α := ℝ) (V n ∩ B n).card)) + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +inductive LeavittGenerator where + | s : Fin 2 → LeavittGenerator + | t : Fin 2 → LeavittGenerator + deriving Fintype + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +abbrev LeavittFree : Type := FreeAlgebra (ZMod 2) LeavittGenerator + +private instance leavittFreeCountable : Countable LeavittFree := + ((FreeAlgebra.equivMonoidAlgebraFreeMonoid + (R := ZMod 2) (X := LeavittGenerator)).toEquiv.trans + (MonoidAlgebra.coeffEquiv + (R := ZMod 2) (M := FreeMonoid LeavittGenerator))).injective.countable + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +inductive LeavittRelation : LeavittFree → LeavittFree → Prop where + | inverse (i j : Fin 2) : + LeavittRelation + (FreeAlgebra.ι (ZMod 2) (.t i) * FreeAlgebra.ι (ZMod 2) (.s j)) + (if i = j then 1 else 0) + | partition : + LeavittRelation + (FreeAlgebra.ι (ZMod 2) (.s 0) * FreeAlgebra.ι (ZMod 2) (.t 0) + + FreeAlgebra.ι (ZMod 2) (.s 1) * FreeAlgebra.ι (ZMod 2) (.t 1)) + 1 + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +abbrev BinaryLeavitt : Type := RingQuot LeavittRelation + +private instance binaryLeavittCountable : Countable BinaryLeavitt := + (RingQuot.mkAlgHom_surjective (ZMod 2) LeavittRelation).countable + +private def leavittQuotient : LeavittFree →ₐ[ZMod 2] BinaryLeavitt := + RingQuot.mkAlgHom (ZMod 2) LeavittRelation + +public +instance binaryLeavittFiniteType : Algebra.FiniteType (ZMod 2) BinaryLeavitt := + Algebra.FiniteType.of_surjective leavittQuotient + (RingQuot.mkAlgHom_surjective (ZMod 2) LeavittRelation) + +private def leavittS (i : Fin 2) : BinaryLeavitt := + leavittQuotient (FreeAlgebra.ι (ZMod 2) (.s i)) + +private def leavittT (i : Fin 2) : BinaryLeavitt := + leavittQuotient (FreeAlgebra.ι (ZMod 2) (.t i)) + +private theorem leavittT_mul_S (i j : Fin 2) : + leavittT i * leavittS j = if i = j then 1 else 0 := by + simpa only [leavittT, leavittQuotient, leavittS, map_mul, MonoidWithZeroHom.map_ite_one_zero] + using + RingQuot.mkAlgHom_rel (ZMod 2) (LeavittRelation.inverse i j) + +private theorem leavitt_partition : + leavittS 0 * leavittT 0 + leavittS 1 * leavittT 1 = 1 := by + simpa only [leavittS, leavittQuotient, Fin.isValue, leavittT, map_add, map_mul, map_one] using + RingQuot.mkAlgHom_rel (ZMod 2) LeavittRelation.partition + +private abbrev leavittSequence : Type := ℕ → ZMod 2 + +private def prefixOperator (i : Fin 2) : Module.End (ZMod 2) leavittSequence where + toFun x n := if n % 2 = i.val then x (n / 2) else 0 + map_add' x y := by + ext n + simp only [Pi.add_apply] + split_ifs <;> simp + map_smul' a x := by + ext n + simp only [Pi.smul_apply, RingHom.id_apply] + split_ifs <;> simp + +private def deletionOperator (i : Fin 2) : Module.End (ZMod 2) leavittSequence where + toFun x n := x (2 * n + i.val) + map_add' x y := by + ext n + rfl + map_smul' a x := by + ext n + rfl + +private theorem deletion_mul_prefix (i j : Fin 2) : + deletionOperator i * prefixOperator j = if i = j then 1 else 0 := by + fin_cases i <;> fin_cases j <;> ext x n <;> + simp [deletionOperator, prefixOperator, Module.End.mul_apply, Nat.add_mod] + congr 1 + omega + +private theorem prefix_deletion_partition : + prefixOperator 0 * deletionOperator 0 + + prefixOperator 1 * deletionOperator 1 = 1 := by + ext x n + simp only [LinearMap.add_apply, Module.End.mul_apply, Module.End.one_apply] + change + (if n % 2 = 0 then x (2 * (n / 2)) else 0) + + (if n % 2 = 1 then x (2 * (n / 2) + 1) else 0) = x n + have h : n % 2 = 0 ∨ n % 2 = 1 := by omega + rcases h with h | h <;> simp [h] <;> congr 1 <;> omega + +private def leavittGeneratorAction : + LeavittGenerator → Module.End (ZMod 2) leavittSequence + | .s i => prefixOperator i + | .t i => deletionOperator i + +private def leavittFreeRepresentation : + LeavittFree →ₐ[ZMod 2] Module.End (ZMod 2) leavittSequence := + FreeAlgebra.lift (ZMod 2) leavittGeneratorAction + +private theorem leavittFreeRepresentation_respects {x y : LeavittFree} + (h : LeavittRelation x y) : + leavittFreeRepresentation x = leavittFreeRepresentation y := by + cases h with + | inverse i j => + simp only [leavittFreeRepresentation, map_mul, FreeAlgebra.lift_ι_apply, + leavittGeneratorAction, + deletion_mul_prefix, MonoidWithZeroHom.map_ite_one_zero] + | partition => + simpa only [leavittFreeRepresentation, Fin.isValue, map_add, map_mul, + FreeAlgebra.lift_ι_apply, + leavittGeneratorAction, map_one] using prefix_deletion_partition + +private def leavittRepresentation : + BinaryLeavitt →ₐ[ZMod 2] Module.End (ZMod 2) leavittSequence := + RingQuot.liftAlgHom (ZMod 2) + ⟨leavittFreeRepresentation, fun _ _ h => leavittFreeRepresentation_respects h⟩ + +@[simp] private theorem leavittRepresentation_S (i : Fin 2) : + leavittRepresentation (leavittS i) = prefixOperator i := by + simp only [leavittRepresentation, leavittFreeRepresentation, leavittS, leavittQuotient, + RingQuot.liftAlgHom_mkAlgHom_apply, FreeAlgebra.lift_ι_apply, leavittGeneratorAction] + +@[simp] private theorem leavittRepresentation_T (i : Fin 2) : + leavittRepresentation (leavittT i) = deletionOperator i := by + simp only [leavittRepresentation, leavittFreeRepresentation, leavittT, leavittQuotient, + RingQuot.liftAlgHom_mkAlgHom_apply, FreeAlgebra.lift_ι_apply, leavittGeneratorAction] + +public +instance binaryLeavittNontrivial : Nontrivial BinaryLeavitt := + leavittRepresentation.toRingHom.domain_nontrivial + +private theorem prefix_deletion_ne_one : + prefixOperator 0 * deletionOperator 0 ≠ 1 := by + intro h + have h' := congrArg + (fun f : Module.End (ZMod 2) leavittSequence => f (fun _ => 1) 1) h + simp only [prefixOperator, Fin.isValue, Fin.coe_ofNat_eq_mod, Nat.zero_mod, deletionOperator, + add_zero, + Module.End.mul_apply, LinearMap.coe_mk, AddHom.coe_mk, Nat.mod_succ, one_ne_zero, ↓reduceIte, + Module.End.one_apply, + zero_ne_one] at h' + +private theorem leavittS_mul_T_ne_one : leavittS 0 * leavittT 0 ≠ 1 := by + intro h + apply prefix_deletion_ne_one + simpa only [Fin.isValue, map_mul, leavittRepresentation_S, leavittRepresentation_T, map_one] using + congrArg leavittRepresentation h + +private instance binaryLeavittInfinite : Infinite BinaryLeavitt where + not_finite h := by + let := h + apply leavittS_mul_T_ne_one + exact mul_eq_one_symm (by simpa only [Fin.isValue, ↓reduceIte] using leavittT_mul_S 0 0) + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def leavittWordS : List (Fin 2) → BinaryLeavitt + | [] => 1 + | i :: a => leavittS i * leavittWordS a + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def leavittWordT : List (Fin 2) → BinaryLeavitt + | [] => 1 + | i :: a => leavittWordT a * leavittT i + +public +theorem leavittWordT_mul_wordS_self (a : List (Fin 2)) : + leavittWordT a * leavittWordS a = 1 := by + induction a with + | nil => simp only [leavittWordT, leavittWordS, mul_one] + | cons i a ih => + calc + leavittWordT (i :: a) * leavittWordS (i :: a) = + leavittWordT a * + ((leavittT i * leavittS i) * leavittWordS a) := by + simp only [leavittWordT, leavittWordS, mul_assoc] + _ = 1 := by simp only [leavittT_mul_S, ↓reduceIte, one_mul, ih] + +public +theorem leavittWordT_mul_wordS_of_incomparable + (a b : List (Fin 2)) (hab : ¬a <+: b) (hba : ¬b <+: a) : + leavittWordT a * leavittWordS b = 0 := by + induction a generalizing b with + | nil => exact (hab (by simp only [List.nil_prefix])).elim + | cons i a ih => + cases b with + | nil => exact (hba (by simp only [List.nil_prefix])).elim + | cons j b => + by_cases hij : i = j + · subst j + have hab' : ¬a <+: b := by + intro hp + apply hab + simpa only [List.cons_prefix_cons, true_and] using hp + have hba' : ¬b <+: a := by + intro hp + apply hba + simpa only [List.cons_prefix_cons, true_and] using hp + calc + leavittWordT (i :: a) * leavittWordS (i :: b) = + leavittWordT a * + ((leavittT i * leavittS i) * leavittWordS b) := by + simp only [leavittWordT, leavittWordS, mul_assoc] + _ = leavittWordT a * leavittWordS b := by + simp only [leavittT_mul_S, ↓reduceIte, one_mul] + _ = 0 := ih b hab' hba' + · calc + leavittWordT (i :: a) * leavittWordS (j :: b) = + leavittWordT a * + ((leavittT i * leavittS j) * leavittWordS b) := by + simp only [leavittWordT, leavittWordS, mul_assoc] + _ = 0 := by simp only [leavittT_mul_S, hij, ↓reduceIte, zero_mul, mul_zero] + +public +theorem leavittWordS_append (a b : List (Fin 2)) : + leavittWordS (a ++ b) = leavittWordS a * leavittWordS b := by + induction a with + | nil => simp only [List.nil_append, leavittWordS, one_mul] + | cons i a ih => simp only [List.cons_append, leavittWordS, ih, mul_assoc] + +public +theorem leavittWordT_append (a b : List (Fin 2)) : + leavittWordT (a ++ b) = leavittWordT b * leavittWordT a := by + induction a with + | nil => simp only [List.nil_append, leavittWordT, mul_one] + | cons i a ih => simp only [List.cons_append, leavittWordT, ih, mul_assoc] + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def leavittCylinder (a : List (Fin 2)) : BinaryLeavitt := + leavittWordS a * leavittWordT a + +private theorem leavittCylinder_split (a : List (Fin 2)) : + leavittCylinder a = + leavittCylinder (a ++ [0]) + leavittCylinder (a ++ [1]) := by + calc + leavittCylinder a = + leavittWordS a * + (leavittS 0 * leavittT 0 + leavittS 1 * leavittT 1) * + leavittWordT a := by + rw [leavitt_partition] + simp only [leavittCylinder, mul_one] + _ = leavittCylinder (a ++ [0]) + leavittCylinder (a ++ [1]) := by + simp only [Fin.isValue, mul_add, add_mul, mul_assoc, leavittCylinder, leavittWordS_append, + leavittWordS, + mul_one, leavittWordT_append, leavittWordT, one_mul] + +namespace MatrixCorner + +variable {ι A : Type*} [Fintype ι] [Ring A] + +private def codeIdempotent (s t : ι → A) : A := ∑ i, s i * t i + +private def encode (s t : ι → A) (M : Matrix ι ι A) : A := + ∑ i, ∑ j, s i * M i j * t j + +private def decode (s t : ι → A) (x : A) : Matrix ι ι A := + fun i j => t i * x * s j + +private theorem decode_encode [DecidableEq ι] (s t : ι → A) + (h : ∀ i j, t i * s j = if i = j then 1 else 0) + (M : Matrix ι ι A) : decode s t (encode s t M) = M := by + ext i j + change t i * (∑ k, ∑ l, s k * M k l * t l) * s j = M i j + calc + t i * (∑ k, ∑ l, s k * M k l * t l) * s j = + ∑ k, ∑ l, (t i * s k) * M k l * (t l * s j) := by + simp only [mul_assoc, Finset.mul_sum, Finset.sum_mul] + _ = M i j := by simp only [h, ite_mul, one_mul, zero_mul, mul_ite, mul_one, mul_zero, + Finset.sum_ite_eq', Finset.mem_univ, + ↓reduceIte, Finset.sum_ite_eq] + +private theorem encode_decode (s t : ι → A) (x : A) : + encode s t (decode s t x) = + codeIdempotent s t * x * codeIdempotent s t := by + change + (∑ i, ∑ j, s i * (t i * x * s j) * t j) = + (∑ i, s i * t i) * x * (∑ j, s j * t j) + calc + (∑ i, ∑ j, s i * (t i * x * s j) * t j) = + ∑ i, ∑ j, (s i * t i) * x * (s j * t j) := by + apply Finset.sum_congr rfl + intro i _ + apply Finset.sum_congr rfl + intro j _ + simp only [mul_assoc] + _ = (∑ i, s i * t i) * x * (∑ j, s j * t j) := by + simp only [Finset.sum_mul, Finset.mul_sum] + exact Finset.sum_comm + +private theorem codeIdempotent_isIdempotent [DecidableEq ι] (s t : ι → A) + (h : ∀ i j, t i * s j = if i = j then 1 else 0) : + IsIdempotentElem (codeIdempotent s t) := by + change (∑ i, s i * t i) * (∑ i, s i * t i) = ∑ i, s i * t i + calc + (∑ i, s i * t i) * (∑ i, s i * t i) = + ∑ i, ∑ j, s i * (t i * s j) * t j := by + rw [Finset.sum_mul] + apply Finset.sum_congr rfl + intro i _ + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro j _ + simp only [mul_assoc] + _ = ∑ i, s i * t i := by simp only [h, mul_ite, mul_one, mul_zero, ite_mul, zero_mul, + Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte] + +private theorem encode_one [DecidableEq ι] (s t : ι → A) : + encode s t (1 : Matrix ι ι A) = codeIdempotent s t := by + simp only [encode, Matrix.one_apply, mul_ite, mul_one, mul_zero, ite_mul, zero_mul, + Finset.sum_ite_eq, + Finset.mem_univ, ↓reduceIte, codeIdempotent] + +private theorem encode_mul [DecidableEq ι] (s t : ι → A) + (h : ∀ i j, t i * s j = if i = j then 1 else 0) + (M N : Matrix ι ι A) : + encode s t (M * N) = encode s t M * encode s t N := by + symm + calc + encode s t M * encode s t N = + ∑ i, ∑ j, ∑ k, ∑ l, + s i * M i j * (t j * s k) * N k l * t l := by + change + (∑ i, ∑ j, s i * M i j * t j) * + (∑ k, ∑ l, s k * N k l * t l) = _ + rw [Finset.sum_mul] + apply Finset.sum_congr rfl + intro i _ + rw [Finset.sum_mul] + apply Finset.sum_congr rfl + intro j _ + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro k _ + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro l _ + simp only [mul_assoc] + _ = ∑ i, ∑ j, ∑ l, s i * M i j * N j l * t l := by + simp only [h, mul_ite, mul_one, mul_zero, ite_mul, zero_mul, Finset.sum_ite_irrel, + Finset.sum_const_zero, + Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte] + _ = ∑ i, ∑ l, ∑ j, s i * M i j * N j l * t l := by + apply Finset.sum_congr rfl + intro i _ + exact Finset.sum_comm + _ = encode s t (M * N) := by + simp only [encode, Matrix.mul_apply] + apply Finset.sum_congr rfl + intro i _ + apply Finset.sum_congr rfl + intro l _ + rw [Finset.mul_sum, Finset.sum_mul] + apply Finset.sum_congr rfl + intro j _ + simp only [mul_assoc] + +private def ringEquiv [DecidableEq ι] (s t : ι → A) + (h : ∀ i j, t i * s j = if i = j then 1 else 0) : + Matrix ι ι A ≃+* (codeIdempotent_isIdempotent s t h).Corner where + toFun M := + ⟨encode s t M, ⟨encode s t M, by + change + codeIdempotent s t * encode s t M * codeIdempotent s t = + encode s t M + rw [← encode_decode, decode_encode s t h]⟩⟩ + invFun x := decode s t x.1 + left_inv M := decode_encode s t h M + right_inv x := Subtype.ext <| by + change encode s t (decode s t x.1) = x.1 + rw [encode_decode] + have hx := + (Subsemigroup.mem_corner_iff + (codeIdempotent_isIdempotent s t h)).mp x.property + rw [hx.1, hx.2] + map_mul' M N := Subtype.ext (encode_mul s t h M N) + map_add' M N := Subtype.ext <| by + change encode s t (M + N) = encode s t M + encode s t N + simp only [encode, Matrix.add_apply, mul_add, add_mul, Finset.sum_add_distrib] + +end MatrixCorner + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +structure BinaryPrefixCode (ι : Type*) where + /-- Internal interface connecting the split non-sofic proof modules. -/ + word : ι → List (Fin 2) + prefix_free : ∀ ⦃i j⦄, i ≠ j → ¬word i <+: word j + +private theorem binaryPrefixCode_orthogonal {ι : Type*} [DecidableEq ι] + (E : BinaryPrefixCode ι) (i j : ι) : + leavittWordT (E.word i) * leavittWordS (E.word j) = + if i = j then 1 else 0 := by + by_cases hij : i = j + · subst j + simp only [leavittWordT_mul_wordS_self, ↓reduceIte] + · simp only [hij, ↓reduceIte] + exact leavittWordT_mul_wordS_of_incomparable _ _ + (E.prefix_free hij) (E.prefix_free (Ne.symm hij)) + +private def binaryPrefixCornerEquiv {ι : Type*} [Fintype ι] [DecidableEq ι] + (E : BinaryPrefixCode ι) : + Matrix ι ι BinaryLeavitt ≃+* + (MatrixCorner.codeIdempotent_isIdempotent + (fun i => leavittWordS (E.word i)) + (fun i => leavittWordT (E.word i)) + (binaryPrefixCode_orthogonal E)).Corner := + MatrixCorner.ringEquiv + (fun i => leavittWordS (E.word i)) + (fun i => leavittWordT (E.word i)) + (binaryPrefixCode_orthogonal E) + +private def prefixTable {ι : Type*} [Fintype ι] + (source target : BinaryPrefixCode ι) : BinaryLeavitt := + ∑ i, leavittWordS (target.word i) * leavittWordT (source.word i) + +private theorem prefixTable_mul_reverse {ι : Type*} [Fintype ι] + (source target : BinaryPrefixCode ι) : + prefixTable source target * prefixTable target source = + MatrixCorner.codeIdempotent + (fun i => leavittWordS (target.word i)) + (fun i => leavittWordT (target.word i)) := by + classical + change + (∑ i, leavittWordS (target.word i) * leavittWordT (source.word i)) * + (∑ j, leavittWordS (source.word j) * leavittWordT (target.word j)) = + ∑ i, leavittWordS (target.word i) * leavittWordT (target.word i) + calc + (∑ i, leavittWordS (target.word i) * leavittWordT (source.word i)) * + (∑ j, leavittWordS (source.word j) * leavittWordT (target.word j)) = + ∑ i, ∑ j, + leavittWordS (target.word i) * + (leavittWordT (source.word i) * + leavittWordS (source.word j)) * + leavittWordT (target.word j) := by + rw [Finset.sum_mul] + apply Finset.sum_congr rfl + intro i _ + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro j _ + simp only [mul_assoc] + _ = ∑ i, leavittWordS (target.word i) * + leavittWordT (target.word i) := by + simp only [binaryPrefixCode_orthogonal, mul_ite, mul_one, mul_zero, ite_mul, zero_mul, + Finset.sum_ite_eq, + Finset.mem_univ, ↓reduceIte] + +private def prefixTableUnit {ι : Type*} [Fintype ι] + (source target : BinaryPrefixCode ι) + (hsource : MatrixCorner.codeIdempotent + (fun i => leavittWordS (source.word i)) + (fun i => leavittWordT (source.word i)) = 1) + (htarget : MatrixCorner.codeIdempotent + (fun i => leavittWordS (target.word i)) + (fun i => leavittWordT (target.word i)) = 1) : BinaryLeavittˣ where + val := prefixTable source target + inv := prefixTable target source + val_inv := (prefixTable_mul_reverse source target).trans htarget + inv_val := (prefixTable_mul_reverse target source).trans hsource + +private def alphaWord : Fin 3 → List (Fin 2) + | 0 => [0, 0, 0] + | 1 => [0, 0, 1] + | _ => [0, 1] + +private def betaWord : Fin 3 → List (Fin 2) + | 0 => [1, 0, 0, 0] + | 1 => [1, 0, 0, 1] + | _ => [1, 0, 1] + +private def nuWord : Fin 3 → List (Fin 2) + | 0 => [1, 1, 0, 0] + | 1 => [1, 1, 0, 1] + | _ => [1, 1, 1] + +private def etaWord : Fin 3 → List (Fin 2) + | 0 => [1, 0, 0] + | 1 => [1, 0, 1] + | _ => [1, 1] + +private def nineWord : Fin 9 → List (Fin 2) + | 0 => alphaWord 0 + | 1 => betaWord 0 + | 2 => nuWord 0 + | 3 => alphaWord 1 + | 4 => betaWord 1 + | 5 => nuWord 1 + | 6 => alphaWord 2 + | 7 => betaWord 2 + | _ => nuWord 2 + +private def uWord : Fin 9 → List (Fin 2) + | 0 => alphaWord 0 ++ [0] + | 1 => alphaWord 0 ++ [1] + | 2 => etaWord 0 + | 3 => alphaWord 1 ++ [0] + | 4 => alphaWord 1 ++ [1] + | 5 => etaWord 1 + | 6 => alphaWord 2 ++ [0] + | 7 => alphaWord 2 ++ [1] + | _ => etaWord 2 + +private def vWord : Fin 9 → List (Fin 2) + | 0 => alphaWord 0 ++ [0] + | 1 => etaWord 0 + | 2 => alphaWord 0 ++ [1] + | 3 => alphaWord 1 ++ [0] + | 4 => etaWord 1 + | 5 => alphaWord 1 ++ [1] + | 6 => alphaWord 2 ++ [0] + | 7 => etaWord 2 + | _ => alphaWord 2 ++ [1] + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def alphaPrefixCode : BinaryPrefixCode (Fin 3) where + word := alphaWord + prefix_free := by decide + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def ninePrefixCode : BinaryPrefixCode (Fin 9) where + word := nineWord + prefix_free := by decide + +private def uPrefixCode : BinaryPrefixCode (Fin 9) where + word := uWord + prefix_free := by decide + +private def vPrefixCode : BinaryPrefixCode (Fin 9) where + word := vWord + prefix_free := by decide + +private theorem alpha_cylinders : + leavittCylinder (alphaWord 0) + + leavittCylinder (alphaWord 1) + + leavittCylinder (alphaWord 2) = + leavittCylinder [0] := by + have h₀₀ : + leavittCylinder [0, 0, 0] + leavittCylinder [0, 0, 1] = + leavittCylinder [0, 0] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split [0, + 0]).symm + have h₀ : + leavittCylinder [0, 0] + leavittCylinder [0, 1] = + leavittCylinder [0] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split + [0]).symm + change + leavittCylinder [0, 0, 0] + + leavittCylinder [0, 0, 1] + + leavittCylinder [0, 1] = leavittCylinder [0] + rw [h₀₀, h₀] + +private theorem beta_cylinders : + leavittCylinder (betaWord 0) + + leavittCylinder (betaWord 1) + + leavittCylinder (betaWord 2) = + leavittCylinder [1, 0] := by + have h₁₀₀ : + leavittCylinder [1, 0, 0, 0] + leavittCylinder [1, 0, 0, 1] = + leavittCylinder [1, 0, 0] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split [1, 0, + 0]).symm + have h₁₀ : + leavittCylinder [1, 0, 0] + leavittCylinder [1, 0, 1] = + leavittCylinder [1, 0] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split [1, + 0]).symm + change + leavittCylinder [1, 0, 0, 0] + + leavittCylinder [1, 0, 0, 1] + + leavittCylinder [1, 0, 1] = leavittCylinder [1, 0] + rw [h₁₀₀, h₁₀] + +private theorem nu_cylinders : + leavittCylinder (nuWord 0) + + leavittCylinder (nuWord 1) + + leavittCylinder (nuWord 2) = + leavittCylinder [1, 1] := by + have h₁₁₀ : + leavittCylinder [1, 1, 0, 0] + leavittCylinder [1, 1, 0, 1] = + leavittCylinder [1, 1, 0] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split [1, 1, + 0]).symm + have h₁₁ : + leavittCylinder [1, 1, 0] + leavittCylinder [1, 1, 1] = + leavittCylinder [1, 1] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split [1, + 1]).symm + change + leavittCylinder [1, 1, 0, 0] + + leavittCylinder [1, 1, 0, 1] + + leavittCylinder [1, 1, 1] = leavittCylinder [1, 1] + rw [h₁₁₀, h₁₁] + +private theorem eta_cylinders : + leavittCylinder (etaWord 0) + + leavittCylinder (etaWord 1) + + leavittCylinder (etaWord 2) = + leavittCylinder [1] := by + have h₁₀ : + leavittCylinder [1, 0, 0] + leavittCylinder [1, 0, 1] = + leavittCylinder [1, 0] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split [1, + 0]).symm + have h₁ : + leavittCylinder [1, 0] + leavittCylinder [1, 1] = + leavittCylinder [1] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split + [1]).symm + change + leavittCylinder [1, 0, 0] + + leavittCylinder [1, 0, 1] + + leavittCylinder [1, 1] = leavittCylinder [1] + rw [h₁₀, h₁] + +private theorem ninePrefixCode_complete : + MatrixCorner.codeIdempotent + (fun i => leavittWordS (ninePrefixCode.word i)) + (fun i => leavittWordT (ninePrefixCode.word i)) = 1 := by + change (∑ i : Fin 9, leavittCylinder (nineWord i)) = 1 + have h₁ : + leavittCylinder [1, 0] + leavittCylinder [1, 1] = + leavittCylinder [1] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split + [1]).symm + have hroot : leavittCylinder [0] + leavittCylinder [1] = 1 := by + simpa only [leavittCylinder, leavittWordS, Fin.isValue, mul_one, leavittWordT, one_mul] using + leavitt_partition + calc + (∑ i : Fin 9, leavittCylinder (nineWord i)) = + (leavittCylinder (alphaWord 0) + + leavittCylinder (alphaWord 1) + + leavittCylinder (alphaWord 2)) + + (leavittCylinder (betaWord 0) + + leavittCylinder (betaWord 1) + + leavittCylinder (betaWord 2)) + + (leavittCylinder (nuWord 0) + + leavittCylinder (nuWord 1) + + leavittCylinder (nuWord 2)) := by + simp only [nineWord, Fin.isValue, Fin.sum_univ_succ, Fin.succ_ne_zero, imp_self, + Fin.succ_zero_eq_one, + Fin.succ_one_eq_two, Fin.reduceSucc, Finset.univ_unique, Fin.default_eq_zero, + Finset.sum_singleton] + ac_rfl + _ = leavittCylinder [0] + + leavittCylinder [1, 0] + leavittCylinder [1, 1] := by + rw [alpha_cylinders, beta_cylinders, nu_cylinders] + _ = leavittCylinder [0] + leavittCylinder [1] := by + rw [add_assoc, h₁] + _ = 1 := hroot + +private theorem uPrefixCode_complete : + MatrixCorner.codeIdempotent + (fun i => leavittWordS (uPrefixCode.word i)) + (fun i => leavittWordT (uPrefixCode.word i)) = 1 := by + change (∑ i : Fin 9, leavittCylinder (uWord i)) = 1 + have h₀ : + leavittCylinder (alphaWord 0 ++ [0]) + + leavittCylinder (alphaWord 0 ++ [1]) = + leavittCylinder (alphaWord 0) := + (leavittCylinder_split (alphaWord 0)).symm + have h₁ : + leavittCylinder (alphaWord 1 ++ [0]) + + leavittCylinder (alphaWord 1 ++ [1]) = + leavittCylinder (alphaWord 1) := + (leavittCylinder_split (alphaWord 1)).symm + have h₂ : + leavittCylinder (alphaWord 2 ++ [0]) + + leavittCylinder (alphaWord 2 ++ [1]) = + leavittCylinder (alphaWord 2) := + (leavittCylinder_split (alphaWord 2)).symm + have hroot : leavittCylinder [0] + leavittCylinder [1] = 1 := by + simpa only [leavittCylinder, leavittWordS, Fin.isValue, mul_one, leavittWordT, one_mul] using + leavitt_partition + calc + (∑ i : Fin 9, leavittCylinder (uWord i)) = + ((leavittCylinder (alphaWord 0 ++ [0]) + + leavittCylinder (alphaWord 0 ++ [1])) + + (leavittCylinder (alphaWord 1 ++ [0]) + + leavittCylinder (alphaWord 1 ++ [1])) + + (leavittCylinder (alphaWord 2 ++ [0]) + + leavittCylinder (alphaWord 2 ++ [1]))) + + (leavittCylinder (etaWord 0) + + leavittCylinder (etaWord 1) + + leavittCylinder (etaWord 2)) := by + simp only [uWord, Fin.isValue, Fin.sum_univ_succ, Fin.succ_ne_zero, imp_self, + Fin.succ_zero_eq_one, + Fin.succ_one_eq_two, Fin.reduceSucc, Finset.univ_unique, Fin.default_eq_zero, + Finset.sum_singleton] + ac_rfl + _ = (leavittCylinder (alphaWord 0) + + leavittCylinder (alphaWord 1) + + leavittCylinder (alphaWord 2)) + leavittCylinder [1] := by + rw [h₀, h₁, h₂, eta_cylinders] + _ = leavittCylinder [0] + leavittCylinder [1] := by + rw [alpha_cylinders] + _ = 1 := hroot + +private theorem vPrefixCode_complete : + MatrixCorner.codeIdempotent + (fun i => leavittWordS (vPrefixCode.word i)) + (fun i => leavittWordT (vPrefixCode.word i)) = 1 := by + change (∑ i : Fin 9, leavittCylinder (vWord i)) = 1 + calc + (∑ i : Fin 9, leavittCylinder (vWord i)) = + ∑ i : Fin 9, leavittCylinder (uWord i) := by + simp only [vWord, Fin.isValue, Fin.sum_univ_succ, Fin.succ_ne_zero, imp_self, + Fin.succ_zero_eq_one, + Fin.succ_one_eq_two, Fin.reduceSucc, Finset.univ_unique, Fin.default_eq_zero, + Finset.sum_singleton, uWord, + add_right_inj] + ac_rfl + _ = 1 := uPrefixCode_complete + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def compressionU : BinaryLeavittˣ := + prefixTableUnit ninePrefixCode uPrefixCode + ninePrefixCode_complete uPrefixCode_complete + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def compressionV : BinaryLeavittˣ := + prefixTableUnit ninePrefixCode vPrefixCode + ninePrefixCode_complete vPrefixCode_complete + +private instance binaryLeavittCharP : CharP BinaryLeavitt 2 := + CharP.of_ringHom_of_ne_zero + (algebraMap (ZMod 2) BinaryLeavitt) 2 (by decide) + +private theorem matrixUnitTransport_root + {A ι : Type*} [Ring A] [Fintype ι] [DecidableEq ι] + (sSource tSource sTarget tTarget : ι → A) + (hsource : ∀ i j, tSource i * sSource j = if i = j then 1 else 0) + (i j : ι) (a : A) : + (∑ k, sTarget k * tSource k) * + (sSource i * a * tSource j) * + (∑ k, sSource k * tTarget k) = + sTarget i * a * tTarget j := by + have hleft : + (∑ k, sTarget k * tSource k) * sSource i = sTarget i := by + calc + (∑ k, sTarget k * tSource k) * sSource i = + ∑ k, sTarget k * (tSource k * sSource i) := by + simp only [Finset.sum_mul, mul_assoc] + _ = sTarget i := by simp only [hsource, mul_ite, mul_one, mul_zero, Finset.sum_ite_eq', + Finset.mem_univ, ↓reduceIte] + have hright : + tSource j * (∑ k, sSource k * tTarget k) = tTarget j := by + calc + tSource j * (∑ k, sSource k * tTarget k) = + ∑ k, (tSource j * sSource k) * tTarget k := by + simp only [Finset.mul_sum, mul_assoc] + _ = tTarget j := by simp only [hsource, ite_mul, one_mul, zero_mul, Finset.sum_ite_eq, + Finset.mem_univ, ↓reduceIte] + calc + (∑ k, sTarget k * tSource k) * + (sSource i * a * tSource j) * + (∑ k, sSource k * tTarget k) = + ((∑ k, sTarget k * tSource k) * sSource i) * a * + (tSource j * (∑ k, sSource k * tTarget k)) := by + simp only [mul_assoc] + _ = sTarget i * a * tTarget j := by rw [hleft, hright] + +private theorem prefixTable_transport_root {ι : Type*} + [Fintype ι] + (source target : BinaryPrefixCode ι) (i j : ι) + (a : BinaryLeavitt) : + prefixTable source target * + (leavittWordS (source.word i) * a * + leavittWordT (source.word j)) * + prefixTable target source = + leavittWordS (target.word i) * a * leavittWordT (target.word j) := by + classical + exact matrixUnitTransport_root + (fun k => leavittWordS (source.word k)) + (fun k => leavittWordT (source.word k)) + (fun k => leavittWordS (target.word k)) + (fun k => leavittWordT (target.word k)) + (binaryPrefixCode_orthogonal source) i j a + +private theorem compressionU_conjugate_root (i j : Fin 9) (a : BinaryLeavitt) : + (compressionU : BinaryLeavitt) * + (leavittWordS (nineWord i) * a * leavittWordT (nineWord j)) * + (↑(compressionU⁻¹) : BinaryLeavitt) = + leavittWordS (uWord i) * a * leavittWordT (uWord j) := by + exact prefixTable_transport_root ninePrefixCode uPrefixCode i j a + +private theorem compressionV_conjugate_root (i j : Fin 9) (a : BinaryLeavitt) : + (compressionV : BinaryLeavitt) * + (leavittWordS (nineWord i) * a * leavittWordT (nineWord j)) * + (↑(compressionV⁻¹) : BinaryLeavitt) = + leavittWordS (vWord i) * a * leavittWordT (vWord j) := by + exact prefixTable_transport_root ninePrefixCode vPrefixCode i j a + +private def alphaNineIndex (i : Fin 3) : Fin 9 := + ⟨3 * i.val, by omega⟩ + +@[simp] +private theorem nineWord_alphaNineIndex (i : Fin 3) : + nineWord (alphaNineIndex i) = alphaWord i := by + fin_cases i <;> rfl + +@[simp] +private theorem uWord_alphaNineIndex (i : Fin 3) : + uWord (alphaNineIndex i) = alphaWord i ++ [0] := by + fin_cases i <;> rfl + +@[simp] +private theorem vWord_alphaNineIndex (i : Fin 3) : + vWord (alphaNineIndex i) = alphaWord i ++ [0] := by + fin_cases i <;> rfl + +private theorem compressionU_conjugate_alpha_root + (i j : Fin 3) (a : BinaryLeavitt) : + (compressionU : BinaryLeavitt) * + (leavittWordS (alphaWord i) * a * leavittWordT (alphaWord j)) * + (↑(compressionU⁻¹) : BinaryLeavitt) = + leavittWordS (alphaWord i ++ [0]) * a * + leavittWordT (alphaWord j ++ [0]) := by + simpa only [nineWord_alphaNineIndex, uWord_alphaNineIndex] using + compressionU_conjugate_root (alphaNineIndex i) (alphaNineIndex j) a + +private theorem compressionV_conjugate_alpha_root + (i j : Fin 3) (a : BinaryLeavitt) : + (compressionV : BinaryLeavitt) * + (leavittWordS (alphaWord i) * a * leavittWordT (alphaWord j)) * + (↑(compressionV⁻¹) : BinaryLeavitt) = + leavittWordS (alphaWord i ++ [0]) * a * + leavittWordT (alphaWord j ++ [0]) := by + simpa only [nineWord_alphaNineIndex, vWord_alphaNineIndex] using + compressionV_conjugate_root (alphaNineIndex i) (alphaNineIndex j) a + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def alphaZeroPrefixCode : BinaryPrefixCode (Fin 3) where + word i := alphaWord i ++ [0] + prefix_free := by decide + +private def prefixElementaryUnit {ι : Type*} [DecidableEq ι] + (E : BinaryPrefixCode ι) (i j : ι) (hij : i ≠ j) + (a : BinaryLeavitt) : BinaryLeavittˣ := by + let x := leavittWordS (E.word i) * a * leavittWordT (E.word j) + have hzero : leavittWordT (E.word j) * leavittWordS (E.word i) = 0 := by + simpa only [hij.symm, ↓reduceIte] using binaryPrefixCode_orthogonal E j i + have hx : x * x = 0 := by + dsimp [x] + calc + (leavittWordS (E.word i) * a * leavittWordT (E.word j)) * + (leavittWordS (E.word i) * a * leavittWordT (E.word j)) = + leavittWordS (E.word i) * a * + (leavittWordT (E.word j) * leavittWordS (E.word i)) * + a * leavittWordT (E.word j) := by + simp only [mul_assoc] + _ = 0 := by rw [hzero]; simp only [mul_zero, zero_mul] + exact + { val := 1 + x + inv := 1 - x + val_inv := by noncomm_ring [hx] + inv_val := by noncomm_ring [hx] } + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def prefixElementaryGroup {ι : Type*} [DecidableEq ι] + (E : BinaryPrefixCode ι) : Subgroup BinaryLeavittˣ := + Subgroup.closure + {z | ∃ (i j : ι) (h : i ≠ j) (a : BinaryLeavitt), + prefixElementaryUnit E i j h a = z} + +private theorem compressionU_conjugate_alpha_elementaryUnit + (i j : Fin 3) (hij : i ≠ j) (a : BinaryLeavitt) : + MulAut.conj compressionU + (prefixElementaryUnit alphaPrefixCode i j hij a) = + prefixElementaryUnit alphaZeroPrefixCode i j hij a := by + apply Units.ext + change + (compressionU : BinaryLeavitt) * + (1 + leavittWordS (alphaWord i) * a * + leavittWordT (alphaWord j)) * + (↑(compressionU⁻¹) : BinaryLeavitt) = + 1 + leavittWordS (alphaWord i ++ [0]) * a * + leavittWordT (alphaWord j ++ [0]) + calc + (compressionU : BinaryLeavitt) * + (1 + leavittWordS (alphaWord i) * a * + leavittWordT (alphaWord j)) * + (↑(compressionU⁻¹) : BinaryLeavitt) = + 1 + (compressionU : BinaryLeavitt) * + (leavittWordS (alphaWord i) * a * + leavittWordT (alphaWord j)) * + (↑(compressionU⁻¹) : BinaryLeavitt) := by + simp only [mul_add, mul_one, add_mul, Units.mul_inv] + _ = 1 + leavittWordS (alphaWord i ++ [0]) * a * + leavittWordT (alphaWord j ++ [0]) := by + rw [compressionU_conjugate_alpha_root] + +private theorem compressionV_conjugate_alpha_elementaryUnit + (i j : Fin 3) (hij : i ≠ j) (a : BinaryLeavitt) : + MulAut.conj compressionV + (prefixElementaryUnit alphaPrefixCode i j hij a) = + prefixElementaryUnit alphaZeroPrefixCode i j hij a := by + apply Units.ext + change + (compressionV : BinaryLeavitt) * + (1 + leavittWordS (alphaWord i) * a * + leavittWordT (alphaWord j)) * + (↑(compressionV⁻¹) : BinaryLeavitt) = + 1 + leavittWordS (alphaWord i ++ [0]) * a * + leavittWordT (alphaWord j ++ [0]) + calc + (compressionV : BinaryLeavitt) * + (1 + leavittWordS (alphaWord i) * a * + leavittWordT (alphaWord j)) * + (↑(compressionV⁻¹) : BinaryLeavitt) = + 1 + (compressionV : BinaryLeavitt) * + (leavittWordS (alphaWord i) * a * + leavittWordT (alphaWord j)) * + (↑(compressionV⁻¹) : BinaryLeavitt) := by + simp only [mul_add, mul_one, add_mul, Units.mul_inv] + _ = 1 + leavittWordS (alphaWord i ++ [0]) * a * + leavittWordT (alphaWord j ++ [0]) := by + rw [compressionV_conjugate_alpha_root] + +private theorem prefixElementaryGroup_map_conj + {ι : Type*} [DecidableEq ι] + (E E' : BinaryPrefixCode ι) (g : BinaryLeavittˣ) + (hconj : ∀ (i j : ι) (hij : i ≠ j) (a : BinaryLeavitt), + MulAut.conj g (prefixElementaryUnit E i j hij a) = + prefixElementaryUnit E' i j hij a) : + (prefixElementaryGroup E).map (MulAut.conj g).toMonoidHom = + prefixElementaryGroup E' := by + unfold prefixElementaryGroup + rw [MonoidHom.map_closure] + congr 1 + ext z + constructor + · rintro ⟨_, ⟨i, j, hij, a, rfl⟩, hz⟩ + exact ⟨i, j, hij, a, (hconj i j hij a).symm.trans hz⟩ + · rintro ⟨i, j, hij, a, rfl⟩ + exact ⟨prefixElementaryUnit E i j hij a, + ⟨i, j, hij, a, rfl⟩, hconj i j hij a⟩ + +public +theorem compressionU_map_alphaPrefixElementaryGroup : + (prefixElementaryGroup alphaPrefixCode).map + (MulAut.conj compressionU).toMonoidHom = + prefixElementaryGroup alphaZeroPrefixCode := + prefixElementaryGroup_map_conj alphaPrefixCode alphaZeroPrefixCode + compressionU compressionU_conjugate_alpha_elementaryUnit + +public +theorem compressionV_map_alphaPrefixElementaryGroup : + (prefixElementaryGroup alphaPrefixCode).map + (MulAut.conj compressionV).toMonoidHom = + prefixElementaryGroup alphaZeroPrefixCode := + prefixElementaryGroup_map_conj alphaPrefixCode alphaZeroPrefixCode + compressionV compressionV_conjugate_alpha_elementaryUnit + +private theorem alphaZero_prefixElementaryUnit_eq + (i j : Fin 3) (hij : i ≠ j) (a : BinaryLeavitt) : + prefixElementaryUnit alphaZeroPrefixCode i j hij a = + prefixElementaryUnit alphaPrefixCode i j hij + (leavittS 0 * a * leavittT 0) := by + apply Units.ext + change + 1 + leavittWordS (alphaWord i ++ [0]) * a * + leavittWordT (alphaWord j ++ [0]) = + 1 + leavittWordS (alphaWord i) * + (leavittS 0 * a * leavittT 0) * leavittWordT (alphaWord j) + simp only [Fin.isValue, leavittWordS_append, leavittWordS, mul_one, mul_assoc, + leavittWordT_append, + leavittWordT, one_mul] + +public +theorem alphaZero_prefixElementaryGroup_le : + prefixElementaryGroup alphaZeroPrefixCode ≤ + prefixElementaryGroup alphaPrefixCode := by + rw [prefixElementaryGroup, Subgroup.closure_le] + rintro _ ⟨i, j, hij, a, rfl⟩ + rw [alphaZero_prefixElementaryUnit_eq] + exact Subgroup.subset_closure + ⟨i, j, hij, leavittS 0 * a * leavittT 0, rfl⟩ + +section NoncommutativeElementaryGroup + +variable {ι R : Type*} [Fintype ι] [DecidableEq ι] [Ring R] + +private theorem single_mul_self_eq_zero (i j : ι) (h : i ≠ j) (a : R) : + Matrix.single i j a * Matrix.single i j a = 0 := + Matrix.single_mul_single_of_ne (c := a) i j i h.symm a + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def elementaryUnit (i j : ι) (h : i ≠ j) (a : R) : (Matrix ι ι R)ˣ where + val := 1 + Matrix.single i j a + inv := 1 - Matrix.single i j a + val_inv := by + have hx := single_mul_self_eq_zero i j h a + noncomm_ring [hx] + inv_val := by + have hx := single_mul_self_eq_zero i j h a + noncomm_ring [hx] + +@[simp] private theorem elementaryUnit_zero (i j : ι) (h : i ≠ j) : + elementaryUnit (R := R) i j h 0 = 1 := by + apply Units.ext + simp only [elementaryUnit, Matrix.single_zero, add_zero, sub_zero, Units.val_one] + +private theorem elementaryUnit_mul (i j : ι) (h : i ≠ j) (a b : R) : + elementaryUnit i j h a * elementaryUnit i j h b = + elementaryUnit i j h (a + b) := by + apply Units.ext + change + (1 + Matrix.single i j a) * (1 + Matrix.single i j b) = + 1 + Matrix.single i j (a + b) + have hab : Matrix.single i j a * Matrix.single i j b = 0 := + Matrix.single_mul_single_of_ne (c := a) i j i h.symm b + rw [Matrix.single_add] + noncomm_ring [hab] + +private theorem elementaryUnit_injective (i j : ι) (h : i ≠ j) : + Function.Injective (elementaryUnit (R := R) i j h) := by + intro a b hab + have he := congrArg (fun z : (Matrix ι ι R)ˣ => (z : Matrix ι ι R) i j) hab + simpa only [elementaryUnit, Matrix.add_apply, ne_eq, h, not_false_eq_true, Matrix.one_apply_ne, + Matrix.single_apply_same, zero_add] using he + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def elementaryGroup (ι R : Type*) [Fintype ι] [DecidableEq ι] [Ring R] : + Subgroup (Matrix ι ι R)ˣ := + Subgroup.closure + {z | ∃ (i j : ι) (h : i ≠ j) (a : R), elementaryUnit i j h a = z} + +public +theorem elementaryUnit_mem (i j : ι) (h : i ≠ j) (a : R) : + elementaryUnit i j h a ∈ elementaryGroup ι R := + Subgroup.subset_closure ⟨i, j, h, a, rfl⟩ + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def elementaryRootHom (i j : ι) (h : i ≠ j) : + Multiplicative R →* elementaryGroup ι R where + toFun a := ⟨elementaryUnit i j h a.toAdd, elementaryUnit_mem i j h a.toAdd⟩ + map_one' := by + apply Subtype.ext + exact elementaryUnit_zero i j h + map_mul' a b := by + apply Subtype.ext + exact (elementaryUnit_mul i j h a.toAdd b.toAdd).symm + +private theorem elementaryGroup_infinite [Infinite R] (i j : ι) (h : i ≠ j) : + Infinite (elementaryGroup ι R) := by + apply Infinite.of_injective + (fun a : R => (⟨elementaryUnit i j h a, elementaryUnit_mem i j h a⟩ : + elementaryGroup ι R)) + intro a b hab + exact elementaryUnit_injective i j h (congrArg Subtype.val hab) + +private theorem cylinder_transposition_factorization [CharP R 2] (P Q : R) + (hPP : P * P = 0) (hPQP : P * Q * P = P) : + (1 + P) * (1 + Q) * (1 + P) = + 1 - P * Q - Q * P + P + Q := by + simp only [CharTwo.sub_eq_add] + have hthree : (3 : ℤ) • P = P := by + rw [zsmul_eq_mul, CharTwo.intCast_eq_mod] + norm_num + noncomm_ring [hPP, hPQP] + simp only [hthree] + +public +theorem elementaryUnit_commutator (i j k : ι) + (hij : i ≠ j) (hjk : j ≠ k) (hik : i ≠ k) (a b : R) : + ⁅elementaryUnit i j hij a, elementaryUnit j k hjk b⁆ = + elementaryUnit i k hik (a * b) := by + apply Units.ext + change + (1 + Matrix.single i j a) * (1 + Matrix.single j k b) * + (1 - Matrix.single i j a) * (1 - Matrix.single j k b) = + 1 + Matrix.single i k (a * b) + have hxx := single_mul_self_eq_zero i j hij a + have hyy := single_mul_self_eq_zero j k hjk b + have hyx : Matrix.single j k b * Matrix.single i j a = 0 := + Matrix.single_mul_single_of_ne (c := b) j k i hik.symm a + have hxy : Matrix.single i j a * Matrix.single j k b = + Matrix.single i k (a * b) := + Matrix.single_mul_single_same (c := a) i j k b + have hzx : Matrix.single i k (a * b) * Matrix.single i j a = 0 := + Matrix.single_mul_single_of_ne (c := a * b) i k i hik.symm a + have hzy : Matrix.single i k (a * b) * Matrix.single j k b = 0 := + Matrix.single_mul_single_of_ne (c := a * b) i k j hjk.symm b + have hzz := single_mul_self_eq_zero i k hik (a * b) + noncomm_ring [hxx, hyy, hyx, hxy, hzx, hzy, hzz] + +public +theorem elementaryUnit_mem_of_two_step + (H : Subgroup (Matrix ι ι R)ˣ) (i j k : ι) + (hij : i ≠ j) (hjk : j ≠ k) (hik : i ≠ k) (a : R) + (hleft : elementaryUnit i j hij a ∈ H) + (hright : elementaryUnit j k hjk 1 ∈ H) : + elementaryUnit i k hik a ∈ H := by + have hc : ⁅elementaryUnit i j hij a, elementaryUnit j k hjk 1⁆ ∈ H := by + rw [commutatorElement_def] + exact H.mul_mem (H.mul_mem (H.mul_mem hleft hright) (H.inv_mem hleft)) + (H.inv_mem hright) + rw [elementaryUnit_commutator i j k hij hjk hik a 1] at hc + simpa only [mul_one] using hc + +end NoncommutativeElementaryGroup + +section FiniteGeneration + +variable {R : Type*} [Ring R] + +private noncomputable def finiteElementaryGenerators [DecidableEq R] + (n : ℕ) (s : Finset R) : Finset (Matrix (Fin n) (Fin n) R)ˣ := + Finset.univ.biUnion (fun i : Fin n => + Finset.univ.biUnion (fun j : Fin n => + if h : i ≠ j then (insert 1 s).image (elementaryUnit i j h) else ∅)) + +private theorem mem_finiteElementaryGenerators [DecidableEq R] (n : ℕ) (s : Finset R) + (z : (Matrix (Fin n) (Fin n) R)ˣ) : + z ∈ finiteElementaryGenerators n s ↔ + ∃ (i j : Fin n) (h : i ≠ j) (a : R), + a ∈ insert 1 s ∧ elementaryUnit i j h a = z := by + constructor + · intro hz + unfold finiteElementaryGenerators at hz + obtain ⟨i, _, hi⟩ := Finset.mem_biUnion.mp hz + obtain ⟨j, _, hj⟩ := Finset.mem_biUnion.mp hi + by_cases h : i ≠ j + · rw [dite_eq_left h] at hj + obtain ⟨a, ha, rfl⟩ := Finset.mem_image.mp hj + exact ⟨i, j, h, a, ha, rfl⟩ + · rw [dite_eq_right h] at hj + simp only [Finset.notMem_empty] at hj + · rintro ⟨i, j, h, a, ha, rfl⟩ + unfold finiteElementaryGenerators + apply Finset.mem_biUnion.mpr + refine ⟨i, Finset.mem_univ i, ?_⟩ + apply Finset.mem_biUnion.mpr + refine ⟨j, Finset.mem_univ j, ?_⟩ + rw [dite_eq_left h] + exact Finset.mem_image.mpr ⟨a, ha, rfl⟩ + +variable [Algebra (ZMod 2) R] + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def elementaryCoefficientSubalgebra (n : ℕ) (hn : 2 < n) + (H : Subgroup (Matrix (Fin n) (Fin n) R)ˣ) + (hunit : ∀ (i j : Fin n) (h : i ≠ j), elementaryUnit i j h (1 : R) ∈ H) : + Subalgebra (ZMod 2) R where + carrier := + {a | ∀ (i j : Fin n) (h : i ≠ j), elementaryUnit i j h a ∈ H} + add_mem' := by + intro a b ha hb i j hij + rw [← elementaryUnit_mul] + exact H.mul_mem (ha i j hij) (hb i j hij) + mul_mem' := by + intro a b ha hb i j hij + obtain ⟨k, hki, hkj⟩ := Fin.exists_ne_and_ne_of_two_lt i j hn + have hik : i ≠ k := hki.symm + have hleft := ha i k hik + have hright := hb k j hkj + have hc : ⁅elementaryUnit i k hik a, elementaryUnit k j hkj b⁆ ∈ H := by + rw [commutatorElement_def] + exact H.mul_mem + (H.mul_mem (H.mul_mem hleft hright) (H.inv_mem hleft)) + (H.inv_mem hright) + rw [elementaryUnit_commutator i k j hik hkj hij a b] at hc + exact hc + algebraMap_mem' := by + intro z + have hz : z = 0 ∨ z = 1 := by + fin_cases z + · exact Or.inl rfl + · exact Or.inr rfl + rcases hz with rfl | rfl + · intro i j hij + simpa only [map_zero, elementaryUnit_zero] using H.one_mem + · intro i j hij + simpa only [map_one] using hunit i j hij + +private theorem elementaryGroup_finitelyGenerated + [Algebra.FiniteType (ZMod 2) R] + (n : ℕ) (hn : 2 < n) : + Group.FG (elementaryGroup (Fin n) R) := by + classical + obtain ⟨s, hs⟩ := Algebra.FiniteType.out (R := ZMod 2) (A := R) + let t : Finset (Matrix (Fin n) (Fin n) R)ˣ := + finiteElementaryGenerators n s + let H : Subgroup (Matrix (Fin n) (Fin n) R)ˣ := + Subgroup.closure (t : Set (Matrix (Fin n) (Fin n) R)ˣ) + have hunit : ∀ (i j : Fin n) (h : i ≠ j), + elementaryUnit i j h (1 : R) ∈ H := by + intro i j hij + apply Subgroup.subset_closure + change elementaryUnit i j hij (1 : R) ∈ finiteElementaryGenerators n s + exact (mem_finiteElementaryGenerators n s _).mpr + ⟨i, j, hij, 1, Finset.mem_insert_self 1 s, rfl⟩ + let C : Subalgebra (ZMod 2) R := + elementaryCoefficientSubalgebra n hn H hunit + have hgen : (s : Set R) ⊆ (C : Set R) := by + intro a ha i j hij + apply Subgroup.subset_closure + change elementaryUnit i j hij a ∈ finiteElementaryGenerators n s + exact (mem_finiteElementaryGenerators n s _).mpr + ⟨i, j, hij, a, Finset.mem_insert_of_mem ha, rfl⟩ + have hC : C = ⊤ := by + apply top_unique + rw [← hs] + exact Algebra.adjoin_le hgen + have heq : H = elementaryGroup (Fin n) R := by + apply le_antisymm + · change Subgroup.closure (t : Set (Matrix (Fin n) (Fin n) R)ˣ) ≤ _ + rw [Subgroup.closure_le] + intro z hz + change z ∈ finiteElementaryGenerators n s at hz + obtain ⟨i, j, hij, a, _, rfl⟩ := + (mem_finiteElementaryGenerators n s z).mp hz + exact elementaryUnit_mem i j hij a + · rw [elementaryGroup, Subgroup.closure_le] + rintro _ ⟨i, j, hij, a, rfl⟩ + have ha : a ∈ C := by simp only [hC, Algebra.mem_top] + exact ha i j hij + apply (Group.fg_iff_subgroup_fg (elementaryGroup (Fin n) R)).mpr + exact ⟨t, heq⟩ + +private theorem elementaryGroup_three_finitelyGenerated + [Algebra.FiniteType (ZMod 2) R] : + Group.FG (elementaryGroup (Fin 3) R) := + elementaryGroup_finitelyGenerated 3 (by decide) + +end FiniteGeneration + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +abbrev binaryLeavittElementaryGroup (n : ℕ) : Type := + elementaryGroup (Fin n) BinaryLeavitt + +private def completePrefixMatrixEquiv {ι : Type*} [Fintype ι] [DecidableEq ι] + (E : BinaryPrefixCode ι) + (hcomplete : MatrixCorner.codeIdempotent + (fun i => leavittWordS (E.word i)) + (fun i => leavittWordT (E.word i)) = 1) : + Matrix ι ι BinaryLeavitt ≃+* BinaryLeavitt where + toFun := MatrixCorner.encode + (fun i => leavittWordS (E.word i)) + (fun i => leavittWordT (E.word i)) + invFun := MatrixCorner.decode + (fun i => leavittWordS (E.word i)) + (fun i => leavittWordT (E.word i)) + left_inv := MatrixCorner.decode_encode _ _ (binaryPrefixCode_orthogonal E) + right_inv x := by + rw [MatrixCorner.encode_decode, hcomplete] + simp only [one_mul, mul_one] + map_mul' := MatrixCorner.encode_mul _ _ (binaryPrefixCode_orthogonal E) + map_add' M N := by + simp only [MatrixCorner.encode, Matrix.add_apply, mul_add, add_mul, Finset.sum_add_distrib] + +private def completePrefixUnitEquiv {ι : Type*} [Fintype ι] [DecidableEq ι] + (E : BinaryPrefixCode ι) + (hcomplete : MatrixCorner.codeIdempotent + (fun i => leavittWordS (E.word i)) + (fun i => leavittWordT (E.word i)) = 1) : + (Matrix ι ι BinaryLeavitt)ˣ ≃* BinaryLeavittˣ := + Units.mapEquiv (completePrefixMatrixEquiv E hcomplete).toMulEquiv + +private theorem completePrefixUnitEquiv_elementaryUnit + {ι : Type*} [Fintype ι] [DecidableEq ι] + (E : BinaryPrefixCode ι) + (hcomplete : MatrixCorner.codeIdempotent + (fun i => leavittWordS (E.word i)) + (fun i => leavittWordT (E.word i)) = 1) + (i j : ι) (hij : i ≠ j) (a : BinaryLeavitt) : + completePrefixUnitEquiv E hcomplete (elementaryUnit i j hij a) = + prefixElementaryUnit E i j hij a := by + apply Units.ext + change + MatrixCorner.encode + (fun k => leavittWordS (E.word k)) + (fun k => leavittWordT (E.word k)) + (1 + Matrix.single i j a) = + 1 + leavittWordS (E.word i) * a * leavittWordT (E.word j) + have h₁ : + MatrixCorner.encode + (fun k => leavittWordS (E.word k)) + (fun k => leavittWordT (E.word k)) + (1 : Matrix ι ι BinaryLeavitt) = 1 := by + rw [MatrixCorner.encode_one, hcomplete] + calc + MatrixCorner.encode + (fun k => leavittWordS (E.word k)) + (fun k => leavittWordT (E.word k)) + (1 + Matrix.single i j a) = + MatrixCorner.encode + (fun k => leavittWordS (E.word k)) + (fun k => leavittWordT (E.word k)) + (1 : Matrix ι ι BinaryLeavitt) + + MatrixCorner.encode + (fun k => leavittWordS (E.word k)) + (fun k => leavittWordT (E.word k)) + (Matrix.single i j a) := by + simp only [MatrixCorner.encode, Matrix.add_apply, mul_add, add_mul, + Finset.sum_add_distrib] + _ = 1 + leavittWordS (E.word i) * a * leavittWordT (E.word j) := by + rw [h₁] + simp only [MatrixCorner.encode, Matrix.single_apply, ite_and, mul_ite, mul_zero, ite_mul, + zero_mul, + Finset.sum_ite_irrel, Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte, Finset.sum_const_zero] + +private theorem completePrefixElementaryGroup_map + {ι : Type*} [Fintype ι] [DecidableEq ι] + (E : BinaryPrefixCode ι) + (hcomplete : MatrixCorner.codeIdempotent + (fun i => leavittWordS (E.word i)) + (fun i => leavittWordT (E.word i)) = 1) : + (elementaryGroup ι BinaryLeavitt).map + (completePrefixUnitEquiv E hcomplete).toMonoidHom = + prefixElementaryGroup E := by + unfold elementaryGroup prefixElementaryGroup + rw [MonoidHom.map_closure] + congr 1 + ext z + constructor + · rintro ⟨_, ⟨i, j, hij, a, rfl⟩, hz⟩ + exact ⟨i, j, hij, a, + (completePrefixUnitEquiv_elementaryUnit E hcomplete i j hij a).symm.trans hz⟩ + · rintro ⟨i, j, hij, a, rfl⟩ + exact ⟨elementaryUnit i j hij a, ⟨i, j, hij, a, rfl⟩, + completePrefixUnitEquiv_elementaryUnit E hcomplete i j hij a⟩ + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def ninePrefixElementaryGroupEquiv : + binaryLeavittElementaryGroup 9 ≃* prefixElementaryGroup ninePrefixCode := + ((completePrefixUnitEquiv ninePrefixCode ninePrefixCode_complete).subgroupMap + (elementaryGroup (Fin 9) BinaryLeavitt)).trans + (MulEquiv.subgroupCongr + (completePrefixElementaryGroup_map ninePrefixCode ninePrefixCode_complete)) + +private def idempotentCornerUnitExtension {A : Type*} [Ring A] + {e : A} (he : IsIdempotentElem e) : he.Cornerˣ →* Aˣ where + toFun u := + { val := u.val.val + (1 - e) + inv := u.inv.val + (1 - e) + val_inv := by + have hu := (Subsemigroup.mem_corner_iff he).mp u.val.property + have hv := (Subsemigroup.mem_corner_iff he).mp u.inv.property + have huv : u.val.val * u.inv.val = e := by + have h := congrArg (fun z : he.Corner => z.val) u.val_inv + exact h + noncomm_ring [he.eq, hu.1, hu.2, hv.1, hv.2, huv] + inv_val := by + have hu := (Subsemigroup.mem_corner_iff he).mp u.val.property + have hv := (Subsemigroup.mem_corner_iff he).mp u.inv.property + have hvu : u.inv.val * u.val.val = e := by + have h := congrArg (fun z : he.Corner => z.val) u.inv_val + exact h + noncomm_ring [he.eq, hu.1, hu.2, hv.1, hv.2, hvu] } + map_one' := by + apply Units.ext + change e + (1 - e) = 1 + noncomm_ring + map_mul' u v := by + apply Units.ext + have hu := (Subsemigroup.mem_corner_iff he).mp u.val.property + have hv := (Subsemigroup.mem_corner_iff he).mp v.val.property + change + u.val.val * v.val.val + (1 - e) = + (u.val.val + (1 - e)) * (v.val.val + (1 - e)) + noncomm_ring [he.eq, hu.1, hu.2, hv.1, hv.2] + +private theorem idempotentCornerUnitExtension_injective + {A : Type*} [Ring A] {e : A} (he : IsIdempotentElem e) : + Function.Injective (idempotentCornerUnitExtension he) := by + intro u v huv + apply Units.ext + apply Subtype.ext + have h := congrArg (fun z : Aˣ => (z : A)) huv + change u.val.val + (1 - e) = v.val.val + (1 - e) at h + exact add_right_cancel h + +private def prefixCornerUnitHom {ι : Type*} [Fintype ι] [DecidableEq ι] + (E : BinaryPrefixCode ι) : + (Matrix ι ι BinaryLeavitt)ˣ →* BinaryLeavittˣ := + (idempotentCornerUnitExtension + (MatrixCorner.codeIdempotent_isIdempotent + (fun i => leavittWordS (E.word i)) + (fun i => leavittWordT (E.word i)) + (binaryPrefixCode_orthogonal E))).comp + (Units.mapEquiv (binaryPrefixCornerEquiv E).toMulEquiv).toMonoidHom + +private theorem prefixCornerUnitHom_injective + {ι : Type*} [Fintype ι] [DecidableEq ι] + (E : BinaryPrefixCode ι) : + Function.Injective (prefixCornerUnitHom E) := by + exact (idempotentCornerUnitExtension_injective + (MatrixCorner.codeIdempotent_isIdempotent + (fun i => leavittWordS (E.word i)) + (fun i => leavittWordT (E.word i)) + (binaryPrefixCode_orthogonal E))).comp + (Units.mapEquiv (binaryPrefixCornerEquiv E).toMulEquiv).injective + +private theorem prefixCornerUnitHom_elementaryUnit + {ι : Type*} [Fintype ι] [DecidableEq ι] + (E : BinaryPrefixCode ι) + (i j : ι) (hij : i ≠ j) (a : BinaryLeavitt) : + prefixCornerUnitHom E (elementaryUnit i j hij a) = + prefixElementaryUnit E i j hij a := by + apply Units.ext + change + MatrixCorner.encode + (fun k => leavittWordS (E.word k)) + (fun k => leavittWordT (E.word k)) + (1 + Matrix.single i j a) + + (1 - MatrixCorner.codeIdempotent + (fun k => leavittWordS (E.word k)) + (fun k => leavittWordT (E.word k))) = + 1 + leavittWordS (E.word i) * a * leavittWordT (E.word j) + have henc : + MatrixCorner.encode + (fun k => leavittWordS (E.word k)) + (fun k => leavittWordT (E.word k)) + (1 + Matrix.single i j a) = + MatrixCorner.codeIdempotent + (fun k => leavittWordS (E.word k)) + (fun k => leavittWordT (E.word k)) + + leavittWordS (E.word i) * a * leavittWordT (E.word j) := by + calc + MatrixCorner.encode + (fun k => leavittWordS (E.word k)) + (fun k => leavittWordT (E.word k)) + (1 + Matrix.single i j a) = + MatrixCorner.encode + (fun k => leavittWordS (E.word k)) + (fun k => leavittWordT (E.word k)) + (1 : Matrix ι ι BinaryLeavitt) + + MatrixCorner.encode + (fun k => leavittWordS (E.word k)) + (fun k => leavittWordT (E.word k)) + (Matrix.single i j a) := by + simp only [MatrixCorner.encode, Matrix.add_apply, mul_add, add_mul, + Finset.sum_add_distrib] + _ = MatrixCorner.codeIdempotent + (fun k => leavittWordS (E.word k)) + (fun k => leavittWordT (E.word k)) + + leavittWordS (E.word i) * a * leavittWordT (E.word j) := by + rw [MatrixCorner.encode_one] + simp only [MatrixCorner.encode, Matrix.single_apply, ite_and, mul_ite, mul_zero, + ite_mul, zero_mul, + Finset.sum_ite_irrel, Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte, + Finset.sum_const_zero] + rw [henc] + noncomm_ring + +private theorem prefixCornerElementaryGroup_map + {ι : Type*} [Fintype ι] [DecidableEq ι] + (E : BinaryPrefixCode ι) : + (elementaryGroup ι BinaryLeavitt).map (prefixCornerUnitHom E) = + prefixElementaryGroup E := by + unfold elementaryGroup prefixElementaryGroup + rw [MonoidHom.map_closure] + congr 1 + ext z + constructor + · rintro ⟨_, ⟨i, j, hij, a, rfl⟩, hz⟩ + exact ⟨i, j, hij, a, + (prefixCornerUnitHom_elementaryUnit E i j hij a).symm.trans hz⟩ + · rintro ⟨i, j, hij, a, rfl⟩ + exact ⟨elementaryUnit i j hij a, ⟨i, j, hij, a, rfl⟩, + prefixCornerUnitHom_elementaryUnit E i j hij a⟩ + +private def alphaPrefixElementaryGroupEquiv : + binaryLeavittElementaryGroup 3 ≃* prefixElementaryGroup alphaPrefixCode := + ((elementaryGroup (Fin 3) BinaryLeavitt).equivMapOfInjective + (prefixCornerUnitHom alphaPrefixCode) + (prefixCornerUnitHom_injective alphaPrefixCode)).trans + (MulEquiv.subgroupCongr + (prefixCornerElementaryGroup_map alphaPrefixCode)) + +namespace SourceGeneration + +open scoped commutatorElement + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def sourceGeneratedGroup : Subgroup BinaryLeavittˣ := + Subgroup.closure + ((prefixElementaryGroup alphaPrefixCode : Set BinaryLeavittˣ) ∪ + {compressionU, compressionV}) + +private theorem alphaRoot_mem_sourceGenerated + (i j : Fin 3) (hij : i ≠ j) (a : BinaryLeavitt) : + prefixElementaryUnit alphaPrefixCode i j hij a ∈ sourceGeneratedGroup := by + apply Subgroup.subset_closure + apply Set.mem_union_left + exact Subgroup.subset_closure ⟨i, j, hij, a, rfl⟩ + +private theorem compressionU_mem_sourceGenerated : + compressionU ∈ sourceGeneratedGroup := by + apply Subgroup.subset_closure + apply Set.mem_union_right + simp only [Set.mem_insert_iff, Set.mem_singleton_iff, true_or] + +private theorem compressionV_mem_sourceGenerated : + compressionV ∈ sourceGeneratedGroup := by + apply Subgroup.subset_closure + apply Set.mem_union_right + simp only [Set.mem_insert_iff, Set.mem_singleton_iff, or_true] + +private theorem prefixTable_mul_wordS {ι : Type*} [Fintype ι] + (source target : BinaryPrefixCode ι) (i : ι) : + prefixTable source target * leavittWordS (source.word i) = + leavittWordS (target.word i) := by + classical + calc + prefixTable source target * leavittWordS (source.word i) = + ∑ j, leavittWordS (target.word j) * + (leavittWordT (source.word j) * leavittWordS (source.word i)) := by + simp only [prefixTable, Finset.sum_mul, mul_assoc] + _ = leavittWordS (target.word i) := by + simp only [binaryPrefixCode_orthogonal, mul_ite, mul_one, mul_zero, Finset.sum_ite_eq', + Finset.mem_univ, + ↓reduceIte] + +private theorem wordT_mul_prefixTable {ι : Type*} [Fintype ι] + (source target : BinaryPrefixCode ι) (i : ι) : + leavittWordT (target.word i) * prefixTable source target = + leavittWordT (source.word i) := by + classical + calc + leavittWordT (target.word i) * prefixTable source target = + ∑ j, (leavittWordT (target.word i) * + leavittWordS (target.word j)) * leavittWordT (source.word j) := by + simp only [prefixTable, Finset.mul_sum, mul_assoc] + _ = leavittWordT (source.word i) := by + simp only [binaryPrefixCode_orthogonal, ite_mul, one_mul, zero_mul, Finset.sum_ite_eq, + Finset.mem_univ, + ↓reduceIte] + +private theorem leavittWordS_split (a : List (Fin 2)) : + leavittWordS a = + leavittWordS (a ++ [0]) * leavittT 0 + + leavittWordS (a ++ [1]) * leavittT 1 := by + calc + leavittWordS a = leavittWordS a * + (leavittS 0 * leavittT 0 + leavittS 1 * leavittT 1) := by + rw [leavitt_partition] + simp only [mul_one] + _ = leavittWordS (a ++ [0]) * leavittT 0 + + leavittWordS (a ++ [1]) * leavittT 1 := by + simp only [Fin.isValue, mul_add, leavittWordS_append, leavittWordS, mul_one, mul_assoc] + +private theorem leavittWordT_split (a : List (Fin 2)) : + leavittWordT a = + leavittS 0 * leavittWordT (a ++ [0]) + + leavittS 1 * leavittWordT (a ++ [1]) := by + calc + leavittWordT a = + (leavittS 0 * leavittT 0 + leavittS 1 * leavittT 1) * + leavittWordT a := by + rw [leavitt_partition] + simp only [one_mul] + _ = leavittS 0 * leavittWordT (a ++ [0]) + + leavittS 1 * leavittWordT (a ++ [1]) := by + simp only [Fin.isValue, add_mul, mul_assoc, leavittWordT_append, leavittWordT, one_mul] + +private def betaNineIndex (i : Fin 3) : Fin 9 := + ⟨3 * i.val + 1, by omega⟩ + +private def nuNineIndex (i : Fin 3) : Fin 9 := + ⟨3 * i.val + 2, by omega⟩ + +@[simp] private theorem nineWord_betaNineIndex (i : Fin 3) : + nineWord (betaNineIndex i) = betaWord i := by + fin_cases i <;> rfl + +@[simp] private theorem nineWord_nuNineIndex (i : Fin 3) : + nineWord (nuNineIndex i) = nuWord i := by + fin_cases i <;> rfl + +@[simp] private theorem uWord_betaNineIndex (i : Fin 3) : + uWord (betaNineIndex i) = alphaWord i ++ [1] := by + fin_cases i <;> rfl + +@[simp] private theorem vWord_nuNineIndex (i : Fin 3) : + vWord (nuNineIndex i) = alphaWord i ++ [1] := by + fin_cases i <;> rfl + +private theorem compressionU_inv_mul_alphaWordS (i : Fin 3) : + (↑(compressionU⁻¹) : BinaryLeavitt) * leavittWordS (alphaWord i) = + leavittWordS (alphaWord i) * leavittT 0 + + leavittWordS (betaWord i) * leavittT 1 := by + calc + (↑(compressionU⁻¹) : BinaryLeavitt) * leavittWordS (alphaWord i) = + (↑(compressionU⁻¹) : BinaryLeavitt) * + (leavittWordS (alphaWord i ++ [0]) * leavittT 0 + + leavittWordS (alphaWord i ++ [1]) * leavittT 1) := + congrArg ((↑(compressionU⁻¹) : BinaryLeavitt) * ·) + (leavittWordS_split (alphaWord i)) + _ = (prefixTable uPrefixCode ninePrefixCode * + leavittWordS (alphaWord i ++ [0])) * leavittT 0 + + (prefixTable uPrefixCode ninePrefixCode * + leavittWordS (alphaWord i ++ [1])) * leavittT 1 := by + change + prefixTable uPrefixCode ninePrefixCode * + (leavittWordS (alphaWord i ++ [0]) * leavittT 0 + + leavittWordS (alphaWord i ++ [1]) * leavittT 1) = _ + simp only [Fin.isValue, mul_add, mul_assoc] + _ = leavittWordS (alphaWord i) * leavittT 0 + + leavittWordS (betaWord i) * leavittT 1 := by + simpa only [ninePrefixCode, uPrefixCode, nineWord_alphaNineIndex, + nineWord_betaNineIndex, uWord_alphaNineIndex, uWord_betaNineIndex] + using congrArg₂ (· + ·) + (congrArg (· * leavittT 0) + (prefixTable_mul_wordS uPrefixCode ninePrefixCode + (alphaNineIndex i))) + (congrArg (· * leavittT 1) + (prefixTable_mul_wordS uPrefixCode ninePrefixCode + (betaNineIndex i))) + +private theorem alphaWordT_mul_compressionU (i : Fin 3) : + leavittWordT (alphaWord i) * (compressionU : BinaryLeavitt) = + leavittS 0 * leavittWordT (alphaWord i) + + leavittS 1 * leavittWordT (betaWord i) := by + calc + leavittWordT (alphaWord i) * (compressionU : BinaryLeavitt) = + (leavittS 0 * leavittWordT (alphaWord i ++ [0]) + + leavittS 1 * leavittWordT (alphaWord i ++ [1])) * + (compressionU : BinaryLeavitt) := + congrArg (· * (compressionU : BinaryLeavitt)) + (leavittWordT_split (alphaWord i)) + _ = leavittS 0 * (leavittWordT (alphaWord i ++ [0]) * + prefixTable ninePrefixCode uPrefixCode) + + leavittS 1 * (leavittWordT (alphaWord i ++ [1]) * + prefixTable ninePrefixCode uPrefixCode) := by + change + (leavittS 0 * leavittWordT (alphaWord i ++ [0]) + + leavittS 1 * leavittWordT (alphaWord i ++ [1])) * + prefixTable ninePrefixCode uPrefixCode = _ + simp only [Fin.isValue, add_mul, mul_assoc] + _ = leavittS 0 * leavittWordT (alphaWord i) + + leavittS 1 * leavittWordT (betaWord i) := by + simpa only [ninePrefixCode, uPrefixCode, nineWord_alphaNineIndex, + nineWord_betaNineIndex, uWord_alphaNineIndex, uWord_betaNineIndex] + using congrArg₂ (· + ·) + (congrArg (leavittS 0 * ·) + (wordT_mul_prefixTable ninePrefixCode uPrefixCode + (alphaNineIndex i))) + (congrArg (leavittS 1 * ·) + (wordT_mul_prefixTable ninePrefixCode uPrefixCode + (betaNineIndex i))) + +private def alphaBetaNineIndex (p : Fin 2) (i : Fin 3) : Fin 9 := + ⟨3 * i.val + p.val, by omega⟩ + +private theorem alphaBetaNineIndex_ne {i j : Fin 3} (hij : i ≠ j) + (p q : Fin 2) : alphaBetaNineIndex p i ≠ alphaBetaNineIndex q j := by + intro h + apply hij + apply Fin.ext + have hv := congrArg Fin.val h + change 3 * i.val + p.val = 3 * j.val + q.val at hv + omega + +@[simp] private theorem nineWord_alphaBetaNineIndex (p : Fin 2) (i : Fin 3) : + nineWord (alphaBetaNineIndex p i) = + if p = 0 then alphaWord i else betaWord i := by + fin_cases p <;> fin_cases i <;> rfl + +private theorem binaryBlockSandwich + (x₀ x₁ y₀ y₁ a : BinaryLeavitt) (p q : Fin 2) : + (x₀ * leavittT 0 + x₁ * leavittT 1) * + (leavittS p * a * leavittT q) * + (leavittS 0 * y₀ + leavittS 1 * y₁) = + (if p = 0 then x₀ else x₁) * a * + (if q = 0 then y₀ else y₁) := by + have hact (r s : Fin 2) (x : BinaryLeavitt) : + leavittT r * (leavittS s * x) = if r = s then x else 0 := by + rw [← mul_assoc, leavittT_mul_S] + split <;> simp + fin_cases p <;> fin_cases q <;> + simp [add_mul, mul_add, mul_assoc, hact] + +private theorem alphaBetaRoot_mem_sourceGenerated + (i j : Fin 3) (hij : i ≠ j) (p q : Fin 2) (a : BinaryLeavitt) : + prefixElementaryUnit ninePrefixCode + (alphaBetaNineIndex p i) (alphaBetaNineIndex q j) + (alphaBetaNineIndex_ne hij p q) a ∈ sourceGeneratedGroup := by + have hα := alphaRoot_mem_sourceGenerated i j hij + (leavittS p * a * leavittT q) + have hU := compressionU_mem_sourceGenerated + have hconj : + compressionU⁻¹ * + prefixElementaryUnit alphaPrefixCode i j hij + (leavittS p * a * leavittT q) * compressionU ∈ + sourceGeneratedGroup := + sourceGeneratedGroup.mul_mem + (sourceGeneratedGroup.mul_mem (sourceGeneratedGroup.inv_mem hU) hα) hU + have heq : + compressionU⁻¹ * + prefixElementaryUnit alphaPrefixCode i j hij + (leavittS p * a * leavittT q) * compressionU = + prefixElementaryUnit ninePrefixCode + (alphaBetaNineIndex p i) (alphaBetaNineIndex q j) + (alphaBetaNineIndex_ne hij p q) a := by + apply Units.ext + change + (↑(compressionU⁻¹) : BinaryLeavitt) * + (1 + leavittWordS (alphaWord i) * + (leavittS p * a * leavittT q) * + leavittWordT (alphaWord j)) * + (compressionU : BinaryLeavitt) = + 1 + leavittWordS (nineWord (alphaBetaNineIndex p i)) * a * + leavittWordT (nineWord (alphaBetaNineIndex q j)) + calc + (↑(compressionU⁻¹) : BinaryLeavitt) * + (1 + leavittWordS (alphaWord i) * + (leavittS p * a * leavittT q) * + leavittWordT (alphaWord j)) * + (compressionU : BinaryLeavitt) = + 1 + ((↑(compressionU⁻¹) : BinaryLeavitt) * + leavittWordS (alphaWord i)) * + (leavittS p * a * leavittT q) * + (leavittWordT (alphaWord j) * (compressionU : BinaryLeavitt)) := by + simp only [mul_assoc, mul_add, mul_one, add_mul, Units.inv_mul] + _ = 1 + + (leavittWordS (alphaWord i) * leavittT 0 + + leavittWordS (betaWord i) * leavittT 1) * + (leavittS p * a * leavittT q) * + (leavittS 0 * leavittWordT (alphaWord j) + + leavittS 1 * leavittWordT (betaWord j)) := by + rw [compressionU_inv_mul_alphaWordS, + alphaWordT_mul_compressionU] + _ = 1 + leavittWordS (nineWord (alphaBetaNineIndex p i)) * a * + leavittWordT (nineWord (alphaBetaNineIndex q j)) := by + rw [binaryBlockSandwich] + simp only [nineWord_alphaBetaNineIndex] + split_ifs <;> rfl + exact heq ▸ hconj + +private def prefixElementaryEntry {ι : Type*} (E : BinaryPrefixCode ι) + (i j : ι) (a : BinaryLeavitt) : BinaryLeavitt := + leavittWordS (E.word i) * a * leavittWordT (E.word j) + +private theorem prefixElementaryEntry_mul {ι : Type*} [DecidableEq ι] + (E : BinaryPrefixCode ι) (i j k l : ι) + (a b : BinaryLeavitt) : + prefixElementaryEntry E i j a * prefixElementaryEntry E k l b = + if j = k then prefixElementaryEntry E i l (a * b) else 0 := by + calc + prefixElementaryEntry E i j a * prefixElementaryEntry E k l b = + leavittWordS (E.word i) * a * + (leavittWordT (E.word j) * leavittWordS (E.word k)) * + b * leavittWordT (E.word l) := by + simp only [prefixElementaryEntry, mul_assoc] + _ = if j = k then prefixElementaryEntry E i l (a * b) else 0 := by + rw [binaryPrefixCode_orthogonal E j k] + split <;> simp [prefixElementaryEntry, mul_assoc] + +private theorem prefixElementaryUnit_commutator {ι : Type*} [DecidableEq ι] + (E : BinaryPrefixCode ι) (i j k : ι) + (hij : i ≠ j) (hjk : j ≠ k) (hik : i ≠ k) + (a b : BinaryLeavitt) : + ⁅prefixElementaryUnit E i j hij a, + prefixElementaryUnit E j k hjk b⁆ = + prefixElementaryUnit E i k hik (a * b) := by + let x := prefixElementaryEntry E i j a + let y := prefixElementaryEntry E j k b + let z := prefixElementaryEntry E i k (a * b) + have hxx : x * x = 0 := by + change prefixElementaryEntry E i j a * + prefixElementaryEntry E i j a = 0 + rw [prefixElementaryEntry_mul, ite_eq_right hij.symm] + have hyy : y * y = 0 := by + change prefixElementaryEntry E j k b * + prefixElementaryEntry E j k b = 0 + rw [prefixElementaryEntry_mul, ite_eq_right hjk.symm] + have hyx : y * x = 0 := by + change prefixElementaryEntry E j k b * + prefixElementaryEntry E i j a = 0 + rw [prefixElementaryEntry_mul, ite_eq_right hik.symm] + have hxy : x * y = z := by + change prefixElementaryEntry E i j a * + prefixElementaryEntry E j k b = + prefixElementaryEntry E i k (a * b) + rw [prefixElementaryEntry_mul, ite_eq_left rfl] + have hzx : z * x = 0 := by + change prefixElementaryEntry E i k (a * b) * + prefixElementaryEntry E i j a = 0 + rw [prefixElementaryEntry_mul, ite_eq_right hik.symm] + have hzy : z * y = 0 := by + change prefixElementaryEntry E i k (a * b) * + prefixElementaryEntry E j k b = 0 + rw [prefixElementaryEntry_mul, ite_eq_right hjk.symm] + have hzz : z * z = 0 := by + change prefixElementaryEntry E i k (a * b) * + prefixElementaryEntry E i k (a * b) = 0 + rw [prefixElementaryEntry_mul, ite_eq_right hik.symm] + have hxz : x * z = 0 := by + change prefixElementaryEntry E i j a * + prefixElementaryEntry E i k (a * b) = 0 + rw [prefixElementaryEntry_mul, ite_eq_right hij.symm] + have hyz : y * z = 0 := by + change prefixElementaryEntry E j k b * + prefixElementaryEntry E i k (a * b) = 0 + rw [prefixElementaryEntry_mul, ite_eq_right hik.symm] + apply Units.ext + change (1 + x) * (1 + y) * (1 - x) * (1 - y) = 1 + z + noncomm_ring [hxx, hyy, hyx, hxy, hzx, hzy, hzz, hxz, hyz] + +private theorem prefixElementaryUnit_mem_of_two_step + {ι : Type*} [DecidableEq ι] (E : BinaryPrefixCode ι) + (H : Subgroup BinaryLeavittˣ) (i j k : ι) + (hij : i ≠ j) (hjk : j ≠ k) (hik : i ≠ k) (a : BinaryLeavitt) + (hleft : prefixElementaryUnit E i j hij a ∈ H) + (hright : prefixElementaryUnit E j k hjk 1 ∈ H) : + prefixElementaryUnit E i k hik a ∈ H := by + have hc : + ⁅prefixElementaryUnit E i j hij a, + prefixElementaryUnit E j k hjk 1⁆ ∈ H := by + rw [commutatorElement_def] + exact H.mul_mem + (H.mul_mem (H.mul_mem hleft hright) (H.inv_mem hleft)) + (H.inv_mem hright) + rw [prefixElementaryUnit_commutator E i j k hij hjk hik a 1] at hc + simpa only [mul_one] using hc + +private theorem prefixElementaryGroup_le_of_hub + {ι : Type*} [DecidableEq ι] (E : BinaryPrefixCode ι) + (H : Subgroup BinaryLeavittˣ) (k : ι) + (hto : ∀ (i : ι) (h : i ≠ k) (a : BinaryLeavitt), + prefixElementaryUnit E i k h a ∈ H) + (hfrom : ∀ (j : ι) (h : k ≠ j) (a : BinaryLeavitt), + prefixElementaryUnit E k j h a ∈ H) : + prefixElementaryGroup E ≤ H := by + rw [prefixElementaryGroup, Subgroup.closure_le] + rintro _ ⟨i, j, hij, a, rfl⟩ + by_cases hi : i = k + · subst k + exact hfrom j hij a + by_cases hj : j = k + · subst k + exact hto i hij a + exact prefixElementaryUnit_mem_of_two_step E H i k j + hi (Ne.symm hj) hij a (hto i hi a) (hfrom j (Ne.symm hj) 1) + +private theorem compressionV_inv_mul_alphaWordS (i : Fin 3) : + (↑(compressionV⁻¹) : BinaryLeavitt) * leavittWordS (alphaWord i) = + leavittWordS (alphaWord i) * leavittT 0 + + leavittWordS (nuWord i) * leavittT 1 := by + calc + (↑(compressionV⁻¹) : BinaryLeavitt) * leavittWordS (alphaWord i) = + (↑(compressionV⁻¹) : BinaryLeavitt) * + (leavittWordS (alphaWord i ++ [0]) * leavittT 0 + + leavittWordS (alphaWord i ++ [1]) * leavittT 1) := + congrArg ((↑(compressionV⁻¹) : BinaryLeavitt) * ·) + (leavittWordS_split (alphaWord i)) + _ = (prefixTable vPrefixCode ninePrefixCode * + leavittWordS (alphaWord i ++ [0])) * leavittT 0 + + (prefixTable vPrefixCode ninePrefixCode * + leavittWordS (alphaWord i ++ [1])) * leavittT 1 := by + change + prefixTable vPrefixCode ninePrefixCode * + (leavittWordS (alphaWord i ++ [0]) * leavittT 0 + + leavittWordS (alphaWord i ++ [1]) * leavittT 1) = _ + simp only [Fin.isValue, mul_add, mul_assoc] + _ = leavittWordS (alphaWord i) * leavittT 0 + + leavittWordS (nuWord i) * leavittT 1 := by + simpa only [ninePrefixCode, vPrefixCode, nineWord_alphaNineIndex, + nineWord_nuNineIndex, vWord_alphaNineIndex, vWord_nuNineIndex] + using congrArg₂ (· + ·) + (congrArg (· * leavittT 0) + (prefixTable_mul_wordS vPrefixCode ninePrefixCode + (alphaNineIndex i))) + (congrArg (· * leavittT 1) + (prefixTable_mul_wordS vPrefixCode ninePrefixCode + (nuNineIndex i))) + +private theorem alphaWordT_mul_compressionV (i : Fin 3) : + leavittWordT (alphaWord i) * (compressionV : BinaryLeavitt) = + leavittS 0 * leavittWordT (alphaWord i) + + leavittS 1 * leavittWordT (nuWord i) := by + calc + leavittWordT (alphaWord i) * (compressionV : BinaryLeavitt) = + (leavittS 0 * leavittWordT (alphaWord i ++ [0]) + + leavittS 1 * leavittWordT (alphaWord i ++ [1])) * + (compressionV : BinaryLeavitt) := + congrArg (· * (compressionV : BinaryLeavitt)) + (leavittWordT_split (alphaWord i)) + _ = leavittS 0 * (leavittWordT (alphaWord i ++ [0]) * + prefixTable ninePrefixCode vPrefixCode) + + leavittS 1 * (leavittWordT (alphaWord i ++ [1]) * + prefixTable ninePrefixCode vPrefixCode) := by + change + (leavittS 0 * leavittWordT (alphaWord i ++ [0]) + + leavittS 1 * leavittWordT (alphaWord i ++ [1])) * + prefixTable ninePrefixCode vPrefixCode = _ + simp only [Fin.isValue, add_mul, mul_assoc] + _ = leavittS 0 * leavittWordT (alphaWord i) + + leavittS 1 * leavittWordT (nuWord i) := by + simpa only [ninePrefixCode, vPrefixCode, nineWord_alphaNineIndex, + nineWord_nuNineIndex, vWord_alphaNineIndex, vWord_nuNineIndex] + using congrArg₂ (· + ·) + (congrArg (leavittS 0 * ·) + (wordT_mul_prefixTable ninePrefixCode vPrefixCode + (alphaNineIndex i))) + (congrArg (leavittS 1 * ·) + (wordT_mul_prefixTable ninePrefixCode vPrefixCode + (nuNineIndex i))) + +private def alphaNuNineIndex (p : Fin 2) (i : Fin 3) : Fin 9 := + ⟨3 * i.val + 2 * p.val, by omega⟩ + +private theorem alphaNuNineIndex_ne {i j : Fin 3} (hij : i ≠ j) + (p q : Fin 2) : alphaNuNineIndex p i ≠ alphaNuNineIndex q j := by + intro h + apply hij + apply Fin.ext + have hv := congrArg Fin.val h + change 3 * i.val + 2 * p.val = 3 * j.val + 2 * q.val at hv + omega + +@[simp] private theorem nineWord_alphaNuNineIndex (p : Fin 2) (i : Fin 3) : + nineWord (alphaNuNineIndex p i) = + if p = 0 then alphaWord i else nuWord i := by + fin_cases p <;> fin_cases i <;> rfl + +private theorem alphaNuRoot_mem_sourceGenerated + (i j : Fin 3) (hij : i ≠ j) (p q : Fin 2) (a : BinaryLeavitt) : + prefixElementaryUnit ninePrefixCode + (alphaNuNineIndex p i) (alphaNuNineIndex q j) + (alphaNuNineIndex_ne hij p q) a ∈ sourceGeneratedGroup := by + have hα := alphaRoot_mem_sourceGenerated i j hij + (leavittS p * a * leavittT q) + have hV := compressionV_mem_sourceGenerated + have hconj : + compressionV⁻¹ * + prefixElementaryUnit alphaPrefixCode i j hij + (leavittS p * a * leavittT q) * compressionV ∈ + sourceGeneratedGroup := + sourceGeneratedGroup.mul_mem + (sourceGeneratedGroup.mul_mem (sourceGeneratedGroup.inv_mem hV) hα) hV + have heq : + compressionV⁻¹ * + prefixElementaryUnit alphaPrefixCode i j hij + (leavittS p * a * leavittT q) * compressionV = + prefixElementaryUnit ninePrefixCode + (alphaNuNineIndex p i) (alphaNuNineIndex q j) + (alphaNuNineIndex_ne hij p q) a := by + apply Units.ext + change + (↑(compressionV⁻¹) : BinaryLeavitt) * + (1 + leavittWordS (alphaWord i) * + (leavittS p * a * leavittT q) * + leavittWordT (alphaWord j)) * + (compressionV : BinaryLeavitt) = + 1 + leavittWordS (nineWord (alphaNuNineIndex p i)) * a * + leavittWordT (nineWord (alphaNuNineIndex q j)) + calc + (↑(compressionV⁻¹) : BinaryLeavitt) * + (1 + leavittWordS (alphaWord i) * + (leavittS p * a * leavittT q) * + leavittWordT (alphaWord j)) * + (compressionV : BinaryLeavitt) = + 1 + ((↑(compressionV⁻¹) : BinaryLeavitt) * + leavittWordS (alphaWord i)) * + (leavittS p * a * leavittT q) * + (leavittWordT (alphaWord j) * (compressionV : BinaryLeavitt)) := by + simp only [mul_assoc, mul_add, mul_one, add_mul, Units.inv_mul] + _ = 1 + + (leavittWordS (alphaWord i) * leavittT 0 + + leavittWordS (nuWord i) * leavittT 1) * + (leavittS p * a * leavittT q) * + (leavittS 0 * leavittWordT (alphaWord j) + + leavittS 1 * leavittWordT (nuWord j)) := by + rw [compressionV_inv_mul_alphaWordS, + alphaWordT_mul_compressionV] + _ = 1 + leavittWordS (nineWord (alphaNuNineIndex p i)) * a * + leavittWordT (nineWord (alphaNuNineIndex q j)) := by + rw [binaryBlockSandwich] + simp only [nineWord_alphaNuNineIndex] + split_ifs <;> rfl + exact heq ▸ hconj + +private theorem nineRoot_to_alphaHub_mem_sourceGenerated + (i : Fin 9) (hi : i ≠ 0) (a : BinaryLeavitt) : + prefixElementaryUnit ninePrefixCode i 0 hi a ∈ sourceGeneratedGroup := by + fin_cases i + · exact (hi rfl).elim + · exact prefixElementaryUnit_mem_of_two_step + ninePrefixCode sourceGeneratedGroup 1 3 0 + (by decide) (by decide) hi a + (by + simpa only [Fin.isValue, alphaBetaNineIndex, Fin.coe_ofNat_eq_mod, Nat.zero_mod, mul_zero, + Nat.mod_succ, + zero_add, Fin.mk_one, Nat.one_mod, mul_one, add_zero, Fin.reduceFinMk] using + alphaBetaRoot_mem_sourceGenerated (0 : Fin 3) (1 : Fin 3) (by decide) (1 : Fin 2) (0 : Fin + 2) a) + (by + simpa only [Fin.isValue, alphaBetaNineIndex, Fin.coe_ofNat_eq_mod, Nat.one_mod, mul_one, + Nat.zero_mod, + add_zero, Fin.reduceFinMk, mul_zero, Fin.zero_eta] using + alphaBetaRoot_mem_sourceGenerated (1 : Fin 3) (0 : Fin 3) (by decide) (0 : Fin 2) (0 : Fin + 2) (1 : BinaryLeavitt)) + · exact prefixElementaryUnit_mem_of_two_step + ninePrefixCode sourceGeneratedGroup 2 3 0 + (by decide) (by decide) hi a + (by + simpa only [Fin.isValue, alphaNuNineIndex, Fin.coe_ofNat_eq_mod, Nat.zero_mod, mul_zero, + Nat.mod_succ, + mul_one, zero_add, Fin.reduceFinMk, Nat.one_mod, add_zero] using + alphaNuRoot_mem_sourceGenerated (0 : Fin 3) (1 : Fin 3) (by decide) (1 : Fin 2) (0 : Fin + 2) a) + (by + simpa only [Fin.isValue, alphaBetaNineIndex, Fin.coe_ofNat_eq_mod, Nat.one_mod, mul_one, + Nat.zero_mod, + add_zero, Fin.reduceFinMk, mul_zero, Fin.zero_eta] using + alphaBetaRoot_mem_sourceGenerated (1 : Fin 3) (0 : Fin 3) (by decide) (0 : Fin 2) (0 : Fin + 2) (1 : BinaryLeavitt)) + · simpa only [Nat.reduceAdd, Fin.reduceFinMk, Fin.isValue, alphaBetaNineIndex, + Fin.coe_ofNat_eq_mod, + Nat.one_mod, mul_one, Nat.zero_mod, add_zero, mul_zero, Fin.zero_eta] using + alphaBetaRoot_mem_sourceGenerated (1 : Fin 3) (0 : Fin 3) (by decide) (0 : Fin 2) (0 : Fin 2) + a + · simpa only [Nat.reduceAdd, Fin.reduceFinMk, Fin.isValue, alphaBetaNineIndex, + Fin.coe_ofNat_eq_mod, + Nat.one_mod, mul_one, Nat.mod_succ, Nat.zero_mod, mul_zero, add_zero, Fin.zero_eta] using + alphaBetaRoot_mem_sourceGenerated (1 : Fin 3) (0 : Fin 3) (by decide) (1 : Fin 2) (0 : Fin 2) + a + · simpa only [Nat.reduceAdd, Fin.reduceFinMk, Fin.isValue, alphaNuNineIndex, Fin.coe_ofNat_eq_mod, + Nat.one_mod, + mul_one, Nat.mod_succ, Nat.zero_mod, mul_zero, add_zero, Fin.zero_eta] using + alphaNuRoot_mem_sourceGenerated (1 : Fin 3) (0 : Fin 3) (by decide) (1 : Fin 2) (0 : Fin 2) a + · simpa only [Nat.reduceAdd, Fin.reduceFinMk, Fin.isValue, alphaBetaNineIndex, + Fin.coe_ofNat_eq_mod, + Nat.mod_succ, Nat.reduceMul, Nat.zero_mod, add_zero, mul_zero, Fin.zero_eta] using + alphaBetaRoot_mem_sourceGenerated (2 : Fin 3) (0 : Fin 3) (by decide) (0 : Fin 2) (0 : Fin 2) + a + · simpa only [Nat.reduceAdd, Fin.reduceFinMk, Fin.isValue, alphaBetaNineIndex, + Fin.coe_ofNat_eq_mod, + Nat.mod_succ, Nat.reduceMul, Nat.zero_mod, mul_zero, add_zero, Fin.zero_eta] using + alphaBetaRoot_mem_sourceGenerated (2 : Fin 3) (0 : Fin 3) (by decide) (1 : Fin 2) (0 : Fin 2) + a + · simpa only [Nat.reduceAdd, Fin.reduceFinMk, Fin.isValue, alphaNuNineIndex, Fin.coe_ofNat_eq_mod, + Nat.mod_succ, + Nat.reduceMul, mul_one, Nat.zero_mod, mul_zero, add_zero, Fin.zero_eta] using + alphaNuRoot_mem_sourceGenerated (2 : Fin 3) (0 : Fin 3) (by decide) (1 : Fin 2) (0 : Fin 2) a + +private theorem nineRoot_from_alphaHub_mem_sourceGenerated + (i : Fin 9) (hi : (0 : Fin 9) ≠ i) (a : BinaryLeavitt) : + prefixElementaryUnit ninePrefixCode 0 i hi a ∈ sourceGeneratedGroup := by + fin_cases i + · exact (hi rfl).elim + · exact prefixElementaryUnit_mem_of_two_step + ninePrefixCode sourceGeneratedGroup 0 3 1 + (by decide) (by decide) hi a + (by + simpa only [Fin.isValue, alphaBetaNineIndex, Fin.coe_ofNat_eq_mod, Nat.zero_mod, mul_zero, + add_zero, + Fin.zero_eta, Nat.one_mod, mul_one, Fin.reduceFinMk] using + alphaBetaRoot_mem_sourceGenerated (0 : Fin 3) (1 : Fin 3) (by decide) (0 : Fin 2) (0 : Fin + 2) a) + (by + simpa only [Fin.isValue, alphaBetaNineIndex, Fin.coe_ofNat_eq_mod, Nat.one_mod, mul_one, + Nat.zero_mod, + add_zero, Fin.reduceFinMk, mul_zero, Nat.mod_succ, zero_add, Fin.mk_one] using + alphaBetaRoot_mem_sourceGenerated (1 : Fin 3) (0 : Fin 3) (by decide) (0 : Fin 2) (1 : Fin + 2) (1 : BinaryLeavitt)) + · exact prefixElementaryUnit_mem_of_two_step + ninePrefixCode sourceGeneratedGroup 0 3 2 + (by decide) (by decide) hi a + (by + simpa only [Fin.isValue, alphaBetaNineIndex, Fin.coe_ofNat_eq_mod, Nat.zero_mod, mul_zero, + add_zero, + Fin.zero_eta, Nat.one_mod, mul_one, Fin.reduceFinMk] using + alphaBetaRoot_mem_sourceGenerated (0 : Fin 3) (1 : Fin 3) (by decide) (0 : Fin 2) (0 : Fin + 2) a) + (by + simpa only [Fin.isValue, alphaNuNineIndex, Fin.coe_ofNat_eq_mod, Nat.one_mod, mul_one, + Nat.zero_mod, mul_zero, + add_zero, Fin.reduceFinMk, Nat.mod_succ, zero_add] using + alphaNuRoot_mem_sourceGenerated (1 : Fin 3) (0 : Fin 3) (by decide) (0 : Fin 2) (1 : Fin + 2) (1 : BinaryLeavitt)) + · simpa only [Fin.isValue, Nat.reduceAdd, Fin.reduceFinMk, alphaBetaNineIndex, + Fin.coe_ofNat_eq_mod, + Nat.zero_mod, mul_zero, add_zero, Fin.zero_eta, Nat.one_mod, mul_one] using + alphaBetaRoot_mem_sourceGenerated (0 : Fin 3) (1 : Fin 3) (by decide) (0 : Fin 2) (0 : Fin 2) + a + · simpa only [Fin.isValue, Nat.reduceAdd, Fin.reduceFinMk, alphaBetaNineIndex, + Fin.coe_ofNat_eq_mod, + Nat.zero_mod, mul_zero, add_zero, Fin.zero_eta, Nat.one_mod, mul_one, Nat.mod_succ] using + alphaBetaRoot_mem_sourceGenerated (0 : Fin 3) (1 : Fin 3) (by decide) (0 : Fin 2) (1 : Fin 2) + a + · simpa only [Fin.isValue, Nat.reduceAdd, Fin.reduceFinMk, alphaNuNineIndex, Fin.coe_ofNat_eq_mod, + Nat.zero_mod, + mul_zero, add_zero, Fin.zero_eta, Nat.one_mod, mul_one, Nat.mod_succ] using + alphaNuRoot_mem_sourceGenerated (0 : Fin 3) (1 : Fin 3) (by decide) (0 : Fin 2) (1 : Fin 2) a + · simpa only [Fin.isValue, Nat.reduceAdd, Fin.reduceFinMk, alphaBetaNineIndex, + Fin.coe_ofNat_eq_mod, + Nat.zero_mod, mul_zero, add_zero, Fin.zero_eta, Nat.mod_succ, Nat.reduceMul] using + alphaBetaRoot_mem_sourceGenerated (0 : Fin 3) (2 : Fin 3) (by decide) (0 : Fin 2) (0 : Fin 2) + a + · simpa only [Fin.isValue, Nat.reduceAdd, Fin.reduceFinMk, alphaBetaNineIndex, + Fin.coe_ofNat_eq_mod, + Nat.zero_mod, mul_zero, add_zero, Fin.zero_eta, Nat.mod_succ, Nat.reduceMul] using + alphaBetaRoot_mem_sourceGenerated (0 : Fin 3) (2 : Fin 3) (by decide) (0 : Fin 2) (1 : Fin 2) + a + · simpa only [Fin.isValue, Nat.reduceAdd, Fin.reduceFinMk, alphaNuNineIndex, Fin.coe_ofNat_eq_mod, + Nat.zero_mod, + mul_zero, add_zero, Fin.zero_eta, Nat.mod_succ, Nat.reduceMul, mul_one] using + alphaNuRoot_mem_sourceGenerated (0 : Fin 3) (2 : Fin 3) (by decide) (0 : Fin 2) (1 : Fin 2) a + +private theorem ninePrefixElementaryGroup_le_sourceGenerated : + prefixElementaryGroup ninePrefixCode ≤ sourceGeneratedGroup := + prefixElementaryGroup_le_of_hub ninePrefixCode sourceGeneratedGroup + (0 : Fin 9) nineRoot_to_alphaHub_mem_sourceGenerated + nineRoot_from_alphaHub_mem_sourceGenerated + +private theorem alphaNineIndex_ne {i j : Fin 3} (hij : i ≠ j) : + alphaNineIndex i ≠ alphaNineIndex j := by + intro h + apply hij + apply Fin.ext + have hv := congrArg Fin.val h + change 3 * i.val = 3 * j.val at hv + omega + +private theorem alphaPrefixElementaryUnit_eq_nine + (i j : Fin 3) (hij : i ≠ j) (a : BinaryLeavitt) : + prefixElementaryUnit alphaPrefixCode i j hij a = + prefixElementaryUnit ninePrefixCode + (alphaNineIndex i) (alphaNineIndex j) + (alphaNineIndex_ne hij) a := by + apply Units.ext + change + 1 + leavittWordS (alphaWord i) * a * leavittWordT (alphaWord j) = + 1 + leavittWordS (nineWord (alphaNineIndex i)) * a * + leavittWordT (nineWord (alphaNineIndex j)) + rw [nineWord_alphaNineIndex, nineWord_alphaNineIndex] + +public +theorem alphaPrefixElementaryGroup_le_nine : + prefixElementaryGroup alphaPrefixCode ≤ + prefixElementaryGroup ninePrefixCode := by + rw [prefixElementaryGroup, Subgroup.closure_le] + rintro _ ⟨i, j, hij, a, rfl⟩ + rw [alphaPrefixElementaryUnit_eq_nine] + exact Subgroup.subset_closure + ⟨alphaNineIndex i, alphaNineIndex j, alphaNineIndex_ne hij, a, rfl⟩ + +private theorem sourceGeneratedGroup_le_nine_of_compressions + (hu : compressionU ∈ prefixElementaryGroup ninePrefixCode) + (hv : compressionV ∈ prefixElementaryGroup ninePrefixCode) : + sourceGeneratedGroup ≤ prefixElementaryGroup ninePrefixCode := by + rw [sourceGeneratedGroup, Subgroup.closure_le] + intro z hz + rcases hz with hz | hz + · exact alphaPrefixElementaryGroup_le_nine hz + · simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with rfl | rfl + · exact hu + · exact hv + +private theorem sourceGeneratedGroup_eq_nine_of_compressions + (hu : compressionU ∈ prefixElementaryGroup ninePrefixCode) + (hv : compressionV ∈ prefixElementaryGroup ninePrefixCode) : + sourceGeneratedGroup = prefixElementaryGroup ninePrefixCode := + le_antisymm (sourceGeneratedGroup_le_nine_of_compressions hu hv) + ninePrefixElementaryGroup_le_sourceGenerated + +end SourceGeneration + +private theorem binaryLeavittMatrixUnitSubgroup_countable (n : ℕ) + (H : Subgroup (Matrix (Fin n) (Fin n) BinaryLeavitt)ˣ) : Countable H := by + let : Countable (Matrix (Fin n) (Fin n) BinaryLeavitt) := + Countable.of_equiv (Fin n → Fin n → BinaryLeavitt) + (Matrix.of : (Fin n → Fin n → BinaryLeavitt) ≃ + Matrix (Fin n) (Fin n) BinaryLeavitt) + have h : Function.Injective + (fun x : H => (x.val.val : Matrix (Fin n) (Fin n) BinaryLeavitt)) := by + intro x y hxy + apply Subtype.ext + exact Units.ext hxy + exact h.countable + +private instance binaryLeavittElementaryGroupCountable (n : ℕ) : + Countable (binaryLeavittElementaryGroup n) := + binaryLeavittMatrixUnitSubgroup_countable n + (elementaryGroup (Fin n) BinaryLeavitt) + +private theorem binaryLeavittEL3_finitelyGenerated : + Group.FG (binaryLeavittElementaryGroup 3) := + elementaryGroup_three_finitelyGenerated + +public +theorem binaryLeavittEL3_infinite : + Infinite (binaryLeavittElementaryGroup 3) := + elementaryGroup_infinite (R := BinaryLeavitt) + (0 : Fin 3) (1 : Fin 3) (by decide) + +public +theorem alphaPrefixElementaryGroup_finitelyGenerated : + Group.FG (prefixElementaryGroup alphaPrefixCode) := by + let : Group.FG (binaryLeavittElementaryGroup 3) := + binaryLeavittEL3_finitelyGenerated + exact Group.fg_of_surjective + (f := alphaPrefixElementaryGroupEquiv.toMonoidHom) + alphaPrefixElementaryGroupEquiv.surjective + +public +theorem ninePrefixElementaryGroup_countable : + Countable (prefixElementaryGroup ninePrefixCode) := + ninePrefixElementaryGroupEquiv.symm.injective.countable + +private noncomputable def midrankFirstMoment (a : ℝ) : List ℝ → ℝ + | [] => 0 + | p :: ps => p * (a + p / 2) + midrankFirstMoment (a + p) ps + +private noncomputable def midrankSecondMoment (a : ℝ) : List ℝ → ℝ + | [] => 0 + | p :: ps => p * (a + p / 2) ^ 2 + midrankSecondMoment (a + p) ps + +private theorem midrankFirstMoment_eq (a : ℝ) (ps : List ℝ) : + midrankFirstMoment a ps = ((a + ps.sum) ^ 2 - a ^ 2) / 2 := by + induction ps generalizing a with + | nil => simp only [midrankFirstMoment, List.sum_nil, add_zero, sub_self, zero_div] + | cons p ps ih => + simp only [midrankFirstMoment, List.sum_cons] + rw [ih (a + p)] + ring + +private theorem midrankSecondMoment_eq (a : ℝ) (ps : List ℝ) : + midrankSecondMoment a ps = + ((a + ps.sum) ^ 3 - a ^ 3) / 3 - + (ps.map fun p => p ^ 3).sum / 12 := by + induction ps generalizing a with + | nil => simp only [midrankSecondMoment, List.sum_nil, add_zero, sub_self, zero_div, List.map_nil] + | cons p ps ih => + simp only [midrankSecondMoment, List.sum_cons, List.map_cons] + rw [ih (a + p)] + ring + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def midrankVariance (ps : List ℝ) : ℝ := + midrankSecondMoment 0 ps - (midrankFirstMoment 0 ps) ^ 2 + +private theorem midrankVariance_eq (ps : List ℝ) (hsum : ps.sum = 1) : + midrankVariance ps = (1 - (ps.map fun p => p ^ 3).sum) / 12 := by + unfold midrankVariance + rw [midrankSecondMoment_eq, midrankFirstMoment_eq, hsum] + ring + +private theorem cubeSum_le_dominant_mul_sum (ps : List ℝ) (m : ℝ) + (hpos : ∀ p ∈ ps, 0 ≤ p) + (hone : ∀ p ∈ ps, p ≤ 1) + (hdom : ∀ p ∈ ps, p ≤ m) : + (ps.map fun p => p ^ 3).sum ≤ m * ps.sum := by + induction ps with + | nil => simp only [List.map_nil, List.sum_nil, mul_zero, Std.le_refl] + | cons p ps ih => + have hp : 0 ≤ p := hpos p (by simp only [List.mem_cons, true_or]) + have hpone : p ≤ 1 := hone p (by simp only [List.mem_cons, true_or]) + have hpm : p ≤ m := hdom p (by simp only [List.mem_cons, true_or]) + have hsq : p * p ≤ m := calc + p * p ≤ p * 1 := mul_le_mul_of_nonneg_left hpone hp + _ = p := by ring + _ ≤ m := hpm + have hcube : p ^ 3 ≤ m * p := calc + p ^ 3 = (p * p) * p := by ring + _ ≤ m * p := mul_le_mul_of_nonneg_right hsq hp + have htailpos : ∀ q ∈ ps, 0 ≤ q := by + intro q hq + exact hpos q (by simp only [List.mem_cons, hq, or_true]) + have htailone : ∀ q ∈ ps, q ≤ 1 := by + intro q hq + exact hone q (by simp only [List.mem_cons, hq, or_true]) + have htaildom : ∀ q ∈ ps, q ≤ m := by + intro q hq + exact hdom q (by simp only [List.mem_cons, hq, or_true]) + have htail := ih htailpos htailone htaildom + simpa only [List.map_cons, List.sum_cons, mul_add, ge_iff_le] using add_le_add hcube htail + +private theorem cube_sum_le_dominant_mass (ps : List ℝ) (m : ℝ) + (hsum : ps.sum = 1) + (hpos : ∀ p ∈ ps, 0 ≤ p) + (hdom : ∀ p ∈ ps, p ≤ m) : + (ps.map fun p => p ^ 3).sum ≤ m := by + have hone : ∀ p ∈ ps, p ≤ (1 : ℝ) := by + intro p hp + have hsub : List.Sublist [p] ps := List.singleton_sublist.mpr hp + have hle : ([p] : List ℝ).sum ≤ ps.sum := + hsub.sum_le_sum hpos + simpa only [ge_iff_le, List.sum_cons, List.sum_nil, add_zero, hsum] using hle + have h := cubeSum_le_dominant_mul_sum ps m hpos hone hdom + simpa only [ge_iff_le, hsum, mul_one] using h + +private theorem midrankVariance_controls_dominant_mass + (ps : List ℝ) (m : ℝ) + (hsum : ps.sum = 1) + (hpos : ∀ p ∈ ps, 0 ≤ p) + (hdom : ∀ p ∈ ps, p ≤ m) : + (1 - m) / 12 ≤ midrankVariance ps := by + rw [midrankVariance_eq ps hsum] + have hcube := cube_sum_le_dominant_mass ps m hsum hpos hdom + linarith + +private theorem weighted_midrank_dominant_mass_le {ι : Type*} + (I : Finset ι) (weight : ι → ℝ) + (q : ι → List ℝ) (m : ι → ℝ) + (hweight : ∀ i ∈ I, 0 ≤ weight i) + (hsum : ∀ i ∈ I, (q i).sum = 1) + (hpositive : ∀ i ∈ I, ∀ x ∈ q i, 0 ≤ x) + (hdominant : ∀ i ∈ I, ∀ x ∈ q i, x ≤ m i) : + (∑ i ∈ I, weight i * (1 - m i)) ≤ + 12 * ∑ i ∈ I, weight i * midrankVariance (q i) := by + calc + (∑ i ∈ I, weight i * (1 - m i)) ≤ + ∑ i ∈ I, 12 * (weight i * midrankVariance (q i)) := by + apply Finset.sum_le_sum + intro i hi + have hvar := midrankVariance_controls_dominant_mass + (q i) (m i) (hsum i hi) (hpositive i hi) (hdominant i hi) + have hpoint : 1 - m i ≤ 12 * midrankVariance (q i) := by + linarith + calc + weight i * (1 - m i) ≤ + weight i * (12 * midrankVariance (q i)) := + mul_le_mul_of_nonneg_left hpoint (hweight i hi) + _ = 12 * (weight i * midrankVariance (q i)) := by ring + _ = 12 * ∑ i ∈ I, weight i * midrankVariance (q i) := by + rw [Finset.mul_sum] + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def componentRankMass {V : Type*} + (C : Finset V) (b : V → ℤ) (j : ℤ) : ℝ := + ((C.filter fun x => b x = j).card : ℝ) / (C.card : ℝ) + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def componentVertexMidrank {V : Type*} + (C : Finset V) (b : V → ℤ) (x : V) : ℝ := + (((C.filter fun z => b z < b x).card : ℝ) + + ((C.filter fun z => b z = b x).card : ℝ) / 2) / + (C.card : ℝ) + +private theorem componentVertexMidrank_eq_sum_componentRankMass + {V : Type*} + (C : Finset V) (b : V → ℤ) (x : V) : + componentVertexMidrank C b x = + (∑ j ∈ (C.image b).filter (fun j => j < b x), + componentRankMass C b j) + componentRankMass C b (b x) / 2 := by + classical + let J : Finset ℤ := (C.image b).filter fun j => j < b x + have hfilter : + C.filter (fun z => b z ∈ J) = + C.filter (fun z => b z < b x) := by + ext z + simp only [Finset.mem_filter] + dsimp [J] + simp only [Finset.mem_filter, Finset.mem_image] + aesop + have hcard : + (∑ j ∈ J, (C.filter fun z => b z = j).card) = + (C.filter fun z => b z < b x).card := by + calc + (∑ j ∈ J, (C.filter fun z => b z = j).card) = + (C.filter fun z => b z ∈ J).card := + Finset.sum_card_fiberwise_eq_card_filter C J b + _ = (C.filter fun z => b z < b x).card := + congrArg Finset.card hfilter + have hcard' : + (∑ j ∈ J, ((C.filter fun z => b z = j).card : ℝ)) = + ((C.filter fun z => b z < b x).card : ℝ) := by + exact_mod_cast hcard + simp only [componentVertexMidrank, componentRankMass, ← Finset.sum_div] + rw [show + (∑ j ∈ (C.image b).filter (fun j => j < b x), + ((C.filter fun z => b z = j).card : ℝ)) = + ((C.filter fun z => b z < b x).card : ℝ) from by + simpa only [J] using hcard'] + ring + +private theorem componentRankMass_nonneg {V : Type*} + (C : Finset V) (b : V → ℤ) (j : ℤ) : + 0 ≤ componentRankMass C b j := by + unfold componentRankMass + positivity + +private theorem sum_componentRankMass {V : Type*} + (C : Finset V) (b : V → ℤ) (hC : C.Nonempty) : + (∑ j ∈ C.image b, componentRankMass C b j) = 1 := by + have hcard : + (∑ j ∈ C.image b, ((C.filter fun x => b x = j).card : ℝ)) = + (C.card : ℝ) := by + exact_mod_cast (Finset.card_eq_sum_card_image b C).symm + have hne : (C.card : ℝ) ≠ 0 := by + exact_mod_cast (Finset.card_ne_zero.mpr hC) + simp only [componentRankMass, ← Finset.sum_div] + rw [hcard, div_self hne] + +public +theorem componentVertexMidrank_nonneg {V : Type*} + (C : Finset V) (b : V → ℤ) (x : V) : + 0 ≤ componentVertexMidrank C b x := by + unfold componentVertexMidrank + positivity + +private theorem component_lower_equal_disjoint + {V : Type*} + (C : Finset V) (b : V → ℤ) (x : V) : + Disjoint (C.filter fun z => b z < b x) + (C.filter fun z => b z = b x) := by + apply Finset.disjoint_left.mpr + intro z hzlow hzeq + have hlow := (Finset.mem_filter.mp hzlow).2 + have heq := (Finset.mem_filter.mp hzeq).2 + omega + +public +theorem componentVertexMidrank_le_one {V : Type*} + (C : Finset V) (b : V → ℤ) (x : V) : + componentVertexMidrank C b x ≤ 1 := by + classical + rcases C.eq_empty_or_nonempty with rfl | hC + · simp only [componentVertexMidrank, Finset.filter_empty, Finset.card_empty, CharP.cast_eq_zero, + zero_div, + add_zero, div_zero, zero_le_one] + · have hc : 0 < (C.card : ℝ) := by + exact_mod_cast Finset.card_pos.mpr hC + have hdisj := component_lower_equal_disjoint C b x + have hsub : + (C.filter fun z => b z < b x) ∪ + (C.filter fun z => b z = b x) ⊆ C := by + intro z hz + rcases Finset.mem_union.mp hz with hz | hz + · exact (Finset.mem_filter.mp hz).1 + · exact (Finset.mem_filter.mp hz).1 + have hcard := Finset.card_le_card hsub + rw [Finset.card_union_of_disjoint hdisj] at hcard + have hcard' : + ((C.filter fun z => b z < b x).card : ℝ) + + ((C.filter fun z => b z = b x).card : ℝ) ≤ + (C.card : ℝ) := by + exact_mod_cast hcard + unfold componentVertexMidrank + apply (div_le_one hc).2 + have heq : 0 ≤ ((C.filter fun z => b z = b x).card : ℝ) := by + positivity + linarith + +private theorem componentVertexMidrank_mono {V : Type*} + (C : Finset V) (b : V → ℤ) {x y : V} + (hxy : b x ≤ b y) : + componentVertexMidrank C b x ≤ componentVertexMidrank C b y := by + classical + rcases C.eq_empty_or_nonempty with rfl | hC + · simp only [componentVertexMidrank, Finset.filter_empty, Finset.card_empty, CharP.cast_eq_zero, + zero_div, + add_zero, div_zero, Std.le_refl] + · have hc : 0 < (C.card : ℝ) := by + exact_mod_cast Finset.card_pos.mpr hC + rcases hxy.eq_or_lt with heq | hlt + · unfold componentVertexMidrank + simp only [heq, Std.le_refl] + · have hdisj := component_lower_equal_disjoint C b x + have hsub : + (C.filter fun z => b z < b x) ∪ + (C.filter fun z => b z = b x) ⊆ + C.filter fun z => b z < b y := by + intro z hz + rcases Finset.mem_union.mp hz with hz | hz + · obtain ⟨hzC, hzx⟩ := Finset.mem_filter.mp hz + exact Finset.mem_filter.mpr ⟨hzC, lt_trans hzx hlt⟩ + · obtain ⟨hzC, hzx⟩ := Finset.mem_filter.mp hz + exact Finset.mem_filter.mpr ⟨hzC, hzx.symm ▸ hlt⟩ + have hcard := Finset.card_le_card hsub + rw [Finset.card_union_of_disjoint hdisj] at hcard + have hcard' : + ((C.filter fun z => b z < b x).card : ℝ) + + ((C.filter fun z => b z = b x).card : ℝ) ≤ + ((C.filter fun z => b z < b y).card : ℝ) := by + exact_mod_cast hcard + have hex : 0 ≤ ((C.filter fun z => b z = b x).card : ℝ) := by + positivity + have hey : 0 ≤ ((C.filter fun z => b z = b y).card : ℝ) := by + positivity + unfold componentVertexMidrank + apply (div_le_div_iff_of_pos_right hc).2 + linarith + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def componentRankMassList {V : Type*} + (C : Finset V) (b : V → ℤ) : List ℝ := + ((C.image b).sort (· ≤ ·)).map (componentRankMass C b) + +private theorem sum_map_sort_eq {α : Type*} + [LinearOrder α] + (s : Finset α) (f : α → ℝ) : + ((s.sort (· ≤ ·)).map f).sum = ∑ a ∈ s, f a := by + change + ((s.sort (· ≤ ·)).map f).sum = + (s.val.map f).sum + have h := congrArg + (fun t : Multiset α => (t.map f).sum) + (s.sort_eq (· ≤ ·)) + simpa only [Multiset.map_coe, Multiset.sum_coe] using h + +private theorem componentRankMassList_sum {V : Type*} + (C : Finset V) (b : V → ℤ) (hC : C.Nonempty) : + (componentRankMassList C b).sum = 1 := by + unfold componentRankMassList + rw [sum_map_sort_eq] + exact sum_componentRankMass C b hC + +private theorem componentRankMassList_nonneg {V : Type*} + (C : Finset V) (b : V → ℤ) : + ∀ p ∈ componentRankMassList C b, 0 ≤ p := by + intro p hp + unfold componentRankMassList at hp + obtain ⟨j, hj, rfl⟩ := List.mem_map.mp hp + exact componentRankMass_nonneg C b j + +private theorem componentRankMassList_le_max {V : Type*} + (C : Finset V) (b : V → ℤ) (j : ℤ) + (hmax : ∀ k ∈ C.image b, + componentRankMass C b k ≤ componentRankMass C b j) : + ∀ p ∈ componentRankMassList C b, + p ≤ componentRankMass C b j := by + intro p hp + unfold componentRankMassList at hp + obtain ⟨k, hk, rfl⟩ := List.mem_map.mp hp + exact hmax k (((C.image b).mem_sort (· ≤ ·)).mp hk) + +public +theorem exists_maximal_componentRankMass + {V : Type*} + (C : Finset V) (b : V → ℤ) (hC : C.Nonempty) : + ∃ j ∈ C.image b, + ∀ k ∈ C.image b, + componentRankMass C b k ≤ componentRankMass C b j := by + have himage : (C.image b).Nonempty := hC.image b + obtain ⟨j, hj, hmax⟩ := + Finset.exists_max_image (C.image b) (componentRankMass C b) himage + exact ⟨j, hj, hmax⟩ + +private theorem component_omitted_rank_card_eq + {V : Type*} + (C : Finset V) (b : V → ℤ) (j : ℤ) + (hC : C.Nonempty) : + ((C.card - (C.filter fun x => b x = j).card : ℕ) : ℝ) = + (C.card : ℝ) * (1 - componentRankMass C b j) := by + have hsub : (C.filter fun x => b x = j).card ≤ C.card := + Finset.card_le_card (Finset.filter_subset _ _) + have hne : (C.card : ℝ) ≠ 0 := by + exact_mod_cast Finset.card_ne_zero.mpr hC + rw [Nat.cast_sub hsub] + unfold componentRankMass + field_simp [hne] + +public +theorem actual_weighted_midrank_dominant_mass_le + {V ι : Type*} + (I : Finset ι) (C : ι → Finset V) (b : V → ℤ) (j : ι → ℤ) + (hC : ∀ i ∈ I, (C i).Nonempty) + (hmax : ∀ i ∈ I, ∀ k ∈ (C i).image b, + componentRankMass (C i) b k ≤ componentRankMass (C i) b (j i)) : + (∑ i ∈ I, + (((C i).card - ((C i).filter fun x => b x = j i).card : ℕ) : ℝ)) ≤ + 12 * ∑ i ∈ I, + ((C i).card : ℝ) * + midrankVariance (componentRankMassList (C i) b) := by + calc + (∑ i ∈ I, + (((C i).card - ((C i).filter fun x => b x = j i).card : ℕ) : ℝ)) = + ∑ i ∈ I, + ((C i).card : ℝ) * + (1 - componentRankMass (C i) b (j i)) := by + apply Finset.sum_congr rfl + intro i hi + exact component_omitted_rank_card_eq (C i) b (j i) (hC i hi) + _ ≤ 12 * ∑ i ∈ I, + ((C i).card : ℝ) * + midrankVariance (componentRankMassList (C i) b) := by + apply weighted_midrank_dominant_mass_le + I (fun i => ((C i).card : ℝ)) + (fun i => componentRankMassList (C i) b) + (fun i => componentRankMass (C i) b (j i)) + · intro i hi + positivity + · intro i hi + exact componentRankMassList_sum (C i) b (hC i hi) + · intro i hi + exact componentRankMassList_nonneg (C i) b + · intro i hi + exact componentRankMassList_le_max (C i) b (j i) (hmax i hi) + +private theorem exists_maximum_overlap_component + {V : Type u} [DecidableEq V] {U : Finset V} + (Q : Finpartition U) (C : Finset V) + (hC : C.Nonempty) (hCU : C ⊆ U) : + ∃ D ∈ Q.parts, + ∀ E ∈ Q.parts, (C ∩ E).card ≤ (C ∩ D).card := by + classical + have hU : U.Nonempty := hC.mono hCU + exact Finset.exists_max_image Q.parts + (fun D : Finset V => (C ∩ D).card) + (Q.parts_nonempty hU.ne_empty) + +public +theorem sum_card_component_inter_partition + {V : Type u} [DecidableEq V] {U : Finset V} + (Q : Finpartition U) (C : Finset V) (hCU : C ⊆ U) : + ∑ D ∈ Q.parts, (C ∩ D).card = C.card := by + have h := sum_card_inter_partition Q C + simpa only [Finset.inter_comm, Finset.inter_eq_right.mpr hCU] using h + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def maximumOverlapPart + {V : Type u} [DecidableEq V] {U : Finset V} + (Q : Finpartition U) (C : Finset V) : Finset V := by + classical + exact if h : C.Nonempty ∧ C ⊆ U then + (exists_maximum_overlap_component Q C h.1 h.2).choose else ∅ + +public +theorem maximumOverlapPart_mem + {V : Type u} [DecidableEq V] {U : Finset V} + (Q : Finpartition U) (C : Finset V) + (hC : C.Nonempty) (hCU : C ⊆ U) : + maximumOverlapPart Q C ∈ Q.parts := by + classical + have h : C.Nonempty ∧ C ⊆ U := ⟨hC, hCU⟩ + simpa only [maximumOverlapPart, dite_eq_left h] using + (exists_maximum_overlap_component Q C hC hCU).choose_spec.1 + +public +theorem maximumOverlapPart_maximal + {V : Type u} [DecidableEq V] {U : Finset V} + (Q : Finpartition U) (C : Finset V) + (hC : C.Nonempty) (hCU : C ⊆ U) : + ∀ E ∈ Q.parts, + (C ∩ E).card ≤ (C ∩ maximumOverlapPart Q C).card := by + classical + have h : C.Nonempty ∧ C ⊆ U := ⟨hC, hCU⟩ + simpa only [maximumOverlapPart, dite_eq_left h] using + (exists_maximum_overlap_component Q C hC hCU).choose_spec.2 + +namespace PrefixCompressionU + +open scoped BigOperators + +private def sourceCrossRoot (i j : Fin 9) (h : i ≠ j) + (a b : List (Fin 2)) : BinaryLeavittˣ := + prefixElementaryUnit ninePrefixCode i j h + (leavittWordS a * leavittWordT b) + +private theorem sourceCrossRoot_mem (i j : Fin 9) (h : i ≠ j) + (a b : List (Fin 2)) : + sourceCrossRoot i j h a b ∈ prefixElementaryGroup ninePrefixCode := + Subgroup.subset_closure ⟨i, j, h, + leavittWordS a * leavittWordT b, rfl⟩ + +@[simp] private theorem sourceCrossRoot_val (i j : Fin 9) (h : i ≠ j) + (a b : List (Fin 2)) : + (↑(sourceCrossRoot i j h a b) : BinaryLeavitt) = + 1 + leavittWordS (nineWord i ++ a) * + leavittWordT (nineWord j ++ b) := by + change + 1 + leavittWordS (nineWord i) * + (leavittWordS a * leavittWordT b) * leavittWordT (nineWord j) = _ + rw [leavittWordS_append, leavittWordT_append] + noncomm_ring + +private def sourceCrossSwap (i j : Fin 9) (h : i ≠ j) + (a b : List (Fin 2)) : BinaryLeavittˣ := + sourceCrossRoot i j h a b * + sourceCrossRoot j i h.symm b a * + sourceCrossRoot i j h a b + +private theorem sourceCrossSwap_mem (i j : Fin 9) (h : i ≠ j) + (a b : List (Fin 2)) : + sourceCrossSwap i j h a b ∈ prefixElementaryGroup ninePrefixCode := by + exact (prefixElementaryGroup ninePrefixCode).mul_mem + ((prefixElementaryGroup ninePrefixCode).mul_mem + (sourceCrossRoot_mem i j h a b) + (sourceCrossRoot_mem j i h.symm b a)) + (sourceCrossRoot_mem i j h a b) + +private theorem sourceRefinementOrthogonal (i j : Fin 9) (h : i ≠ j) + (a b : List (Fin 2)) : + leavittWordT (nineWord i ++ a) * + leavittWordS (nineWord j ++ b) = 0 := by + have hz : leavittWordT (nineWord i) * leavittWordS (nineWord j) = 0 := by + simpa only [ninePrefixCode, h, ↓reduceIte] using binaryPrefixCode_orthogonal ninePrefixCode i j + rw [leavittWordT_append, leavittWordS_append] + calc + (leavittWordT a * leavittWordT (nineWord i)) * + (leavittWordS (nineWord j) * leavittWordS b) = + leavittWordT a * + (leavittWordT (nineWord i) * leavittWordS (nineWord j)) * + leavittWordS b := by noncomm_ring + _ = 0 := by rw [hz]; simp only [mul_zero, zero_mul] + +private theorem sourceCrossSwap_val (i j : Fin 9) (h : i ≠ j) + (a b : List (Fin 2)) : + (↑(sourceCrossSwap i j h a b) : BinaryLeavitt) = + 1 - leavittWordS (nineWord i ++ a) * + leavittWordT (nineWord i ++ a) - + leavittWordS (nineWord j ++ b) * + leavittWordT (nineWord j ++ b) + + leavittWordS (nineWord i ++ a) * + leavittWordT (nineWord j ++ b) + + leavittWordS (nineWord j ++ b) * + leavittWordT (nineWord i ++ a) := by + let A : List (Fin 2) := nineWord i ++ a + let B : List (Fin 2) := nineWord j ++ b + let P : BinaryLeavitt := leavittWordS A * leavittWordT B + let Q : BinaryLeavitt := leavittWordS B * leavittWordT A + have hba : leavittWordT B * leavittWordS A = 0 := + sourceRefinementOrthogonal j i h.symm b a + have hPP : P * P = 0 := by + change + (leavittWordS A * leavittWordT B) * + (leavittWordS A * leavittWordT B) = 0 + calc + (leavittWordS A * leavittWordT B) * + (leavittWordS A * leavittWordT B) = + leavittWordS A * + (leavittWordT B * leavittWordS A) * leavittWordT B := by + noncomm_ring + _ = 0 := by rw [hba]; simp only [mul_zero, zero_mul] + have hPQ : P * Q = leavittWordS A * leavittWordT A := by + change + (leavittWordS A * leavittWordT B) * + (leavittWordS B * leavittWordT A) = + leavittWordS A * leavittWordT A + calc + (leavittWordS A * leavittWordT B) * + (leavittWordS B * leavittWordT A) = + leavittWordS A * + (leavittWordT B * leavittWordS B) * leavittWordT A := by + noncomm_ring + _ = leavittWordS A * leavittWordT A := by + rw [leavittWordT_mul_wordS_self] + simp only [mul_one] + have hQP : Q * P = leavittWordS B * leavittWordT B := by + change + (leavittWordS B * leavittWordT A) * + (leavittWordS A * leavittWordT B) = + leavittWordS B * leavittWordT B + calc + (leavittWordS B * leavittWordT A) * + (leavittWordS A * leavittWordT B) = + leavittWordS B * + (leavittWordT A * leavittWordS A) * leavittWordT B := by + noncomm_ring + _ = leavittWordS B * leavittWordT B := by + rw [leavittWordT_mul_wordS_self] + simp only [mul_one] + have hPQP : P * Q * P = P := by + rw [hPQ] + change + (leavittWordS A * leavittWordT A) * + (leavittWordS A * leavittWordT B) = + leavittWordS A * leavittWordT B + calc + (leavittWordS A * leavittWordT A) * + (leavittWordS A * leavittWordT B) = + leavittWordS A * + (leavittWordT A * leavittWordS A) * leavittWordT B := by + noncomm_ring + _ = leavittWordS A * leavittWordT B := by + rw [leavittWordT_mul_wordS_self] + simp only [mul_one] + change + (↑(sourceCrossSwap i j h a b) : BinaryLeavitt) = + 1 - leavittWordS A * leavittWordT A - + leavittWordS B * leavittWordT B + P + Q + calc + (↑(sourceCrossSwap i j h a b) : BinaryLeavitt) = + (1 + P) * (1 + Q) * (1 + P) := by + simp only [sourceCrossSwap, Units.val_mul, sourceCrossRoot_val] + rfl + _ = 1 - P * Q - Q * P + P + Q := + cylinder_transposition_factorization P Q hPP hPQP + _ = 1 - leavittWordS A * leavittWordT A - + leavittWordS B * leavittWordT B + P + Q := by rw [hPQ, hQP] + +private def refinedSourceWord : Fin 19 → List (Fin 2) + | 0 => [0, 0, 0, 0] + | 1 => [0, 0, 0, 1] + | 2 => [1, 0, 0, 0, 0] + | 3 => [1, 0, 0, 0, 1] + | 4 => [1, 1, 0, 0, 0] + | 5 => [1, 1, 0, 0, 1] + | 6 => [0, 0, 1] + | 7 => [1, 0, 0, 1, 0] + | 8 => [1, 0, 0, 1, 1] + | 9 => [1, 1, 0, 1] + | 10 => [0, 1, 0, 0] + | 11 => [0, 1, 0, 1] + | 12 => [0, 1, 1] + | 13 => [1, 0, 1, 0, 0] + | 14 => [1, 0, 1, 0, 1] + | 15 => [1, 0, 1, 1] + | 16 => [1, 1, 1, 0, 0] + | 17 => [1, 1, 1, 0, 1] + | _ => [1, 1, 1, 1] + +private def refinedSourcePrefixCode : BinaryPrefixCode (Fin 19) where + word := refinedSourceWord + prefix_free := by decide + +private theorem refinedSourcePrefixCode_complete : + MatrixCorner.codeIdempotent + (fun i => leavittWordS (refinedSourcePrefixCode.word i)) + (fun i => leavittWordT (refinedSourcePrefixCode.word i)) = 1 := by + have h000 : + leavittCylinder [0, 0, 0, 0] + + leavittCylinder [0, 0, 0, 1] = + leavittCylinder [0, 0, 0] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split [0, 0, + 0]).symm + have h1000 : + leavittCylinder [1, 0, 0, 0, 0] + + leavittCylinder [1, 0, 0, 0, 1] = + leavittCylinder [1, 0, 0, 0] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split [1, 0, + 0, 0]).symm + have h1100 : + leavittCylinder [1, 1, 0, 0, 0] + + leavittCylinder [1, 1, 0, 0, 1] = + leavittCylinder [1, 1, 0, 0] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split [1, 1, + 0, 0]).symm + have h1001 : + leavittCylinder [1, 0, 0, 1, 0] + + leavittCylinder [1, 0, 0, 1, 1] = + leavittCylinder [1, 0, 0, 1] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split [1, 0, + 0, 1]).symm + have h010 : + leavittCylinder [0, 1, 0, 0] + + leavittCylinder [0, 1, 0, 1] = + leavittCylinder [0, 1, 0] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split [0, 1, + 0]).symm + have h01 : + leavittCylinder [0, 1, 0] + + leavittCylinder [0, 1, 1] = + leavittCylinder [0, 1] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split [0, + 1]).symm + have h1010 : + leavittCylinder [1, 0, 1, 0, 0] + + leavittCylinder [1, 0, 1, 0, 1] = + leavittCylinder [1, 0, 1, 0] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split [1, 0, + 1, 0]).symm + have h101 : + leavittCylinder [1, 0, 1, 0] + + leavittCylinder [1, 0, 1, 1] = + leavittCylinder [1, 0, 1] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split [1, 0, + 1]).symm + have h1110 : + leavittCylinder [1, 1, 1, 0, 0] + + leavittCylinder [1, 1, 1, 0, 1] = + leavittCylinder [1, 1, 1, 0] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split [1, 1, + 1, 0]).symm + have h111 : + leavittCylinder [1, 1, 1, 0] + + leavittCylinder [1, 1, 1, 1] = + leavittCylinder [1, 1, 1] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split [1, 1, + 1]).symm + change (∑ i : Fin 19, leavittCylinder (refinedSourceWord i)) = 1 + calc + (∑ i : Fin 19, leavittCylinder (refinedSourceWord i)) = + (leavittCylinder [0, 0, 0, 0] + + leavittCylinder [0, 0, 0, 1]) + + (leavittCylinder [1, 0, 0, 0, 0] + + leavittCylinder [1, 0, 0, 0, 1]) + + (leavittCylinder [1, 1, 0, 0, 0] + + leavittCylinder [1, 1, 0, 0, 1]) + + leavittCylinder [0, 0, 1] + + (leavittCylinder [1, 0, 0, 1, 0] + + leavittCylinder [1, 0, 0, 1, 1]) + + leavittCylinder [1, 1, 0, 1] + + ((leavittCylinder [0, 1, 0, 0] + + leavittCylinder [0, 1, 0, 1]) + + leavittCylinder [0, 1, 1]) + + ((leavittCylinder [1, 0, 1, 0, 0] + + leavittCylinder [1, 0, 1, 0, 1]) + + leavittCylinder [1, 0, 1, 1]) + + ((leavittCylinder [1, 1, 1, 0, 0] + + leavittCylinder [1, 1, 1, 0, 1]) + + leavittCylinder [1, 1, 1, 1]) := by + simp only [refinedSourceWord, Fin.isValue, Fin.sum_univ_succ, + Fin.succ_ne_zero, imp_self, Fin.succ_zero_eq_one, + Fin.succ_one_eq_two, Fin.reduceSucc, Finset.univ_unique, + Fin.default_eq_zero, Finset.sum_singleton] + ac_rfl + _ = leavittCylinder [0, 0, 0] + + leavittCylinder [1, 0, 0, 0] + + leavittCylinder [1, 1, 0, 0] + + leavittCylinder [0, 0, 1] + + leavittCylinder [1, 0, 0, 1] + + leavittCylinder [1, 1, 0, 1] + + leavittCylinder [0, 1] + + leavittCylinder [1, 0, 1] + + leavittCylinder [1, 1, 1] := by + rw [h000, h1000, h1100, h1001, h010, h01, + h1010, h101, h1110, h111] + _ = ∑ i : Fin 9, leavittCylinder (nineWord i) := by + simp only [Fin.isValue, nineWord, alphaWord, betaWord, nuWord, + Fin.sum_univ_succ, Fin.succ_ne_zero, imp_self, Fin.succ_zero_eq_one, + Fin.succ_one_eq_two, Fin.reduceSucc, Finset.univ_unique, + Fin.default_eq_zero, Finset.sum_singleton] + ac_rfl + _ = 1 := ninePrefixCode_complete + +private theorem completePrefixWord_ext {ι : Type*} [Fintype ι] + (E : BinaryPrefixCode ι) + (hcomplete : MatrixCorner.codeIdempotent + (fun i => leavittWordS (E.word i)) + (fun i => leavittWordT (E.word i)) = 1) + (x y : BinaryLeavitt) + (haction : ∀ i : ι, + x * leavittWordS (E.word i) = + y * leavittWordS (E.word i)) : + x = y := by + calc + x = x * 1 := (mul_one x).symm + _ = x * MatrixCorner.codeIdempotent + (fun i => leavittWordS (E.word i)) + (fun i => leavittWordT (E.word i)) := by rw [hcomplete] + _ = ∑ i : ι, + (x * leavittWordS (E.word i)) * + leavittWordT (E.word i) := by + rw [MatrixCorner.codeIdempotent, Finset.mul_sum] + apply Finset.sum_congr rfl + intro i _ + exact (mul_assoc x _ _).symm + _ = ∑ i : ι, + (y * leavittWordS (E.word i)) * + leavittWordT (E.word i) := by + apply Finset.sum_congr rfl + intro i _ + rw [haction i] + _ = y * MatrixCorner.codeIdempotent + (fun i => leavittWordS (E.word i)) + (fun i => leavittWordT (E.word i)) := by + rw [MatrixCorner.codeIdempotent, Finset.mul_sum] + apply Finset.sum_congr rfl + intro i _ + exact mul_assoc y _ _ + _ = y := by rw [hcomplete, mul_one] + +private theorem prefixTable_mul_sourceWord {ι : Type*} + [Fintype ι] + (source target : BinaryPrefixCode ι) (i : ι) : + prefixTable source target * leavittWordS (source.word i) = + leavittWordS (target.word i) := by + classical + simp only [prefixTable, Finset.sum_mul, mul_assoc, binaryPrefixCode_orthogonal, mul_ite, mul_one, + mul_zero, + Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte] + +private theorem compressionU_mul_nine_refinement + (i : Fin 9) (r : List (Fin 2)) : + (compressionU : BinaryLeavitt) * + leavittWordS (nineWord i ++ r) = + leavittWordS (uWord i ++ r) := by + rw [leavittWordS_append, leavittWordS_append] + change + prefixTable ninePrefixCode uPrefixCode * + (leavittWordS (ninePrefixCode.word i) * leavittWordS r) = + leavittWordS (uPrefixCode.word i) * leavittWordS r + rw [← mul_assoc, prefixTable_mul_sourceWord] + +private def refinedSourceParent : Fin 19 → Fin 9 + | 0 => 0 + | 1 => 0 + | 2 => 1 + | 3 => 1 + | 4 => 2 + | 5 => 2 + | 6 => 3 + | 7 => 4 + | 8 => 4 + | 9 => 5 + | 10 => 6 + | 11 => 6 + | 12 => 6 + | 13 => 7 + | 14 => 7 + | 15 => 7 + | 16 => 8 + | 17 => 8 + | _ => 8 + +private def refinedSourceSuffix : Fin 19 → List (Fin 2) + | 0 => [0] + | 1 => [1] + | 2 => [0] + | 3 => [1] + | 4 => [0] + | 5 => [1] + | 6 => [] + | 7 => [0] + | 8 => [1] + | 9 => [] + | 10 => [0, 0] + | 11 => [0, 1] + | 12 => [1] + | 13 => [0, 0] + | 14 => [0, 1] + | 15 => [1] + | 16 => [0, 0] + | 17 => [0, 1] + | _ => [1] + +private def refinedTargetWord (i : Fin 19) : List (Fin 2) := + uWord (refinedSourceParent i) ++ refinedSourceSuffix i + +private theorem refinedSourceWord_eq_parent_append (i : Fin 19) : + refinedSourceWord i = + nineWord (refinedSourceParent i) ++ refinedSourceSuffix i := by + fin_cases i <;> decide + +private theorem compressionU_mul_refinedSourceWord (i : Fin 19) : + (compressionU : BinaryLeavitt) * + leavittWordS (refinedSourceWord i) = + leavittWordS (refinedTargetWord i) := by + rw [refinedSourceWord_eq_parent_append] + exact compressionU_mul_nine_refinement + (refinedSourceParent i) (refinedSourceSuffix i) + +private def binaryWordCancellation (a b : List (Fin 2)) : BinaryLeavitt := + match a, b with + | [], b => leavittWordS b + | a, [] => leavittWordT a + | i :: a, j :: b => + if i = j then binaryWordCancellation a b else 0 + +private theorem leavittWordT_mul_wordS_cancel (a b : List (Fin 2)) : + leavittWordT a * leavittWordS b = + binaryWordCancellation a b := by + induction a generalizing b with + | nil => simp only [leavittWordT, one_mul, binaryWordCancellation] + | cons i a ih => + cases b with + | nil => simp only [leavittWordS, mul_one, binaryWordCancellation] + | cons j b => + by_cases hij : i = j + · subst j + change + (leavittWordT a * leavittT i) * + (leavittS i * leavittWordS b) = + if i = i then binaryWordCancellation a b else 0 + rw [ite_eq_left rfl] + calc + (leavittWordT a * leavittT i) * + (leavittS i * leavittWordS b) = + leavittWordT a * + ((leavittT i * leavittS i) * leavittWordS b) := by + noncomm_ring + _ = binaryWordCancellation a b := by + rw [leavittT_mul_S] + simpa only [↓reduceIte, one_mul] using ih b + · change + (leavittWordT a * leavittT i) * + (leavittS j * leavittWordS b) = + if i = j then binaryWordCancellation a b else 0 + rw [ite_eq_right hij] + calc + (leavittWordT a * leavittT i) * + (leavittS j * leavittWordS b) = + leavittWordT a * + ((leavittT i * leavittS j) * leavittWordS b) := by + noncomm_ring + _ = 0 := by rw [leavittT_mul_S]; simp only [hij, ↓reduceIte, zero_mul, mul_zero] + +private theorem leavittWordS_mul_wordS (a b : List (Fin 2)) : + leavittWordS a * leavittWordS b = leavittWordS (a ++ b) := + (leavittWordS_append a b).symm + +private theorem sourceCrossSwap_mul_leavittWordS + (i j : Fin 9) (h : i ≠ j) + (a b x : List (Fin 2)) : + (↑(sourceCrossSwap i j h a b) : BinaryLeavitt) * leavittWordS x = + leavittWordS x - + leavittWordS (nineWord i ++ a) * + binaryWordCancellation (nineWord i ++ a) x - + leavittWordS (nineWord j ++ b) * + binaryWordCancellation (nineWord j ++ b) x + + leavittWordS (nineWord i ++ a) * + binaryWordCancellation (nineWord j ++ b) x + + leavittWordS (nineWord j ++ b) * + binaryWordCancellation (nineWord i ++ a) x := by + rw [sourceCrossSwap_val] + simp only [sub_mul, add_mul, one_mul, mul_assoc, + leavittWordT_mul_wordS_cancel] + +private def sourceUChronologicalSwaps : List BinaryLeavittˣ := + [sourceCrossSwap 0 1 (by decide) [0] [], + sourceCrossSwap 0 4 (by decide) [1] [], + sourceCrossSwap 3 7 (by decide) [] [], + sourceCrossSwap 6 2 (by decide) [0, 0] [], + sourceCrossSwap 6 5 (by decide) [0, 1] [], + sourceCrossSwap 6 8 (by decide) [1] [], + sourceCrossSwap 3 6 (by decide) [] [0], + sourceCrossSwap 1 0 (by decide) [] [0, 0], + sourceCrossSwap 4 0 (by decide) [] [0, 1], + sourceCrossSwap 1 0 (by decide) [] [1, 0], + sourceCrossSwap 4 0 (by decide) [] [1, 1], + sourceCrossSwap 3 1 (by decide) [0, 0] [], + sourceCrossSwap 3 4 (by decide) [0, 1] [], + sourceCrossSwap 7 3 (by decide) [] [0], + sourceCrossSwap 7 3 (by decide) [] [1], + sourceCrossSwap 2 6 (by decide) [] [0, 0, 0], + sourceCrossSwap 5 6 (by decide) [] [0, 0, 1], + sourceCrossSwap 8 6 (by decide) [] [0, 1], + sourceCrossSwap 2 6 (by decide) [] [1, 0, 0], + sourceCrossSwap 5 6 (by decide) [] [1, 0, 1], + sourceCrossSwap 8 6 (by decide) [] [1, 1]] + +private def elementaryCompressionU : BinaryLeavittˣ := + sourceUChronologicalSwaps.reverse.prod + +private theorem elementaryCompressionU_mem : + elementaryCompressionU ∈ prefixElementaryGroup ninePrefixCode := by + apply (prefixElementaryGroup ninePrefixCode).list_prod_mem + intro x hx + simp only [List.mem_reverse, sourceUChronologicalSwaps, + List.mem_cons, List.not_mem_nil, or_false] at hx + rcases hx with h | h | h | h | h | h | h | h | h | h | h | + h | h | h | h | h | h | h | h | h | h <;> + subst x <;> exact sourceCrossSwap_mem _ _ _ _ _ + +private theorem elementaryCompressionU_mul_refinedSourceWord (i : Fin 19) : + (elementaryCompressionU : BinaryLeavitt) * + leavittWordS (refinedSourceWord i) = + leavittWordS (refinedTargetWord i) := by + fin_cases i <;> + simp [elementaryCompressionU, sourceUChronologicalSwaps, + sourceCrossSwap_mul_leavittWordS, + refinedSourceWord, refinedTargetWord, + refinedSourceParent, refinedSourceSuffix, + nineWord, uWord, alphaWord, betaWord, nuWord, etaWord, + binaryWordCancellation, leavittWordS_mul_wordS, + List.prod_cons, mul_assoc] + +private theorem elementaryCompressionU_eq_compressionU : + elementaryCompressionU = compressionU := by + apply Units.ext + apply completePrefixWord_ext refinedSourcePrefixCode + refinedSourcePrefixCode_complete + intro i + change + (elementaryCompressionU : BinaryLeavitt) * + leavittWordS (refinedSourceWord i) = + (compressionU : BinaryLeavitt) * + leavittWordS (refinedSourceWord i) + rw [elementaryCompressionU_mul_refinedSourceWord, + compressionU_mul_refinedSourceWord] + +private theorem compressionU_mem_ninePrefixElementaryGroup : + compressionU ∈ prefixElementaryGroup ninePrefixCode := by + rw [← elementaryCompressionU_eq_compressionU] + exact elementaryCompressionU_mem + +end PrefixCompressionU + +public +theorem compressionU_mem_ninePrefixElementaryGroup : + compressionU ∈ prefixElementaryGroup ninePrefixCode := + PrefixCompressionU.compressionU_mem_ninePrefixElementaryGroup + +namespace PrefixCompression + +open scoped BigOperators + +private theorem prefixTable_compose {ι : Type*} [Fintype ι] + (source middle target : BinaryPrefixCode ι) : + prefixTable middle target * prefixTable source middle = + prefixTable source target := by + classical + change + (∑ i, leavittWordS (target.word i) * + leavittWordT (middle.word i)) * + (∑ j, leavittWordS (middle.word j) * + leavittWordT (source.word j)) = + ∑ i, leavittWordS (target.word i) * + leavittWordT (source.word i) + calc + (∑ i, leavittWordS (target.word i) * + leavittWordT (middle.word i)) * + (∑ j, leavittWordS (middle.word j) * + leavittWordT (source.word j)) = + ∑ i, ∑ j, + leavittWordS (target.word i) * + (leavittWordT (middle.word i) * + leavittWordS (middle.word j)) * + leavittWordT (source.word j) := by + rw [Finset.sum_mul] + apply Finset.sum_congr rfl + intro i _ + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro j _ + simp only [mul_assoc] + _ = ∑ i, leavittWordS (target.word i) * + leavittWordT (source.word i) := by + simp only [binaryPrefixCode_orthogonal, mul_ite, mul_one, mul_zero, ite_mul, zero_mul, + Finset.sum_ite_eq, + Finset.mem_univ, ↓reduceIte] + +private def compressionTransition : BinaryLeavittˣ := + prefixTableUnit uPrefixCode vPrefixCode + uPrefixCode_complete vPrefixCode_complete + +private theorem compressionV_eq_transition_mul : + compressionV = compressionTransition * compressionU := by + apply Units.ext + change + prefixTable ninePrefixCode vPrefixCode = + prefixTable uPrefixCode vPrefixCode * + prefixTable ninePrefixCode uPrefixCode + exact (prefixTable_compose ninePrefixCode uPrefixCode vPrefixCode).symm + +private def nineCrossRoot (i j : Fin 9) (hij : i ≠ j) + (a b : List (Fin 2)) : BinaryLeavittˣ := + prefixElementaryUnit ninePrefixCode i j hij + (leavittWordS a * leavittWordT b) + +private theorem nineCrossRoot_mem (i j : Fin 9) (hij : i ≠ j) + (a b : List (Fin 2)) : + nineCrossRoot i j hij a b ∈ prefixElementaryGroup ninePrefixCode := by + exact Subgroup.subset_closure + ⟨i, j, hij, leavittWordS a * leavittWordT b, rfl⟩ + +private def nineCrossSwap (i j : Fin 9) (hij : i ≠ j) + (a b : List (Fin 2)) : BinaryLeavittˣ := + nineCrossRoot i j hij a b * + nineCrossRoot j i hij.symm b a * + nineCrossRoot i j hij a b + +private theorem nineCrossSwap_mem (i j : Fin 9) (hij : i ≠ j) + (a b : List (Fin 2)) : + nineCrossSwap i j hij a b ∈ prefixElementaryGroup ninePrefixCode := by + exact (prefixElementaryGroup ninePrefixCode).mul_mem + ((prefixElementaryGroup ninePrefixCode).mul_mem + (nineCrossRoot_mem i j hij a b) + (nineCrossRoot_mem j i hij.symm b a)) + (nineCrossRoot_mem i j hij a b) + +private def compressionTransitionCrossSwaps : List BinaryLeavittˣ := + [nineCrossSwap 0 1 (by decide) [1, 0] [], + nineCrossSwap 0 4 (by decide) [1, 1] [], + nineCrossSwap 3 7 (by decide) [1] [], + nineCrossSwap 6 2 (by decide) [1, 0, 0] [], + nineCrossSwap 6 5 (by decide) [1, 0, 1] [], + nineCrossSwap 6 8 (by decide) [1, 1] []] + +private theorem compressionTransitionCrossSwaps_prod_mem : + compressionTransitionCrossSwaps.prod ∈ + prefixElementaryGroup ninePrefixCode := by + apply (prefixElementaryGroup ninePrefixCode).list_prod_mem + intro x hx + simp only [compressionTransitionCrossSwaps, List.mem_cons, + List.not_mem_nil, or_false] at hx + rcases hx with h | h | h | h | h | h <;> + subst x <;> exact nineCrossSwap_mem _ _ _ _ _ + +private def transpositionValue {A : Type*} [Ring A] + (sa ta sb tb : A) : A := + 1 - sa * ta - sb * tb + sa * tb + sb * ta + +private theorem transpositionValue_refine {A : Type*} [Ring A] + (sa ta sb tb p₀ q₀ p₁ q₁ : A) + (haa : ta * sa = 1) (hbb : tb * sb = 1) + (hab : ta * sb = 0) (hba : tb * sa = 0) + (h₀₀ : q₀ * p₀ = 1) (h₁₁ : q₁ * p₁ = 1) + (h₀₁ : q₀ * p₁ = 0) (h₁₀ : q₁ * p₀ = 0) + (hpartition : p₀ * q₀ + p₁ * q₁ = 1) : + transpositionValue (sa * p₀) (q₀ * ta) (sb * p₀) (q₀ * tb) * + transpositionValue (sa * p₁) (q₁ * ta) (sb * p₁) (q₁ * tb) = + transpositionValue sa ta sb tb := by + have haa' (x : A) : ta * (sa * x) = x := by + rw [← mul_assoc, haa, one_mul] + have hbb' (x : A) : tb * (sb * x) = x := by + rw [← mul_assoc, hbb, one_mul] + have hab' (x : A) : ta * (sb * x) = 0 := by + rw [← mul_assoc, hab, zero_mul] + have hba' (x : A) : tb * (sa * x) = 0 := by + rw [← mul_assoc, hba, zero_mul] + have h₀₀' (x : A) : q₀ * (p₀ * x) = x := by + rw [← mul_assoc, h₀₀, one_mul] + have h₁₁' (x : A) : q₁ * (p₁ * x) = x := by + rw [← mul_assoc, h₁₁, one_mul] + have h₀₁' (x : A) : q₀ * (p₁ * x) = 0 := by + rw [← mul_assoc, h₀₁, zero_mul] + have h₁₀' (x : A) : q₁ * (p₀ * x) = 0 := by + rw [← mul_assoc, h₁₀, zero_mul] + have hpartition' (x : A) : + p₀ * (q₀ * x) + p₁ * (q₁ * x) = x := by + rw [← mul_assoc, ← mul_assoc, ← add_mul, hpartition, one_mul] + have hpartition_left (z x : A) : + z * (p₀ * (q₀ * x)) + z * (p₁ * (q₁ * x)) = z * x := by + rw [← mul_add, hpartition'] + unfold transpositionValue + calc + _ = 1 - + (sa * (p₀ * (q₀ * ta)) + sa * (p₁ * (q₁ * ta))) - + (sb * (p₀ * (q₀ * tb)) + sb * (p₁ * (q₁ * tb))) + + (sa * (p₀ * (q₀ * tb)) + sa * (p₁ * (q₁ * tb))) + + (sb * (p₀ * (q₀ * ta)) + sb * (p₁ * (q₁ * ta))) := by + noncomm_ring [haa, hbb, hab, hba, h₀₀, h₁₁, h₀₁, h₁₀, + haa', hbb', hab', hba', h₀₀', h₁₁', h₀₁', h₁₀'] + _ = _ := by + rw [hpartition_left sa ta, hpartition_left sb tb, + hpartition_left sa tb, hpartition_left sb ta] + +private theorem nineRefinement_orthogonal + (i j : Fin 9) (hij : i ≠ j) (a b : List (Fin 2)) : + leavittWordT (nineWord i ++ a) * + leavittWordS (nineWord j ++ b) = 0 := by + have hzero : + leavittWordT (nineWord i) * leavittWordS (nineWord j) = 0 := by + simpa only [ninePrefixCode, hij, ↓reduceIte] using binaryPrefixCode_orthogonal ninePrefixCode i + j + rw [leavittWordT_append, leavittWordS_append] + calc + (leavittWordT a * leavittWordT (nineWord i)) * + (leavittWordS (nineWord j) * leavittWordS b) = + leavittWordT a * + (leavittWordT (nineWord i) * leavittWordS (nineWord j)) * + leavittWordS b := by noncomm_ring + _ = 0 := by rw [hzero]; simp only [mul_zero, zero_mul] + +private theorem nineCrossSwap_val (i j : Fin 9) (hij : i ≠ j) + (a b : List (Fin 2)) : + (↑(nineCrossSwap i j hij a b) : BinaryLeavitt) = + transpositionValue + (leavittWordS (nineWord i ++ a)) + (leavittWordT (nineWord i ++ a)) + (leavittWordS (nineWord j ++ b)) + (leavittWordT (nineWord j ++ b)) := by + let A : List (Fin 2) := nineWord i ++ a + let B : List (Fin 2) := nineWord j ++ b + let P : BinaryLeavitt := leavittWordS A * leavittWordT B + let Q : BinaryLeavitt := leavittWordS B * leavittWordT A + have hBA : leavittWordT B * leavittWordS A = 0 := + nineRefinement_orthogonal j i hij.symm b a + have hPP : P * P = 0 := by + change + (leavittWordS A * leavittWordT B) * + (leavittWordS A * leavittWordT B) = 0 + calc + (leavittWordS A * leavittWordT B) * + (leavittWordS A * leavittWordT B) = + leavittWordS A * + (leavittWordT B * leavittWordS A) * + leavittWordT B := by noncomm_ring + _ = 0 := by rw [hBA]; simp only [mul_zero, zero_mul] + have hPQP : P * Q * P = P := by + change + (leavittWordS A * leavittWordT B) * + (leavittWordS B * leavittWordT A) * + (leavittWordS A * leavittWordT B) = + leavittWordS A * leavittWordT B + calc + (leavittWordS A * leavittWordT B) * + (leavittWordS B * leavittWordT A) * + (leavittWordS A * leavittWordT B) = + leavittWordS A * + (leavittWordT B * leavittWordS B) * + (leavittWordT A * leavittWordS A) * + leavittWordT B := by noncomm_ring + _ = leavittWordS A * leavittWordT B := by + rw [leavittWordT_mul_wordS_self, + leavittWordT_mul_wordS_self] + simp only [mul_one] + have hPQ : P * Q = leavittWordS A * leavittWordT A := by + dsimp [P, Q] + calc + (leavittWordS A * leavittWordT B) * + (leavittWordS B * leavittWordT A) = + leavittWordS A * + (leavittWordT B * leavittWordS B) * + leavittWordT A := by noncomm_ring + _ = _ := by rw [leavittWordT_mul_wordS_self]; simp only [mul_one] + have hQP : Q * P = leavittWordS B * leavittWordT B := by + dsimp [P, Q] + calc + (leavittWordS B * leavittWordT A) * + (leavittWordS A * leavittWordT B) = + leavittWordS B * + (leavittWordT A * leavittWordS A) * + leavittWordT B := by noncomm_ring + _ = _ := by rw [leavittWordT_mul_wordS_self]; simp only [mul_one] + change + (1 + leavittWordS (nineWord i) * + (leavittWordS a * leavittWordT b) * leavittWordT (nineWord j)) * + (1 + leavittWordS (nineWord j) * + (leavittWordS b * leavittWordT a) * leavittWordT (nineWord i)) * + (1 + leavittWordS (nineWord i) * + (leavittWordS a * leavittWordT b) * leavittWordT (nineWord j)) = _ + have hleft : + leavittWordS (nineWord i) * + (leavittWordS a * leavittWordT b) * leavittWordT (nineWord j) = + P := by + dsimp [P, A, B] + rw [leavittWordS_append, leavittWordT_append] + noncomm_ring + have hright : + leavittWordS (nineWord j) * + (leavittWordS b * leavittWordT a) * leavittWordT (nineWord i) = + Q := by + dsimp [Q, A, B] + rw [leavittWordS_append, leavittWordT_append] + noncomm_ring + rw [hleft, hright, + cylinder_transposition_factorization P Q hPP hPQP, + hPQ, hQP] + rfl + +private def wordSwapValue (a b : List (Fin 2)) : BinaryLeavitt := + transpositionValue (leavittWordS a) (leavittWordT a) + (leavittWordS b) (leavittWordT b) + +private theorem wordSwapValue_refine (a b : List (Fin 2)) + (hab : leavittWordT a * leavittWordS b = 0) + (hba : leavittWordT b * leavittWordS a = 0) : + wordSwapValue (a ++ [0]) (b ++ [0]) * + wordSwapValue (a ++ [1]) (b ++ [1]) = + wordSwapValue a b := by + unfold wordSwapValue + simpa only [leavittWordS_append, leavittWordT_append, + leavittWordS, leavittWordT, mul_one, one_mul] using + transpositionValue_refine + (leavittWordS a) (leavittWordT a) + (leavittWordS b) (leavittWordT b) + (leavittS 0) (leavittT 0) + (leavittS 1) (leavittT 1) + (leavittWordT_mul_wordS_self a) + (leavittWordT_mul_wordS_self b) + hab hba + (by simpa only [Fin.isValue, ↓reduceIte] using leavittT_mul_S 0 0) + (by simpa only [Fin.isValue, ↓reduceIte] using leavittT_mul_S 1 1) + (by simpa only [Fin.isValue, zero_ne_one, ↓reduceIte] using leavittT_mul_S 0 1) + (by simpa only [Fin.isValue, one_ne_zero, ↓reduceIte] using leavittT_mul_S 1 0) + leavitt_partition + +private theorem compressionTransitionCrossSwaps_prod_val : + (↑compressionTransitionCrossSwaps.prod : BinaryLeavitt) = + wordSwapValue (uWord 1) (uWord 2) * + wordSwapValue (uWord 4) (uWord 5) * + wordSwapValue (uWord 7) (uWord 8) := by + have h₀ : + wordSwapValue [0, 0, 0, 1, 0] [1, 0, 0, 0] * + wordSwapValue [0, 0, 0, 1, 1] [1, 0, 0, 1] = + wordSwapValue [0, 0, 0, 1] [1, 0, 0] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using + wordSwapValue_refine [0, 0, 0, 1] [1, 0, 0] (leavittWordT_mul_wordS_of_incomparable _ _ (by + decide) (by decide)) + (leavittWordT_mul_wordS_of_incomparable _ _ (by decide) (by decide)) + have h₂₀ : + wordSwapValue [0, 1, 1, 0, 0] [1, 1, 0, 0] * + wordSwapValue [0, 1, 1, 0, 1] [1, 1, 0, 1] = + wordSwapValue [0, 1, 1, 0] [1, 1, 0] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using + wordSwapValue_refine [0, 1, 1, 0] [1, 1, 0] (leavittWordT_mul_wordS_of_incomparable _ _ (by + decide) (by decide)) + (leavittWordT_mul_wordS_of_incomparable _ _ (by decide) (by decide)) + have h₂ : + wordSwapValue [0, 1, 1, 0] [1, 1, 0] * + wordSwapValue [0, 1, 1, 1] [1, 1, 1] = + wordSwapValue [0, 1, 1] [1, 1] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using + wordSwapValue_refine [0, 1, 1] [1, 1] (leavittWordT_mul_wordS_of_incomparable _ _ (by decide) + (by decide)) + (leavittWordT_mul_wordS_of_incomparable _ _ (by decide) (by decide)) + simp only [compressionTransitionCrossSwaps, List.prod_cons, List.prod_nil, + Units.val_mul, nineCrossSwap_val, mul_one] + change + wordSwapValue [0, 0, 0, 1, 0] [1, 0, 0, 0] * + (wordSwapValue [0, 0, 0, 1, 1] [1, 0, 0, 1] * + (wordSwapValue [0, 0, 1, 1] [1, 0, 1] * + (wordSwapValue [0, 1, 1, 0, 0] [1, 1, 0, 0] * + (wordSwapValue [0, 1, 1, 0, 1] [1, 1, 0, 1] * + wordSwapValue [0, 1, 1, 1] [1, 1, 1])))) = + wordSwapValue [0, 0, 0, 1] [1, 0, 0] * + wordSwapValue [0, 0, 1, 1] [1, 0, 1] * + wordSwapValue [0, 1, 1] [1, 1] + calc + _ = + (wordSwapValue [0, 0, 0, 1, 0] [1, 0, 0, 0] * + wordSwapValue [0, 0, 0, 1, 1] [1, 0, 0, 1]) * + wordSwapValue [0, 0, 1, 1] [1, 0, 1] * + ((wordSwapValue [0, 1, 1, 0, 0] [1, 1, 0, 0] * + wordSwapValue [0, 1, 1, 0, 1] [1, 1, 0, 1]) * + wordSwapValue [0, 1, 1, 1] [1, 1, 1]) := by + noncomm_ring + _ = _ := by rw [h₀, h₂₀, h₂] + +private theorem transpositionValue_mul_codeWord {ι : Type*} [DecidableEq ι] + (E : BinaryPrefixCode ι) (i j : ι) (hij : i ≠ j) (k : ι) : + transpositionValue + (leavittWordS (E.word i)) (leavittWordT (E.word i)) + (leavittWordS (E.word j)) (leavittWordT (E.word j)) * + leavittWordS (E.word k) = + if k = i then leavittWordS (E.word j) + else if k = j then leavittWordS (E.word i) + else leavittWordS (E.word k) := by + by_cases hki : k = i + · subst k + simp only [transpositionValue, add_mul, sub_mul, one_mul, mul_assoc, + binaryPrefixCode_orthogonal, ↓reduceIte, + mul_one, sub_self, hij.symm, mul_zero, add_zero, zero_add] + · by_cases hkj : k = j + · subst k + simp only [transpositionValue, add_mul, sub_mul, one_mul, mul_assoc, + binaryPrefixCode_orthogonal, hij, + ↓reduceIte, mul_zero, sub_zero, mul_one, sub_self, zero_add, add_zero, hij.symm] + · simp only [transpositionValue, add_mul, sub_mul, one_mul, mul_assoc, + binaryPrefixCode_orthogonal, Ne.symm hki, + ↓reduceIte, mul_zero, sub_zero, Ne.symm hkj, add_zero, hki, hkj] + +private theorem uSwap12_mul (k : Fin 9) : + wordSwapValue (uWord 1) (uWord 2) * leavittWordS (uWord k) = + if k = 1 then leavittWordS (uWord 2) + else if k = 2 then leavittWordS (uWord 1) + else leavittWordS (uWord k) := + transpositionValue_mul_codeWord uPrefixCode 1 2 (by decide) k + +private theorem uSwap45_mul (k : Fin 9) : + wordSwapValue (uWord 4) (uWord 5) * leavittWordS (uWord k) = + if k = 4 then leavittWordS (uWord 5) + else if k = 5 then leavittWordS (uWord 4) + else leavittWordS (uWord k) := + transpositionValue_mul_codeWord uPrefixCode 4 5 (by decide) k + +private theorem uSwap78_mul (k : Fin 9) : + wordSwapValue (uWord 7) (uWord 8) * leavittWordS (uWord k) = + if k = 7 then leavittWordS (uWord 8) + else if k = 8 then leavittWordS (uWord 7) + else leavittWordS (uWord k) := + transpositionValue_mul_codeWord uPrefixCode 7 8 (by decide) k + +private theorem compressionTransitionParentSwaps_mul_word (k : Fin 9) : + (wordSwapValue (uWord 1) (uWord 2) * + wordSwapValue (uWord 4) (uWord 5) * + wordSwapValue (uWord 7) (uWord 8)) * + leavittWordS (uWord k) = leavittWordS (vWord k) := by + fin_cases k <;> + simp [mul_assoc, uSwap12_mul, uSwap45_mul, uSwap78_mul] <;> + rfl + +private theorem compressionTransitionParentSwaps_eq_table : + wordSwapValue (uWord 1) (uWord 2) * + wordSwapValue (uWord 4) (uWord 5) * + wordSwapValue (uWord 7) (uWord 8) = + prefixTable uPrefixCode vPrefixCode := by + let x : BinaryLeavitt := + wordSwapValue (uWord 1) (uWord 2) * + wordSwapValue (uWord 4) (uWord 5) * + wordSwapValue (uWord 7) (uWord 8) + change x = prefixTable uPrefixCode vPrefixCode + calc + x = x * 1 := (mul_one x).symm + _ = x * MatrixCorner.codeIdempotent + (fun i => leavittWordS (uPrefixCode.word i)) + (fun i => leavittWordT (uPrefixCode.word i)) := by + rw [uPrefixCode_complete] + _ = ∑ i : Fin 9, + (x * leavittWordS (uWord i)) * leavittWordT (uWord i) := by + simp only [MatrixCorner.codeIdempotent, uPrefixCode, Finset.mul_sum, mul_assoc] + _ = ∑ i : Fin 9, + leavittWordS (vWord i) * leavittWordT (uWord i) := by + apply Finset.sum_congr rfl + intro i _ + rw [show x * leavittWordS (uWord i) = + leavittWordS (vWord i) from + compressionTransitionParentSwaps_mul_word i] + _ = prefixTable uPrefixCode vPrefixCode := rfl + +private theorem compressionTransitionCrossSwaps_prod_eq : + compressionTransitionCrossSwaps.prod = compressionTransition := by + apply Units.ext + exact compressionTransitionCrossSwaps_prod_val.trans + compressionTransitionParentSwaps_eq_table + +private theorem compressionTransition_mem : + compressionTransition ∈ prefixElementaryGroup ninePrefixCode := by + rw [← compressionTransitionCrossSwaps_prod_eq] + exact compressionTransitionCrossSwaps_prod_mem + +private theorem compressionV_mem_of_compressionU + (hU : compressionU ∈ prefixElementaryGroup ninePrefixCode) : + compressionV ∈ prefixElementaryGroup ninePrefixCode := by + rw [compressionV_eq_transition_mul] + exact (prefixElementaryGroup ninePrefixCode).mul_mem + compressionTransition_mem hU + +end PrefixCompression + +public +theorem compressionV_mem_ninePrefixElementaryGroup : + compressionV ∈ prefixElementaryGroup ninePrefixCode := + PrefixCompression.compressionV_mem_of_compressionU + compressionU_mem_ninePrefixElementaryGroup + +public +theorem sourceGeneratedGroup_eq_nine : + SourceGeneration.sourceGeneratedGroup = + prefixElementaryGroup ninePrefixCode := + SourceGeneration.sourceGeneratedGroup_eq_nine_of_compressions + compressionU_mem_ninePrefixElementaryGroup + compressionV_mem_ninePrefixElementaryGroup + +private theorem shifted_floor_drop_subset_two_intervals + (u v H : ℝ) (hH : 0 < H) (k : ℤ) (hk : k = ⌊u / H⌋) : + {r : ℝ | r ∈ Set.Ico 0 H ∧ ⌊(v + r) / H⌋ < ⌊(u + r) / H⌋} ⊆ + Set.Ico ((k : ℝ) * H - u) ((k : ℝ) * H - v) ∪ + Set.Ico (((k + 1 : ℤ) : ℝ) * H - u) + (((k + 1 : ℤ) : ℝ) * H - v) := by + intro r hr + rcases hr with ⟨⟨hr0, hrH⟩, hdrop⟩ + let j : ℤ := ⌊(u + r) / H⌋ + have hlow : k ≤ j := by + rw [hk] + apply Int.floor_mono + apply (div_le_div_iff_of_pos_right hH).2 + linarith + have hhigh : j < k + 2 := by + apply Int.floor_lt.mpr + have hu : u / H < (k : ℝ) + 1 := by + rw [hk] + exact Int.lt_floor_add_one (u / H) + have hr' : r / H < 1 := (div_lt_one hH).mpr hrH + calc + (u + r) / H = u / H + r / H := by ring + _ < ((k : ℝ) + 1) + 1 := add_lt_add hu hr' + _ = ((k + 2 : ℤ) : ℝ) := by push_cast; ring + have hcases : j = k ∨ j = k + 1 := by omega + have hv : (v + r) / H < (j : ℝ) := by + apply Int.floor_lt.mp + exact hdrop + have hu : (j : ℝ) ≤ (u + r) / H := Int.floor_le _ + have hv' : v + r < (j : ℝ) * H := (div_lt_iff₀ hH).mp hv + have hu' : (j : ℝ) * H ≤ u + r := (le_div_iff₀ hH).mp hu + rcases hcases with hcase | hcase + · left + rw [hcase] at hv' hu' + exact ⟨by linarith, by linarith⟩ + · right + rw [hcase] at hv' hu' + exact ⟨by linarith, by linarith⟩ + +private theorem measurableSet_shifted_floor_drop (u v H : ℝ) : + MeasurableSet + {r : ℝ | ⌊(v + r) / H⌋ < ⌊(u + r) / H⌋} := by + have hv : Measurable (fun r : ℝ => ⌊(v + r) / H⌋) := by + fun_prop + have hu : Measurable (fun r : ℝ => ⌊(u + r) / H⌋) := by + fun_prop + exact measurableSet_lt hv hu + +private theorem exists_common_offset_below_average + (H : ℝ) (hH : 0 < H) (f : ℝ → ℝ) + (hf : MeasureTheory.IntegrableOn f (Set.Ico 0 H) + MeasureTheory.volume) : + ∃ r ∈ Set.Ico 0 H, + f r ≤ MeasureTheory.average + (MeasureTheory.volume.restrict (Set.Ico 0 H)) f := by + have hvolume : MeasureTheory.volume (Set.Ico (0 : ℝ) H) = + ENNReal.ofReal H := by + rw [Real.volume_Ico, sub_zero] + have hnezero : MeasureTheory.volume (Set.Ico (0 : ℝ) H) ≠ 0 := by + rw [hvolume] + exact ENNReal.ofReal_ne_zero_iff.mpr hH + have hnetop : MeasureTheory.volume (Set.Ico (0 : ℝ) H) ≠ ⊤ := by + rw [hvolume] + exact ENNReal.ofReal_ne_top + exact MeasureTheory.exists_le_setAverage hnezero hnetop hf + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def rankDropCount {ι : Type*} [Fintype ι] + (u v : ι → ℝ) (H r : ℝ) : ℝ := + Finset.univ.sum (fun i : ι => + if ⌊(v i + r) / H⌋ < ⌊(u i + r) / H⌋ then (1 : ℝ) else 0) + +private theorem measurable_rankDropCount {ι : Type*} [Fintype ι] + (u v : ι → ℝ) (H : ℝ) : + Measurable (fun r : ℝ => rankDropCount u v H r) := by + classical + unfold rankDropCount + apply Finset.measurable_sum + intro i hi + exact Measurable.ite + (measurableSet_shifted_floor_drop (u i) (v i) H) + measurable_const measurable_const + +private theorem rankDropCount_nonneg_and_le {ι : Type*} [Fintype ι] + (u v : ι → ℝ) (H r : ℝ) : + 0 ≤ rankDropCount u v H r ∧ + rankDropCount u v H r ≤ (Fintype.card ι : ℝ) := by + classical + constructor + · unfold rankDropCount + exact Finset.sum_nonneg (fun i hi => by split_ifs <;> norm_num) + · unfold rankDropCount + calc + (∑ i : ι, if ⌊(v i + r) / H⌋ < ⌊(u i + r) / H⌋ + then (1 : ℝ) else 0) ≤ ∑ _i : ι, (1 : ℝ) := by + apply Finset.sum_le_sum + intro i hi + split_ifs <;> norm_num + _ = (Fintype.card ι : ℝ) := by simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul, + mul_one] + +private theorem integrableOn_rankDropCount {ι : Type*} [Fintype ι] + (u v : ι → ℝ) (H : ℝ) : + MeasureTheory.IntegrableOn (fun r : ℝ => rankDropCount u v H r) + (Set.Ico 0 H) MeasureTheory.volume := by + have hfinite : MeasureTheory.volume (Set.Ico (0 : ℝ) H) < ⊤ := by + rw [Real.volume_Ico] + exact ENNReal.ofReal_lt_top + refine ⟨(measurable_rankDropCount u v H).aestronglyMeasurable, ?_⟩ + apply MeasureTheory.HasFiniteIntegral.restrict_of_bounded + (Fintype.card ι : ℝ) hfinite + filter_upwards [] with r + rw [Real.norm_eq_abs, abs_of_nonneg + (rankDropCount_nonneg_and_le u v H r).1] + exact (rankDropCount_nonneg_and_le u v H r).2 + +private theorem integrable_rankDropIndicator + (u v H : ℝ) : + MeasureTheory.Integrable + (fun r : ℝ => + if ⌊(v + r) / H⌋ < ⌊(u + r) / H⌋ then (1 : ℝ) else 0) + (MeasureTheory.volume.restrict (Set.Ico 0 H)) := by + have hfinite : MeasureTheory.volume (Set.Ico (0 : ℝ) H) < ⊤ := by + rw [Real.volume_Ico] + exact ENNReal.ofReal_lt_top + have hmeas : Measurable + (fun r : ℝ => + if ⌊(v + r) / H⌋ < ⌊(u + r) / H⌋ then (1 : ℝ) else 0) := + Measurable.ite (measurableSet_shifted_floor_drop u v H) + measurable_const measurable_const + refine ⟨hmeas.aestronglyMeasurable, ?_⟩ + apply MeasureTheory.HasFiniteIntegral.restrict_of_bounded + (1 : ℝ) hfinite + filter_upwards [] with r + split_ifs <;> norm_num + +private theorem exists_common_rank_offset {ι : Type*} [Fintype ι] + (u v : ι → ℝ) (H : ℝ) (hH : 0 < H) : + ∃ r ∈ Set.Ico 0 H, + rankDropCount u v H r ≤ + MeasureTheory.average + (MeasureTheory.volume.restrict (Set.Ico 0 H)) + (fun t : ℝ => rankDropCount u v H t) := by + exact exists_common_offset_below_average H hH + (fun t : ℝ => rankDropCount u v H t) + (integrableOn_rankDropCount u v H) + +private theorem rankDropCount_integral_eq {ι : Type*} [Fintype ι] + (u v : ι → ℝ) (H : ℝ) : + (∫ r, rankDropCount u v H r + ∂(MeasureTheory.volume.restrict (Set.Ico 0 H))) = + ∑ i : ι, (MeasureTheory.volume.restrict (Set.Ico 0 H)).real + {r : ℝ | ⌊(v i + r) / H⌋ < ⌊(u i + r) / H⌋} := by + classical + unfold rankDropCount + rw [MeasureTheory.integral_finsetSum Finset.univ + (fun i hi => integrable_rankDropIndicator (u i) (v i) H)] + apply Finset.sum_congr rfl + intro i hi + have hindicator : + (fun r : ℝ => + if ⌊(v i + r) / H⌋ < ⌊(u i + r) / H⌋ + then (1 : ℝ) else 0) = + {r : ℝ | ⌊(v i + r) / H⌋ < ⌊(u i + r) / H⌋}.indicator + (fun _ : ℝ => (1 : ℝ)) := by + funext r + simp only [Set.indicator, Set.mem_ofPred_eq] + rw [hindicator] + exact MeasureTheory.integral_indicator_one + (measurableSet_shifted_floor_drop (u i) (v i) H) + +private theorem rankDropCount_average_eq {ι : Type*} [Fintype ι] + (u v : ι → ℝ) (H : ℝ) (hH : 0 < H) : + MeasureTheory.average + (MeasureTheory.volume.restrict (Set.Ico 0 H)) + (fun r : ℝ => rankDropCount u v H r) = + H⁻¹ * ∑ i : ι, + (MeasureTheory.volume.restrict (Set.Ico 0 H)).real + {r : ℝ | ⌊(v i + r) / H⌋ < ⌊(u i + r) / H⌋} := by + rw [MeasureTheory.average_eq, + MeasureTheory.measureReal_restrict_apply_univ, + Real.volume_real_Ico_of_le hH.le, sub_zero, + rankDropCount_integral_eq] + exact smul_eq_mul _ _ + +private theorem rankDropCount_clamp_eq {ι : Type*} [Fintype ι] + (u v : ι → ℝ) (H r : ℝ) (hH : 0 < H) : + rankDropCount u v H r = + rankDropCount u (fun i => min (v i) (u i)) H r := by + classical + unfold rankDropCount + apply Finset.sum_congr rfl + intro i hi + change + (if ⌊(v i + r) / H⌋ < ⌊(u i + r) / H⌋ + then (1 : ℝ) else 0) = + if ⌊(min (v i) (u i) + r) / H⌋ < ⌊(u i + r) / H⌋ + then (1 : ℝ) else 0 + by_cases hle : v i ≤ u i + · rw [min_eq_left hle] + · have hreverse : u i ≤ v i := le_of_not_ge hle + have hfloor : + ¬ ⌊(v i + r) / H⌋ < ⌊(u i + r) / H⌋ := by + apply not_lt_of_ge + apply Int.floor_mono + apply (div_le_div_iff_of_pos_right hH).2 + linarith + simp only [hfloor, ↓reduceIte, min_eq_right hreverse, lt_self_iff_false] + +private theorem shifted_floor_drop_volume_bound_sharp + (u v H : ℝ) (hH : 0 < H) (hvu : v ≤ u) : + MeasureTheory.volume + {r : ℝ | r ∈ Set.Ico 0 H ∧ + ⌊(v + r) / H⌋ < ⌊(u + r) / H⌋} ≤ + ENNReal.ofReal (u - v) := by + let k : ℤ := ⌊u / H⌋ + let c : ℝ := (((k + 1 : ℤ) : ℝ) * H - u) + let d : ℝ := u - v + have hd : 0 ≤ d := sub_nonneg.mpr hvu + have hklo : (k : ℝ) ≤ u / H := by + dsimp [k] + exact Int.floor_le _ + have hkhi : u / H < (k : ℝ) + 1 := by + dsimp [k] + exact Int.lt_floor_add_one _ + have hklo' : (k : ℝ) * H ≤ u := (le_div_iff₀ hH).mp hklo + have hkhi' : u < ((k : ℝ) + 1) * H := (div_lt_iff₀ hH).mp hkhi + have hc0 : 0 ≤ c := by + dsimp [c] + push_cast + linarith + have hcH : c ≤ H := by + dsimp [c] + push_cast + linarith + let A : Set ℝ := Set.Ico 0 (max 0 (c - H + d)) + let B : Set ℝ := Set.Ico c (min H (c + d)) + have hsubset : + {r : ℝ | r ∈ Set.Ico 0 H ∧ + ⌊(v + r) / H⌋ < ⌊(u + r) / H⌋} ⊆ A ∪ B := by + intro r hr + have htwo := shifted_floor_drop_subset_two_intervals u v H hH k rfl hr + rcases htwo with hleft | hright + · left + change r ∈ Set.Ico 0 (max 0 (c - H + d)) + refine ⟨hr.1.1, ?_⟩ + apply lt_of_lt_of_le (b := c - H + d) + · have hupper := hleft.2 + dsimp [c, d] + push_cast + linarith + · exact le_max_right _ _ + · right + change r ∈ Set.Ico c (min H (c + d)) + refine ⟨?_, lt_min hr.1.2 ?_⟩ + · have hlower := hright.1 + dsimp [c] + exact hlower + · have hupper := hright.2 + dsimp [c, d] + push_cast at hupper ⊢ + linarith + have hA : MeasureTheory.volume A = + ENNReal.ofReal (max 0 (c - H + d)) := by + dsimp [A] + rw [Real.volume_Ico, sub_zero] + have hB : MeasureTheory.volume B = + ENNReal.ofReal (min H (c + d) - c) := by + dsimp [B] + rw [Real.volume_Ico] + have hA0 : 0 ≤ max 0 (c - H + d) := le_max_left _ _ + have hB0 : 0 ≤ min H (c + d) - c := by + apply sub_nonneg.mpr + exact le_min hcH (by linarith) + have hlength : max 0 (c - H + d) + (min H (c + d) - c) = d := by + by_cases hshort : d ≤ H - c + · rw [max_eq_left (by linarith), min_eq_right (by linarith)] + ring + · have hlong : H - c < d := lt_of_not_ge hshort + rw [max_eq_right (by linarith), min_eq_left (by linarith)] + ring + calc + MeasureTheory.volume + {r : ℝ | r ∈ Set.Ico 0 H ∧ + ⌊(v + r) / H⌋ < ⌊(u + r) / H⌋} ≤ + MeasureTheory.volume (A ∪ B) := + MeasureTheory.measure_mono hsubset + _ ≤ MeasureTheory.volume A + MeasureTheory.volume B := + MeasureTheory.measure_union_le A B + _ = ENNReal.ofReal (max 0 (c - H + d)) + + ENNReal.ofReal (min H (c + d) - c) := by rw [hA, hB] + _ = ENNReal.ofReal d := by + rw [← ENNReal.ofReal_add hA0 hB0, hlength] + _ = ENNReal.ofReal (u - v) := by rfl + +private theorem rankDrop_measureReal_bound_sharp + (u v H : ℝ) (hH : 0 < H) (hvu : v ≤ u) : + (MeasureTheory.volume.restrict (Set.Ico 0 H)).real + {r : ℝ | ⌊(v + r) / H⌋ < ⌊(u + r) / H⌋} ≤ + u - v := by + rw [MeasureTheory.measureReal_restrict_apply + (measurableSet_shifted_floor_drop u v H)] + have heq : + {r : ℝ | ⌊(v + r) / H⌋ < ⌊(u + r) / H⌋} ∩ Set.Ico 0 H = + {r : ℝ | r ∈ Set.Ico 0 H ∧ + ⌊(v + r) / H⌋ < ⌊(u + r) / H⌋} := by + ext r + simp only [Set.mem_inter_iff, Set.mem_ofPred_eq, Set.mem_Ico, and_comm] + rw [heq, MeasureTheory.measureReal_def] + have hbound := shifted_floor_drop_volume_bound_sharp u v H hH hvu + have hreal := ENNReal.toReal_mono ENNReal.ofReal_ne_top hbound + rwa [ENNReal.toReal_ofReal (sub_nonneg.mpr hvu)] at hreal + +private theorem exists_common_rank_offset_bound_sharp {ι : Type*} [Fintype ι] + (u v : ι → ℝ) (H : ℝ) (hH : 0 < H) + (hvu : ∀ i : ι, v i ≤ u i) : + ∃ r ∈ Set.Ico 0 H, + rankDropCount u v H r ≤ + (1 / H) * ∑ i : ι, (u i - v i) := by + classical + obtain ⟨r, hr, hmean⟩ := exists_common_rank_offset u v H hH + refine ⟨r, hr, hmean.trans ?_⟩ + rw [rankDropCount_average_eq u v H hH] + have hsum : + (∑ i : ι, (MeasureTheory.volume.restrict (Set.Ico 0 H)).real + {r : ℝ | ⌊(v i + r) / H⌋ < ⌊(u i + r) / H⌋}) ≤ + ∑ i : ι, (u i - v i) := by + exact Finset.sum_le_sum (fun i hi => + rankDrop_measureReal_bound_sharp (u i) (v i) H hH (hvu i)) + calc + H⁻¹ * + (∑ i : ι, (MeasureTheory.volume.restrict (Set.Ico 0 H)).real + {r : ℝ | ⌊(v i + r) / H⌋ < ⌊(u i + r) / H⌋}) ≤ + H⁻¹ * ∑ i : ι, (u i - v i) := + mul_le_mul_of_nonneg_left hsum (inv_nonneg.mpr hH.le) + _ = (1 / H) * ∑ i : ι, (u i - v i) := by + rw [one_div] + +private theorem exists_common_rank_offset_one_sided_sharp + {ι : Type*} [Fintype ι] + (u v delta : ι → ℝ) (H : ℝ) (hH : 0 < H) + (hdelta : ∀ i : ι, 0 ≤ delta i) + (hone : ∀ i : ι, u i - delta i ≤ v i) : + ∃ r ∈ Set.Ico 0 H, + rankDropCount u v H r ≤ + (1 / H) * ∑ i : ι, delta i := by + classical + obtain ⟨r, hr, hbound⟩ := + exists_common_rank_offset_bound_sharp + u (fun i => min (v i) (u i)) + H hH (fun i => min_le_right (v i) (u i)) + refine ⟨r, hr, ?_⟩ + have hsum : + (∑ i : ι, (u i - min (v i) (u i))) ≤ + ∑ i : ι, delta i := by + apply Finset.sum_le_sum + intro i hi + by_cases hle : v i ≤ u i + · rw [min_eq_left hle] + linarith [hone i] + · rw [min_eq_right (le_of_not_ge hle), sub_self] + exact hdelta i + calc + rankDropCount u v H r = + rankDropCount u (fun i => min (v i) (u i)) H r := + rankDropCount_clamp_eq u v H r hH + _ ≤ (1 / H) * ∑ i : ι, (u i - min (v i) (u i)) := hbound + _ ≤ (1 / H) * ∑ i : ι, delta i := + mul_le_mul_of_nonneg_left hsum (by positivity) + +private theorem log_one_sided_of_multiplicative + (x y eta : ℝ) (hx : 0 < x) + (heta0 : 0 ≤ eta) (heta1 : eta < 1) + (hcomparison : (1 - eta) * x ≤ y) : + Real.log x - |Real.log (1 - eta)| ≤ Real.log y := by + have hfactor : 0 < 1 - eta := by linarith + have hy : 0 < y := + lt_of_lt_of_le (mul_pos hfactor hx) hcomparison + have hlog : Real.log ((1 - eta) * x) ≤ Real.log y := + (Real.log_le_log_iff (mul_pos hfactor hx) hy).2 hcomparison + rw [Real.log_mul hfactor.ne' hx.ne'] at hlog + have hnonpos : Real.log (1 - eta) ≤ 0 := + Real.log_nonpos hfactor.le (by linarith) + rw [abs_of_nonpos hnonpos] + linarith + +private theorem exists_common_log_rank_offset {ι : Type*} [Fintype ι] + (x y : ι → ℝ) (eta H : ℝ) + (hx : ∀ i : ι, 0 < x i) + (heta0 : 0 ≤ eta) (heta1 : eta < 1) (hH : 0 < H) + (hcomparison : ∀ i : ι, (1 - eta) * x i ≤ y i) : + ∃ r ∈ Set.Ico 0 H, + rankDropCount (fun i => Real.log (x i)) + (fun i => Real.log (y i)) H r ≤ + (Fintype.card ι : ℝ) * |Real.log (1 - eta)| / H := by + classical + obtain ⟨r, hr, hbound⟩ := + exists_common_rank_offset_one_sided_sharp + (fun i => Real.log (x i)) + (fun i => Real.log (y i)) + (fun _ : ι => |Real.log (1 - eta)|) + H hH + (fun _ => abs_nonneg _) + (fun i => log_one_sided_of_multiplicative + (x i) (y i) eta (hx i) heta0 heta1 (hcomparison i)) + refine ⟨r, hr, hbound.trans_eq ?_⟩ + simp only [one_div, Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + ring + +private theorem abs_log_one_sub_le_two_mul + (eta : ℝ) (heta0 : 0 ≤ eta) (hetaHalf : eta ≤ (1 : ℝ) / 2) : + |Real.log (1 - eta)| ≤ 2 * eta := by + have hfactor : 0 < 1 - eta := by linarith + have hlog : Real.log (1 - eta) ≤ 0 := + Real.log_nonpos hfactor.le (by linarith) + rw [abs_of_nonpos hlog] + have hlower := Real.one_sub_inv_le_log_of_pos hfactor + have hratio : eta / (1 - eta) ≤ 2 * eta := by + apply (div_le_iff₀ hfactor).2 + nlinarith [mul_nonneg heta0 (by linarith : 0 ≤ 1 - 2 * eta)] + have hidentity : (1 - eta)⁻¹ - 1 = eta / (1 - eta) := by + field_simp + ring + linarith + +private theorem abs_log_one_sub_div_tendsto_zero + (eta H : ℕ → ℝ) + (heta0 : ∀ n, 0 ≤ eta n) + (hH : ∀ n, 0 < H n) + (heta : Filter.Tendsto eta Filter.atTop (nhds 0)) + (hratio : Filter.Tendsto + (fun n => eta n / H n) Filter.atTop (nhds 0)) : + Filter.Tendsto + (fun n => |Real.log (1 - eta n)| / H n) + Filter.atTop (nhds 0) := by + have hsmall : ∀ᶠ n in Filter.atTop, + eta n < (1 : ℝ) / 2 := + heta.eventually (gt_mem_nhds (by norm_num)) + have hupper : ∀ᶠ n in Filter.atTop, + |Real.log (1 - eta n)| / H n ≤ + 2 * (eta n / H n) := by + filter_upwards [hsmall] with n hn + calc + |Real.log (1 - eta n)| / H n ≤ + (2 * eta n) / H n := + (div_le_div_iff_of_pos_right (hH n)).2 + (abs_log_one_sub_le_two_mul + (eta n) (heta0 n) hn.le) + _ = 2 * (eta n / H n) := by ring + have hlimit : Filter.Tendsto + (fun n => 2 * (eta n / H n)) Filter.atTop (nhds 0) := by + simpa only [mul_zero] using Filter.Tendsto.const_mul (2 : ℝ) hratio + exact squeeze_zero' + (Filter.Eventually.of_forall fun n => + div_nonneg (abs_nonneg _) (hH n).le) + hupper hlimit + +namespace CheegerPoincare + +open scoped BigOperators + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def positiveSupport {V : Type*} [Fintype V] + (f : V → ℝ) : Finset V := by + classical + exact Finset.univ.filter fun x => 0 < f x + +@[simp] public theorem mem_positiveSupport {V : Type*} [Fintype V] + (f : V → ℝ) (x : V) : + x ∈ positiveSupport f ↔ 0 < f x := by + classical + simp only [positiveSupport, Finset.mem_filter, Finset.mem_univ, true_and] + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def finiteMean {V : Type*} [Fintype V] (f : V → ℝ) : ℝ := + (∑ x : V, f x) / (Fintype.card V : ℝ) + +private theorem sum_sub_finiteMean_eq_zero {V : Type*} [Fintype V] [Nonempty V] + (f : V → ℝ) : + (∑ x : V, (f x - finiteMean f)) = 0 := by + have hcard : (Fintype.card V : ℝ) ≠ 0 := by + exact_mod_cast Fintype.card_ne_zero + simp only [Finset.sum_sub_distrib, Finset.sum_const, + Finset.card_univ, nsmul_eq_mul, finiteMean] + field_simp + ring + +public +theorem sum_sq_sub_finiteMean_le {V : Type*} [Fintype V] [Nonempty V] + (f : V → ℝ) (c : ℝ) : + (∑ x : V, (f x - finiteMean f) ^ 2) ≤ + ∑ x : V, (f x - c) ^ 2 := by + have hpoint (x : V) : + (f x - c) ^ 2 = + (f x - finiteMean f) ^ 2 + + 2 * (finiteMean f - c) * (f x - finiteMean f) + + (finiteMean f - c) ^ 2 := by + ring + have hidentity : + (∑ x : V, (f x - c) ^ 2) = + (∑ x : V, (f x - finiteMean f) ^ 2) + + (Fintype.card V : ℝ) * (finiteMean f - c) ^ 2 := by + calc + (∑ x : V, (f x - c) ^ 2) = + ∑ x : V, + ((f x - finiteMean f) ^ 2 + + 2 * (finiteMean f - c) * (f x - finiteMean f) + + (finiteMean f - c) ^ 2) := + Finset.sum_congr rfl (fun x _ => hpoint x) + _ = (∑ x : V, (f x - finiteMean f) ^ 2) + + 2 * (finiteMean f - c) * + (∑ x : V, (f x - finiteMean f)) + + (Fintype.card V : ℝ) * (finiteMean f - c) ^ 2 := by + simp only [Finset.sum_add_distrib, ← Finset.mul_sum, + Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + _ = (∑ x : V, (f x - finiteMean f) ^ 2) + + (Fintype.card V : ℝ) * (finiteMean f - c) ^ 2 := by + rw [sum_sub_finiteMean_eq_zero] + ring + rw [hidentity] + exact le_add_of_nonneg_right + (mul_nonneg (Nat.cast_nonneg _) (sq_nonneg _)) + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def lowerLevel {V : Type*} [Fintype V] + (f : V → ℝ) (a : ℝ) : Finset V := by + classical + exact Finset.univ.filter fun x => f x < a + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def upperLevel {V : Type*} [Fintype V] + (f : V → ℝ) (a : ℝ) : Finset V := by + classical + exact Finset.univ.filter fun x => a < f x + +@[simp] public theorem mem_lowerLevel {V : Type*} [Fintype V] + (f : V → ℝ) (a : ℝ) (x : V) : + x ∈ lowerLevel f a ↔ f x < a := by + classical + simp only [lowerLevel, Finset.mem_filter, Finset.mem_univ, true_and] + +@[simp] public theorem mem_upperLevel {V : Type*} [Fintype V] + (f : V → ℝ) (a : ℝ) (x : V) : + x ∈ upperLevel f a ↔ a < f x := by + classical + simp only [upperLevel, Finset.mem_filter, Finset.mem_univ, true_and] + +public +theorem exists_finite_real_median {V : Type*} [Fintype V] [Nonempty V] + (f : V → ℝ) : + ∃ m : ℝ, + 2 * (lowerLevel f m).card ≤ Fintype.card V ∧ + 2 * (upperLevel f m).card ≤ Fintype.card V := by + classical + let values : Finset ℝ := Finset.univ.image f + have hvalues : values.Nonempty := by + obtain ⟨x⟩ := ‹Nonempty V› + refine ⟨f x, ?_⟩ + exact Finset.mem_image.mpr ⟨x, Finset.mem_univ x, rfl⟩ + let a : ℝ := values.min' hvalues + have ha_values : a ∈ values := Finset.min'_mem values hvalues + have ha_lower : lowerLevel f a = ∅ := by + apply Finset.eq_empty_iff_forall_notMem.mpr + intro x hx + have hx_lt : f x < a := (mem_lowerLevel f a x).mp hx + have hx_values : f x ∈ values := + Finset.mem_image.mpr ⟨x, Finset.mem_univ x, rfl⟩ + exact (not_lt_of_ge (Finset.min'_le values (f x) hx_values)) hx_lt + let candidates : Finset ℝ := + values.filter fun c => 2 * (lowerLevel f c).card ≤ Fintype.card V + have hcandidates : candidates.Nonempty := by + refine ⟨a, ?_⟩ + apply Finset.mem_filter.mpr + refine ⟨ha_values, ?_⟩ + simp only [ha_lower, Finset.card_empty, mul_zero, zero_le] + let m : ℝ := candidates.max' hcandidates + have hm_candidates : m ∈ candidates := + Finset.max'_mem candidates hcandidates + have hm_lower : 2 * (lowerLevel f m).card ≤ Fintype.card V := + (Finset.mem_filter.mp hm_candidates).2 + refine ⟨m, hm_lower, ?_⟩ + by_contra hu + have hu_large : Fintype.card V < 2 * (upperLevel f m).card := + Nat.lt_of_not_ge hu + have hu_nonempty : (upperLevel f m).Nonempty := by + apply Finset.card_pos.mp + omega + let upperValues : Finset ℝ := (upperLevel f m).image f + have hupperValues : upperValues.Nonempty := + Finset.image_nonempty.mpr hu_nonempty + let b : ℝ := upperValues.min' hupperValues + have hb_upperValues : b ∈ upperValues := + Finset.min'_mem upperValues hupperValues + obtain ⟨z, hz_upper, hz_b⟩ := Finset.mem_image.mp hb_upperValues + have hmb : m < b := by + rw [← hz_b] + exact (mem_upperLevel f m z).mp hz_upper + have hdisjoint : Disjoint (lowerLevel f b) (upperLevel f m) := by + apply Finset.disjoint_left.mpr + intro x hx_lower hx_upper + have hx_lt : f x < b := (mem_lowerLevel f b x).mp hx_lower + have hx_image : f x ∈ upperValues := + Finset.mem_image.mpr ⟨x, hx_upper, rfl⟩ + have hb_le : b ≤ f x := + Finset.min'_le upperValues (f x) hx_image + exact (not_lt_of_ge hb_le) hx_lt + have hcard : + (lowerLevel f b).card + (upperLevel f m).card ≤ Fintype.card V := by + calc + (lowerLevel f b).card + (upperLevel f m).card = + ((lowerLevel f b) ∪ (upperLevel f m)).card := + (Finset.card_union_of_disjoint hdisjoint).symm + _ ≤ (Finset.univ : Finset V).card := + Finset.card_le_card (Finset.subset_univ _) + _ = Fintype.card V := Finset.card_univ + have hb_lower : 2 * (lowerLevel f b).card ≤ Fintype.card V := by + omega + have hb_values : b ∈ values := by + rw [← hz_b] + exact Finset.mem_image.mpr ⟨z, Finset.mem_univ z, rfl⟩ + have hb_candidates : b ∈ candidates := + Finset.mem_filter.mpr ⟨hb_values, hb_lower⟩ + have hb_le_m : b ≤ m := + Finset.le_max' candidates b hb_candidates + exact (not_le_of_gt hmb) hb_le_m + +private theorem positive_max_iff (a : ℝ) : 0 < max a 0 ↔ 0 < a := by + by_cases ha : 0 < a + · rw [max_eq_left ha.le] + · rw [max_eq_right (le_of_not_gt ha)] + simp only [lt_self_iff_false, ha] + +public +theorem positiveSupport_max_sub {V : Type*} [Fintype V] + (f : V → ℝ) (m : ℝ) : + positiveSupport (fun x => max (f x - m) 0) = upperLevel f m := by + classical + ext x + simp only [mem_positiveSupport, mem_upperLevel, + positive_max_iff, sub_pos] + +public +theorem positiveSupport_max_sub_reverse {V : Type*} [Fintype V] + (f : V → ℝ) (m : ℝ) : + positiveSupport (fun x => max (m - f x) 0) = lowerLevel f m := by + classical + ext x + simp only [mem_positiveSupport, mem_lowerLevel, + positive_max_iff, sub_pos] + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def finiteVariance {V : Type*} [Fintype V] (f : V → ℝ) : ℝ := + (∑ x : V, (f x - finiteMean f) ^ 2) / (Fintype.card V : ℝ) + +public +theorem finiteVariance_nonneg {V : Type*} [Fintype V] + (f : V → ℝ) : 0 ≤ finiteVariance f := by + unfold finiteVariance + exact div_nonneg + (Finset.sum_nonneg (fun _ _ => sq_nonneg _)) + (Nat.cast_nonneg _) + +public +theorem card_mul_finiteVariance {V : Type*} [Fintype V] [Nonempty V] + (f : V → ℝ) : + (Fintype.card V : ℝ) * finiteVariance f = + ∑ x : V, (f x - finiteMean f) ^ 2 := by + have hc : (Fintype.card V : ℝ) ≠ 0 := by + exact_mod_cast Fintype.card_ne_zero + unfold finiteVariance + field_simp + +end CheegerPoincare + +namespace ThompsonPrefixLocal + +open scoped BigOperators + +private theorem idempotentCornerUnitExtensions_commute + {A : Type*} [Ring A] {e f : A} + (he : IsIdempotentElem e) (hf : IsIdempotentElem f) + (hef : e * f = 0) (hfe : f * e = 0) + (u : he.Cornerˣ) (v : hf.Cornerˣ) : + Commute + (idempotentCornerUnitExtension he u) + (idempotentCornerUnitExtension hf v) := by + apply Units.ext + have hu := (Subsemigroup.mem_corner_iff he).mp u.val.property + have hv := (Subsemigroup.mem_corner_iff hf).mp v.val.property + have huv : u.val.val * v.val.val = 0 := by + calc + u.val.val * v.val.val = + (u.val.val * e) * (f * v.val.val) := by rw [hu.2, hv.1] + _ = u.val.val * (e * f) * v.val.val := by noncomm_ring + _ = 0 := by rw [hef]; simp only [mul_zero, zero_mul] + have hvu : v.val.val * u.val.val = 0 := by + calc + v.val.val * u.val.val = + (v.val.val * f) * (e * u.val.val) := by rw [hv.2, hu.1] + _ = v.val.val * (f * e) * u.val.val := by noncomm_ring + _ = 0 := by rw [hfe]; simp only [mul_zero, zero_mul] + have hev : e * v.val.val = 0 := by + calc + e * v.val.val = e * (f * v.val.val) := by rw [hv.1] + _ = (e * f) * v.val.val := by rw [mul_assoc] + _ = 0 := by rw [hef]; simp only [zero_mul] + have hve : v.val.val * e = 0 := by + calc + v.val.val * e = (v.val.val * f) * e := by rw [hv.2] + _ = v.val.val * (f * e) := by rw [mul_assoc] + _ = 0 := by rw [hfe]; simp only [mul_zero] + have huf : u.val.val * f = 0 := by + calc + u.val.val * f = (u.val.val * e) * f := by rw [hu.2] + _ = u.val.val * (e * f) := by rw [mul_assoc] + _ = 0 := by rw [hef]; simp only [mul_zero] + have hfu : f * u.val.val = 0 := by + calc + f * u.val.val = f * (e * u.val.val) := by rw [hu.1] + _ = (f * e) * u.val.val := by rw [mul_assoc] + _ = 0 := by rw [hfe]; simp only [zero_mul] + change + (u.val.val + (1 - e)) * (v.val.val + (1 - f)) = + (v.val.val + (1 - f)) * (u.val.val + (1 - e)) + noncomm_ring [he.eq, hf.eq, hu.1, hu.2, hv.1, hv.2, + hef, hfe, huv, hvu, hev, hve, huf, hfu] + +private theorem idempotentCornerUnitExtensions_eq_one + {A : Type*} [Ring A] {e f : A} + (he : IsIdempotentElem e) (hf : IsIdempotentElem f) + (hef : e * f = 0) + (u : he.Cornerˣ) (v : hf.Cornerˣ) + (h : idempotentCornerUnitExtension he u = + idempotentCornerUnitExtension hf v) : + idempotentCornerUnitExtension he u = 1 := by + have hu := (Subsemigroup.mem_corner_iff he).mp u.val.property + have hv := (Subsemigroup.mem_corner_iff hf).mp v.val.property + have hev : e * v.val.val = 0 := by + calc + e * v.val.val = e * (f * v.val.val) := by rw [hv.1] + _ = (e * f) * v.val.val := by rw [mul_assoc] + _ = 0 := by rw [hef, zero_mul] + have hval := congrArg (fun z : Aˣ => (z : A)) h + change u.val.val + (1 - e) = v.val.val + (1 - f) at hval + have hleft := congrArg (fun z : A => e * z) hval + have hue : u.val.val = e := by + simpa only [mul_add, hu.1, mul_sub, mul_one, he.eq, sub_self, add_zero, hev, hef, sub_zero, + zero_add] using + hleft + apply Units.ext + change u.val.val + (1 - e) = 1 + rw [hue] + noncomm_ring + +private def idempotentCornerGroup {A : Type*} [Ring A] + {e : A} (he : IsIdempotentElem e) : Subgroup Aˣ := + (idempotentCornerUnitExtension he).range + +private theorem idempotentCornerGroup_le_centralizer + {A : Type*} [Ring A] {e f : A} + (he : IsIdempotentElem e) (hf : IsIdempotentElem f) + (hef : e * f = 0) (hfe : f * e = 0) : + idempotentCornerGroup hf ≤ + Subgroup.centralizer (idempotentCornerGroup he : Set Aˣ) := by + intro z hz + obtain ⟨v, rfl⟩ := hz + apply Subgroup.mem_centralizer_iff.mpr + intro x hx + obtain ⟨u, rfl⟩ := hx + exact (idempotentCornerUnitExtensions_commute he hf hef hfe u v).eq + +private theorem idempotentCornerGroup_inf_eq_bot + {A : Type*} [Ring A] {e f : A} + (he : IsIdempotentElem e) (hf : IsIdempotentElem f) + (hef : e * f = 0) : + idempotentCornerGroup he ⊓ idempotentCornerGroup hf = ⊥ := by + apply le_antisymm + · intro z hz + obtain ⟨⟨u, hu⟩, ⟨v, hv⟩⟩ := hz + have huv : idempotentCornerUnitExtension he u = + idempotentCornerUnitExtension hf v := hu.trans hv.symm + have hone := idempotentCornerUnitExtensions_eq_one he hf hef u v huv + have hz : z = 1 := hu.symm.trans hone + simp only [hz, one_mem] + · exact bot_le + +private theorem leavittCylinder_isIdempotent (a : List (Fin 2)) : + IsIdempotentElem (leavittCylinder a) := by + change + (leavittWordS a * leavittWordT a) * + (leavittWordS a * leavittWordT a) = + leavittWordS a * leavittWordT a + calc + (leavittWordS a * leavittWordT a) * + (leavittWordS a * leavittWordT a) = + leavittWordS a * + (leavittWordT a * leavittWordS a) * leavittWordT a := by + noncomm_ring + _ = leavittWordS a * leavittWordT a := by + rw [leavittWordT_mul_wordS_self] + simp only [mul_one] + +private theorem leavittCylinder_mul_eq_zero_of_incomparable + (a b : List (Fin 2)) (hab : ¬ a <+: b) (hba : ¬ b <+: a) : + leavittCylinder a * leavittCylinder b = 0 := by + change + (leavittWordS a * leavittWordT a) * + (leavittWordS b * leavittWordT b) = 0 + calc + (leavittWordS a * leavittWordT a) * + (leavittWordS b * leavittWordT b) = + leavittWordS a * + (leavittWordT a * leavittWordS b) * leavittWordT b := by + noncomm_ring + _ = 0 := by + rw [leavittWordT_mul_wordS_of_incomparable a b hab hba] + simp only [mul_zero, zero_mul] + +private def cylinderCornerGroup (a : List (Fin 2)) : Subgroup BinaryLeavittˣ := + idempotentCornerGroup (leavittCylinder_isIdempotent a) + +private def prefixCodeIdempotent {ι : Type*} [Fintype ι] + (E : BinaryPrefixCode ι) : BinaryLeavitt := + MatrixCorner.codeIdempotent + (fun i => leavittWordS (E.word i)) + (fun i => leavittWordT (E.word i)) + +private def prefixCodeCornerGroup {ι : Type*} [Fintype ι] [DecidableEq ι] + (E : BinaryPrefixCode ι) : Subgroup BinaryLeavittˣ := + idempotentCornerGroup + (MatrixCorner.codeIdempotent_isIdempotent + (fun i => leavittWordS (E.word i)) + (fun i => leavittWordT (E.word i)) + (binaryPrefixCode_orthogonal E)) + +private theorem prefixElementaryGroup_le_corner + {ι : Type*} [Fintype ι] [DecidableEq ι] + (E : BinaryPrefixCode ι) : + prefixElementaryGroup E ≤ prefixCodeCornerGroup E := by + rw [← prefixCornerElementaryGroup_map E] + rintro _ ⟨u, _, rfl⟩ + exact ⟨(Units.mapEquiv (binaryPrefixCornerEquiv E).toMulEquiv) u, rfl⟩ + +private theorem alphaZeroWord_incomparable_local (i : Fin 3) : + ¬ alphaZeroPrefixCode.word i <+: [0, 0, 0, 1] := by + fin_cases i <;> decide + +private theorem localWord_incomparable_alphaZero (i : Fin 3) : + ¬ [0, 0, 0, 1] <+: alphaZeroPrefixCode.word i := by + fin_cases i <;> decide + +private theorem alphaZeroCode_mul_localCylinder : + prefixCodeIdempotent alphaZeroPrefixCode * + leavittCylinder [0, 0, 0, 1] = 0 := by + change + (∑ i : Fin 3, leavittCylinder (alphaZeroPrefixCode.word i)) * + leavittCylinder [0, 0, 0, 1] = 0 + rw [Finset.sum_mul] + apply Finset.sum_eq_zero + intro i hi + exact leavittCylinder_mul_eq_zero_of_incomparable + (alphaZeroPrefixCode.word i) [0, 0, 0, 1] + (alphaZeroWord_incomparable_local i) + (localWord_incomparable_alphaZero i) + +private theorem localCylinder_mul_alphaZeroCode : + leavittCylinder [0, 0, 0, 1] * + prefixCodeIdempotent alphaZeroPrefixCode = 0 := by + change + leavittCylinder [0, 0, 0, 1] * + (∑ i : Fin 3, leavittCylinder (alphaZeroPrefixCode.word i)) = 0 + rw [Finset.mul_sum] + apply Finset.sum_eq_zero + intro i hi + exact leavittCylinder_mul_eq_zero_of_incomparable + [0, 0, 0, 1] (alphaZeroPrefixCode.word i) + (localWord_incomparable_alphaZero i) + (alphaZeroWord_incomparable_local i) + +private theorem localCylinderCorner_le_centralizer_alphaZero : + cylinderCornerGroup [0, 0, 0, 1] ≤ + Subgroup.centralizer + (prefixElementaryGroup alphaZeroPrefixCode : Set BinaryLeavittˣ) := by + let he := MatrixCorner.codeIdempotent_isIdempotent + (fun i => leavittWordS (alphaZeroPrefixCode.word i)) + (fun i => leavittWordT (alphaZeroPrefixCode.word i)) + (binaryPrefixCode_orthogonal alphaZeroPrefixCode) + let hf := leavittCylinder_isIdempotent [0, 0, 0, 1] + have hef : prefixCodeIdempotent alphaZeroPrefixCode * + leavittCylinder [0, 0, 0, 1] = 0 := + alphaZeroCode_mul_localCylinder + have hfe : leavittCylinder [0, 0, 0, 1] * + prefixCodeIdempotent alphaZeroPrefixCode = 0 := + localCylinder_mul_alphaZeroCode + intro z hz + apply Subgroup.mem_centralizer_iff.mpr + intro x hx + have hx' := prefixElementaryGroup_le_corner alphaZeroPrefixCode hx + have hz' : z ∈ idempotentCornerGroup hf := hz + have hc := idempotentCornerGroup_le_centralizer he hf hef hfe hz' + exact Subgroup.mem_centralizer_iff.mp hc x hx' + +private theorem alphaZero_inf_localCylinderCorner_eq_bot : + prefixElementaryGroup alphaZeroPrefixCode ⊓ + cylinderCornerGroup [0, 0, 0, 1] = ⊥ := by + let he := MatrixCorner.codeIdempotent_isIdempotent + (fun i => leavittWordS (alphaZeroPrefixCode.word i)) + (fun i => leavittWordT (alphaZeroPrefixCode.word i)) + (binaryPrefixCode_orthogonal alphaZeroPrefixCode) + let hf := leavittCylinder_isIdempotent [0, 0, 0, 1] + have hzero := idempotentCornerGroup_inf_eq_bot he hf + alphaZeroCode_mul_localCylinder + apply le_antisymm + · intro z hz + have hx := prefixElementaryGroup_le_corner alphaZeroPrefixCode hz.1 + have hz' : z ∈ idempotentCornerGroup he ⊓ idempotentCornerGroup hf := + ⟨hx, hz.2⟩ + rw [hzero] at hz' + exact hz' + · exact bot_le + +end ThompsonPrefixLocal + +public +theorem target_majority_of_small_symmDiff + {V : Type*} [DecidableEq V] (C D : Finset V) + (hsmall : 2 * (C ∆ D).card < C.card) : + D.card < 2 * (C ∩ D).card := by + have hC := Finset.card_sdiff_add_card_inter C D + have hD := Finset.card_sdiff_add_card_inter D C + have hleft : (C \ D).card ≤ (C ∆ D).card := + Finset.card_le_card (Finset.symmDiff_subset_sdiff (s := C) (t := D)) + have hright : (D \ C).card ≤ (C ∆ D).card := + Finset.card_le_card (Finset.symmDiff_subset_sdiff' (s := C) (t := D)) + rw [Finset.inter_comm D C] at hD + omega + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def matchedRetainedFinpartition + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (R : Finset (Finset V)) + (hR : R ⊆ P.parts) : Finpartition (matchedRetainedSupport R) := + P.ofSubset hR (Finset.sup_eq_biUnion R id) + +public +theorem matchedRetainedSupport_nonempty + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (R : Finset (Finset V)) + (hR : R ⊆ P.parts) (hRne : R.Nonempty) : + (matchedRetainedSupport R).Nonempty := by + obtain ⟨C, hC⟩ := hRne + obtain ⟨x, hx⟩ := P.nonempty_of_mem_parts (hR hC) + refine ⟨x, ?_⟩ + exact Finset.mem_biUnion.mpr ⟨C, hC, by simpa only [id_eq] using hx⟩ + +private theorem partitionWordCrossing_indexed_sum_card_le_target_add_unmatched + {V ι : Type*} [DecidableEq V] {U : Finset V} + (P Q : Finpartition U) (R : Finset (Finset V)) + (hR : R ⊆ P.parts) (D : Finset V → Finset V) + (hD : ∀ C ∈ R, D C ∈ Q.parts) + (hinj : Set.InjOn D (R : Set (Finset V))) + (I : Finset ι) (w : ι → Equiv.Perm V) : + (∑ i ∈ I, (partitionWordCrossing P (w i)).card) ≤ + (∑ i ∈ I, (partitionWordCrossing Q (w i)).card) + + 2 * I.card * (U \ matchedCore R D).card := by + calc + (∑ i ∈ I, (partitionWordCrossing P (w i)).card) ≤ + ∑ i ∈ I, + ((partitionWordCrossing Q (w i)).card + + 2 * (U \ matchedCore R D).card) := + Finset.sum_le_sum fun i _ => + partitionWordCrossing_card_le_target_add_unmatched + P Q R hR D hD hinj (w i) + _ = (∑ i ∈ I, (partitionWordCrossing Q (w i)).card) + + 2 * I.card * (U \ matchedCore R D).card := by + simp only [Finset.sum_add_distrib, Finset.sum_const, smul_eq_mul, mul_comm, mul_assoc] + +public +theorem matchedRetainedSupport_cover_density_tendsto_one + {V : ℕ → Type*} [∀ n, DecidableEq (V n)] + (U : ∀ n, Finset (V n)) (hU : ∀ n, (U n).Nonempty) + (P : ∀ n, Finpartition (U n)) + (R : ∀ n, Finset (Finset (V n))) + (hR : ∀ n, R n ⊆ (P n).parts) + (hdiscard : Tendsto + (fun n => (((U n \ matchedRetainedSupport (R n)).card : ℝ) / + (U n).card)) atTop (𝓝 0)) : + Tendsto + (fun n => ((matchedRetainedSupport (R n)).card : ℝ) / (U n).card) + atTop (𝓝 1) := by + have hform (n : ℕ) : + ((matchedRetainedSupport (R n)).card : ℝ) / (U n).card = + 1 - (((U n \ matchedRetainedSupport (R n)).card : ℝ) / + (U n).card) := by + have hcard := Finset.card_sdiff_add_card_eq_card + (matchedRetainedSupport_subset (P n) (R n) (hR n)) + have hreal : + ((U n \ matchedRetainedSupport (R n)).card : ℝ) + + (matchedRetainedSupport (R n)).card = (U n).card := by + exact_mod_cast hcard + have hden : ((U n).card : ℝ) ≠ 0 := by + exact_mod_cast (hU n).card_pos.ne' + field_simp + linarith + have hlimit : Tendsto + (fun n => + (1 : ℝ) - (((U n \ matchedRetainedSupport (R n)).card : ℝ) / + (U n).card)) atTop (𝓝 1) := by + simpa only [sub_zero] using + (tendsto_const_nhds.sub hdiscard : + Tendsto + (fun n => + (1 : ℝ) - (((U n \ matchedRetainedSupport (R n)).card : ℝ) / + (U n).card)) + atTop (𝓝 ((1 : ℝ) - 0))) + convert hlimit using 1 + funext n + exact hform n + +public +theorem exists_matched_slow_diagonal_word_errors + {V : ℕ → Type*} [∀ n, DecidableEq (V n)] {ι : Type*} + (U : ∀ n, Finset (V n)) + (P Q : ∀ n, Finpartition (U n)) + (R : ∀ n, Finset (Finset (V n))) + (hR : ∀ n, R n ⊆ (P n).parts) + (D : ∀ n, Finset (V n) → Finset (V n)) + (hD : ∀ n C, C ∈ R n → D n C ∈ (Q n).parts) + (hmajor : ∀ n C, C ∈ R n → + (D n C).card < 2 * (C ∩ D n C).card) + (hdiscard : Tendsto + (fun n => (((U n \ matchedRetainedSupport (R n)).card : ℝ) / + (U n).card)) atTop (𝓝 0)) + (hsymm : Tendsto + (fun n => + ((∑ C ∈ R n, (C ∆ D n C).card : ℕ) : ℝ) / (U n).card) + atTop (𝓝 0)) + (I : ℕ → Finset ι) + (w : ∀ n, ι → Equiv.Perm (V n)) + (hword : ∀ k, Tendsto + (fun n => + ((∑ i ∈ I k, + (partitionWordCrossing (Q n) (w n i)).card : ℕ) : ℝ) / + (U n).card) + atTop (𝓝 0)) + (B : ∀ n, ℕ → Finset (V n)) + (hbad : ∀ k, Tendsto + (fun n => (((U n ∩ B n k).card : ℝ) / (U n).card)) + atTop (𝓝 0)) : + ∃ r : ℕ → ℕ, + Tendsto r atTop atTop ∧ + Tendsto + (fun n => + (((∑ i ∈ I (r n), + (partitionWordCrossing (P n) (w n i)).card : ℕ) : ℝ) + + (U n ∩ B n (r n)).card) / (U n).card) + atTop (𝓝 0) := by + have hmissing := matchedCore_missing_density_tendsto_zero + U P R hR D hdiscard hsymm + have hsource (k : ℕ) : Tendsto + (fun n => + ((∑ i ∈ I k, + (partitionWordCrossing (P n) (w n i)).card : ℕ) : ℝ) / + (U n).card) + atTop (𝓝 0) := by + have hscaled : Tendsto + (fun n => + ((2 * (I k).card : ℕ) : ℝ) * + (((U n \ matchedCore (R n) (D n)).card : ℝ) / + (U n).card)) + atTop (𝓝 0) := by + simpa only [mul_zero] using + (tendsto_const_nhds.mul hmissing : + Tendsto + (fun n => + ((2 * (I k).card : ℕ) : ℝ) * + (((U n \ matchedCore (R n) (D n)).card : ℝ) / + (U n).card)) + atTop (𝓝 (((2 * (I k).card : ℕ) : ℝ) * 0))) + have hupper : Tendsto + (fun n => + ((∑ i ∈ I k, + (partitionWordCrossing (Q n) (w n i)).card : ℕ) : ℝ) / + (U n).card + + ((2 * (I k).card : ℕ) : ℝ) * + (((U n \ matchedCore (R n) (D n)).card : ℝ) / + (U n).card)) + atTop (𝓝 0) := by + simpa only [add_zero] using (hword k).add hscaled + refine squeeze_zero (fun n => by positivity) ?_ hupper + intro n + have hcard : + ((∑ i ∈ I k, + (partitionWordCrossing (P n) (w n i)).card : ℕ) : ℝ) ≤ + ((∑ i ∈ I k, + (partitionWordCrossing (Q n) (w n i)).card : ℕ) : ℝ) + + ((2 * (I k).card : ℕ) : ℝ) * + ((U n \ matchedCore (R n) (D n)).card : ℝ) := by + exact_mod_cast + partitionWordCrossing_indexed_sum_card_le_target_add_unmatched + (P n) (Q n) (R n) (hR n) (D n) (hD n) + (finpartition_dominant_matching_injOn + (P n) (R n) (hR n) (D n) (hmajor n)) + (I k) (w n) + calc + ((∑ i ∈ I k, + (partitionWordCrossing (P n) (w n i)).card : ℕ) : ℝ) / + (U n).card ≤ + (((∑ i ∈ I k, + (partitionWordCrossing (Q n) (w n i)).card : ℕ) : ℝ) + + ((2 * (I k).card : ℕ) : ℝ) * + ((U n \ matchedCore (R n) (D n)).card : ℝ)) / + (U n).card := + div_le_div_of_nonneg_right hcard (by positivity) + _ = ((∑ i ∈ I k, + (partitionWordCrossing (Q n) (w n i)).card : ℕ) : ℝ) / + (U n).card + + ((2 * (I k).card : ℕ) : ℝ) * + (((U n \ matchedCore (R n) (D n)).card : ℝ) / + (U n).card) := by + ring + let e : ℕ → ℕ → ℝ := fun n k => + (((∑ i ∈ I k, + (partitionWordCrossing (P n) (w n i)).card : ℕ) : ℝ) + + (U n ∩ B n k).card) / (U n).card + have he_nonneg (n k : ℕ) : 0 ≤ e n k := by + dsimp [e] + positivity + have he (k : ℕ) : Tendsto (fun n => e n k) atTop (𝓝 0) := by + have hsum : Tendsto + (fun n => + ((∑ i ∈ I k, + (partitionWordCrossing (P n) (w n i)).card : ℕ) : ℝ) / + (U n).card + + ((U n ∩ B n k).card : ℝ) / (U n).card) + atTop (𝓝 0) := by + simpa only [add_zero] using (hsource k).add (hbad k) + convert hsum using 1 + funext n + dsimp [e] + ring + obtain ⟨r, hr, her⟩ := + exists_diverging_radius_with_vanishing_diagonal_error e he_nonneg he + exact ⟨r, hr, her⟩ + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def matchedRadiusBad {V ι : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (I : Finset ι) (w : ι → Equiv.Perm V) + (B : Finset V) : Finset V := + B ∪ I.biUnion fun i => partitionWordCrossing P (w i) + +public +theorem matchedRadiusBad_card_le + {V ι : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (I : Finset ι) (w : ι → Equiv.Perm V) + (B : Finset V) : + (U ∩ matchedRadiusBad P I w B).card ≤ + (U ∩ B).card + + ∑ i ∈ I, (partitionWordCrossing P (w i)).card := by + have hsubset : U ∩ matchedRadiusBad P I w B ⊆ + (U ∩ B) ∪ I.biUnion (fun i => partitionWordCrossing P (w i)) := by + intro x hx + obtain ⟨hxU, hx⟩ := Finset.mem_inter.mp hx + rcases Finset.mem_union.mp hx with hxB | hxW + · exact Finset.mem_union_left _ (Finset.mem_inter.mpr ⟨hxU, hxB⟩) + · exact Finset.mem_union_right _ hxW + have hfirst := Finset.card_le_card hsubset + have hsecond := Finset.card_union_le + (U ∩ B) (I.biUnion fun i => partitionWordCrossing P (w i)) + have hthird := Finset.card_biUnion_le + (s := I) (t := fun i => partitionWordCrossing P (w i)) + omega + +public +theorem matched_exists_le_weighted_average {ι : Type*} + (s : Finset ι) (hs : s.Nonempty) (weight bad : ι → ℝ) + (hweight : ∀ i ∈ s, 0 < weight i) : + ∃ i ∈ s, + bad i / weight i ≤ (∑ j ∈ s, bad j) / (∑ j ∈ s, weight j) := by + have hsum : 0 < ∑ j ∈ s, weight j := Finset.sum_pos hweight hs + have havg : + ∑ i ∈ s, bad i ≤ + ∑ i ∈ s, + ((∑ j ∈ s, bad j) / (∑ j ∈ s, weight j)) * weight i := by + rw [← Finset.mul_sum, div_mul_cancel₀ _ hsum.ne'] + obtain ⟨i, hi, hbound⟩ := Finset.exists_le_of_sum_le hs havg + exact ⟨i, hi, (div_le_iff₀ (hweight i hi)).2 hbound⟩ + +public +theorem matched_sum_card_inter_partition + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (B : Finset V) : + ∑ C ∈ P.parts, (C ∩ B).card = (U ∩ B).card := by + have hdis : + (P.parts : Set (Finset V)).PairwiseDisjoint + (fun C : Finset V => C ∩ B) := by + intro C hC D hD hne + exact (P.disjoint hC hD hne).mono + Finset.inter_subset_left Finset.inter_subset_left + have hunion : P.parts.biUnion (fun C => C ∩ B) = U ∩ B := by + ext x + simp only [Finset.mem_biUnion, Finset.mem_inter, ← P.biUnion_parts, id_eq] + aesop + calc + ∑ C ∈ P.parts, (C ∩ B).card = + (P.parts.biUnion fun C => C ∩ B).card := + (Finset.card_biUnion hdis).symm + _ = (U ∩ B).card := congrArg Finset.card hunion + +public +theorem matchedRetained_bad_density_tendsto_zero + {V : ℕ → Type*} [∀ n, DecidableEq (V n)] + (U : ∀ n, Finset (V n)) (hU : ∀ n, (U n).Nonempty) + (P : ∀ n, Finpartition (U n)) + (R : ∀ n, Finset (Finset (V n))) + (hR : ∀ n, R n ⊆ (P n).parts) + (hRne : ∀ n, (R n).Nonempty) + (hdiscard : Tendsto + (fun n => (((U n \ matchedRetainedSupport (R n)).card : ℝ) / + (U n).card)) atTop (𝓝 0)) + (B : ∀ n, Finset (V n)) + (hbad : Tendsto + (fun n => (((U n ∩ B n).card : ℝ) / (U n).card)) + atTop (𝓝 0)) : + Tendsto + (fun n => + (((matchedRetainedSupport (R n) ∩ B n).card : ℝ) / + (matchedRetainedSupport (R n)).card)) + atTop (𝓝 0) := by + have hcover := matchedRetainedSupport_cover_density_tendsto_one + U hU P R hR hdiscard + have hhalf : ∀ᶠ n in atTop, + (1 / 2 : ℝ) ≤ + ((matchedRetainedSupport (R n)).card : ℝ) / (U n).card := + (hcover.eventually (lt_mem_nhds (by norm_num : (1 / 2 : ℝ) < 1))).mono + fun _ h => h.le + have htwice : Tendsto + (fun n => + (2 : ℝ) * (((U n ∩ B n).card : ℝ) / (U n).card)) + atTop (𝓝 0) := by + simpa only [mul_zero] using + (tendsto_const_nhds.mul hbad : + Tendsto + (fun n => + (2 : ℝ) * (((U n ∩ B n).card : ℝ) / (U n).card)) + atTop (𝓝 ((2 : ℝ) * 0))) + refine squeeze_zero' + (Eventually.of_forall fun n => by positivity) ?_ htwice + filter_upwards [hhalf] with n hn + have hucard : (0 : ℝ) < (U n).card := by + exact_mod_cast (hU n).card_pos + have hrcard : (0 : ℝ) < (matchedRetainedSupport (R n)).card := by + exact_mod_cast + (matchedRetainedSupport_nonempty (P n) (R n) (hR n) (hRne n)).card_pos + have hmass : + ((U n).card : ℝ) ≤ 2 * (matchedRetainedSupport (R n)).card := by + have h := (le_div_iff₀ hucard).1 hn + linarith + have hbadcard : + ((matchedRetainedSupport (R n) ∩ B n).card : ℝ) ≤ + (U n ∩ B n).card := by + exact_mod_cast Finset.card_le_card + (Finset.inter_subset_inter_right + (matchedRetainedSupport_subset (P n) (R n) (hR n))) + calc + ((matchedRetainedSupport (R n) ∩ B n).card : ℝ) / + (matchedRetainedSupport (R n)).card ≤ + ((U n ∩ B n).card : ℝ) / (matchedRetainedSupport (R n)).card := + div_le_div_of_nonneg_right hbadcard hrcard.le + _ ≤ 2 * (((U n ∩ B n).card : ℝ) / (U n).card) := by + rw [← mul_div_assoc] + apply (div_le_div_iff₀ hrcard hucard).2 + simpa only [mul_comm, mul_assoc] using + (mul_le_mul_of_nonneg_left hmass (Nat.cast_nonneg (α := ℝ) (U n ∩ B n).card)) + +public +theorem matched_eventually_exists_good_vertex + {V : ℕ → Type*} [∀ n, DecidableEq (V n)] + (C B : ∀ n, Finset (V n)) (hC : ∀ n, (C n).Nonempty) + (hbad : Tendsto + (fun n => (((C n ∩ B n).card : ℝ) / (C n).card)) + atTop (𝓝 0)) : + ∀ᶠ n in atTop, ∃ x ∈ C n, x ∉ B n := by + filter_upwards [hbad.eventually (gt_mem_nhds zero_lt_one)] with n hn + by_contra h + push Not at h + have heq : C n ∩ B n = C n := Finset.inter_eq_left.2 h + have hc : ((C n).card : ℝ) ≠ 0 := by + exact_mod_cast (hC n).card_pos.ne' + rw [heq, div_self hc] at hn + exact (lt_irrefl (1 : ℝ)) hn + +namespace ComponentMidrankVariance + +open scoped BigOperators + +private def lowerRankWeight (s : Finset ℤ) (w : ℤ → ℝ) (j : ℤ) : ℝ := + (s.filter (fun i => i < j)).sum w + +private theorem sum_weighted_ordered_midpoints_sq (s : Finset ℤ) (w : ℤ → ℝ) : + (∑ j ∈ s, w j * (lowerRankWeight s w j + w j / 2) ^ 2) = + (∑ j ∈ s, w j) ^ 3 / 3 - + (∑ j ∈ s, w j ^ 3) / 12 := by + classical + induction s using Finset.induction_on_max with + | empty => simp only [lowerRankWeight, Finset.filter_empty, Finset.sum_empty, zero_add, ne_eq, + OfNat.ofNat_ne_zero, + not_false_eq_true, zero_pow, zero_div, sub_self] + | @insert a s hmax ih => + have ha : a ∉ s := by + intro ha + exact (lt_irrefl a) (hmax a ha) + have hfiltera : + (insert a s).filter (fun i : ℤ => i < a) = s := by + ext i + simp only [Finset.mem_filter, Finset.mem_insert] + constructor + · rintro ⟨hi | hi, hia⟩ + · subst i + exact (lt_irrefl _ hia).elim + · exact hi + · intro hi + exact ⟨Or.inr hi, hmax i hi⟩ + have hprefixa : + lowerRankWeight (insert a s) w a = ∑ i ∈ s, w i := by + unfold lowerRankWeight + rw [hfiltera] + have hprefix (j : ℤ) (hj : j ∈ s) : + lowerRankWeight (insert a s) w j = lowerRankWeight s w j := by + unfold lowerRankWeight + have hnot : ¬ a < j := not_lt_of_ge (le_of_lt (hmax j hj)) + rw [Finset.filter_insert, ite_eq_right hnot] + calc + (∑ j ∈ insert a s, + w j * (lowerRankWeight (insert a s) w j + w j / 2) ^ 2) = + w a * ((∑ i ∈ s, w i) + w a / 2) ^ 2 + + ∑ j ∈ s, w j * (lowerRankWeight s w j + w j / 2) ^ 2 := by + rw [Finset.sum_insert ha, hprefixa] + congr 1 + apply Finset.sum_congr rfl + intro j hj + rw [hprefix j hj] + _ = w a * ((∑ i ∈ s, w i) + w a / 2) ^ 2 + + ((∑ j ∈ s, w j) ^ 3 / 3 - + (∑ j ∈ s, w j ^ 3) / 12) := by rw [ih] + _ = (∑ j ∈ insert a s, w j) ^ 3 / 3 - + (∑ j ∈ insert a s, w j ^ 3) / 12 := by + rw [Finset.sum_insert ha, Finset.sum_insert ha] + ring + +private theorem twice_lower_rank_pairs_add_equal_rank_pairs + {V : Type*} (C : Finset V) (b : V → ℤ) : + 2 * (∑ x ∈ C, ((C.filter fun z => b z < b x).card : ℝ)) + + (∑ x ∈ C, ((C.filter fun z => b z = b x).card : ℝ)) = + (C.card : ℝ) ^ 2 := by + classical + let L : V → V → ℝ := fun x z => if b z < b x then 1 else 0 + let E : V → V → ℝ := fun x z => if b z = b x then 1 else 0 + have htri (x z : V) : L x z + L z x + E x z = 1 := by + dsimp [L, E] + split_ifs <;> norm_num <;> omega + have hswap : + (∑ x ∈ C, ∑ z ∈ C, L z x) = + ∑ x ∈ C, ∑ z ∈ C, L x z := by + rw [Finset.sum_comm] + have hlower (x : V) : + ((C.filter fun z => b z < b x).card : ℝ) = + ∑ z ∈ C, L x z := by + change ((C.filter fun z => b z < b x).card : ℝ) = + ∑ z ∈ C, if b z < b x then 1 else 0 + exact (Finset.sum_boole (fun z : V => b z < b x) C).symm + have hequal (x : V) : + ((C.filter fun z => b z = b x).card : ℝ) = + ∑ z ∈ C, E x z := by + change ((C.filter fun z => b z = b x).card : ℝ) = + ∑ z ∈ C, if b z = b x then 1 else 0 + exact (Finset.sum_boole (fun z : V => b z = b x) C).symm + simp_rw [hlower, hequal] + calc + 2 * (∑ x ∈ C, ∑ z ∈ C, L x z) + + (∑ x ∈ C, ∑ z ∈ C, E x z) = + ∑ x ∈ C, ∑ z ∈ C, (L x z + L z x + E x z) := by + simp_rw [Finset.sum_add_distrib] + rw [hswap] + ring + _ = ∑ x ∈ C, ∑ _z ∈ C, (1 : ℝ) := by + apply Finset.sum_congr rfl + intro x _ + apply Finset.sum_congr rfl + intro z _ + exact htri x z + _ = (C.card : ℝ) ^ 2 := by + simp only [Finset.sum_const, nsmul_eq_mul, mul_one, pow_two] + +private theorem sum_componentVertexMidrank + {V : Type*} + (C : Finset V) (b : V → ℤ) (hC : C.Nonempty) : + (∑ x ∈ C, componentVertexMidrank C b x) = + (C.card : ℝ) / 2 := by + have hcard : (C.card : ℝ) ≠ 0 := by + exact_mod_cast Finset.card_ne_zero.mpr hC + have hpairs := twice_lower_rank_pairs_add_equal_rank_pairs C b + unfold componentVertexMidrank + rw [← Finset.sum_div] + have hnum : + (∑ x ∈ C, + (((C.filter fun z => b z < b x).card : ℝ) + + ((C.filter fun z => b z = b x).card : ℝ) / 2)) = + (C.card : ℝ) ^ 2 / 2 := by + rw [Finset.sum_add_distrib, ← Finset.sum_div] + linarith + rw [hnum] + field_simp + +private theorem componentVertexMidrank_eq_ordered_midpoint + {V : Type*} + (C : Finset V) (b : V → ℤ) (x : V) : + componentVertexMidrank C b x = + lowerRankWeight (C.image b) (componentRankMass C b) (b x) + + componentRankMass C b (b x) / 2 := by + simpa only [lowerRankWeight] using + componentVertexMidrank_eq_sum_componentRankMass C b x + +private theorem sum_componentVertexMidrank_sq_eq + {V : Type*} + (C : Finset V) (b : V → ℤ) (hC : C.Nonempty) : + (∑ x ∈ C, componentVertexMidrank C b x ^ 2) = + (C.card : ℝ) * + ((1 : ℝ) / 3 - + (∑ j ∈ C.image b, componentRankMass C b j ^ 3) / 12) := by + classical + have hcard : (C.card : ℝ) ≠ 0 := by + exact_mod_cast Finset.card_ne_zero.mpr hC + have hfiber := Finset.sum_fiberwise_of_maps_to + (s := C) (t := C.image b) (g := b) + (fun x hx => Finset.mem_image.mpr ⟨x, hx, rfl⟩) + (fun x => componentVertexMidrank C b x ^ 2) + calc + (∑ x ∈ C, componentVertexMidrank C b x ^ 2) = + ∑ j ∈ C.image b, + ∑ x ∈ C.filter (fun x => b x = j), + componentVertexMidrank C b x ^ 2 := hfiber.symm + _ = ∑ j ∈ C.image b, + ((C.filter fun x => b x = j).card : ℝ) * + (lowerRankWeight (C.image b) (componentRankMass C b) j + + componentRankMass C b j / 2) ^ 2 := by + apply Finset.sum_congr rfl + intro j _ + calc + (∑ x ∈ C.filter (fun x => b x = j), + componentVertexMidrank C b x ^ 2) = + ∑ _x ∈ C.filter (fun x => b x = j), + (lowerRankWeight (C.image b) (componentRankMass C b) j + + componentRankMass C b j / 2) ^ 2 := by + apply Finset.sum_congr rfl + intro x hx + have hbx : b x = j := (Finset.mem_filter.mp hx).2 + rw [componentVertexMidrank_eq_ordered_midpoint C b x, hbx] + _ = ((C.filter fun x => b x = j).card : ℝ) * + (lowerRankWeight (C.image b) (componentRankMass C b) j + + componentRankMass C b j / 2) ^ 2 := by + simp only [Finset.sum_const, nsmul_eq_mul] + _ = (C.card : ℝ) * + (∑ j ∈ C.image b, + componentRankMass C b j * + (lowerRankWeight (C.image b) (componentRankMass C b) j + + componentRankMass C b j / 2) ^ 2) := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro j _ + have hweight : + ((C.filter fun x => b x = j).card : ℝ) = + (C.card : ℝ) * componentRankMass C b j := by + unfold componentRankMass + field_simp + rw [hweight] + ring + _ = (C.card : ℝ) * + (((∑ j ∈ C.image b, componentRankMass C b j) ^ 3 / 3) - + (∑ j ∈ C.image b, componentRankMass C b j ^ 3) / 12) := by + rw [sum_weighted_ordered_midpoints_sq] + _ = (C.card : ℝ) * + ((1 : ℝ) / 3 - + (∑ j ∈ C.image b, componentRankMass C b j ^ 3) / 12) := by + rw [sum_componentRankMass C b hC] + norm_num + +private theorem componentRankMassList_cube_sum + {V : Type*} + (C : Finset V) (b : V → ℤ) : + ((componentRankMassList C b).map fun p => p ^ 3).sum = + ∑ j ∈ C.image b, componentRankMass C b j ^ 3 := by + unfold componentRankMassList + simp only [List.map_map] + exact sum_map_sort_eq (C.image b) + (fun j => componentRankMass C b j ^ 3) + +private theorem componentVertexMidrank_variance_eq + {V : Type*} + (C : Finset V) (b : V → ℤ) (hC : C.Nonempty) : + (∑ x ∈ C, + (componentVertexMidrank C b x - (1 / 2 : ℝ)) ^ 2) = + (C.card : ℝ) * + midrankVariance (componentRankMassList C b) := by + have hcenter : + (∑ x ∈ C, + (componentVertexMidrank C b x - (1 / 2 : ℝ)) ^ 2) = + (∑ x ∈ C, componentVertexMidrank C b x ^ 2) - + (∑ x ∈ C, componentVertexMidrank C b x) + + (C.card : ℝ) / 4 := by + calc + (∑ x ∈ C, + (componentVertexMidrank C b x - (1 / 2 : ℝ)) ^ 2) = + ∑ x ∈ C, + (componentVertexMidrank C b x ^ 2 - + componentVertexMidrank C b x + (1 / 4 : ℝ)) := by + apply Finset.sum_congr rfl + intro x _ + ring + _ = (∑ x ∈ C, componentVertexMidrank C b x ^ 2) - + (∑ x ∈ C, componentVertexMidrank C b x) + + (C.card : ℝ) / 4 := by + rw [Finset.sum_add_distrib, Finset.sum_sub_distrib] + simp only [div_eq_mul_inv, one_mul, Finset.sum_const, nsmul_eq_mul] + calc + (∑ x ∈ C, + (componentVertexMidrank C b x - (1 / 2 : ℝ)) ^ 2) = + (C.card : ℝ) * + ((1 : ℝ) / 3 - + (∑ j ∈ C.image b, + componentRankMass C b j ^ 3) / 12) - + (C.card : ℝ) / 2 + (C.card : ℝ) / 4 := by + rw [hcenter, sum_componentVertexMidrank_sq_eq C b hC, + sum_componentVertexMidrank C b hC] + _ = (C.card : ℝ) * + midrankVariance (componentRankMassList C b) := by + rw [midrankVariance_eq + (componentRankMassList C b) + (componentRankMassList_sum C b hC), + componentRankMassList_cube_sum C b] + ring + +private theorem componentVertexMidrank_finiteMean_eq_half + {V : Type*} + (C : Finset V) (b : V → ℤ) (hC : C.Nonempty) : + CheegerPoincare.finiteMean + (fun x : {x // x ∈ C} => + componentVertexMidrank C b x) = + (1 / 2 : ℝ) := by + have hc : (C.card : ℝ) ≠ 0 := by + exact_mod_cast Finset.card_ne_zero.mpr hC + unfold CheegerPoincare.finiteMean + rw [← Finset.sum_subtype C (fun _ => Iff.rfl) + (componentVertexMidrank C b), + Fintype.card_coe, + ComponentMidrankVariance.sum_componentVertexMidrank C b hC] + field_simp + +public +theorem componentVertexMidrank_finiteVariance_eq + {V : Type*} + (C : Finset V) (b : V → ℤ) (hC : C.Nonempty) : + CheegerPoincare.finiteVariance + (fun x : {x // x ∈ C} => + componentVertexMidrank C b x) = + midrankVariance (componentRankMassList C b) := by + have hc : (C.card : ℝ) ≠ 0 := by + exact_mod_cast Finset.card_ne_zero.mpr hC + unfold CheegerPoincare.finiteVariance + rw [componentVertexMidrank_finiteMean_eq_half C b hC, + ← Finset.sum_subtype C (fun _ => Iff.rfl) + (fun x => + (componentVertexMidrank C b x - (1 / 2 : ℝ)) ^ 2), + Fintype.card_coe, + ComponentMidrankVariance.componentVertexMidrank_variance_eq + C b hC] + field_simp + +end ComponentMidrankVariance + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def insufficientOverlapComponents + {V : Type u} [DecidableEq V] {U : Finset V} + (P Q : Finpartition U) (eta : ℝ) : Finset (Finset V) := by + classical + exact P.parts.filter fun C => + ((C ∩ maximumOverlapPart Q C).card : ℝ) < + (1 - eta) * (C.card : ℝ) + +public +theorem insufficientOverlapComponents_subset + {V : Type u} [DecidableEq V] {U : Finset V} + (P Q : Finpartition U) (eta : ℝ) : + insufficientOverlapComponents P Q eta ⊆ P.parts := by + classical + exact Finset.filter_subset _ _ + +public +theorem insufficientOverlapComponents_mass_le_loss + {V : Type u} [DecidableEq V] {U : Finset V} + (P Q : Finpartition U) (eta : ℝ) : + eta * (∑ C ∈ insufficientOverlapComponents P Q eta, + (C.card : ℝ)) ≤ + ∑ C ∈ P.parts, + ((C.card : ℝ) - ((C ∩ maximumOverlapPart Q C).card : ℝ)) := by + classical + calc + eta * (∑ C ∈ insufficientOverlapComponents P Q eta, + (C.card : ℝ)) = + ∑ C ∈ insufficientOverlapComponents P Q eta, + eta * (C.card : ℝ) := by + rw [Finset.mul_sum] + _ ≤ ∑ C ∈ insufficientOverlapComponents P Q eta, + ((C.card : ℝ) - ((C ∩ maximumOverlapPart Q C).card : ℝ)) := by + apply Finset.sum_le_sum + intro C hC + have hbad := + (Finset.mem_filter.mp + (show C ∈ P.parts.filter (fun C => + ((C ∩ maximumOverlapPart Q C).card : ℝ) < + (1 - eta) * (C.card : ℝ)) from hC)).2 + linarith + _ ≤ ∑ C ∈ P.parts, + ((C.card : ℝ) - ((C ∩ maximumOverlapPart Q C).card : ℝ)) := by + apply Finset.sum_le_sum_of_subset_of_nonneg + (insufficientOverlapComponents_subset P Q eta) + intro C _ _ + exact sub_nonneg.mpr (by + exact_mod_cast Finset.card_le_card + (Finset.inter_subset_left : + C ∩ maximumOverlapPart Q C ⊆ C)) + +private noncomputable def finsetPermutationOrderIso + {V : Type u} (T : Equiv.Perm V) : Finset V ≃o Finset V where + toEquiv := T.finsetCongr + map_rel_iff' := by + intro A B + exact Finset.map_subset_map + +private noncomputable def transportedFinpartition + {V : Type u} [DecidableEq V] {U : Finset V} + (Q : Finpartition U) (T : Equiv.Perm V) : + Finpartition (U.map T.toEmbedding) := + Q.map (finsetPermutationOrderIso T) + +@[simp] +private theorem transportedFinpartition_parts + {V : Type u} [DecidableEq V] {U : Finset V} + (Q : Finpartition U) (T : Equiv.Perm V) : + (transportedFinpartition Q T).parts = + Q.parts.image (fun C : Finset V => C.map T.toEmbedding) := by + classical + change Q.parts.map (finsetPermutationOrderIso T).toEmbedding = + Q.parts.image (fun C : Finset V => C.map T.toEmbedding) + exact Finset.map_eq_image (finsetPermutationOrderIso T).toEmbedding Q.parts + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def transportedUnivFinpartition + {V : Type u} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) : Finpartition (Finset.univ : Finset V) := + (transportedFinpartition Q T).copy (Finset.map_univ_equiv T) + +@[simp] +public +theorem transportedUnivFinpartition_parts + {V : Type u} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) : + (transportedUnivFinpartition Q T).parts = + Q.parts.image (fun C : Finset V => C.map T.toEmbedding) := by + exact transportedFinpartition_parts Q T + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def partitionComponentSize + {V : Type u} [DecidableEq V] {U : Finset V} + (Q : Finpartition U) (x : V) : ℕ := + (Q.part x).card + +public +theorem partitionComponentSize_eq_card_of_mem + {V : Type u} [DecidableEq V] {U : Finset V} + (Q : Finpartition U) (C : Finset V) (hC : C ∈ Q.parts) + (x : V) (hx : x ∈ C) : + partitionComponentSize Q x = C.card := by + unfold partitionComponentSize + rw [Q.part_eq_of_mem hC hx] + +private theorem partitionComponentSize_transport_lower_of_overlap + {V : Type u} [DecidableEq V] {U : Finset V} + (Q : Finpartition U) (T : Equiv.Perm V) + (C D : Finset V) (hC : C ∈ Q.parts) (hD : D ∈ Q.parts) + (eta : ℝ) + (hoverlap : + (1 - eta) * (C.card : ℝ) ≤ + (((C.map T.toEmbedding) ∩ D).card : ℝ)) + (x : V) (hx : x ∈ C) (hTx : T x ∈ D) : + (1 - eta) * (partitionComponentSize Q x : ℝ) ≤ + (partitionComponentSize Q (T x) : ℝ) := by + rw [partitionComponentSize_eq_card_of_mem Q C hC x hx, + partitionComponentSize_eq_card_of_mem Q D hD (T x) hTx] + calc + (1 - eta) * (C.card : ℝ) ≤ + (((C.map T.toEmbedding) ∩ D).card : ℝ) := hoverlap + _ ≤ (D.card : ℝ) := by + exact_mod_cast Finset.card_le_card + (Finset.inter_subset_right : (C.map T.toEmbedding) ∩ D ⊆ D) + +public +theorem maximumOverlapPart_overlap_of_not_mem_insufficient + {V : Type u} [DecidableEq V] {U : Finset V} + (P Q : Finpartition U) (eta : ℝ) (C : Finset V) + (hC : C ∈ P.parts) + (hretained : C ∉ insufficientOverlapComponents P Q eta) : + (1 - eta) * (C.card : ℝ) ≤ + ((C ∩ maximumOverlapPart Q C).card : ℝ) := by + classical + apply le_of_not_gt + intro hbad + apply hretained + change C ∈ P.parts.filter (fun C => + ((C ∩ maximumOverlapPart Q C).card : ℝ) < + (1 - eta) * (C.card : ℝ)) + exact Finset.mem_filter.mpr ⟨hC, hbad⟩ + +public +theorem partitionComponentSize_transport_lower_of_retained + {V : Type u} [Fintype V] [DecidableEq V] + (Q : Finpartition (Finset.univ : Finset V)) + (T : Equiv.Perm V) (C : Finset V) (hC : C ∈ Q.parts) + (eta : ℝ) + (hretained : C.map T.toEmbedding ∉ + insufficientOverlapComponents + (transportedUnivFinpartition Q T) Q eta) + (x : V) (hx : x ∈ C) + (hTx : T x ∈ maximumOverlapPart Q (C.map T.toEmbedding)) : + (1 - eta) * (partitionComponentSize Q x : ℝ) ≤ + (partitionComponentSize Q (T x) : ℝ) := by + have htransport : C.map T.toEmbedding ∈ + (transportedUnivFinpartition Q T).parts := by + rw [transportedUnivFinpartition_parts] + exact Finset.mem_image_of_mem + (fun C : Finset V => C.map T.toEmbedding) hC + have hsize := maximumOverlapPart_overlap_of_not_mem_insufficient + (transportedUnivFinpartition Q T) Q eta + (C.map T.toEmbedding) htransport hretained + have hsize' : + (1 - eta) * (C.card : ℝ) ≤ + (((C.map T.toEmbedding) ∩ + maximumOverlapPart Q (C.map T.toEmbedding)).card : ℝ) := by + simpa only [Finset.card_map] using hsize + have htarget := maximumOverlapPart_mem Q + (C.map T.toEmbedding) + ((Finset.map_nonempty).2 (Q.nonempty_of_mem_parts hC)) + (Finset.subset_univ _) + exact partitionComponentSize_transport_lower_of_overlap Q T C + (maximumOverlapPart Q (C.map T.toEmbedding)) hC htarget + eta hsize' x hx hTx + +namespace ThompsonPrefixInsertion + +open scoped BigOperators + +private def singletonPrefixCode (a : List (Fin 2)) : BinaryPrefixCode (Fin 1) where + word _ := a + prefix_free := by + intro i j hij + exact (hij (Subsingleton.elim i j)).elim + +private theorem singletonPrefixCode_codeIdempotent (a : List (Fin 2)) : + MatrixCorner.codeIdempotent + (fun i => leavittWordS ((singletonPrefixCode a).word i)) + (fun i => leavittWordT ((singletonPrefixCode a).word i)) = + leavittCylinder a := by + simp only [MatrixCorner.codeIdempotent, Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, + singletonPrefixCode, Finset.sum_const, Finset.card_singleton, one_smul, leavittCylinder] + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def prefixInsertionHom (a : List (Fin 2)) : + BinaryLeavittˣ →* BinaryLeavittˣ := + (prefixCornerUnitHom (singletonPrefixCode a)).comp + (Units.mapEquiv + (Matrix.uniqueRingEquiv (m := Fin 1) + (A := BinaryLeavitt)).symm.toMulEquiv).toMonoidHom + +public +theorem prefixInsertionHom_injective (a : List (Fin 2)) : + Function.Injective (prefixInsertionHom a) := + (prefixCornerUnitHom_injective (singletonPrefixCode a)).comp + (Units.mapEquiv + (Matrix.uniqueRingEquiv (m := Fin 1) + (A := BinaryLeavitt)).symm.toMulEquiv).injective + + +private def cylinderCornerGroup (a : List (Fin 2)) : Subgroup BinaryLeavittˣ := + (idempotentCornerUnitExtension (ThompsonPrefixLocal.leavittCylinder_isIdempotent a)).range + +private theorem cylinderCornerGroup_eq_source (a : List (Fin 2)) : + cylinderCornerGroup a = ThompsonPrefixLocal.cylinderCornerGroup a := by + rfl + +private theorem prefixInsertionHom_mem_cylinderCorner + (a : List (Fin 2)) (u : BinaryLeavittˣ) : + prefixInsertionHom a u ∈ cylinderCornerGroup a := by + unfold cylinderCornerGroup + let he := MatrixCorner.codeIdempotent_isIdempotent + (fun i => leavittWordS ((singletonPrefixCode a).word i)) + (fun i => leavittWordT ((singletonPrefixCode a).word i)) + (binaryPrefixCode_orthogonal (singletonPrefixCode a)) + have hidem : + (⟨MatrixCorner.codeIdempotent + (fun i => leavittWordS ((singletonPrefixCode a).word i)) + (fun i => leavittWordT ((singletonPrefixCode a).word i)), he⟩ : + {e : BinaryLeavitt // IsIdempotentElem e}) = + ⟨leavittCylinder a, ThompsonPrefixLocal.leavittCylinder_isIdempotent a⟩ := + Subtype.ext (singletonPrefixCode_codeIdempotent a) + have hcorner := congrArg + (fun p : {e : BinaryLeavitt // IsIdempotentElem e} => + (idempotentCornerUnitExtension p.property).range) + hidem + rw [← hcorner] + refine ⟨(Units.mapEquiv + (binaryPrefixCornerEquiv (singletonPrefixCode a)).toMulEquiv) + ((Units.mapEquiv + (Matrix.uniqueRingEquiv (m := Fin 1) + (A := BinaryLeavitt)).symm.toMulEquiv) u), ?_⟩ + rfl + +public +theorem prefixInsertionHom_val (a : List (Fin 2)) (u : BinaryLeavittˣ) : + (↑(prefixInsertionHom a u) : BinaryLeavitt) = + leavittWordS a * (u : BinaryLeavitt) * leavittWordT a + + (1 - leavittCylinder a) := by + change + MatrixCorner.encode + (fun i => leavittWordS ((singletonPrefixCode a).word i)) + (fun i => leavittWordT ((singletonPrefixCode a).word i)) + ((Matrix.uniqueRingEquiv (m := Fin 1) + (A := BinaryLeavitt)).symm (u : BinaryLeavitt)) + + (1 - MatrixCorner.codeIdempotent + (fun i => leavittWordS ((singletonPrefixCode a).word i)) + (fun i => leavittWordT ((singletonPrefixCode a).word i))) = _ + simp only [MatrixCorner.encode, Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, + singletonPrefixCode, + Matrix.uniqueRingEquiv_symm_apply, Matrix.of_apply, Finset.sum_const, Finset.card_singleton, + one_smul, + MatrixCorner.codeIdempotent, leavittCylinder] + +private theorem transpositionValue_mul_self {A : Type*} [Ring A] + (sa ta sb tb : A) + (haa : ta * sa = 1) (hbb : tb * sb = 1) + (hab : ta * sb = 0) (hba : tb * sa = 0) : + PrefixCompression.transpositionValue sa ta sb tb * + PrefixCompression.transpositionValue sa ta sb tb = 1 := by + have haa' (x : A) : ta * (sa * x) = x := by + rw [← mul_assoc, haa, one_mul] + have hbb' (x : A) : tb * (sb * x) = x := by + rw [← mul_assoc, hbb, one_mul] + have hab' (x : A) : ta * (sb * x) = 0 := by + rw [← mul_assoc, hab, zero_mul] + have hba' (x : A) : tb * (sa * x) = 0 := by + rw [← mul_assoc, hba, zero_mul] + unfold PrefixCompression.transpositionValue + noncomm_ring [haa, hbb, hab, hba, haa', hbb', hab', hba'] + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def cylinderSwap (a b : List (Fin 2)) + (hab : ¬ a <+: b) (hba : ¬ b <+: a) : BinaryLeavittˣ where + val := PrefixCompression.wordSwapValue a b + inv := PrefixCompression.wordSwapValue a b + val_inv := transpositionValue_mul_self + (leavittWordS a) (leavittWordT a) + (leavittWordS b) (leavittWordT b) + (leavittWordT_mul_wordS_self a) + (leavittWordT_mul_wordS_self b) + (leavittWordT_mul_wordS_of_incomparable a b hab hba) + (leavittWordT_mul_wordS_of_incomparable b a hba hab) + inv_val := transpositionValue_mul_self + (leavittWordS a) (leavittWordT a) + (leavittWordS b) (leavittWordT b) + (leavittWordT_mul_wordS_self a) + (leavittWordT_mul_wordS_self b) + (leavittWordT_mul_wordS_of_incomparable a b hab hba) + (leavittWordT_mul_wordS_of_incomparable b a hba hab) + +private theorem append_not_prefix_append (a b x y : List (Fin 2)) + (hab : ¬ a <+: b) (hba : ¬ b <+: a) : + ¬ a ++ x <+: b ++ y := by + intro h + have ha : a <+: b ++ y := (List.prefix_append a x).trans h + by_cases hle : a.length ≤ b.length + · exact hab ((List.isPrefix_append_of_length hle).mp ha) + · apply hba + rw [List.prefix_iff_eq_take] + have hea := List.prefix_iff_eq_take.mp ha + rw [hea, List.take_take, Nat.min_eq_left (Nat.le_of_not_ge hle)] + simp only [List.take_left'] + +private theorem prepend_not_prefix_prepend (l a b : List (Fin 2)) + (hab : ¬ a <+: b) : + ¬ l ++ a <+: l ++ b := by + intro h + apply hab + simpa only [List.prefix_append_right_inj] using h + +private theorem prefixInsertionHom_cylinderSwap + (l a b : List (Fin 2)) + (hab : ¬ a <+: b) (hba : ¬ b <+: a) : + prefixInsertionHom l (cylinderSwap a b hab hba) = + cylinderSwap (l ++ a) (l ++ b) + (prepend_not_prefix_prepend l a b hab) + (prepend_not_prefix_prepend l b a hba) := by + apply Units.ext + rw [prefixInsertionHom_val] + change + leavittWordS l * + (1 - leavittWordS a * leavittWordT a - + leavittWordS b * leavittWordT b + + leavittWordS a * leavittWordT b + + leavittWordS b * leavittWordT a) * leavittWordT l + + (1 - leavittWordS l * leavittWordT l) = + 1 - leavittWordS (l ++ a) * leavittWordT (l ++ a) - + leavittWordS (l ++ b) * leavittWordT (l ++ b) + + leavittWordS (l ++ a) * leavittWordT (l ++ b) + + leavittWordS (l ++ b) * leavittWordT (l ++ a) + rw [leavittWordS_append, leavittWordT_append, + leavittWordS_append, leavittWordT_append] + simp only [CharTwo.sub_eq_add] + noncomm_ring + simp only [zsmul_eq_mul, Int.cast_ofNat, CharTwo.two_eq_zero, zero_mul, zero_add] + +private theorem transpositionValue_braid {A : Type*} [Ring A] + (sa ta sb tb sc tc : A) + (haa : ta * sa = 1) (hbb : tb * sb = 1) (hcc : tc * sc = 1) + (hab : ta * sb = 0) (hba : tb * sa = 0) + (hac : ta * sc = 0) (hca : tc * sa = 0) + (hbc : tb * sc = 0) (hcb : tc * sb = 0) : + PrefixCompression.transpositionValue sa ta sc tc * + PrefixCompression.transpositionValue sb tb sc tc * + PrefixCompression.transpositionValue sa ta sc tc = + PrefixCompression.transpositionValue sa ta sb tb := by + have haa' (x : A) : ta * (sa * x) = x := by + rw [← mul_assoc, haa, one_mul] + have hbb' (x : A) : tb * (sb * x) = x := by + rw [← mul_assoc, hbb, one_mul] + have hcc' (x : A) : tc * (sc * x) = x := by + rw [← mul_assoc, hcc, one_mul] + have hab' (x : A) : ta * (sb * x) = 0 := by + rw [← mul_assoc, hab, zero_mul] + have hba' (x : A) : tb * (sa * x) = 0 := by + rw [← mul_assoc, hba, zero_mul] + have hac' (x : A) : ta * (sc * x) = 0 := by + rw [← mul_assoc, hac, zero_mul] + have hca' (x : A) : tc * (sa * x) = 0 := by + rw [← mul_assoc, hca, zero_mul] + have hbc' (x : A) : tb * (sc * x) = 0 := by + rw [← mul_assoc, hbc, zero_mul] + have hcb' (x : A) : tc * (sb * x) = 0 := by + rw [← mul_assoc, hcb, zero_mul] + unfold PrefixCompression.transpositionValue + noncomm_ring [haa, hbb, hcc, hab, hba, hac, hca, hbc, hcb, + haa', hbb', hcc', hab', hba', hac', hca', hbc', hcb'] + +private def prefixCrossRoot {ι : Type*} [DecidableEq ι] + (E : BinaryPrefixCode ι) + (i j : ι) (hij : i ≠ j) (a b : List (Fin 2)) : BinaryLeavittˣ := + prefixElementaryUnit E i j hij + (leavittWordS a * leavittWordT b) + +private theorem prefixCrossRoot_mem {ι : Type*} [DecidableEq ι] + (E : BinaryPrefixCode ι) + (i j : ι) (hij : i ≠ j) (a b : List (Fin 2)) : + prefixCrossRoot E i j hij a b ∈ prefixElementaryGroup E := + Subgroup.subset_closure + ⟨i, j, hij, leavittWordS a * leavittWordT b, rfl⟩ + +private def prefixCrossSwap {ι : Type*} [DecidableEq ι] + (E : BinaryPrefixCode ι) + (i j : ι) (hij : i ≠ j) (a b : List (Fin 2)) : BinaryLeavittˣ := + prefixCrossRoot E i j hij a b * + prefixCrossRoot E j i hij.symm b a * + prefixCrossRoot E i j hij a b + +private theorem prefixCrossSwap_mem {ι : Type*} [DecidableEq ι] + (E : BinaryPrefixCode ι) + (i j : ι) (hij : i ≠ j) (a b : List (Fin 2)) : + prefixCrossSwap E i j hij a b ∈ prefixElementaryGroup E := + (prefixElementaryGroup E).mul_mem + ((prefixElementaryGroup E).mul_mem + (prefixCrossRoot_mem E i j hij a b) + (prefixCrossRoot_mem E j i hij.symm b a)) + (prefixCrossRoot_mem E i j hij a b) + +private theorem prefixCrossSwap_val {ι : Type*} [DecidableEq ι] + (E : BinaryPrefixCode ι) + (i j : ι) (hij : i ≠ j) (a b : List (Fin 2)) : + (↑(prefixCrossSwap E i j hij a b) : BinaryLeavitt) = + PrefixCompression.wordSwapValue + (E.word i ++ a) (E.word j ++ b) := by + let A : List (Fin 2) := E.word i ++ a + let B : List (Fin 2) := E.word j ++ b + let P : BinaryLeavitt := leavittWordS A * leavittWordT B + let Q : BinaryLeavitt := leavittWordS B * leavittWordT A + have hBA : leavittWordT B * leavittWordS A = 0 := by + apply leavittWordT_mul_wordS_of_incomparable B A + · exact append_not_prefix_append (E.word j) (E.word i) + b a (E.prefix_free hij.symm) (E.prefix_free hij) + · exact append_not_prefix_append (E.word i) (E.word j) + a b (E.prefix_free hij) (E.prefix_free hij.symm) + have hPP : P * P = 0 := by + change + (leavittWordS A * leavittWordT B) * + (leavittWordS A * leavittWordT B) = 0 + calc + (leavittWordS A * leavittWordT B) * + (leavittWordS A * leavittWordT B) = + leavittWordS A * + (leavittWordT B * leavittWordS A) * + leavittWordT B := by noncomm_ring + _ = 0 := by rw [hBA]; simp only [mul_zero, zero_mul] + have hPQP : P * Q * P = P := by + change + (leavittWordS A * leavittWordT B) * + (leavittWordS B * leavittWordT A) * + (leavittWordS A * leavittWordT B) = + leavittWordS A * leavittWordT B + calc + (leavittWordS A * leavittWordT B) * + (leavittWordS B * leavittWordT A) * + (leavittWordS A * leavittWordT B) = + leavittWordS A * + (leavittWordT B * leavittWordS B) * + (leavittWordT A * leavittWordS A) * + leavittWordT B := by noncomm_ring + _ = leavittWordS A * leavittWordT B := by + rw [leavittWordT_mul_wordS_self, + leavittWordT_mul_wordS_self] + simp only [mul_one] + have hPQ : P * Q = leavittWordS A * leavittWordT A := by + dsimp [P, Q] + calc + (leavittWordS A * leavittWordT B) * + (leavittWordS B * leavittWordT A) = + leavittWordS A * + (leavittWordT B * leavittWordS B) * + leavittWordT A := by noncomm_ring + _ = _ := by rw [leavittWordT_mul_wordS_self]; simp only [mul_one] + have hQP : Q * P = leavittWordS B * leavittWordT B := by + dsimp [P, Q] + calc + (leavittWordS B * leavittWordT A) * + (leavittWordS A * leavittWordT B) = + leavittWordS B * + (leavittWordT A * leavittWordS A) * + leavittWordT B := by noncomm_ring + _ = _ := by rw [leavittWordT_mul_wordS_self]; simp only [mul_one] + change + (1 + leavittWordS (E.word i) * + (leavittWordS a * leavittWordT b) * leavittWordT (E.word j)) * + (1 + leavittWordS (E.word j) * + (leavittWordS b * leavittWordT a) * leavittWordT (E.word i)) * + (1 + leavittWordS (E.word i) * + (leavittWordS a * leavittWordT b) * leavittWordT (E.word j)) = _ + have hleft : + leavittWordS (E.word i) * + (leavittWordS a * leavittWordT b) * leavittWordT (E.word j) = + P := by + dsimp [P, A, B] + rw [leavittWordS_append, leavittWordT_append] + noncomm_ring + have hright : + leavittWordS (E.word j) * + (leavittWordS b * leavittWordT a) * leavittWordT (E.word i) = + Q := by + dsimp [Q, A, B] + rw [leavittWordS_append, leavittWordT_append] + noncomm_ring + rw [hleft, hright, + cylinder_transposition_factorization P Q hPP hPQP, + hPQ, hQP] + rfl + +private theorem samePrefixCylinderSwap_mem {ι : Type*} [DecidableEq ι] + (E : BinaryPrefixCode ι) + (i j : ι) (hij : i ≠ j) + (a b c : List (Fin 2)) + (hab : ¬ a <+: b) (hba : ¬ b <+: a) : + cylinderSwap (E.word i ++ a) (E.word i ++ b) + (prepend_not_prefix_prepend (E.word i) a b hab) + (prepend_not_prefix_prepend (E.word i) b a hba) ∈ + prefixElementaryGroup E := by + let x := prefixCrossSwap E i j hij a c + let y := prefixCrossSwap E i j hij b c + have hx : x ∈ prefixElementaryGroup E := + prefixCrossSwap_mem E i j hij a c + have hy : y ∈ prefixElementaryGroup E := + prefixCrossSwap_mem E i j hij b c + have hfactor : x * y * x = + cylinderSwap (E.word i ++ a) (E.word i ++ b) + (prepend_not_prefix_prepend (E.word i) a b hab) + (prepend_not_prefix_prepend (E.word i) b a hba) := by + apply Units.ext + change + (↑(prefixCrossSwap E i j hij a c) : BinaryLeavitt) * + (↑(prefixCrossSwap E i j hij b c) : BinaryLeavitt) * + (↑(prefixCrossSwap E i j hij a c) : BinaryLeavitt) = + PrefixCompression.wordSwapValue (E.word i ++ a) (E.word i ++ b) + rw [prefixCrossSwap_val, prefixCrossSwap_val] + exact transpositionValue_braid + (leavittWordS (E.word i ++ a)) + (leavittWordT (E.word i ++ a)) + (leavittWordS (E.word i ++ b)) + (leavittWordT (E.word i ++ b)) + (leavittWordS (E.word j ++ c)) + (leavittWordT (E.word j ++ c)) + (leavittWordT_mul_wordS_self (E.word i ++ a)) + (leavittWordT_mul_wordS_self (E.word i ++ b)) + (leavittWordT_mul_wordS_self (E.word j ++ c)) + (leavittWordT_mul_wordS_of_incomparable + (E.word i ++ a) (E.word i ++ b) + (prepend_not_prefix_prepend (E.word i) a b hab) + (prepend_not_prefix_prepend (E.word i) b a hba)) + (leavittWordT_mul_wordS_of_incomparable + (E.word i ++ b) (E.word i ++ a) + (prepend_not_prefix_prepend (E.word i) b a hba) + (prepend_not_prefix_prepend (E.word i) a b hab)) + (leavittWordT_mul_wordS_of_incomparable + (E.word i ++ a) (E.word j ++ c) + (append_not_prefix_append (E.word i) (E.word j) a c + (E.prefix_free hij) (E.prefix_free hij.symm)) + (append_not_prefix_append (E.word j) (E.word i) c a + (E.prefix_free hij.symm) (E.prefix_free hij))) + (leavittWordT_mul_wordS_of_incomparable + (E.word j ++ c) (E.word i ++ a) + (append_not_prefix_append (E.word j) (E.word i) c a + (E.prefix_free hij.symm) (E.prefix_free hij)) + (append_not_prefix_append (E.word i) (E.word j) a c + (E.prefix_free hij) (E.prefix_free hij.symm))) + (leavittWordT_mul_wordS_of_incomparable + (E.word i ++ b) (E.word j ++ c) + (append_not_prefix_append (E.word i) (E.word j) b c + (E.prefix_free hij) (E.prefix_free hij.symm)) + (append_not_prefix_append (E.word j) (E.word i) c b + (E.prefix_free hij.symm) (E.prefix_free hij))) + (leavittWordT_mul_wordS_of_incomparable + (E.word j ++ c) (E.word i ++ b) + (append_not_prefix_append (E.word j) (E.word i) c b + (E.prefix_free hij.symm) (E.prefix_free hij)) + (append_not_prefix_append (E.word i) (E.word j) b c + (E.prefix_free hij) (E.prefix_free hij.symm))) + rw [← hfactor] + exact (prefixElementaryGroup E).mul_mem + ((prefixElementaryGroup E).mul_mem hx hy) hx + +private theorem sourceLocal_cylinderSwap_mem_alpha + (a b : List (Fin 2)) + (hab : ¬ a <+: b) (hba : ¬ b <+: a) : + prefixInsertionHom [0, 0, 0, 1] (cylinderSwap a b hab hba) ∈ + prefixElementaryGroup alphaPrefixCode := by + rw [prefixInsertionHom_cylinderSwap] + have h := samePrefixCylinderSwap_mem alphaPrefixCode + (0 : Fin 3) (1 : Fin 3) (by decide) + ([1] ++ a) ([1] ++ b) [] + (prepend_not_prefix_prepend [1] a b hab) + (prepend_not_prefix_prepend [1] b a hba) + simpa only [alphaPrefixCode, Fin.isValue, List.cons_append, List.nil_append, alphaWord] using h + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def binaryPrefixTranspositionGroup : Subgroup BinaryLeavittˣ := + Subgroup.closure + {z | ∃ (a b : List (Fin 2)) + (hab : ¬ a <+: b) (hba : ¬ b <+: a), + cylinderSwap a b hab hba = z} + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def localPrefixTranspositionGroup + (l : List (Fin 2)) : Subgroup BinaryLeavittˣ := + binaryPrefixTranspositionGroup.map (prefixInsertionHom l) + +private theorem localPrefixTranspositionGroup_le_cylinderCorner + (l : List (Fin 2)) : + localPrefixTranspositionGroup l ≤ cylinderCornerGroup l := by + rintro _ ⟨u, _, rfl⟩ + exact prefixInsertionHom_mem_cylinderCorner l u + +private theorem localPrefixTranspositionGroup_le_sourceCylinderCorner + (l : List (Fin 2)) : + localPrefixTranspositionGroup l ≤ + ThompsonPrefixLocal.cylinderCornerGroup l := by + rw [← cylinderCornerGroup_eq_source] + exact localPrefixTranspositionGroup_le_cylinderCorner l + +private theorem sourceLocalPrefixTranspositionGroup_le_alpha : + localPrefixTranspositionGroup [0, 0, 0, 1] ≤ + prefixElementaryGroup alphaPrefixCode := by + apply (Subgroup.map_le_iff_le_comap).2 + apply (Subgroup.closure_le _).2 + rintro _ ⟨a, b, hab, hba, rfl⟩ + exact sourceLocal_cylinderSwap_mem_alpha a b hab hba + +public +theorem sourceLocalPrefixTranspositionGroup_le_alpha_sourceWord : + localPrefixTranspositionGroup [0, 0, 0, 1] ≤ + prefixElementaryGroup alphaPrefixCode := by + exact sourceLocalPrefixTranspositionGroup_le_alpha + +private theorem sourceLocalPrefixTranspositionGroup_le_nine : + localPrefixTranspositionGroup [0, 0, 0, 1] ≤ + prefixElementaryGroup ninePrefixCode := + sourceLocalPrefixTranspositionGroup_le_alpha_sourceWord.trans + SourceGeneration.alphaPrefixElementaryGroup_le_nine + +private theorem sourceLocalPrefixTranspositionGroup_le_centralizer_alphaZero : + localPrefixTranspositionGroup [0, 0, 0, 1] ≤ + Subgroup.centralizer + (prefixElementaryGroup alphaZeroPrefixCode : Set BinaryLeavittˣ) := + (localPrefixTranspositionGroup_le_sourceCylinderCorner + [0, 0, 0, 1]).trans + ThompsonPrefixLocal.localCylinderCorner_le_centralizer_alphaZero + +private theorem alphaZero_inf_sourceLocalPrefixTranspositionGroup_eq_bot : + prefixElementaryGroup alphaZeroPrefixCode ⊓ + localPrefixTranspositionGroup [0, 0, 0, 1] = ⊥ := by + apply le_antisymm + · calc + prefixElementaryGroup alphaZeroPrefixCode ⊓ + localPrefixTranspositionGroup [0, 0, 0, 1] ≤ + prefixElementaryGroup alphaZeroPrefixCode ⊓ + ThompsonPrefixLocal.cylinderCornerGroup + [0, 0, 0, 1] := + inf_le_inf_left _ + (localPrefixTranspositionGroup_le_sourceCylinderCorner + [0, 0, 0, 1]) + _ = ⊥ := ThompsonPrefixLocal.alphaZero_inf_localCylinderCorner_eq_bot + · exact bot_le + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def sourceCompressedLocalProductHom : + (prefixElementaryGroup alphaZeroPrefixCode × + localPrefixTranspositionGroup [0, 0, 0, 1]) →* + BinaryLeavittˣ where + toFun x := (x.1 : BinaryLeavittˣ) * (x.2 : BinaryLeavittˣ) + map_one' := by simp only [Prod.fst_one, OneMemClass.coe_one, Prod.snd_one, mul_one] + map_mul' p q := by + have hcomm : + (q.1 : BinaryLeavittˣ) * (p.2 : BinaryLeavittˣ) = + (p.2 : BinaryLeavittˣ) * (q.1 : BinaryLeavittˣ) := + Subgroup.mem_centralizer_iff.mp + (sourceLocalPrefixTranspositionGroup_le_centralizer_alphaZero + p.2.property) + (q.1 : BinaryLeavittˣ) q.1.property + change + ((p.1 : BinaryLeavittˣ) * (q.1 : BinaryLeavittˣ)) * + ((p.2 : BinaryLeavittˣ) * (q.2 : BinaryLeavittˣ)) = + ((p.1 : BinaryLeavittˣ) * (p.2 : BinaryLeavittˣ)) * + ((q.1 : BinaryLeavittˣ) * (q.2 : BinaryLeavittˣ)) + calc + ((p.1 : BinaryLeavittˣ) * (q.1 : BinaryLeavittˣ)) * + ((p.2 : BinaryLeavittˣ) * (q.2 : BinaryLeavittˣ)) = + (p.1 : BinaryLeavittˣ) * + (((q.1 : BinaryLeavittˣ) * (p.2 : BinaryLeavittˣ)) * + (q.2 : BinaryLeavittˣ)) := by simp only [mul_assoc] + _ = (p.1 : BinaryLeavittˣ) * + (((p.2 : BinaryLeavittˣ) * (q.1 : BinaryLeavittˣ)) * + (q.2 : BinaryLeavittˣ)) := by rw [hcomm] + _ = ((p.1 : BinaryLeavittˣ) * (p.2 : BinaryLeavittˣ)) * + ((q.1 : BinaryLeavittˣ) * (q.2 : BinaryLeavittˣ)) := by + simp only [mul_assoc] + +private theorem sourceCompressedLocalProductHom_injective : + Function.Injective sourceCompressedLocalProductHom := by + apply (injective_iff_map_eq_one sourceCompressedLocalProductHom).2 + rintro ⟨k, j⟩ hone + change (k : BinaryLeavittˣ) * (j : BinaryLeavittˣ) = 1 at hone + have hkinv : (k : BinaryLeavittˣ) = (j : BinaryLeavittˣ)⁻¹ := + eq_inv_of_mul_eq_one_left hone + have hkJ : + (k : BinaryLeavittˣ) ∈ + localPrefixTranspositionGroup [0, 0, 0, 1] := by + rw [hkinv] + exact (localPrefixTranspositionGroup + [0, 0, 0, 1]).inv_mem j.property + have hkbot : + (k : BinaryLeavittˣ) ∈ + prefixElementaryGroup alphaZeroPrefixCode ⊓ + localPrefixTranspositionGroup + [0, 0, 0, 1] := + ⟨k.property, hkJ⟩ + rw [alphaZero_inf_sourceLocalPrefixTranspositionGroup_eq_bot] at hkbot + have hkone : (k : BinaryLeavittˣ) = 1 := by + simpa only [OneMemClass.coe_eq_one, Subgroup.mem_bot] using hkbot + have hjone : (j : BinaryLeavittˣ) = 1 := by + simpa only [OneMemClass.coe_eq_one, hkone, one_mul] using hone + apply Prod.ext + · exact Subtype.ext hkone + · exact Subtype.ext hjone + +private theorem sourceCompressedLocalProductHom_range_le_nine : + sourceCompressedLocalProductHom.range ≤ + prefixElementaryGroup ninePrefixCode := by + rintro _ ⟨⟨k, j⟩, rfl⟩ + exact (prefixElementaryGroup ninePrefixCode).mul_mem + (SourceGeneration.alphaPrefixElementaryGroup_le_nine + (alphaZero_prefixElementaryGroup_le k.property)) + (sourceLocalPrefixTranspositionGroup_le_nine j.property) + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def sourceCompressedLocalProductEmbedding : + (prefixElementaryGroup alphaZeroPrefixCode × + localPrefixTranspositionGroup [0, 0, 0, 1]) →* + prefixElementaryGroup ninePrefixCode := + sourceCompressedLocalProductHom.codRestrict + (prefixElementaryGroup ninePrefixCode) + (fun x => sourceCompressedLocalProductHom_range_le_nine ⟨x, rfl⟩) + +public +theorem sourceCompressedLocalProductEmbedding_injective : + Function.Injective sourceCompressedLocalProductEmbedding := by + intro x y hxy + apply sourceCompressedLocalProductHom_injective + exact congrArg Subtype.val hxy + +end ThompsonPrefixInsertion + +namespace MidrankPermutationEnergy + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def partitionVertexMidrank {V : Type*} [DecidableEq V] + {U : Finset V} (P : Finpartition U) (b : V → ℤ) (x : V) : ℝ := + componentVertexMidrank (P.part x) b x + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def rankDecreasingVertices {V : Type*} + (U : Finset V) (b : V → ℤ) (p : Equiv.Perm V) : Finset V := + U.filter (fun x => b (p x) < b x) + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def offsetFloorRank {V : Type*} (u : V → ℝ) (H r : ℝ) : V → ℤ := + fun x => ⌊(u x + r) / H⌋ + +public +theorem rankDropCount_eq_sum_rankDecreasingVertices + {V ι : Type*} [Fintype V] [Fintype ι] + (u : V → ℝ) (p : ι → Equiv.Perm V) (H r : ℝ) : + rankDropCount + (fun e : ι × V => u e.2) + (fun e : ι × V => u (p e.1 e.2)) H r = + ∑ i : ι, + ((rankDecreasingVertices Finset.univ + (offsetFloorRank u H r) (p i)).card : ℝ) := by + classical + unfold rankDropCount + rw [← Finset.univ_product_univ, Finset.sum_product] + apply Finset.sum_congr rfl + intro i hi + unfold rankDecreasingVertices offsetFloorRank + exact Finset.sum_boole + (fun x : V => + ⌊(u (p i x) + r) / H⌋ < ⌊(u x + r) / H⌋) + Finset.univ + +private def midpointDecreasingVertices {V : Type*} [DecidableEq V] + {U : Finset V} (P : Finpartition U) (b : V → ℤ) + (p : Equiv.Perm V) : Finset V := + U.filter (fun x => partitionVertexMidrank P b (p x) < + partitionVertexMidrank P b x) + +private theorem midpointDecreasing_subset_crossing_union_rankDecreasing + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (b : V → ℤ) (p : Equiv.Perm V) : + midpointDecreasingVertices P b p ⊆ + partitionWordCrossing P p ∪ rankDecreasingVertices U b p := by + intro x hx + have hxmem := (Finset.mem_filter.mp hx).1 + have hxdec := (Finset.mem_filter.mp hx).2 + by_cases hcross : p x ∈ P.part x + · apply Finset.mem_union.mpr + right + apply Finset.mem_filter.mpr + refine ⟨hxmem, ?_⟩ + by_contra hnot + have hrank : b x ≤ b (p x) := le_of_not_gt hnot + have hpart : P.part x ∈ P.parts := P.part_mem.mpr hxmem + have hsame : P.part (p x) = P.part x := + P.part_eq_of_mem hpart hcross + have hmono := componentVertexMidrank_mono (P.part x) b hrank + unfold partitionVertexMidrank at hxdec + rw [hsame] at hxdec + exact (not_lt_of_ge hmono) hxdec + · apply Finset.mem_union.mpr + left + exact Finset.mem_filter.mpr ⟨hxmem, hcross⟩ + +private theorem partitionVertexMidrank_permutation_energy_le + {V : Type*} [Fintype V] [DecidableEq V] + (P : Finpartition (Finset.univ : Finset V)) + (b : V → ℤ) (p : Equiv.Perm V) : + (∑ x : V, + (partitionVertexMidrank P b (p x) - + partitionVertexMidrank P b x) ^ 2) ≤ + 2 * ((partitionWordCrossing P p).card : ℝ) + + 2 * ((rankDecreasingVertices Finset.univ b p).card : ℝ) := by + have hbase := permutation_squared_increment_le_twice_decreasing + p (partitionVertexMidrank P b) + (fun x => componentVertexMidrank_nonneg (P.part x) b x) + (fun x => componentVertexMidrank_le_one (P.part x) b x) + have hsubset : + (Finset.univ.filter fun x => + partitionVertexMidrank P b (p x) < partitionVertexMidrank P b x) ⊆ + partitionWordCrossing P p ∪ + rankDecreasingVertices Finset.univ b p := by + exact midpointDecreasing_subset_crossing_union_rankDecreasing P b p + have hcard : + (Finset.univ.filter fun x => + partitionVertexMidrank P b (p x) < + partitionVertexMidrank P b x).card ≤ + (partitionWordCrossing P p).card + + (rankDecreasingVertices Finset.univ b p).card := + (Finset.card_le_card hsubset).trans + (Finset.card_union_le _ _) + have hcast : + ((Finset.univ.filter fun x => + partitionVertexMidrank P b (p x) < + partitionVertexMidrank P b x).card : ℝ) ≤ + ((partitionWordCrossing P p).card : ℝ) + + ((rankDecreasingVertices Finset.univ b p).card : ℝ) := by + exact_mod_cast hcard + nlinarith + +private theorem sum_partitionVertexMidrank_permutation_energy_le + {V ι : Type*} [Fintype V] [DecidableEq V] + (I : Finset ι) + (P : Finpartition (Finset.univ : Finset V)) + (b : V → ℤ) (p : ι → Equiv.Perm V) : + (∑ i ∈ I, ∑ x : V, + (partitionVertexMidrank P b (p i x) - + partitionVertexMidrank P b x) ^ 2) ≤ + 2 * (∑ i ∈ I, ((partitionWordCrossing P (p i)).card : ℝ)) + + 2 * (∑ i ∈ I, + ((rankDecreasingVertices Finset.univ b (p i)).card : ℝ)) := by + calc + (∑ i ∈ I, ∑ x : V, + (partitionVertexMidrank P b (p i x) - + partitionVertexMidrank P b x) ^ 2) ≤ + ∑ i ∈ I, + (2 * ((partitionWordCrossing P (p i)).card : ℝ) + + 2 * ((rankDecreasingVertices Finset.univ b (p i)).card : ℝ)) := by + apply Finset.sum_le_sum + intro i hi + exact partitionVertexMidrank_permutation_energy_le P b (p i) + _ = 2 * (∑ i ∈ I, ((partitionWordCrossing P (p i)).card : ℝ)) + + 2 * (∑ i ∈ I, + ((rankDecreasingVertices Finset.univ b (p i)).card : ℝ)) := by + rw [Finset.sum_add_distrib, ← Finset.mul_sum, ← Finset.mul_sum] + +public +theorem partitionVertexMidrank_permutation_energy_tendsto_zero + (V ι : ℕ → Type*) + [∀ n, Fintype (V n)] [∀ n, DecidableEq (V n)] + [∀ n, Fintype (ι n)] + (P : (n : ℕ) → Finpartition (Finset.univ : Finset (V n))) + (b : (n : ℕ) → V n → ℤ) + (p : (n : ℕ) → ι n → Equiv.Perm (V n)) + (N : ℕ → ℝ) + (hN : ∀ n, 0 < N n) + (hcross : Tendsto + (fun n => + (∑ i : ι n, ((partitionWordCrossing (P n) (p n i)).card : ℝ)) / + N n) + atTop (nhds 0)) + (hrank : Tendsto + (fun n => + (∑ i : ι n, + ((rankDecreasingVertices Finset.univ (b n) (p n i)).card : ℝ)) / + N n) + atTop (nhds 0)) : + Tendsto + (fun n => + (∑ i : ι n, ∑ x : V n, + (partitionVertexMidrank (P n) (b n) (p n i x) - + partitionVertexMidrank (P n) (b n) x) ^ 2) / N n) + atTop (nhds 0) := by + have hnonnegative : ∀ n, + 0 ≤ (∑ i : ι n, ∑ x : V n, + (partitionVertexMidrank (P n) (b n) (p n i x) - + partitionVertexMidrank (P n) (b n) x) ^ 2) / N n := by + intro n + apply div_nonneg _ (hN n).le + apply Finset.sum_nonneg + intro i hi + exact Finset.sum_nonneg fun x hx => sq_nonneg _ + have hupper : ∀ n, + (∑ i : ι n, ∑ x : V n, + (partitionVertexMidrank (P n) (b n) (p n i x) - + partitionVertexMidrank (P n) (b n) x) ^ 2) / N n ≤ + 2 * ((∑ i : ι n, + ((partitionWordCrossing (P n) (p n i)).card : ℝ)) / N n) + + 2 * ((∑ i : ι n, + ((rankDecreasingVertices Finset.univ (b n) (p n i)).card : ℝ)) / + N n) := by + intro n + have hfinite := sum_partitionVertexMidrank_permutation_energy_le + (Finset.univ : Finset (ι n)) (P n) (b n) (p n) + have hdiv := (div_le_div_iff_of_pos_right (hN n)).2 hfinite + calc + (∑ i : ι n, ∑ x : V n, + (partitionVertexMidrank (P n) (b n) (p n i x) - + partitionVertexMidrank (P n) (b n) x) ^ 2) / N n ≤ + (2 * (∑ i : ι n, + ((partitionWordCrossing (P n) (p n i)).card : ℝ)) + + 2 * (∑ i : ι n, + ((rankDecreasingVertices Finset.univ (b n) (p n i)).card : ℝ))) / + N n := hdiv + _ = 2 * ((∑ i : ι n, + ((partitionWordCrossing (P n) (p n i)).card : ℝ)) / N n) + + 2 * ((∑ i : ι n, + ((rankDecreasingVertices Finset.univ (b n) (p n i)).card : ℝ)) / + N n) := by ring + have hlimit : Tendsto + (fun n => + 2 * ((∑ i : ι n, + ((partitionWordCrossing (P n) (p n i)).card : ℝ)) / N n) + + 2 * ((∑ i : ι n, + ((rankDecreasingVertices Finset.univ (b n) (p n i)).card : ℝ)) / + N n)) + atTop (nhds 0) := by + simpa only [mul_zero, add_zero] using + (Filter.Tendsto.const_mul (2 : ℝ) hcross).add (Filter.Tendsto.const_mul (2 : ℝ) hrank) + exact squeeze_zero' + (Filter.Eventually.of_forall hnonnegative) + (Filter.Eventually.of_forall hupper) + hlimit + +end MidrankPermutationEnergy + +namespace RankArcCharging + +open scoped BigOperators + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def selectedRankSupport + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (b : V → ℤ) (j : Finset V → ℤ) : Finset V := + P.parts.biUnion (fun C => C.filter (fun x => b x = j C)) + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def rankChangingArc + {V : Type*} + (U : Finset V) (b : V → ℤ) (w : Equiv.Perm V) : Finset V := + U.filter (fun x => b (w x) ≠ b x) + +private def rankSupportPreimageBad + {V : Type*} [DecidableEq V] + (U S : Finset V) (w : Equiv.Perm V) : Finset V := + U.filter (fun x => w x ∈ U \ S) + +private theorem selectedRankSupport_subset + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (b : V → ℤ) (j : Finset V → ℤ) : + selectedRankSupport P b j ⊆ U := by + intro x hx + obtain ⟨C, hC, hxC⟩ := Finset.mem_biUnion.mp hx + exact P.subset hC (Finset.mem_filter.mp hxC).1 + +private theorem selectedRankSupport_card + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (b : V → ℤ) (j : Finset V → ℤ) : + (selectedRankSupport P b j).card = + ∑ C ∈ P.parts, (C.filter fun x => b x = j C).card := by + unfold selectedRankSupport + apply Finset.card_biUnion + intro C hC D hD hne + exact (P.disjoint hC hD hne).mono + (Finset.filter_subset _ _) (Finset.filter_subset _ _) + +public +theorem card_sdiff_selectedRankSupport + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (b : V → ℤ) (j : Finset V → ℤ) : + (U \ selectedRankSupport P b j).card = + ∑ C ∈ P.parts, + (C.card - (C.filter fun x => b x = j C).card) := by + rw [Finset.card_sdiff_of_subset (selectedRankSupport_subset P b j), + selectedRankSupport_card] + rw [Finset.sum_tsub_distrib] + · rw [P.sum_card_parts] + · intro C hC + exact Finset.card_le_card (Finset.filter_subset _ _) + +private theorem selectedRankSupport_rank_eq + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (b : V → ℤ) (j : Finset V → ℤ) + {x : V} (hx : x ∈ selectedRankSupport P b j) : + b x = j (P.part x) := by + obtain ⟨C, hC, hxC⟩ := Finset.mem_biUnion.mp hx + obtain ⟨hxmem, hxrank⟩ := Finset.mem_filter.mp hxC + have hpart : P.part x = C := P.part_eq_of_mem hC hxmem + simpa only [hpart] using hxrank + +private theorem rankSupportPreimageBad_card_le + {V : Type*} [DecidableEq V] + (U S : Finset V) (w : Equiv.Perm V) : + (rankSupportPreimageBad U S w).card ≤ (U \ S).card := by + apply Finset.card_le_card_of_injOn w + · intro x hx + exact (Finset.mem_filter.mp hx).2 + · intro x hx y hy hxy + exact w.injective hxy + +private theorem rankChangingArc_subset_crossing_or_unselected + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (b : V → ℤ) (j : Finset V → ℤ) + (w : Equiv.Perm V) : + rankChangingArc U b w ⊆ + partitionWordCrossing P w ∪ + (U \ selectedRankSupport P b j) ∪ + rankSupportPreimageBad U (selectedRankSupport P b j) w := by + intro x hx + obtain ⟨hxU, hxchange⟩ := Finset.mem_filter.mp hx + by_cases hxselected : x ∈ selectedRankSupport P b j + · by_cases hcross : w x ∈ P.part x + · by_cases hwselected : w x ∈ selectedRankSupport P b j + · exfalso + apply hxchange + have hpart : P.part (w x) = P.part x := + P.part_eq_of_mem (P.part_mem.mpr hxU) hcross + rw [selectedRankSupport_rank_eq P b j hwselected, + selectedRankSupport_rank_eq P b j hxselected, hpart] + · have hwU : w x ∈ U := P.part_subset x hcross + exact Finset.mem_union_right _ + (Finset.mem_filter.mpr + ⟨hxU, Finset.mem_sdiff.mpr ⟨hwU, hwselected⟩⟩) + · exact Finset.mem_union_left _ + (Finset.mem_union_left _ + (Finset.mem_filter.mpr ⟨hxU, hcross⟩)) + · exact Finset.mem_union_left _ + (Finset.mem_union_right _ + (Finset.mem_sdiff.mpr ⟨hxU, hxselected⟩)) + +private theorem rankChangingArc_card_le_crossing_add_unselected + {V : Type*} [DecidableEq V] {U : Finset V} + (P : Finpartition U) (b : V → ℤ) (j : Finset V → ℤ) + (w : Equiv.Perm V) : + (rankChangingArc U b w).card ≤ + (partitionWordCrossing P w).card + + 2 * (U \ selectedRankSupport P b j).card := by + have hsubset := Finset.card_le_card + (rankChangingArc_subset_crossing_or_unselected P b j w) + have hfirst := Finset.card_union_le + (partitionWordCrossing P w) (U \ selectedRankSupport P b j) + have hsecond := Finset.card_union_le + (partitionWordCrossing P w ∪ (U \ selectedRankSupport P b j)) + (rankSupportPreimageBad U (selectedRankSupport P b j) w) + have hpre := rankSupportPreimageBad_card_le + U (selectedRankSupport P b j) w + omega + +public +theorem rankChangingArc_density_tendsto_zero + (V : ℕ → Type*) [∀ n, DecidableEq (V n)] + (U : ∀ n, Finset (V n)) + (P : ∀ n, Finpartition (U n)) + (b : ∀ n, V n → ℤ) + (j : ∀ n, Finset (V n) → ℤ) + (w : ∀ n, Equiv.Perm (V n)) + (N : ℕ → ℝ) (hN : ∀ n, 0 < N n) + (hcross : Filter.Tendsto + (fun n => ((partitionWordCrossing (P n) (w n)).card : ℝ) / N n) + Filter.atTop (nhds 0)) + (homit : Filter.Tendsto + (fun n => + (((U n \ selectedRankSupport (P n) (b n) (j n)).card : ℝ) / + N n)) + Filter.atTop (nhds 0)) : + Filter.Tendsto + (fun n => ((rankChangingArc (U n) (b n) (w n)).card : ℝ) / N n) + Filter.atTop (nhds 0) := by + have hnonnegative : ∀ n, + 0 ≤ ((rankChangingArc (U n) (b n) (w n)).card : ℝ) / N n := by + intro n + exact div_nonneg (Nat.cast_nonneg _) (hN n).le + have hupper : ∀ n, + ((rankChangingArc (U n) (b n) (w n)).card : ℝ) / N n ≤ + ((partitionWordCrossing (P n) (w n)).card : ℝ) / N n + + 2 * (((U n \ selectedRankSupport (P n) (b n) (j n)).card : ℝ) / + N n) := by + intro n + have hnat := rankChangingArc_card_le_crossing_add_unselected + (P n) (b n) (j n) (w n) + have hreal : + ((rankChangingArc (U n) (b n) (w n)).card : ℝ) ≤ + ((partitionWordCrossing (P n) (w n)).card : ℝ) + + 2 * ((U n \ selectedRankSupport (P n) (b n) (j n)).card : ℝ) := by + exact_mod_cast hnat + calc + ((rankChangingArc (U n) (b n) (w n)).card : ℝ) / N n ≤ + (((partitionWordCrossing (P n) (w n)).card : ℝ) + + 2 * ((U n \ selectedRankSupport (P n) (b n) (j n)).card : ℝ)) / + N n := + div_le_div_of_nonneg_right hreal (hN n).le + _ = ((partitionWordCrossing (P n) (w n)).card : ℝ) / N n + + 2 * (((U n \ selectedRankSupport (P n) (b n) (j n)).card : ℝ) / + N n) := by + ring + have hlimit : Filter.Tendsto + (fun n => + ((partitionWordCrossing (P n) (w n)).card : ℝ) / N n + + 2 * (((U n \ selectedRankSupport (P n) (b n) (j n)).card : ℝ) / + N n)) + Filter.atTop (nhds 0) := by + simpa only [mul_zero, add_zero] using hcross.add (Filter.Tendsto.const_mul (2 : ℝ) homit) + exact squeeze_zero' + (Filter.Eventually.of_forall hnonnegative) + (Filter.Eventually.of_forall hupper) + hlimit + +end RankArcCharging + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def permutationDistance {V : Type*} [Fintype V] [DecidableEq V] + (p q : Equiv.Perm V) : ℕ := + hammingDist (fun x => p x) (fun x => q x) + +@[simp] +public +theorem permutationDistance_self {V : Type*} [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) : permutationDistance p p = 0 := by + simp only [permutationDistance, hammingDist_self] + +private theorem permutationDistance_comm {V : Type*} [Fintype V] [DecidableEq V] + (p q : Equiv.Perm V) : permutationDistance p q = permutationDistance q p := by + exact hammingDist_comm _ _ + +private theorem permutationDistance_triangle {V : Type*} + [Fintype V] [DecidableEq V] (p q r : Equiv.Perm V) : + permutationDistance p r ≤ permutationDistance p q + permutationDistance q r := + hammingDist_triangle _ _ _ + +private theorem permutationDistance_mul_left {V : Type*} + [Fintype V] [DecidableEq V] (s p q : Equiv.Perm V) : + permutationDistance (s * p) (s * q) = permutationDistance p q := by + have h := hammingDist_comp (fun (_ : V) (x : V) => s x) + (x := fun x => p x) (y := fun x => q x) (fun _ => s.injective) + simpa only [permutationDistance, Equiv.Perm.mul_apply] using h + +private theorem permutationDistance_mul_right {V : Type*} + [Fintype V] [DecidableEq V] (s p q : Equiv.Perm V) : + permutationDistance (p * s) (q * s) = permutationDistance p q := by + unfold permutationDistance hammingDist + apply Finset.card_bij (fun x _ => s x) + · intro x hx + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + simpa only [Equiv.Perm.mul_apply] using (Finset.mem_filter.mp hx).2 + · intro x hx y hy h + exact s.injective h + · intro y hy + refine ⟨s.symm y, ?_, by simp only [Equiv.apply_symm_apply]⟩ + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + simpa only [Equiv.Perm.mul_apply, Equiv.apply_symm_apply] using + (Finset.mem_filter.mp hy).2 + +private theorem permutationDistance_mul_le {V : Type*} + [Fintype V] [DecidableEq V] (p p' q q' : Equiv.Perm V) : + permutationDistance (p * q) (p' * q') ≤ + permutationDistance p p' + permutationDistance q q' := by + calc + permutationDistance (p * q) (p' * q') ≤ + permutationDistance (p * q) (p' * q) + + permutationDistance (p' * q) (p' * q') := + permutationDistance_triangle _ _ _ + _ = permutationDistance p p' + permutationDistance q q' := by + rw [permutationDistance_mul_right, permutationDistance_mul_left] + +private theorem permutationDistance_inv {V : Type*} + [Fintype V] [DecidableEq V] (p q : Equiv.Perm V) : + permutationDistance p⁻¹ q⁻¹ = permutationDistance p q := by + calc + permutationDistance p⁻¹ q⁻¹ = + permutationDistance (q * p⁻¹) (q * q⁻¹) := + (permutationDistance_mul_left q p⁻¹ q⁻¹).symm + _ = permutationDistance (q * p⁻¹) 1 := by simp only [mul_inv_cancel] + _ = permutationDistance ((q * p⁻¹) * p) (1 * p) := + (permutationDistance_mul_right p (q * p⁻¹) 1).symm + _ = permutationDistance q p := by simp only [inv_mul_cancel_right, one_mul] + _ = permutationDistance p q := permutationDistance_comm q p + +@[simp] +public +theorem permutationCommutationDefect_one {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) : + permutationCommutationDefect σ 1 = 0 := by + simp only [permutationCommutationDefect, Equiv.Perm.coe_one, id_eq, ne_eq, not_true_eq_false, + Finset.filter_false, Finset.card_empty, Finset.sum_const_zero] + +private theorem permutationCommutationDefect_inv {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (c : Equiv.Perm V) : + permutationCommutationDefect σ c⁻¹ = permutationCommutationDefect σ c := by + classical + unfold permutationCommutationDefect + apply Finset.sum_congr rfl + intro i _ + apply Finset.card_bij (fun x _ => c⁻¹ x) + · intro x hx + have hbad := (Finset.mem_filter.mp hx).2 + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + intro heq + apply hbad + apply c.injective + simpa only [Equiv.Perm.coe_inv, Equiv.apply_symm_apply] using heq.symm + · intro x hx y hy heq + exact (c⁻¹).injective heq + · intro y hy + have hbad := (Finset.mem_filter.mp hy).2 + refine ⟨c y, ?_, by simp only [Equiv.Perm.coe_inv, Equiv.symm_apply_apply]⟩ + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + intro heq + apply hbad + have heq' := congrArg c heq + simpa only [Equiv.Perm.coe_inv, Equiv.symm_apply_apply, Equiv.apply_symm_apply] using heq'.symm + +private theorem permutationCommutationDefect_mul_le {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (p q : Equiv.Perm V) : + permutationCommutationDefect σ (p * q) ≤ + permutationCommutationDefect σ p + permutationCommutationDefect σ q := by + classical + unfold permutationCommutationDefect + rw [← Finset.sum_add_distrib] + apply Finset.sum_le_sum + intro i _ + let Bp : Finset V := + Finset.univ.filter fun x => p (σ i x) ≠ σ i (p x) + let Bq : Finset V := + Finset.univ.filter fun x => q (σ i x) ≠ σ i (q x) + let C : Finset V := + Finset.univ.filter fun x => q x ∈ Bp + have hC : C.card = Bp.card := by + apply Finset.card_bij (fun x _ => q x) + · intro x hx + exact (Finset.mem_filter.mp hx).2 + · intro x hx y hy hxy + exact q.injective hxy + · intro y hy + refine ⟨q.symm y, ?_, by simp only [Equiv.apply_symm_apply]⟩ + exact Finset.mem_filter.mpr + ⟨Finset.mem_univ _, by simpa only [Equiv.apply_symm_apply] using hy⟩ + have hsub : + (Finset.univ.filter fun x => + (p * q) (σ i x) ≠ σ i ((p * q) x)) ⊆ Bq ∪ C := by + intro x hx + have hbad := (Finset.mem_filter.mp hx).2 + by_cases hq : q (σ i x) = σ i (q x) + · apply Finset.mem_union_right + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + intro hp + apply hbad + simpa only [Equiv.Perm.mul_apply, hq] using hp + · apply Finset.mem_union_left + exact Finset.mem_filter.mpr ⟨Finset.mem_univ _, hq⟩ + calc + (Finset.univ.filter fun x => + (p * q) (σ i x) ≠ σ i ((p * q) x)).card ≤ + (Bq ∪ C).card := Finset.card_le_card hsub + _ ≤ Bq.card + C.card := Finset.card_union_le Bq C + _ = Bp.card + Bq.card := by rw [hC, Nat.add_comm] + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +structure AlmostCentralizerElement {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (tolerance : ℕ) where + /-- Internal interface connecting the split non-sofic proof modules. -/ + permutation : Equiv.Perm V + defect_le : permutationCommutationDefect σ permutation ≤ tolerance + +@[ext (iff := false)] +private theorem AlmostCentralizerElement.ext {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + {σ : ι → Equiv.Perm V} {tolerance : ℕ} + (p q : AlmostCentralizerElement σ tolerance) + (h : p.permutation = q.permutation) : p = q := by + cases p with + | mk p hp => + cases q with + | mk q hq => + cases h + rfl + +private instance almostCentralizerElementFinite {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (tolerance : ℕ) : + Finite (AlmostCentralizerElement σ tolerance) := + Finite.of_injective (fun p => p.permutation) + (fun p q hpq => AlmostCentralizerElement.ext p q hpq) + +private structure AlmostCentralizerGap {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (tolerance : ℕ) : Prop where + dichotomy : ∀ p q : AlmostCentralizerElement σ tolerance, + 5 * permutationDistance p.permutation q.permutation ≤ Fintype.card V ∨ + 4 * Fintype.card V < + 5 * permutationDistance p.permutation q.permutation + +private theorem almostCentralizerGap_of_expansion {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (tolerance : ℕ) (h : ℝ) + (hpositive : 0 < h) + (hexp : ∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ (boundary σ A : ℝ)) + (hsmall : (10 : ℝ) * tolerance < h * Fintype.card V) : + AlmostCentralizerGap σ tolerance := by + constructor + intro p q + have hdef : + ((permutationCommutationDefect σ p.permutation + + permutationCommutationDefect σ q.permutation : ℕ) : ℝ) ≤ + 2 * (tolerance : ℝ) := by + have hnat : permutationCommutationDefect σ p.permutation + + permutationCommutationDefect σ q.permutation ≤ 2 * tolerance := by + have hp := p.defect_le + have hq := q.defect_le + omega + exact_mod_cast hnat + rcases hamming_dichotomy_of_expansion σ h hexp p.permutation q.permutation with + hnear | hfar + · left + by_contra hnot + have hlarge : Fintype.card V < + 5 * permutationDistance p.permutation q.permutation := + Nat.lt_of_not_ge hnot + have hlarge' : (Fintype.card V : ℝ) < + 5 * (permutationDistance p.permutation q.permutation : ℝ) := by + exact_mod_cast hlarge + have hpos : 0 < h * + (5 * (permutationDistance p.permutation q.permutation : ℝ) - + Fintype.card V) := + mul_pos hpositive (sub_pos.mpr hlarge') + change h * (permutationDistance p.permutation q.permutation : ℝ) ≤ _ + at hnear + nlinarith + · right + by_contra hnot + have hlarge : + 5 * permutationDistance p.permutation q.permutation ≤ + 4 * Fintype.card V := Nat.le_of_not_gt hnot + have hlarge' : + 5 * (permutationDistance p.permutation q.permutation : ℝ) ≤ + 4 * (Fintype.card V : ℝ) := by + exact_mod_cast hlarge + have hpos : 0 ≤ h * + (4 * (Fintype.card V : ℝ) - + 5 * (permutationDistance p.permutation q.permutation : ℝ)) := + mul_nonneg hpositive.le (sub_nonneg.mpr hlarge') + change h * ((Fintype.card V : ℝ) - + permutationDistance p.permutation q.permutation) ≤ _ at hfar + nlinarith + +private def almostCentralizerSetoid {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (tolerance : ℕ) + (hgap : AlmostCentralizerGap σ tolerance) : + Setoid (AlmostCentralizerElement σ tolerance) where + r p q := 5 * permutationDistance p.permutation q.permutation ≤ Fintype.card V + iseqv := by + refine ⟨?_, ?_, ?_⟩ + · intro p + simp only [permutationDistance_self, mul_zero, zero_le] + · intro p q hpq + simpa only [permutationDistance_comm q.permutation p.permutation] using hpq + · intro p q r hpq hqr + rcases hgap.dichotomy p r with hclose | hfar + · exact hclose + · have htri := permutationDistance_triangle + p.permutation q.permutation r.permutation + omega + +private abbrev AlmostCentralizerClusters {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (tolerance : ℕ) + (hgap : AlmostCentralizerGap σ tolerance) := + Quotient (almostCentralizerSetoid σ tolerance hgap) + +private def almostCentralizerCluster {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + {σ : ι → Equiv.Perm V} {tolerance : ℕ} + (hgap : AlmostCentralizerGap σ tolerance) + (p : AlmostCentralizerElement σ tolerance) : + AlmostCentralizerClusters σ tolerance hgap := + Quotient.mk (almostCentralizerSetoid σ tolerance hgap) p + +private theorem almostCentralizerCluster_eq_iff {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + {σ : ι → Equiv.Perm V} {tolerance : ℕ} + (hgap : AlmostCentralizerGap σ tolerance) + (p q : AlmostCentralizerElement σ tolerance) : + almostCentralizerCluster hgap p = almostCentralizerCluster hgap q ↔ + 5 * permutationDistance p.permutation q.permutation ≤ Fintype.card V := by + exact Quotient.eq + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +structure AlmostCentralizerRepair {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (tolerance : ℕ) where + /-- Internal interface connecting the split non-sofic proof modules. -/ + correct : Equiv.Perm V → Equiv.Perm V + corrected_defect : ∀ p q : AlmostCentralizerElement σ tolerance, + permutationCommutationDefect σ + (correct (p.permutation * q.permutation)) ≤ tolerance + corrected_distance : ∀ p q : AlmostCentralizerElement σ tolerance, + 5 * permutationDistance + (correct (p.permutation * q.permutation)) + (p.permutation * q.permutation) ≤ Fintype.card V + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +structure HasAlmostCentralizerImprovement {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (tolerance : ℕ) : Prop where + improve : ∀ p : Equiv.Perm V, + permutationCommutationDefect σ p ≤ 2 * tolerance → + ∃ q : Equiv.Perm V, + permutationCommutationDefect σ q ≤ tolerance ∧ + 5 * permutationDistance q p ≤ Fintype.card V + +private def almostCentralizerRepairOfImprovement {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + {σ : ι → Equiv.Perm V} {tolerance : ℕ} + (h : HasAlmostCentralizerImprovement σ tolerance) : + AlmostCentralizerRepair σ tolerance := by + classical + let correction : Equiv.Perm V → Equiv.Perm V := fun p => + if hp : permutationCommutationDefect σ p ≤ 2 * tolerance then + (h.improve p hp).choose + else p + refine ⟨correction, ?_, ?_⟩ + · intro p q + have hprod := permutationCommutationDefect_mul_le σ + p.permutation q.permutation + have hp := p.defect_le + have hq := q.defect_le + have hgood : permutationCommutationDefect σ + (p.permutation * q.permutation) ≤ 2 * tolerance := by + omega + change permutationCommutationDefect σ + (correction (p.permutation * q.permutation)) ≤ tolerance + simpa [correction, hgood] using + (h.improve (p.permutation * q.permutation) hgood).choose_spec.1 + · intro p q + have hprod := permutationCommutationDefect_mul_le σ + p.permutation q.permutation + have hp := p.defect_le + have hq := q.defect_le + have hgood : permutationCommutationDefect σ + (p.permutation * q.permutation) ≤ 2 * tolerance := by + omega + change 5 * permutationDistance + (correction (p.permutation * q.permutation)) + (p.permutation * q.permutation) ≤ Fintype.card V + simpa [correction, hgood] using + (h.improve (p.permutation * q.permutation) hgood).choose_spec.2 + +private def correctedAlmostCentralizerProduct {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + {σ : ι → Equiv.Perm V} {tolerance : ℕ} + (R : AlmostCentralizerRepair σ tolerance) + (p q : AlmostCentralizerElement σ tolerance) : + AlmostCentralizerElement σ tolerance := + ⟨R.correct (p.permutation * q.permutation), R.corrected_defect p q⟩ + +private theorem correctedAlmostCentralizerProduct_congr {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + {σ : ι → Equiv.Perm V} {tolerance : ℕ} + (hgap : AlmostCentralizerGap σ tolerance) + (R : AlmostCentralizerRepair σ tolerance) + {p p' q q' : AlmostCentralizerElement σ tolerance} + (hp : 5 * permutationDistance p.permutation p'.permutation ≤ + Fintype.card V) + (hq : 5 * permutationDistance q.permutation q'.permutation ≤ + Fintype.card V) : + 5 * permutationDistance + (correctedAlmostCentralizerProduct R p q).permutation + (correctedAlmostCentralizerProduct R p' q').permutation ≤ + Fintype.card V := by + let a := correctedAlmostCentralizerProduct R p q + let b := correctedAlmostCentralizerProduct R p' q' + have ha := R.corrected_distance p q + have hb := R.corrected_distance p' q' + have hmul := permutationDistance_mul_le + p.permutation p'.permutation q.permutation q'.permutation + have htri₁ := permutationDistance_triangle a.permutation + (p.permutation * q.permutation) b.permutation + have htri₂ := permutationDistance_triangle + (p.permutation * q.permutation) + (p'.permutation * q'.permutation) b.permutation + have hsym : + permutationDistance (p'.permutation * q'.permutation) b.permutation = + permutationDistance b.permutation + (p'.permutation * q'.permutation) := + permutationDistance_comm _ _ + change 5 * permutationDistance a.permutation b.permutation ≤ + Fintype.card V + rcases hgap.dichotomy a b with hclose | hfar + · exact hclose + · change 4 * Fintype.card V < + 5 * permutationDistance a.permutation b.permutation at hfar + change 5 * permutationDistance a.permutation + (p.permutation * q.permutation) ≤ Fintype.card V at ha + change 5 * permutationDistance b.permutation + (p'.permutation * q'.permutation) ≤ Fintype.card V at hb + omega + +private def almostCentralizerClusterMul {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + {σ : ι → Equiv.Perm V} {tolerance : ℕ} + (hgap : AlmostCentralizerGap σ tolerance) + (R : AlmostCentralizerRepair σ tolerance) : + AlmostCentralizerClusters σ tolerance hgap → + AlmostCentralizerClusters σ tolerance hgap → + AlmostCentralizerClusters σ tolerance hgap := + Quotient.map₂ (correctedAlmostCentralizerProduct R) + (fun _ _ hp _ _ hq => + correctedAlmostCentralizerProduct_congr hgap R hp hq) + +private def almostCentralizerOne {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (tolerance : ℕ) : + AlmostCentralizerElement σ tolerance := + ⟨1, by simp only [permutationCommutationDefect_one, zero_le]⟩ + +private def almostCentralizerInverse {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + {σ : ι → Equiv.Perm V} {tolerance : ℕ} + (p : AlmostCentralizerElement σ tolerance) : + AlmostCentralizerElement σ tolerance := + ⟨p.permutation⁻¹, by + rw [permutationCommutationDefect_inv] + exact p.defect_le⟩ + +private def almostCentralizerClusterInv {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + {σ : ι → Equiv.Perm V} {tolerance : ℕ} + (hgap : AlmostCentralizerGap σ tolerance) : + AlmostCentralizerClusters σ tolerance hgap → + AlmostCentralizerClusters σ tolerance hgap := + Quotient.map almostCentralizerInverse (by + intro p q hpq + change 5 * permutationDistance p.permutation⁻¹ q.permutation⁻¹ ≤ + Fintype.card V + rwa [permutationDistance_inv]) + +private theorem correctedAlmostCentralizerProduct_assoc {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + {σ : ι → Equiv.Perm V} {tolerance : ℕ} + (hgap : AlmostCentralizerGap σ tolerance) + (R : AlmostCentralizerRepair σ tolerance) + (p q r : AlmostCentralizerElement σ tolerance) : + 5 * permutationDistance + (correctedAlmostCentralizerProduct R + (correctedAlmostCentralizerProduct R p q) r).permutation + (correctedAlmostCentralizerProduct R p + (correctedAlmostCentralizerProduct R q r)).permutation ≤ + Fintype.card V := by + let a := correctedAlmostCentralizerProduct R p q + let b := correctedAlmostCentralizerProduct R q r + let l := correctedAlmostCentralizerProduct R a r + let t := correctedAlmostCentralizerProduct R p b + have hl := R.corrected_distance a r + have ht := R.corrected_distance p b + have ha := R.corrected_distance p q + have hb := R.corrected_distance q r + have ha' : + 5 * permutationDistance + (a.permutation * r.permutation) + ((p.permutation * q.permutation) * r.permutation) ≤ + Fintype.card V := by + rw [permutationDistance_mul_right] + exact ha + have hb' : + 5 * permutationDistance + ((p.permutation * q.permutation) * r.permutation) + (p.permutation * b.permutation) ≤ Fintype.card V := by + rw [mul_assoc, permutationDistance_mul_left, + permutationDistance_comm] + exact hb + have ht' : + 5 * permutationDistance + (p.permutation * b.permutation) t.permutation ≤ + Fintype.card V := by + rw [permutationDistance_comm] + exact ht + have htri₁ := permutationDistance_triangle l.permutation + (a.permutation * r.permutation) t.permutation + have htri₂ := permutationDistance_triangle + (a.permutation * r.permutation) + ((p.permutation * q.permutation) * r.permutation) t.permutation + have htri₃ := permutationDistance_triangle + ((p.permutation * q.permutation) * r.permutation) + (p.permutation * b.permutation) t.permutation + change 5 * permutationDistance l.permutation t.permutation ≤ + Fintype.card V + rcases hgap.dichotomy l t with hclose | hfar + · exact hclose + · change 4 * Fintype.card V < + 5 * permutationDistance l.permutation t.permutation at hfar + change 5 * permutationDistance l.permutation + (a.permutation * r.permutation) ≤ Fintype.card V at hl + omega + +@[instance_reducible] +private def almostCentralizerClusterGroup {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + {σ : ι → Equiv.Perm V} {tolerance : ℕ} + (hgap : AlmostCentralizerGap σ tolerance) + (R : AlmostCentralizerRepair σ tolerance) : + Group (AlmostCentralizerClusters σ tolerance hgap) := by + letI : One (AlmostCentralizerClusters σ tolerance hgap) := + ⟨almostCentralizerCluster hgap (almostCentralizerOne σ tolerance)⟩ + letI : Mul (AlmostCentralizerClusters σ tolerance hgap) := + ⟨almostCentralizerClusterMul hgap R⟩ + letI : Inv (AlmostCentralizerClusters σ tolerance hgap) := + ⟨almostCentralizerClusterInv hgap⟩ + apply Group.ofLeftAxioms + · intro x y z + induction x, y, z using Quotient.inductionOn₃ with + | _ p q r => + apply Quotient.sound + exact correctedAlmostCentralizerProduct_assoc hgap R p q r + · intro x + induction x using Quotient.inductionOn with + | _ p => + apply Quotient.sound + change 5 * permutationDistance + (R.correct (1 * p.permutation)) p.permutation ≤ Fintype.card V + simpa only [one_mul, almostCentralizerOne] using R.corrected_distance (almostCentralizerOne σ + tolerance) p + · intro x + induction x using Quotient.inductionOn with + | _ p => + apply Quotient.sound + change 5 * permutationDistance + (R.correct (p.permutation⁻¹ * p.permutation)) 1 ≤ Fintype.card V + simpa only [inv_mul_cancel, almostCentralizerInverse] using + R.corrected_distance (almostCentralizerInverse p) p + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +structure ExpandingCentralizerFiniteModel (G : Type*) [Group G] + (F : Finset G) where + /-- Internal interface connecting the split non-sofic proof modules. -/ + vertices : Type + /-- Internal interface connecting the split non-sofic proof modules. -/ + [verticesFintype : Fintype vertices] + /-- Internal interface connecting the split non-sofic proof modules. -/ + [verticesDecidableEq : DecidableEq vertices] + /-- Internal interface connecting the split non-sofic proof modules. -/ + generatorIndex : Type + /-- Internal interface connecting the split non-sofic proof modules. -/ + [generatorFintype : Fintype generatorIndex] + /-- Internal interface connecting the split non-sofic proof modules. -/ + generators : generatorIndex → Equiv.Perm vertices + /-- Internal interface connecting the split non-sofic proof modules. -/ + tolerance : ℕ + /-- Internal interface connecting the split non-sofic proof modules. -/ + cheeger : ℝ + cheeger_positive : 0 < cheeger + expansion : ∀ A : Finset vertices, + cheeger * min (A.card : ℝ) + ((Fintype.card vertices : ℝ) - A.card) ≤ + (boundary generators A : ℝ) + small : (10 : ℝ) * tolerance < cheeger * Fintype.card vertices + /-- Internal interface connecting the split non-sofic proof modules. -/ + repair : AlmostCentralizerRepair generators tolerance + /-- Internal interface connecting the split non-sofic proof modules. -/ + approximation : G → AlmostCentralizerElement generators tolerance + map_one : (approximation 1).permutation = 1 + multiplicative : ∀ x ∈ F, ∀ y ∈ F, + 5 * permutationDistance (approximation (x * y)).permutation + ((approximation x).permutation * (approximation y).permutation) ≤ + Fintype.card vertices + separated : ∀ x ∈ F, ∀ y ∈ F, x ≠ y → + Fintype.card vertices < + 5 * permutationDistance + (approximation x).permutation (approximation y).permutation + +private instance expandingCentralizerFiniteModelVerticesFintype + {G : Type*} [Group G] {F : Finset G} + (M : ExpandingCentralizerFiniteModel G F) : Fintype M.vertices := + M.verticesFintype + +private instance expandingCentralizerFiniteModelVerticesDecidableEq + {G : Type*} [Group G] {F : Finset G} + (M : ExpandingCentralizerFiniteModel G F) : DecidableEq M.vertices := + M.verticesDecidableEq + +private instance expandingCentralizerFiniteModelGeneratorFintype + {G : Type*} [Group G] {F : Finset G} + (M : ExpandingCentralizerFiniteModel G F) : Fintype M.generatorIndex := + M.generatorFintype + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def expandingCentralizerFiniteModelOfImprovement + {G : Type*} [Group G] (F : Finset G) + {V ι : Type} [Fintype V] [DecidableEq V] [Fintype ι] + (σ : ι → Equiv.Perm V) (tolerance : ℕ) (h : ℝ) + (hpositive : 0 < h) + (hexp : ∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ (boundary σ A : ℝ)) + (hsmall : (10 : ℝ) * tolerance < h * Fintype.card V) + (himprove : HasAlmostCentralizerImprovement σ tolerance) + (f : G → AlmostCentralizerElement σ tolerance) + (hone : (f 1).permutation = 1) + (hmul : ∀ x ∈ F, ∀ y ∈ F, + 5 * permutationDistance (f (x * y)).permutation + ((f x).permutation * (f y).permutation) ≤ Fintype.card V) + (hsep : ∀ x ∈ F, ∀ y ∈ F, x ≠ y → + Fintype.card V < 5 * permutationDistance + (f x).permutation (f y).permutation) : + ExpandingCentralizerFiniteModel G F where + vertices := V + verticesFintype := inferInstance + verticesDecidableEq := inferInstance + generatorIndex := ι + generatorFintype := inferInstance + generators := σ + tolerance := tolerance + cheeger := h + cheeger_positive := hpositive + expansion := hexp + small := hsmall + repair := almostCentralizerRepairOfImprovement himprove + approximation := f + map_one := hone + multiplicative := hmul + separated := hsep + +private theorem exists_finite_group_embedding_of_expanding_centralizer + {G : Type*} [Group G] (F : Finset G) + (M : ExpandingCentralizerFiniteModel G F) : + ∃ (H : Type) (_ : Group H) (_ : Finite H) (f : G → H), + Set.InjOn f (F : Set G) ∧ f 1 = 1 ∧ + ∀ x ∈ F, ∀ y ∈ F, f (x * y) = f x * f y := by + let hgap : AlmostCentralizerGap M.generators M.tolerance := + almostCentralizerGap_of_expansion M.generators M.tolerance M.cheeger + M.cheeger_positive M.expansion M.small + let H := AlmostCentralizerClusters M.generators M.tolerance hgap + let : Group H := almostCentralizerClusterGroup hgap M.repair + let : Finite H := inferInstance + let f : G → H := fun x => almostCentralizerCluster hgap (M.approximation x) + refine ⟨H, inferInstance, inferInstance, f, ?_, ?_, ?_⟩ + · intro x hx y hy hxy + by_contra hne + have hclose : + 5 * permutationDistance + (M.approximation x).permutation + (M.approximation y).permutation ≤ Fintype.card M.vertices := + (almostCentralizerCluster_eq_iff hgap + (M.approximation x) (M.approximation y)).mp hxy + have hfar := M.separated x hx y hy hne + omega + · change almostCentralizerCluster hgap (M.approximation 1) = + almostCentralizerCluster hgap + (almostCentralizerOne M.generators M.tolerance) + apply Quotient.sound + change 5 * permutationDistance (M.approximation 1).permutation 1 ≤ + Fintype.card M.vertices + simp only [M.map_one, permutationDistance_self, mul_zero, zero_le] + · intro x hx y hy + change almostCentralizerCluster hgap (M.approximation (x * y)) = + almostCentralizerCluster hgap + (correctedAlmostCentralizerProduct M.repair + (M.approximation x) (M.approximation y)) + apply Quotient.sound + let a := M.approximation (x * y) + let b := correctedAlmostCentralizerProduct M.repair + (M.approximation x) (M.approximation y) + change 5 * permutationDistance a.permutation b.permutation ≤ + Fintype.card M.vertices + rcases hgap.dichotomy a b with hclose | hfar + · exact hclose + · have hmul := M.multiplicative x hx y hy + have hrepair := M.repair.corrected_distance + (M.approximation x) (M.approximation y) + have htri := permutationDistance_triangle a.permutation + ((M.approximation x).permutation * + (M.approximation y).permutation) b.permutation + have hsym : + permutationDistance + ((M.approximation x).permutation * + (M.approximation y).permutation) b.permutation = + permutationDistance b.permutation + ((M.approximation x).permutation * + (M.approximation y).permutation) := + permutationDistance_comm _ _ + change 4 * Fintype.card M.vertices < + 5 * permutationDistance a.permutation b.permutation at hfar + change 5 * permutationDistance a.permutation + ((M.approximation x).permutation * + (M.approximation y).permutation) ≤ Fintype.card M.vertices at hmul + change 5 * permutationDistance b.permutation + ((M.approximation x).permutation * + (M.approximation y).permutation) ≤ + Fintype.card M.vertices at hrepair + omega + +private theorem exists_permutation_embedding_of_expanding_centralizer + {G : Type*} [Group G] (F : Finset G) + (M : ExpandingCentralizerFiniteModel G F) : + ∃ (n : ℕ) (f : G → Equiv.Perm (Fin n)), + Set.InjOn f (F : Set G) ∧ f 1 = 1 ∧ + ∀ x ∈ F, ∀ y ∈ F, f (x * y) = f x * f y := by + obtain ⟨H, hgroup, hfinite, f, hinj, hone, hmul⟩ := + exists_finite_group_embedding_of_expanding_centralizer F M + let : Group H := hgroup + let : Finite H := hfinite + let : Fintype H := Fintype.ofFinite H + let e : H ≃ Fin (Fintype.card H) := Fintype.equivFin H + let ρ : H →* Equiv.Perm (Fin (Fintype.card H)) := + e.permCongrHom.toMonoidHom.comp (MulAction.toPermHom H H) + have hρ : Function.Injective ρ := + e.permCongrHom.injective.comp MulAction.toPerm_injective + refine ⟨Fintype.card H, fun x => ρ (f x), ?_, ?_, ?_⟩ + · intro x hx y hy hxy + exact hinj hx hy (hρ hxy) + · simp only [hone, map_one] + · intro x hx y hy + change ρ (f (x * y)) = ρ (f x) * ρ (f y) + rw [hmul x hx y hy, map_mul] + +public +theorem lef_of_expanding_centralizer_models {G : Type*} [Group G] + (hmodels : ∀ F : Finset G, + Nonempty (ExpandingCentralizerFiniteModel G F)) : LEF G := by + constructor + intro F + obtain ⟨M⟩ := hmodels F + obtain ⟨n, f, hinj, hone, hmul⟩ := + exists_permutation_embedding_of_expanding_centralizer F M + exact ⟨n, f, hinj, ⟨hone, hmul⟩⟩ + +private theorem exists_positive_antitone_slow_vanishing_threshold + (e : ℕ → ℝ) (he_nonneg : ∀ n, 0 ≤ e n) + (he : Tendsto e atTop (nhds 0)) : + ∃ eta : ℕ → ℝ, + (∀ n, 0 < eta n) ∧ Antitone eta ∧ + Tendsto eta atTop (nhds 0) ∧ + Tendsto (fun n => e n / eta n) atTop (nhds 0) := by + have hrange : BddAbove (Set.range e) := he.bddAbove_range + have htail_bdd (n : ℕ) : BddAbove (e '' Set.Ici n) := by + apply hrange.mono + rintro y ⟨k, hk, rfl⟩ + exact ⟨k, rfl⟩ + have htail_ne (n : ℕ) : (e '' Set.Ici n).Nonempty := by + refine ⟨e n, ?_⟩ + exact ⟨n, Set.mem_Ici.mpr (le_refl n), rfl⟩ + let d : ℕ → ℝ := fun n => sSup (e '' Set.Ici n) + have hd_dom (n : ℕ) : e n ≤ d n := by + dsimp [d] + apply le_csSup (htail_bdd n) + exact ⟨n, Set.mem_Ici.mpr (le_refl n), rfl⟩ + have hd_nonneg (n : ℕ) : 0 ≤ d n := + (he_nonneg n).trans (hd_dom n) + have hd_antitone : Antitone d := by + intro a b hab + change sSup (e '' Set.Ici b) ≤ sSup (e '' Set.Ici a) + apply csSup_le_csSup (htail_bdd a) (htail_ne b) + rintro y ⟨k, hk, rfl⟩ + exact ⟨k, Set.mem_Ici.mpr (hab.trans (Set.mem_Ici.mp hk)), rfl⟩ + have hd_zero : Tendsto d atTop (nhds 0) := by + apply tendsto_order.2 + constructor + · intro a ha + exact Eventually.of_forall fun n => lt_of_lt_of_le ha (hd_nonneg n) + · intro a ha + have hev : ∀ᶠ k in atTop, e k < a / 2 := + he.eventually (gt_mem_nhds (half_pos ha)) + obtain ⟨N, hN⟩ := eventually_atTop.mp hev + filter_upwards [eventually_ge_atTop N] with n hn + have hle : d n ≤ a / 2 := by + dsimp [d] + apply csSup_le (htail_ne n) + rintro y ⟨k, hk, rfl⟩ + exact (hN k (hn.trans (Set.mem_Ici.mp hk))).le + exact hle.trans_lt (half_lt_self ha) + let q : ℕ → ℝ := fun n => 1 / ((n : ℝ) + 1) + have hq_pos (n : ℕ) : 0 < q n := by + dsimp [q] + positivity + have hq_antitone : Antitone q := by + intro a b hab + dsimp [q] + apply one_div_le_one_div_of_le (by positivity) + have hab_real : (a : ℝ) ≤ b := by + exact_mod_cast hab + exact add_le_add hab_real (le_refl 1) + have hq_zero : Tendsto q atTop (nhds 0) := by + dsimp [q] + exact tendsto_one_div_add_atTop_nhds_zero_nat + let eta : ℕ → ℝ := fun n => Real.sqrt (d n + q n) + have heta_pos (n : ℕ) : 0 < eta n := by + dsimp [eta] + apply Real.sqrt_pos.2 + exact lt_of_lt_of_le (hq_pos n) (le_add_of_nonneg_left (hd_nonneg n)) + have heta_antitone : Antitone eta := by + intro a b hab + dsimp [eta] + exact Real.sqrt_le_sqrt (add_le_add (hd_antitone hab) (hq_antitone hab)) + have hsum_zero : Tendsto (fun n => d n + q n) atTop (nhds 0) := by + simpa only [add_zero] using hd_zero.add hq_zero + have heta_zero : Tendsto eta atTop (nhds 0) := by + simpa only [eta, Function.comp_def, Real.sqrt_zero] using + (Real.continuous_sqrt.tendsto (0 : ℝ)).comp hsum_zero + have hratio_bound (n : ℕ) : e n / eta n ≤ eta n := by + apply (div_le_iff₀ (heta_pos n)).2 + calc + e n ≤ d n := hd_dom n + _ ≤ d n + q n := le_add_of_nonneg_right (hq_pos n).le + _ = eta n * eta n := by + dsimp [eta] + nlinarith [Real.sq_sqrt (add_nonneg (hd_nonneg n) (hq_pos n).le)] + refine ⟨eta, heta_pos, heta_antitone, heta_zero, ?_⟩ + exact squeeze_zero (fun n => div_nonneg (he_nonneg n) (heta_pos n).le) + hratio_bound heta_zero + +public +theorem exists_positive_antitone_slow_overlap_scales + (e : ℕ → ℝ) (he_nonneg : ∀ n, 0 ≤ e n) + (he : Tendsto e atTop (nhds 0)) : + ∃ eta H : ℕ → ℝ, + (∀ n, 0 < eta n) ∧ Antitone eta ∧ + Tendsto eta atTop (nhds 0) ∧ + (∀ n, 0 < H n) ∧ Antitone H ∧ + Tendsto H atTop (nhds 0) ∧ + Tendsto (fun n => e n / eta n) atTop (nhds 0) ∧ + Tendsto (fun n => eta n / H n) atTop (nhds 0) := by + obtain ⟨eta, heta_pos, heta_antitone, heta_zero, herror_zero⟩ := + exists_positive_antitone_slow_vanishing_threshold e he_nonneg he + let H : ℕ → ℝ := fun n => Real.sqrt (eta n) + have hH_pos (n : ℕ) : 0 < H n := by + exact Real.sqrt_pos.2 (heta_pos n) + have hH_antitone : Antitone H := by + intro a b hab + exact Real.sqrt_le_sqrt (heta_antitone hab) + have hH_zero : Tendsto H atTop (nhds 0) := by + simpa only [H, Function.comp_def, Real.sqrt_zero] using + (Real.continuous_sqrt.tendsto (0 : ℝ)).comp heta_zero + have hquot (n : ℕ) : eta n / H n = H n := by + dsimp [H] + apply (div_eq_iff (Real.sqrt_pos.2 (heta_pos n)).ne').2 + nlinarith [Real.sq_sqrt (heta_pos n).le] + have hquot_zero : Tendsto (fun n => eta n / H n) atTop (nhds 0) := by + have hfun : (fun n => eta n / H n) = H := funext hquot + rw [hfun] + exact hH_zero + exact ⟨eta, H, heta_pos, heta_antitone, heta_zero, + hH_pos, hH_antitone, hH_zero, herror_zero, hquot_zero⟩ + +namespace ExceptionalRankOffset + +open Filter Topology +open scoped BigOperators + +private theorem rankDropCount_goodSubtype_eq + {ι : Type*} + (G : Finset ι) (u v : ι → ℝ) (H r : ℝ) : + rankDropCount + (fun i : {i // i ∈ G} => u i.1) + (fun i : {i // i ∈ G} => v i.1) H r = + ∑ i ∈ G, + if ⌊(v i + r) / H⌋ < ⌊(u i + r) / H⌋ then (1 : ℝ) else 0 := by + classical + unfold rankDropCount + rw [Finset.univ_eq_attach] + change + (∑ i ∈ G.attach, + if ⌊(v i.1 + r) / H⌋ < ⌊(u i.1 + r) / H⌋ then (1 : ℝ) else 0) = + ∑ i ∈ G, + if ⌊(v i + r) / H⌋ < ⌊(u i + r) / H⌋ then (1 : ℝ) else 0 + exact Finset.sum_attach G + (fun i : ι => + if ⌊(v i + r) / H⌋ < ⌊(u i + r) / H⌋ then (1 : ℝ) else 0) + +private theorem rankDropCount_le_goodSubtype_add_exceptions + {ι : Type*} [Fintype ι] [DecidableEq ι] + (G : Finset ι) (u v : ι → ℝ) (H r : ℝ) : + rankDropCount u v H r ≤ + rankDropCount + (fun i : {i // i ∈ G} => u i.1) + (fun i : {i // i ∈ G} => v i.1) H r + + (((Finset.univ : Finset ι) \ G).card : ℝ) := by + classical + let d : ι → ℝ := fun i => + if ⌊(v i + r) / H⌋ < ⌊(u i + r) / H⌋ then 1 else 0 + have hgood : + rankDropCount + (fun i : {i // i ∈ G} => u i.1) + (fun i : {i // i ∈ G} => v i.1) H r = + ∑ i ∈ G, d i := by + exact rankDropCount_goodSubtype_eq G u v H r + have hfull : rankDropCount u v H r = ∑ i : ι, d i := by + rfl + have hsplit : + (∑ i ∈ (Finset.univ : Finset ι) \ G, d i) + + (∑ i ∈ G, d i) = ∑ i : ι, d i := + Finset.sum_sdiff (Finset.subset_univ G) + have hbad : + (∑ i ∈ (Finset.univ : Finset ι) \ G, d i) ≤ + (((Finset.univ : Finset ι) \ G).card : ℝ) := by + calc + (∑ i ∈ (Finset.univ : Finset ι) \ G, d i) ≤ + ∑ _i ∈ (Finset.univ : Finset ι) \ G, (1 : ℝ) := by + apply Finset.sum_le_sum + intro i hi + dsimp [d] + split_ifs <;> norm_num + _ = (((Finset.univ : Finset ι) \ G).card : ℝ) := by simp only [Finset.sum_const, nsmul_eq_mul, + mul_one] + rw [hfull, hgood] + linarith + +private theorem exists_common_log_rank_offset_except + {ι : Type*} [Fintype ι] [DecidableEq ι] + (G : Finset ι) (x y : ι → ℝ) (eta H : ℝ) + (hx : ∀ i ∈ G, 0 < x i) + (heta0 : 0 ≤ eta) (heta1 : eta < 1) (hH : 0 < H) + (hcomparison : ∀ i ∈ G, (1 - eta) * x i ≤ y i) : + ∃ r ∈ Set.Ico 0 H, + rankDropCount + (fun i => Real.log (x i)) + (fun i => Real.log (y i)) H r ≤ + (G.card : ℝ) * |Real.log (1 - eta)| / H + + (((Finset.univ : Finset ι) \ G).card : ℝ) := by + obtain ⟨r, hr, hbound⟩ := exists_common_log_rank_offset + (fun i : {i // i ∈ G} => x i.1) + (fun i : {i // i ∈ G} => y i.1) + eta H + (fun i => hx i.1 i.2) + heta0 heta1 hH + (fun i => hcomparison i.1 i.2) + have hbound' : + rankDropCount + (fun i : {i // i ∈ G} => Real.log (x i.1)) + (fun i : {i // i ∈ G} => Real.log (y i.1)) H r ≤ + (G.card : ℝ) * |Real.log (1 - eta)| / H := by + simpa only [Fintype.card_coe] using hbound + refine ⟨r, hr, ?_⟩ + calc + rankDropCount + (fun i => Real.log (x i)) + (fun i => Real.log (y i)) H r ≤ + rankDropCount + (fun i : {i // i ∈ G} => Real.log (x i.1)) + (fun i : {i // i ∈ G} => Real.log (y i.1)) H r + + (((Finset.univ : Finset ι) \ G).card : ℝ) := + rankDropCount_le_goodSubtype_add_exceptions G + (fun i => Real.log (x i)) (fun i => Real.log (y i)) H r + _ ≤ (G.card : ℝ) * |Real.log (1 - eta)| / H + + (((Finset.univ : Finset ι) \ G).card : ℝ) := + add_le_add hbound' (le_refl _) + +public +theorem exists_common_log_rank_offsets_tendsto_zero_except + (ι : ℕ → Type*) + [∀ n, Fintype (ι n)] [∀ n, DecidableEq (ι n)] + (G : (n : ℕ) → Finset (ι n)) + (x y : (n : ℕ) → ι n → ℝ) + (eta H N : ℕ → ℝ) (C : ℝ) + (hx : ∀ n i, i ∈ G n → 0 < x n i) + (heta0 : ∀ n, 0 ≤ eta n) + (heta1 : ∀ n, eta n < 1) + (hH : ∀ n, 0 < H n) + (hN : ∀ n, 0 < N n) + (hcard : ∀ n, ((G n).card : ℝ) ≤ C * N n) + (hcomparison : ∀ n i, i ∈ G n → + (1 - eta n) * x n i ≤ y n i) + (heta : Tendsto eta atTop (nhds 0)) + (hratio : Tendsto (fun n => eta n / H n) atTop (nhds 0)) + (hexceptions : Tendsto + (fun n => + (((Finset.univ : Finset (ι n)) \ G n).card : ℝ) / N n) + atTop (nhds 0)) : + ∃ r : ℕ → ℝ, + (∀ n, r n ∈ Set.Ico 0 (H n)) ∧ + Tendsto + (fun n => + rankDropCount + (fun i => Real.log (x n i)) + (fun i => Real.log (y n i)) (H n) (r n) / N n) + atTop (nhds 0) := by + have hwitness : ∀ n, ∃ r ∈ Set.Ico 0 (H n), + rankDropCount + (fun i => Real.log (x n i)) + (fun i => Real.log (y n i)) (H n) r ≤ + ((G n).card : ℝ) * |Real.log (1 - eta n)| / H n + + (((Finset.univ : Finset (ι n)) \ G n).card : ℝ) := by + intro n + exact exists_common_log_rank_offset_except + (G n) (x n) (y n) (eta n) (H n) + (hx n) (heta0 n) (heta1 n) (hH n) (hcomparison n) + choose r hr hbound using hwitness + refine ⟨r, hr, ?_⟩ + have hlog := abs_log_one_sub_div_tendsto_zero + eta H heta0 hH heta hratio + have hscaled : Tendsto + (fun n => C * (|Real.log (1 - eta n)| / H n)) + atTop (nhds 0) := by + simpa only [mul_zero] using Filter.Tendsto.const_mul C hlog + have hlimit : Tendsto + (fun n => + C * (|Real.log (1 - eta n)| / H n) + + (((Finset.univ : Finset (ι n)) \ G n).card : ℝ) / N n) + atTop (nhds 0) := by + simpa only [add_zero] using hscaled.add hexceptions + have hnonnegative : ∀ n, + 0 ≤ rankDropCount + (fun i => Real.log (x n i)) + (fun i => Real.log (y n i)) (H n) (r n) / N n := by + intro n + exact div_nonneg + (rankDropCount_nonneg_and_le + (fun i => Real.log (x n i)) + (fun i => Real.log (y n i)) (H n) (r n)).1 + (hN n).le + have hupper : ∀ n, + rankDropCount + (fun i => Real.log (x n i)) + (fun i => Real.log (y n i)) (H n) (r n) / N n ≤ + C * (|Real.log (1 - eta n)| / H n) + + (((Finset.univ : Finset (ι n)) \ G n).card : ℝ) / N n := by + intro n + calc + rankDropCount + (fun i => Real.log (x n i)) + (fun i => Real.log (y n i)) (H n) (r n) / N n ≤ + (((G n).card : ℝ) * |Real.log (1 - eta n)| / H n + + (((Finset.univ : Finset (ι n)) \ G n).card : ℝ)) / N n := + (div_le_div_iff_of_pos_right (hN n)).2 (hbound n) + _ = (((G n).card : ℝ) / N n) * + (|Real.log (1 - eta n)| / H n) + + (((Finset.univ : Finset (ι n)) \ G n).card : ℝ) / N n := by + ring + _ ≤ C * (|Real.log (1 - eta n)| / H n) + + (((Finset.univ : Finset (ι n)) \ G n).card : ℝ) / N n := by + apply add_le_add + · apply mul_le_mul_of_nonneg_right + ((div_le_iff₀ (hN n)).2 (hcard n)) + exact div_nonneg (abs_nonneg _) (hH n).le + · exact le_refl _ + exact squeeze_zero' + (Filter.Eventually.of_forall hnonnegative) + (Filter.Eventually.of_forall hupper) + hlimit + +end ExceptionalRankOffset + +namespace ThompsonPrefixInsertion + +private theorem cylinderSwap_mul_wordS_right + (a b : List (Fin 2)) + (hab : ¬ a <+: b) (hba : ¬ b <+: a) : + (↑(cylinderSwap a b hab hba) : BinaryLeavitt) * + leavittWordS b = leavittWordS a := by + change + PrefixCompression.transpositionValue + (leavittWordS a) (leavittWordT a) + (leavittWordS b) (leavittWordT b) * + leavittWordS b = leavittWordS a + simp only [PrefixCompression.transpositionValue, add_mul, sub_mul, one_mul, mul_assoc, + leavittWordT_mul_wordS_of_incomparable a b hab hba, mul_zero, sub_zero, + leavittWordT_mul_wordS_self, mul_one, + sub_self, zero_add, add_zero] + +end ThompsonPrefixInsertion + +universe u₁ u₂ u₃ + +section ElementaryRingQuotient + +variable {ι : Type u₁} {R : Type u₂} {S : Type u₃} + [Fintype ι] [DecidableEq ι] + [Ring R] [Ring S] + +private def elementaryMatrixUnitMap (f : R →+* S) : + (Matrix ι ι R)ˣ →* (Matrix ι ι S)ˣ := + Units.map f.mapMatrix.toMonoidHom + +private theorem elementaryMatrixUnitMap_elementaryUnit + (f : R →+* S) (i j : ι) (hij : i ≠ j) (a : R) : + elementaryMatrixUnitMap f (elementaryUnit i j hij a) = + elementaryUnit i j hij (f a) := by + apply Units.ext + change f.mapMatrix (1 + Matrix.single i j a) = + 1 + Matrix.single i j (f a) + rw [map_add, map_one] + congr 1 + ext k l + change f (if i = k ∧ j = l then a else 0) = + if i = k ∧ j = l then f a else 0 + split_ifs <;> simp + +private theorem elementaryGroup_map_le (f : R →+* S) : + (elementaryGroup ι R).map (elementaryMatrixUnitMap f) ≤ + elementaryGroup ι S := by + rw [Subgroup.map_le_iff_le_comap, elementaryGroup, Subgroup.closure_le] + rintro _ ⟨i, j, hij, a, rfl⟩ + change elementaryMatrixUnitMap f (elementaryUnit i j hij a) ∈ + elementaryGroup ι S + rw [elementaryMatrixUnitMap_elementaryUnit] + exact elementaryUnit_mem i j hij (f a) + +private theorem elementaryGroup_map_eq_of_surjective + (f : R →+* S) (hf : Function.Surjective f) : + (elementaryGroup ι R).map (elementaryMatrixUnitMap f) = + elementaryGroup ι S := by + apply le_antisymm (elementaryGroup_map_le f) + rw [elementaryGroup, Subgroup.closure_le] + rintro _ ⟨i, j, hij, b, rfl⟩ + obtain ⟨a, rfl⟩ := hf b + refine ⟨elementaryUnit i j hij a, + elementaryUnit_mem i j hij a, ?_⟩ + exact elementaryMatrixUnitMap_elementaryUnit f i j hij a + +end ElementaryRingQuotient + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def binaryPrefixElementaryGroupEquiv + {ι : Type u} [Fintype ι] [DecidableEq ι] + (E : BinaryPrefixCode ι) : + elementaryGroup ι BinaryLeavitt ≃* prefixElementaryGroup E := + ((elementaryGroup ι BinaryLeavitt).equivMapOfInjective + (prefixCornerUnitHom E) (prefixCornerUnitHom_injective E)).trans + (MulEquiv.subgroupCongr (prefixCornerElementaryGroup_map E)) + +namespace CompressionCriterion + +open Filter Topology + +public +theorem normalizedHamming_distinct_tendsto + {G : Type*} [Group G] + (A : SoficApproximation G) + {g h : G} (hne : g ≠ h) : + Tendsto + (fun n => normalizedHamming + ((A.model n).action g) ((A.model n).action h)) + atTop (𝓝 1) := by + have hdifference : g * h⁻¹ ≠ 1 := by + intro he + apply hne + have := congrArg (fun x : G => x * h) he + simpa only [inv_mul_cancel_right, one_mul] using this + have hseparation := A.separated (g * h⁻¹) hdifference + have hmultiplication := A.multiplicative (g * h⁻¹) h + have hlower (n : ℕ) : + normalizedHamming + ((A.model n).action (g * h⁻¹)) 1 - + normalizedHamming + ((A.model n).action ((g * h⁻¹) * h)) + ((A.model n).action (g * h⁻¹) * + (A.model n).action h) ≤ + normalizedHamming + ((A.model n).action g) ((A.model n).action h) := by + have htriangle := normalizedHamming_triangle + ((A.model n).action (g * h⁻¹) * (A.model n).action h) + ((A.model n).action g) + ((A.model n).action h) + have hright := normalizedHamming_mul_right + ((A.model n).action h) ((A.model n).action (g * h⁻¹)) 1 + have hsym := normalizedHamming_comm + ((A.model n).action g) + ((A.model n).action (g * h⁻¹) * (A.model n).action h) + have hword : (g * h⁻¹) * h = g := by simp only [inv_mul_cancel_right] + rw [hword] at * + simp only [one_mul] at hright + linarith + apply tendsto_of_tendsto_of_tendsto_of_le_of_le + (show Tendsto + (fun n => normalizedHamming + ((A.model n).action (g * h⁻¹)) 1 - + normalizedHamming + ((A.model n).action ((g * h⁻¹) * h)) + ((A.model n).action (g * h⁻¹) * (A.model n).action h)) + atTop (𝓝 1) by + simpa only [inv_mul_cancel_right, sub_zero] using hseparation.sub hmultiplication) + tendsto_const_nhds + · exact hlower + · intro n + exact normalizedHamming_le_one _ _ + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def productTrackedTable {J : Type*} [Group J] + (F : Finset J) : Finset J := by + classical + exact multiplicationTable (insert 1 F) + +public +theorem one_mem_productTrackedTable {J : Type*} [Group J] + (F : Finset J) : 1 ∈ productTrackedTable F := by + classical + exact mem_multiplicationTable_of_mem + (Finset.mem_insert_self 1 F) + +public +theorem mem_productTrackedTable {J : Type*} [Group J] + {F : Finset J} {j : J} (hj : j ∈ F) : + j ∈ productTrackedTable F := by + classical + exact mem_multiplicationTable_of_mem + (Finset.mem_insert_of_mem hj) + +public +theorem mul_mem_productTrackedTable {J : Type*} [Group J] + {F : Finset J} {x y : J} (hx : x ∈ F) (hy : y ∈ F) : + x * y ∈ productTrackedTable F := by + classical + exact mul_mem_multiplicationTable + (Finset.mem_insert_of_mem hx) (Finset.mem_insert_of_mem hy) + +end CompressionCriterion + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def permutationGraph {V : Type*} [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) : Finset (V × V) := + Finset.univ.image fun x => (x, p x) + +public +theorem mem_permutationGraph {V : Type*} + [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) (x y : V) : + (x, y) ∈ permutationGraph p ↔ y = p x := by + simp only [permutationGraph, Finset.mem_image, Finset.mem_univ, eq_comm, Prod.mk.injEq, true_and, + exists_eq_left'] + +public +theorem boundary_permutationGraph_eq_commutationDefect + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (p : Equiv.Perm V) : + boundary (fun i => (σ i).prodCongr (σ i)) (permutationGraph p) = + permutationCommutationDefect σ p := by + classical + unfold boundary permutationCommutationDefect + apply Finset.sum_congr rfl + intro i _ + apply Finset.card_bij (fun z _ => z.1) + · intro z hz + obtain ⟨hzgraph, hzbad⟩ := Finset.mem_filter.mp hz + have hzsecond : z.2 = p z.1 := + (mem_permutationGraph p z.1 z.2).mp hzgraph + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + intro hcommute + apply hzbad + apply (mem_permutationGraph p (σ i z.1) (σ i z.2)).mpr + simpa only [hzsecond] using hcommute.symm + · intro z hz w hw hfirst + obtain ⟨hzgraph, _⟩ := Finset.mem_filter.mp hz + obtain ⟨hwgraph, _⟩ := Finset.mem_filter.mp hw + have hzsecond := (mem_permutationGraph p z.1 z.2).mp hzgraph + have hwsecond := (mem_permutationGraph p w.1 w.2).mp hwgraph + apply Prod.ext hfirst + simpa only [hzsecond, hwsecond, EmbeddingLike.apply_eq_iff_eq] using congrArg p hfirst + · intro x hx + obtain ⟨_, hbad⟩ := Finset.mem_filter.mp hx + refine ⟨(x, p x), ?_, rfl⟩ + apply Finset.mem_filter.mpr + refine ⟨(mem_permutationGraph p x (p x)).mpr rfl, ?_⟩ + intro hgraph + have hcommute := + (mem_permutationGraph p (σ i x) (σ i (p x))).mp hgraph + exact hbad hcommute.symm + +public +theorem kazhdan_generator_displacement + {G : Type u} {H : Type v} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + (P : KazhdanPair.{u, v} G) + (π : UnitaryRepresentation G H) + (hfixed : ∀ η : H, (∀ g : G, π g η = η) → η = 0) + (ξ : H) (hξ : ξ ≠ 0) : + ∃ g ∈ P.generators, + P.kazhdanConstant * ‖ξ‖ ≤ ‖π g ξ - ξ‖ := by + classical + by_contra h + push Not at h + have hnorm : 0 < ‖ξ‖ := norm_pos_iff.mpr hξ + let z : ℂ := (‖ξ‖ : ℂ)⁻¹ + let ζ : H := z • ξ + have hζ : ‖ζ‖ = 1 := by + dsimp [ζ, z] + rw [norm_smul, norm_inv, Complex.norm_real, Real.norm_eq_abs, + abs_of_pos hnorm] + exact inv_mul_cancel₀ (ne_of_gt hnorm) + have hζsmall : ∀ g ∈ P.generators, + ‖π g ζ - ζ‖ < P.kazhdanConstant := by + intro g hg + have hscale : + ‖π g ζ - ζ‖ = ‖ξ‖⁻¹ * ‖π g ξ - ξ‖ := by + dsimp [ζ, z] + rw [map_smul, ← smul_sub, norm_smul, norm_inv, Complex.norm_real, + Real.norm_eq_abs, abs_of_pos hnorm] + rw [hscale] + calc + ‖ξ‖⁻¹ * ‖π g ξ - ξ‖ < + ‖ξ‖⁻¹ * (P.kazhdanConstant * ‖ξ‖) := + mul_lt_mul_of_pos_left (h g hg) (inv_pos.mpr hnorm) + _ = P.kazhdanConstant := by + field_simp + obtain ⟨η, hη, hηfixed⟩ := P.invariant H π ζ hζ hζsmall + exact hη (hfixed η hηfixed) + +namespace ThompsonPrefixInsertion + +open scoped commutatorElement + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +structure PrefixWordAction (g : BinaryLeavittˣ) + (a b : List (Fin 2)) : Prop where + prefixing : (↑g : BinaryLeavitt) * leavittWordS a = leavittWordS b + deletion : + leavittWordT a * (↑(g⁻¹) : BinaryLeavitt) = leavittWordT b + +public +theorem prefixWordAction_append + {g : BinaryLeavittˣ} {a b : List (Fin 2)} + (h : PrefixWordAction g a b) (r : List (Fin 2)) : + PrefixWordAction g (a ++ r) (b ++ r) := by + constructor + · rw [leavittWordS_append, leavittWordS_append, ← mul_assoc, h.prefixing] + · rw [leavittWordT_append, leavittWordT_append, mul_assoc, h.deletion] + +public +theorem prefixWordAction_mul + {g h : BinaryLeavittˣ} {a b c : List (Fin 2)} + (hg : PrefixWordAction g b c) + (hh : PrefixWordAction h a b) : + PrefixWordAction (g * h) a c := by + constructor + · change + ((g : BinaryLeavitt) * (h : BinaryLeavitt)) * + leavittWordS a = leavittWordS c + rw [mul_assoc, hh.prefixing, hg.prefixing] + · change + leavittWordT a * + ((↑(h⁻¹) : BinaryLeavitt) * + (↑(g⁻¹) : BinaryLeavitt)) = leavittWordT c + rw [← mul_assoc, hh.deletion, hg.deletion] + +private theorem cylinderSwap_prefixWordAction_left + (a b : List (Fin 2)) + (hab : ¬ a <+: b) (hba : ¬ b <+: a) : + PrefixWordAction (cylinderSwap a b hab hba) a b := by + constructor + · change + PrefixCompression.transpositionValue + (leavittWordS a) (leavittWordT a) + (leavittWordS b) (leavittWordT b) * + leavittWordS a = leavittWordS b + simp only [PrefixCompression.transpositionValue, add_mul, sub_mul, one_mul, mul_assoc, + leavittWordT_mul_wordS_self, mul_one, sub_self, leavittWordT_mul_wordS_of_incomparable b a hba + hab, mul_zero, + add_zero, zero_add] + · change + leavittWordT a * + PrefixCompression.transpositionValue + (leavittWordS a) (leavittWordT a) + (leavittWordS b) (leavittWordT b) = leavittWordT b + have haa : leavittWordT a * leavittWordS a = 1 := + leavittWordT_mul_wordS_self a + have hab' : leavittWordT a * leavittWordS b = 0 := + leavittWordT_mul_wordS_of_incomparable a b hab hba + have haa' (z : BinaryLeavitt) : + leavittWordT a * (leavittWordS a * z) = z := by + rw [← mul_assoc, haa, one_mul] + have hab'' (z : BinaryLeavitt) : + leavittWordT a * (leavittWordS b * z) = 0 := by + rw [← mul_assoc, hab', zero_mul] + unfold PrefixCompression.transpositionValue + noncomm_ring [haa, hab', haa', hab''] + +private theorem cylinderSwap_prefixWordAction_right + (a b : List (Fin 2)) + (hab : ¬ a <+: b) (hba : ¬ b <+: a) : + PrefixWordAction (cylinderSwap a b hab hba) b a := by + constructor + · exact cylinderSwap_mul_wordS_right a b hab hba + · change + leavittWordT b * + PrefixCompression.transpositionValue + (leavittWordS a) (leavittWordT a) + (leavittWordS b) (leavittWordT b) = leavittWordT a + have hbb : leavittWordT b * leavittWordS b = 1 := + leavittWordT_mul_wordS_self b + have hba' : leavittWordT b * leavittWordS a = 0 := + leavittWordT_mul_wordS_of_incomparable b a hba hab + have hbb' (z : BinaryLeavitt) : + leavittWordT b * (leavittWordS b * z) = z := by + rw [← mul_assoc, hbb, one_mul] + have hba'' (z : BinaryLeavitt) : + leavittWordT b * (leavittWordS a * z) = 0 := by + rw [← mul_assoc, hba', zero_mul] + unfold PrefixCompression.transpositionValue + noncomm_ring [hbb, hba', hbb', hba''] + +private theorem cylinderSwap_prefixWordAction_fixed + (a b w : List (Fin 2)) + (hab : ¬ a <+: b) (hba : ¬ b <+: a) + (haw : ¬ a <+: w) (hwa : ¬ w <+: a) + (hbw : ¬ b <+: w) (hwb : ¬ w <+: b) : + PrefixWordAction (cylinderSwap a b hab hba) w w := by + constructor + · change + PrefixCompression.transpositionValue + (leavittWordS a) (leavittWordT a) + (leavittWordS b) (leavittWordT b) * + leavittWordS w = leavittWordS w + simp only [PrefixCompression.transpositionValue, add_mul, sub_mul, one_mul, mul_assoc, + leavittWordT_mul_wordS_of_incomparable a w haw hwa, mul_zero, sub_zero, + leavittWordT_mul_wordS_of_incomparable b w hbw hwb, add_zero] + · change + leavittWordT w * + PrefixCompression.transpositionValue + (leavittWordS a) (leavittWordT a) + (leavittWordS b) (leavittWordT b) = leavittWordT w + have hwa' : leavittWordT w * leavittWordS a = 0 := + leavittWordT_mul_wordS_of_incomparable w a hwa haw + have hwb' : leavittWordT w * leavittWordS b = 0 := + leavittWordT_mul_wordS_of_incomparable w b hwb hbw + have hwa'' (z : BinaryLeavitt) : + leavittWordT w * (leavittWordS a * z) = 0 := by + rw [← mul_assoc, hwa', zero_mul] + have hwb'' (z : BinaryLeavitt) : + leavittWordT w * (leavittWordS b * z) = 0 := by + rw [← mul_assoc, hwb', zero_mul] + unfold PrefixCompression.transpositionValue + noncomm_ring [hwa', hwb', hwa'', hwb''] + +public +theorem prefixInsertionHom_conjugate_of_prefixWordAction + (g : BinaryLeavittˣ) (a b : List (Fin 2)) + (h : PrefixWordAction g a b) (u : BinaryLeavittˣ) : + g * prefixInsertionHom a u * g⁻¹ = prefixInsertionHom b u := by + apply Units.ext + change + (g : BinaryLeavitt) * + (↑(prefixInsertionHom a u) : BinaryLeavitt) * + (↑(g⁻¹) : BinaryLeavitt) = + (↑(prefixInsertionHom b u) : BinaryLeavitt) + rw [prefixInsertionHom_val, prefixInsertionHom_val] + change + (g : BinaryLeavitt) * + (leavittWordS a * (u : BinaryLeavitt) * leavittWordT a + + (1 - leavittWordS a * leavittWordT a)) * + (↑(g⁻¹) : BinaryLeavitt) = + leavittWordS b * (u : BinaryLeavitt) * leavittWordT b + + (1 - leavittWordS b * leavittWordT b) + have hunit : + (g : BinaryLeavitt) * (↑(g⁻¹) : BinaryLeavitt) = 1 := + g.val_inv + calc + (g : BinaryLeavitt) * + (leavittWordS a * (u : BinaryLeavitt) * leavittWordT a + + (1 - leavittWordS a * leavittWordT a)) * + (↑(g⁻¹) : BinaryLeavitt) = + ((g : BinaryLeavitt) * leavittWordS a) * + (u : BinaryLeavitt) * + (leavittWordT a * (↑(g⁻¹) : BinaryLeavitt)) + + ((g : BinaryLeavitt) * (↑(g⁻¹) : BinaryLeavitt) - + ((g : BinaryLeavitt) * leavittWordS a) * + (leavittWordT a * (↑(g⁻¹) : BinaryLeavitt))) := by + simp only [CharTwo.sub_eq_add] + noncomm_ring + _ = leavittWordS b * (u : BinaryLeavitt) * leavittWordT b + + (1 - leavittWordS b * leavittWordT b) := by + rw [h.prefixing, h.deletion, hunit] + +public +theorem prefixInsertionHom_mem_binaryPrefixTranspositionGroup + (a : List (Fin 2)) (u : BinaryLeavittˣ) + (hu : u ∈ binaryPrefixTranspositionGroup) : + prefixInsertionHom a u ∈ binaryPrefixTranspositionGroup := by + have hle : + binaryPrefixTranspositionGroup ≤ + binaryPrefixTranspositionGroup.comap (prefixInsertionHom a) := by + change Subgroup.closure _ ≤ _ + apply (Subgroup.closure_le _).2 + rintro _ ⟨x, y, hxy, hyx, rfl⟩ + change prefixInsertionHom a (cylinderSwap x y hxy hyx) ∈ + binaryPrefixTranspositionGroup + rw [prefixInsertionHom_cylinderSwap] + exact Subgroup.subset_closure + ⟨a ++ x, a ++ y, + prepend_not_prefix_prepend a x y hxy, + prepend_not_prefix_prepend a y x hyx, rfl⟩ + exact hle hu + +end ThompsonPrefixInsertion + +namespace LeavittElementaryMorita + +open scoped BigOperators commutatorElement + +section ElementaryBlockFlattening + +variable {ι κ R : Type*} [Fintype ι] [DecidableEq ι] + [Fintype κ] [DecidableEq κ] [Ring R] + +private def elementaryBlockMatrixEquiv : + Matrix ι ι (Matrix κ κ R) ≃+* + Matrix (ι × κ) (ι × κ) R := + Matrix.compRingEquiv ι κ R + +private def elementaryBlockUnitEquiv : + (Matrix ι ι (Matrix κ κ R))ˣ ≃* + (Matrix (ι × κ) (ι × κ) R)ˣ := + Units.mapEquiv (elementaryBlockMatrixEquiv (ι := ι) + (κ := κ) (R := R)).toMulEquiv + +private theorem elementaryBlockUnitEquiv_elementaryUnit_single + (i j : ι) (hij : i ≠ j) (k l : κ) (a : R) : + elementaryBlockUnitEquiv (ι := ι) (κ := κ) (R := R) + (elementaryUnit i j hij (Matrix.single k l a)) = + elementaryUnit (i, k) (j, l) + (fun h => hij (congrArg Prod.fst h)) a := by + apply Units.ext + change + elementaryBlockMatrixEquiv (ι := ι) (κ := κ) (R := R) + (1 + Matrix.single i j (Matrix.single k l a)) = + 1 + Matrix.single (i, k) (j, l) a + rw [map_add, map_one] + congr 1 + exact Matrix.comp_single_single i j k l a + +private theorem elementaryBlockUnitEquiv_elementaryUnit_mem + (i j : ι) (hij : i ≠ j) (A : Matrix κ κ R) : + elementaryBlockUnitEquiv (ι := ι) (κ := κ) (R := R) + (elementaryUnit i j hij A) ∈ + elementaryGroup (ι × κ) R := by + induction A using Matrix.induction_on' with + | h_zero => + simp only [elementaryUnit_zero, map_one, one_mem] + | h_add A B hA hB => + rw [← elementaryUnit_mul, map_mul] + exact (elementaryGroup (ι × κ) R).mul_mem hA hB + | h_std_basis k l a => + rw [elementaryBlockUnitEquiv_elementaryUnit_single i j hij k l a] + exact elementaryUnit_mem (i, k) (j, l) + (fun h => hij (congrArg Prod.fst h)) a + +private theorem elementaryBlockGroup_map [Nontrivial ι] : + (elementaryGroup ι (Matrix κ κ R)).map + (elementaryBlockUnitEquiv + (ι := ι) (κ := κ) (R := R)).toMonoidHom = + elementaryGroup (ι × κ) R := by + let B : Subgroup (Matrix (ι × κ) (ι × κ) R)ˣ := + (elementaryGroup ι (Matrix κ κ R)).map + (elementaryBlockUnitEquiv + (ι := ι) (κ := κ) (R := R)).toMonoidHom + have hcross (i j : ι) (hij : i ≠ j) (k l : κ) (a : R) : + elementaryUnit (i, k) (j, l) + (fun h => hij (congrArg Prod.fst h)) a ∈ B := by + refine ⟨elementaryUnit i j hij (Matrix.single k l a), + elementaryUnit_mem i j hij (Matrix.single k l a), ?_⟩ + exact elementaryBlockUnitEquiv_elementaryUnit_single + i j hij k l a + change B = elementaryGroup (ι × κ) R + apply le_antisymm + · change + (elementaryGroup ι (Matrix κ κ R)).map + (elementaryBlockUnitEquiv + (ι := ι) (κ := κ) (R := R)).toMonoidHom ≤ + elementaryGroup (ι × κ) R + rw [elementaryGroup, MonoidHom.map_closure, + Subgroup.closure_le] + rintro _ ⟨_, ⟨i, j, hij, A, rfl⟩, rfl⟩ + change + elementaryBlockUnitEquiv (ι := ι) (κ := κ) (R := R) + (elementaryUnit i j hij A) ∈ + elementaryGroup (ι × κ) R + exact elementaryBlockUnitEquiv_elementaryUnit_mem + i j hij A + · rw [elementaryGroup, Subgroup.closure_le] + rintro _ ⟨⟨i, k⟩, ⟨j, l⟩, hne, a, rfl⟩ + by_cases hij : i = j + · subst j + obtain ⟨j, hji⟩ := exists_ne i + exact elementaryUnit_mem_of_two_step B + (i, k) (j, k) (i, l) + (fun h => hji (congrArg Prod.fst h).symm) + (fun h => hji (congrArg Prod.fst h)) + hne a + (hcross i j hji.symm k k a) + (hcross j i hji k l 1) + · exact hcross i j hij k l a + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def elementaryBlockGroupEquiv [Nontrivial ι] : + elementaryGroup ι (Matrix κ κ R) ≃* + elementaryGroup (ι × κ) R := + ((elementaryBlockUnitEquiv + (ι := ι) (κ := κ) (R := R)).subgroupMap + (elementaryGroup ι (Matrix κ κ R))).trans + (MulEquiv.subgroupCongr + (elementaryBlockGroup_map (ι := ι) (κ := κ) (R := R))) + +end ElementaryBlockFlattening + +section ElementaryReindexing + +variable {ι κ R : Type*} [Fintype ι] [DecidableEq ι] + [Fintype κ] [DecidableEq κ] [Ring R] + +private def elementaryReindexUnitEquiv (e : ι ≃ κ) : + (Matrix ι ι R)ˣ ≃* (Matrix κ κ R)ˣ := + Units.mapEquiv (Matrix.reindexRingEquiv R e).toMulEquiv + +private theorem elementaryReindexUnitEquiv_elementaryUnit + (e : ι ≃ κ) (i j : ι) (hij : i ≠ j) (a : R) : + elementaryReindexUnitEquiv (R := R) e + (elementaryUnit i j hij a) = + elementaryUnit (e i) (e j) (e.injective.ne hij) a := by + apply Units.ext + change + (Matrix.reindexRingEquiv R e) + (1 + Matrix.single i j a) = + 1 + Matrix.single (e i) (e j) a + rw [map_add, map_one] + congr 1 + change + Matrix.reindex e e (Matrix.single i j a) = + Matrix.single (e i) (e j) a + simpa only [Matrix.reindex_apply, Equiv.symm_symm] using + (Matrix.submatrix_single_equiv e.symm e.symm i j a) + +private theorem elementaryReindexGroup_map (e : ι ≃ κ) : + (elementaryGroup ι R).map + (elementaryReindexUnitEquiv (R := R) e).toMonoidHom = + elementaryGroup κ R := by + apply le_antisymm + · rw [elementaryGroup, MonoidHom.map_closure, + Subgroup.closure_le] + rintro _ ⟨_, ⟨i, j, hij, a, rfl⟩, rfl⟩ + change + elementaryReindexUnitEquiv (R := R) e + (elementaryUnit i j hij a) ∈ elementaryGroup κ R + rw [elementaryReindexUnitEquiv_elementaryUnit] + exact elementaryUnit_mem (e i) (e j) (e.injective.ne hij) a + · rw [elementaryGroup, Subgroup.closure_le] + rintro _ ⟨k, l, hkl, a, rfl⟩ + have hij : e.symm k ≠ e.symm l := e.symm.injective.ne hkl + refine ⟨elementaryUnit (e.symm k) (e.symm l) hij a, + elementaryUnit_mem (e.symm k) (e.symm l) hij a, ?_⟩ + simpa only [MulEquiv.toMonoidHom_eq_coe, MonoidHom.coe_coe, Equiv.apply_symm_apply] using + elementaryReindexUnitEquiv_elementaryUnit e (e.symm k) (e.symm l) hij a + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def elementaryReindexGroupEquiv (e : ι ≃ κ) : + elementaryGroup ι R ≃* elementaryGroup κ R := + ((elementaryReindexUnitEquiv (R := R) e).subgroupMap + (elementaryGroup ι R)).trans + (MulEquiv.subgroupCongr (elementaryReindexGroup_map e)) + +end ElementaryReindexing + +section ElementaryCoefficientEquivalence + +variable {ι R S : Type*} [Fintype ι] [DecidableEq ι] + [Ring R] [Ring S] + +private def elementaryCoefficientGroupEquiv (f : R ≃+* S) : + elementaryGroup ι R ≃* elementaryGroup ι S := + ((Units.mapEquiv f.mapMatrix.toMulEquiv).subgroupMap + (elementaryGroup ι R)).trans + (MulEquiv.subgroupCongr (by + change + (elementaryGroup ι R).map + (elementaryMatrixUnitMap f.toRingHom) = + elementaryGroup ι S + exact elementaryGroup_map_eq_of_surjective + f.toRingHom f.surjective)) + +end ElementaryCoefficientEquivalence + +private def ternaryLeavittWord : Fin 3 → List (Fin 2) + | 0 => [0, 0] + | 1 => [0, 1] + | _ => [1] + +private def ternaryLeavittPrefixCode : BinaryPrefixCode (Fin 3) where + word := ternaryLeavittWord + prefix_free := by decide + +private theorem ternaryLeavittPrefixCode_complete : + MatrixCorner.codeIdempotent + (fun i => leavittWordS (ternaryLeavittPrefixCode.word i)) + (fun i => leavittWordT (ternaryLeavittPrefixCode.word i)) = + 1 := by + have hzero : + leavittCylinder [0, 0] + leavittCylinder [0, 1] = + leavittCylinder [0] := by + simpa only [Fin.isValue, List.cons_append, List.nil_append] using (leavittCylinder_split + [0]).symm + have hroot : + leavittCylinder [0] + leavittCylinder [1] = 1 := by + simpa only [leavittCylinder, leavittWordS, Fin.isValue, mul_one, leavittWordT, one_mul, + List.nil_append] using + (leavittCylinder_split ([] : List (Fin 2))).symm + have hsum : + leavittCylinder [0, 0] + leavittCylinder [0, 1] + + leavittCylinder [1] = 1 := by + rw [hzero] + exact hroot + simpa only [MatrixCorner.codeIdempotent, ternaryLeavittPrefixCode, ternaryLeavittWord, + Fin.isValue, + Fin.sum_univ_succ, Fin.succ_ne_zero, imp_self, Fin.succ_zero_eq_one, Finset.univ_unique, + Fin.default_eq_zero, + Finset.sum_singleton, Fin.succ_one_eq_two, leavittCylinder, add_assoc] using hsum + +private def binaryLeavittMatrixThreeEquiv : + BinaryLeavitt ≃+* Matrix (Fin 3) (Fin 3) BinaryLeavitt := + (completePrefixMatrixEquiv ternaryLeavittPrefixCode + ternaryLeavittPrefixCode_complete).symm + +private def binaryLeavittElementaryThreeEquivNine : + binaryLeavittElementaryGroup 3 ≃* + binaryLeavittElementaryGroup 9 := + (elementaryCoefficientGroupEquiv + (ι := Fin 3) binaryLeavittMatrixThreeEquiv).trans + ((elementaryBlockGroupEquiv + (ι := Fin 3) (κ := Fin 3) (R := BinaryLeavitt)).trans + (elementaryReindexGroupEquiv + (R := BinaryLeavitt) (finProdFinEquiv : + Fin 3 × Fin 3 ≃ Fin 9))) + +private theorem binaryLeavittElementaryThree_hasPropertyT_of_nine + [HasPropertyT.{0, v} (binaryLeavittElementaryGroup 9)] : + HasPropertyT.{0, v} (binaryLeavittElementaryGroup 3) := + hasPropertyT_of_mulEquiv binaryLeavittElementaryThreeEquivNine.symm + +public +theorem alphaPrefixElementaryGroup_hasPropertyT_of_nine + [HasPropertyT.{0, v} (binaryLeavittElementaryGroup 9)] : + HasPropertyT.{0, v} (prefixElementaryGroup alphaPrefixCode) := by + let : HasPropertyT.{0, v} (binaryLeavittElementaryGroup 3) := + binaryLeavittElementaryThree_hasPropertyT_of_nine + exact hasPropertyT_of_mulEquiv alphaPrefixElementaryGroupEquiv + +public +theorem alphaZeroPrefixElementaryGroup_hasPropertyT_of_nine + [HasPropertyT.{0, v} (binaryLeavittElementaryGroup 9)] : + HasPropertyT.{0, v} (prefixElementaryGroup alphaZeroPrefixCode) := by + let : HasPropertyT.{0, v} (binaryLeavittElementaryGroup 3) := + binaryLeavittElementaryThree_hasPropertyT_of_nine + exact hasPropertyT_of_mulEquiv + (binaryPrefixElementaryGroupEquiv alphaZeroPrefixCode) + +end LeavittElementaryMorita + +namespace ThompsonFiniteGeneration + +open ThompsonPrefixInsertion + +public +theorem cylinderSwap_prefixWordAction_of_cases + {a b w v : List (Fin 2)} + (hab : ¬ a <+: b) (hba : ¬ b <+: a) + (hcase : + (a <+: w ∧ v = b ++ w.drop a.length) ∨ + (b <+: w ∧ v = a ++ w.drop b.length) ∨ + (v = w ∧ ¬ a <+: w ∧ ¬ w <+: a ∧ + ¬ b <+: w ∧ ¬ w <+: b)) : + PrefixWordAction (cylinderSwap a b hab hba) w v := by + rcases hcase with h | h | h + · obtain ⟨haw, rfl⟩ := h + simpa only [(List.prefix_append_drop haw).symm] using + prefixWordAction_append + (cylinderSwap_prefixWordAction_left a b hab hba) + (w.drop a.length) + · obtain ⟨hbw, rfl⟩ := h + simpa only [(List.prefix_append_drop hbw).symm] using + prefixWordAction_append + (cylinderSwap_prefixWordAction_right a b hab hba) + (w.drop b.length) + · obtain ⟨hv, haw, hwa, hbw, hwb⟩ := h + subst v + exact cylinderSwap_prefixWordAction_fixed + a b w hab hba haw hwa hbw hwb + +end ThompsonFiniteGeneration + +end + + +end SoficGroups + +end diff --git a/LeanPool/NonSoficGroup/Spectral.lean b/LeanPool/NonSoficGroup/Spectral.lean new file mode 100644 index 000000000..3532ca4ce --- /dev/null +++ b/LeanPool/NonSoficGroup/Spectral.lean @@ -0,0 +1,10393 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +module + +public import LeanPool.NonSoficGroup.Foundations +import all LeanPool.NonSoficGroup.Foundations +import all Mathlib.Analysis.InnerProductSpace.Reproducing +public import Mathlib.Analysis.InnerProductSpace.PiL2 +import Mathlib.Algebra.Group.Pointwise.Finset.BigOperators +import Mathlib.Algebra.Order.Chebyshev +import Mathlib.Analysis.CStarAlgebra.Module.Constructions +import Mathlib.Analysis.InnerProductSpace.GramMatrix +import Mathlib.Data.Nat.Dist +import Mathlib.Data.Finset.CastCard +import Mathlib.Dynamics.FixedPoints.Topology +import Mathlib.RepresentationTheory.Invariants +import Mathlib.Topology.Algebra.LinearMapCompletion + +/-! +# Spectral and finite-model estimates for the non-sofic group construction + +This file develops the Hilbert-space, expansion, partition, and completion +estimates used in the final obstruction. +-/ + +noncomputable section + +namespace SoficGroups + +section + +open Filter Topology + +section ThreeProjectionSumOfSquares + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] + +/-- A three-vector polarization identity used in the spectral-gap argument. -/ +public +theorem three_pair_sum_norm_sq (a b c : H) : + ‖a + b‖ ^ 2 + ‖b + c‖ ^ 2 + ‖c + a‖ ^ 2 = + ‖a + b + c‖ ^ 2 + (‖a‖ ^ 2 + ‖b‖ ^ 2 + ‖c‖ ^ 2) := by + have hca : + RCLike.re (inner ℂ c a) = RCLike.re (inner ℂ a c) := by + exact @inner_re_symm ℂ H _ _ _ c a + simp only [@norm_add_sq ℂ H, inner_add_left, map_add] + nlinarith + +omit [InnerProductSpace ℂ H] in +private theorem norm_add_three_sq_le_three_mul (a b c : H) : + ‖a + b + c‖ ^ 2 ≤ 3 * (‖a‖ ^ 2 + ‖b‖ ^ 2 + ‖c‖ ^ 2) := by + have htriangle : ‖a + b + c‖ ≤ ‖a‖ + ‖b‖ + ‖c‖ := by + calc + ‖a + b + c‖ ≤ ‖a + b‖ + ‖c‖ := norm_add_le (a + b) c + _ ≤ ‖a‖ + ‖b‖ + ‖c‖ := by gcongr; exact norm_add_le a b + have hsquare : + ‖a + b + c‖ ^ 2 ≤ (‖a‖ + ‖b‖ + ‖c‖) ^ 2 := + (sq_le_sq₀ (norm_nonneg _) (by positivity)).mpr htriangle + nlinarith [sq_nonneg (‖a‖ - ‖b‖), + sq_nonneg (‖b‖ - ‖c‖), sq_nonneg (‖c‖ - ‖a‖)] + +private theorem three_pairwise_residual_spectral_gap + (a b c : H) (ε : ℝ) + (hab : (1 - ε) * (‖a‖ ^ 2 + ‖b‖ ^ 2) ≤ ‖a + b‖ ^ 2) + (hbc : (1 - ε) * (‖b‖ ^ 2 + ‖c‖ ^ 2) ≤ ‖b + c‖ ^ 2) + (hca : (1 - ε) * (‖c‖ ^ 2 + ‖a‖ ^ 2) ≤ ‖c + a‖ ^ 2) : + (1 - 2 * ε) * (‖a‖ ^ 2 + ‖b‖ ^ 2 + ‖c‖ ^ 2) ≤ + ‖a + b + c‖ ^ 2 := by + nlinarith [three_pair_sum_norm_sq a b c] + +end ThreeProjectionSumOfSquares + +section TwoOrthogonalSectors + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] + +private theorem inner_sq_le_of_orthogonal_two_sector + (a₀ a₁ b₀ b₁ : H) + (ha : inner ℂ a₀ a₁ = 0) + (hb : inner ℂ b₀ b₁ = 0) + (hcross₀ : inner ℂ a₀ b₁ = 0) + (hcross₁ : inner ℂ a₁ b₀ = 0) + (h₀ : 8 * ‖inner ℂ a₀ b₀‖ ^ 2 ≤ ‖a₀‖ ^ 2 * ‖b₀‖ ^ 2) + (h₁ : 8 * ‖inner ℂ a₁ b₁‖ ^ 2 ≤ ‖a₁‖ ^ 2 * ‖b₁‖ ^ 2) : + 8 * ‖inner ℂ (a₀ + a₁) (b₀ + b₁)‖ ^ 2 ≤ + ‖a₀ + a₁‖ ^ 2 * ‖b₀ + b₁‖ ^ 2 := by + have hproduct : + (8 * ‖inner ℂ a₀ b₀‖ * ‖inner ℂ a₁ b₁‖) ^ 2 ≤ + (‖a₀‖ * ‖a₁‖ * ‖b₀‖ * ‖b₁‖) ^ 2 := by + calc + (8 * ‖inner ℂ a₀ b₀‖ * ‖inner ℂ a₁ b₁‖) ^ 2 = + (8 * ‖inner ℂ a₀ b₀‖ ^ 2) * + (8 * ‖inner ℂ a₁ b₁‖ ^ 2) := by ring + _ ≤ (‖a₀‖ ^ 2 * ‖b₀‖ ^ 2) * + (‖a₁‖ ^ 2 * ‖b₁‖ ^ 2) := + mul_le_mul h₀ h₁ (by positivity) (by positivity) + _ = (‖a₀‖ * ‖a₁‖ * ‖b₀‖ * ‖b₁‖) ^ 2 := by ring + have hcross : + 8 * ‖inner ℂ a₀ b₀‖ * ‖inner ℂ a₁ b₁‖ ≤ + ‖a₀‖ * ‖a₁‖ * ‖b₀‖ * ‖b₁‖ := + (sq_le_sq₀ (by positivity) (by positivity)).mp hproduct + have hscalar : + 8 * (‖inner ℂ a₀ b₀‖ + ‖inner ℂ a₁ b₁‖) ^ 2 ≤ + (‖a₀‖ ^ 2 + ‖a₁‖ ^ 2) * + (‖b₀‖ ^ 2 + ‖b₁‖ ^ 2) := by + nlinarith [sq_nonneg (‖a₀‖ * ‖b₁‖ - ‖a₁‖ * ‖b₀‖)] + have hinner : + inner ℂ (a₀ + a₁) (b₀ + b₁) = + inner ℂ a₀ b₀ + inner ℂ a₁ b₁ := by + simp only [CStarModule.inner_add_right, CStarModule.inner_add_left, hcross₁, add_zero, hcross₀, + zero_add] + have hnorm : + ‖inner ℂ (a₀ + a₁) (b₀ + b₁)‖ ≤ + ‖inner ℂ a₀ b₀‖ + ‖inner ℂ a₁ b₁‖ := by + rw [hinner] + exact norm_add_le _ _ + have hnormsq : + ‖inner ℂ (a₀ + a₁) (b₀ + b₁)‖ ^ 2 ≤ + (‖inner ℂ a₀ b₀‖ + ‖inner ℂ a₁ b₁‖) ^ 2 := + (sq_le_sq₀ (norm_nonneg _) (by positivity)).mpr hnorm + have ha' : ‖a₀ + a₁‖ ^ 2 = ‖a₀‖ ^ 2 + ‖a₁‖ ^ 2 := by + rw [norm_add_sq (𝕜 := ℂ), ha] + simp only [RCLike.re_to_complex, Complex.zero_re, mul_zero, add_zero] + have hb' : ‖b₀ + b₁‖ ^ 2 = ‖b₀‖ ^ 2 + ‖b₁‖ ^ 2 := by + rw [norm_add_sq (𝕜 := ℂ), hb] + simp only [RCLike.re_to_complex, Complex.zero_re, mul_zero, add_zero] + rw [ha', hb'] + nlinarith + +private theorem inner_sq_le_of_finite_orthogonal_sector_splitting + {ι : Type*} [Finite ι] + (F : ι → Submodule ℂ H) + [∀ i, (F i).HasOrthogonalProjection] + (U V : Submodule ℂ H) + (hU : ∀ (i : ι) ⦃x : H⦄, x ∈ U → + (F i).starProjection x ∈ U) + (hV : ∀ (i : ι) ⦃x : H⦄, x ∈ V → + (F i).starProjection x ∈ V) + (hF : ∀ (i j : ι) ⦃x : H⦄, x ∈ F j → + (F i).starProjection x ∈ F j) + (hsector : ∀ (i : ι) (a b : H), + a ∈ U → b ∈ V → a ∈ (F i)ᗮ → b ∈ (F i)ᗮ → + 8 * ‖inner ℂ a b‖ ^ 2 ≤ ‖a‖ ^ 2 * ‖b‖ ^ 2) + (hterminal : ∀ (a b : H), a ∈ U → b ∈ V → + (∀ i, a ∈ F i) → (∀ i, b ∈ F i) → inner ℂ a b = 0) + (a b : H) (ha : a ∈ U) (hb : b ∈ V) : + 8 * ‖inner ℂ a b‖ ^ 2 ≤ ‖a‖ ^ 2 * ‖b‖ ^ 2 := by + classical + let : Fintype ι := Fintype.ofFinite ι + have hind : ∀ (s : Finset ι) (x y : H), + x ∈ U → y ∈ V → + (∀ j, j ∉ s → x ∈ F j) → + (∀ j, j ∉ s → y ∈ F j) → + 8 * ‖inner ℂ x y‖ ^ 2 ≤ ‖x‖ ^ 2 * ‖y‖ ^ 2 := by + intro s + induction s using Finset.induction_on with + | empty => + intro x y hx hy hxF hyF + have hzero : inner ℂ x y = 0 := + hterminal x y hx hy + (fun j => hxF j (by simp only [Finset.notMem_empty, not_false_eq_true])) + (fun j => hyF j (by simp only [Finset.notMem_empty, not_false_eq_true])) + simpa only [hzero, norm_zero, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, + mul_zero, + ge_iff_le] using mul_nonneg (sq_nonneg ‖x‖) (sq_nonneg ‖y‖) + | @insert i s hi ih => + intro x y hx hy hxF hyF + let x₀ : H := (F i).starProjection x + let x₁ : H := (F i)ᗮ.starProjection x + let y₀ : H := (F i).starProjection y + let y₁ : H := (F i)ᗮ.starProjection y + have hx₀ : x₀ ∈ U := hU i hx + have hy₀ : y₀ ∈ V := hV i hy + have hx₁ : x₁ ∈ U := by + dsimp [x₁] + rw [Submodule.starProjection_orthogonal_val] + exact U.sub_mem hx (hU i hx) + have hy₁ : y₁ ∈ V := by + dsimp [y₁] + rw [Submodule.starProjection_orthogonal_val] + exact V.sub_mem hy (hV i hy) + have hx₀i : x₀ ∈ F i := + Submodule.starProjection_apply_mem (F i) x + have hy₀i : y₀ ∈ F i := + Submodule.starProjection_apply_mem (F i) y + have hx₁i : x₁ ∈ (F i)ᗮ := + Submodule.starProjection_apply_mem (F i)ᗮ x + have hy₁i : y₁ ∈ (F i)ᗮ := + Submodule.starProjection_apply_mem (F i)ᗮ y + have hx₀F : ∀ j, j ∉ s → x₀ ∈ F j := by + intro j hj + by_cases hji : j = i + · subst j + exact hx₀i + · apply hF i j + apply hxF j + simp only [Finset.mem_insert, hji, hj, or_self, not_false_eq_true] + have hy₀F : ∀ j, j ∉ s → y₀ ∈ F j := by + intro j hj + by_cases hji : j = i + · subst j + exact hy₀i + · apply hF i j + apply hyF j + simp only [Finset.mem_insert, hji, hj, or_self, not_false_eq_true] + have h₀ : + 8 * ‖inner ℂ x₀ y₀‖ ^ 2 ≤ + ‖x₀‖ ^ 2 * ‖y₀‖ ^ 2 := + ih x₀ y₀ hx₀ hy₀ hx₀F hy₀F + have h₁ : + 8 * ‖inner ℂ x₁ y₁‖ ^ 2 ≤ + ‖x₁‖ ^ 2 * ‖y₁‖ ^ 2 := + hsector i x₁ y₁ hx₁ hy₁ hx₁i hy₁i + have hsumx : x₀ + x₁ = x := + (F i).starProjection_add_starProjection_orthogonal x + have hsumy : y₀ + y₁ = y := + (F i).starProjection_add_starProjection_orthogonal y + have htwo := inner_sq_le_of_orthogonal_two_sector + x₀ x₁ y₀ y₁ + (Submodule.inner_right_of_mem_orthogonal hx₀i hx₁i) + (Submodule.inner_right_of_mem_orthogonal hy₀i hy₁i) + (Submodule.inner_right_of_mem_orthogonal hx₀i hy₁i) + (Submodule.inner_left_of_mem_orthogonal hy₀i hx₁i) + h₀ h₁ + rwa [hsumx, hsumy] at htwo + apply hind Finset.univ a b ha hb + · intro j hj + exact (hj (Finset.mem_univ j)).elim + · intro j hj + exact (hj (Finset.mem_univ j)).elim + +end TwoOrthogonalSectors + +section ThreeOrthogonalProjections + +variable {H : Type*} [NormedAddCommGroup H] + [InnerProductSpace ℂ H] + +private theorem ejStarProjection_re_inner (W : Submodule ℂ H) + [W.HasOrthogonalProjection] (x : H) : + RCLike.re (inner ℂ (W.starProjection x) x) = + ‖W.starProjection x‖ ^ 2 := by + have hidem : W.starProjection (W.starProjection x) = + W.starProjection x := + Submodule.starProjection_eq_self_iff.mpr + (Submodule.starProjection_apply_mem W x) + have hinner : + inner ℂ (W.starProjection x) x = + inner ℂ (W.starProjection x) (W.starProjection x) := by + calc + inner ℂ (W.starProjection x) x = + inner ℂ x (W.starProjection x) := + Submodule.inner_starProjection_left_eq_right W x x + _ = inner ℂ x (W.starProjection (W.starProjection x)) := + congrArg (inner ℂ x) hidem.symm + _ = inner ℂ (W.starProjection x) (W.starProjection x) := + (Submodule.inner_starProjection_left_eq_right W x + (W.starProjection x)).symm + rw [hinner] + exact (norm_sq_eq_re_inner _).symm + +private def ejResidualProjection (V : Submodule ℂ H) + [V.HasOrthogonalProjection] : H →L[ℂ] H := + Vᗮ.starProjection + +@[simp] +private theorem ejResidualProjection_apply (V : Submodule ℂ H) + [V.HasOrthogonalProjection] (x : H) : + ejResidualProjection V x = x - V.starProjection x := + Submodule.starProjection_orthogonal_val x + +private theorem ejResidualProjection_idempotent (V : Submodule ℂ H) + [V.HasOrthogonalProjection] (x : H) : + ejResidualProjection V (ejResidualProjection V x) = + ejResidualProjection V x := by + change Vᗮ.starProjection (Vᗮ.starProjection x) = Vᗮ.starProjection x + exact Submodule.starProjection_eq_self_iff.mpr + (Submodule.starProjection_apply_mem Vᗮ x) + +private theorem ejResidualProjection_inner (V : Submodule ℂ H) + [V.HasOrthogonalProjection] (x y : H) : + inner ℂ (ejResidualProjection V x) y = + inner ℂ x (ejResidualProjection V y) := + Submodule.inner_starProjection_left_eq_right Vᗮ x y + +private theorem ejResidualProjection_re_inner (V : Submodule ℂ H) + [V.HasOrthogonalProjection] (x : H) : + RCLike.re (inner ℂ (ejResidualProjection V x) x) = + ‖ejResidualProjection V x‖ ^ 2 := by + have hinner : + inner ℂ (ejResidualProjection V x) x = + inner ℂ (ejResidualProjection V x) + (ejResidualProjection V x) := by + calc + inner ℂ (ejResidualProjection V x) x = + inner ℂ x (ejResidualProjection V x) := + ejResidualProjection_inner V x x + _ = inner ℂ x + (ejResidualProjection V (ejResidualProjection V x)) := + congrArg (inner ℂ x) + (ejResidualProjection_idempotent V x).symm + _ = inner ℂ (ejResidualProjection V x) + (ejResidualProjection V x) := + (ejResidualProjection_inner V x + (ejResidualProjection V x)).symm + rw [hinner] + exact (norm_sq_eq_re_inner _).symm + +variable (V : Fin 3 → Submodule ℂ H) + [∀ i, (V i).HasOrthogonalProjection] + +private def ejThreeResidualMap : H →L[ℂ] H := + ejResidualProjection (V 0) + ejResidualProjection (V 1) + + ejResidualProjection (V 2) + +private def ejThreeResidualEnergy (x : H) : ℝ := + ‖ejResidualProjection (V 0) x‖ ^ 2 + + ‖ejResidualProjection (V 1) x‖ ^ 2 + + ‖ejResidualProjection (V 2) x‖ ^ 2 + +private def ejThreeProjectionAverage : H →L[ℂ] H := + ContinuousLinearMap.id ℂ H - + (3 : ℂ)⁻¹ • ejThreeResidualMap V + +@[simp] +private theorem ejThreeResidualMap_apply (x : H) : + ejThreeResidualMap V x = + ejResidualProjection (V 0) x + + ejResidualProjection (V 1) x + + ejResidualProjection (V 2) x := by + rfl + +@[simp] +private theorem ejThreeProjectionAverage_apply (x : H) : + ejThreeProjectionAverage V x = + x - (3 : ℂ)⁻¹ • ejThreeResidualMap V x := by + rfl + +private theorem ejThreeResidualEnergy_nonneg (x : H) : + 0 ≤ ejThreeResidualEnergy V x := by + unfold ejThreeResidualEnergy + positivity + +private theorem ejThreeResidualEnergy_eq_re_inner (x : H) : + ejThreeResidualEnergy V x = + RCLike.re (inner ℂ (ejThreeResidualMap V x) x) := by + simp only [ejThreeResidualEnergy, ejThreeResidualMap_apply, + inner_add_left, map_add] + rw [ejResidualProjection_re_inner (V 0) x, + ejResidualProjection_re_inner (V 1) x, + ejResidualProjection_re_inner (V 2) x] + +private theorem ejThreeResidualMap_norm_sq_le (x : H) : + ‖ejThreeResidualMap V x‖ ^ 2 ≤ + 3 * ejThreeResidualEnergy V x := by + simpa only [ejThreeResidualMap_apply, Fin.isValue, ejResidualProjection_apply, + ejThreeResidualEnergy] using + norm_add_three_sq_le_three_mul (ejResidualProjection (V 0) x) (ejResidualProjection (V 1) x) + (ejResidualProjection (V 2) x) + +private theorem ejResidualProjection_norm_le (i : Fin 3) (x : H) : + ‖ejResidualProjection (V i) x‖ ≤ ‖x‖ := + (V i)ᗮ.norm_starProjection_apply_le x + +private theorem ejThreeResidualEnergy_le_three_norm_sq (x : H) : + ejThreeResidualEnergy V x ≤ 3 * ‖x‖ ^ 2 := by + have h0 : ‖ejResidualProjection (V 0) x‖ ^ 2 ≤ ‖x‖ ^ 2 := + (sq_le_sq₀ (norm_nonneg _) (norm_nonneg _)).mpr + (ejResidualProjection_norm_le V 0 x) + have h1 : ‖ejResidualProjection (V 1) x‖ ^ 2 ≤ ‖x‖ ^ 2 := + (sq_le_sq₀ (norm_nonneg _) (norm_nonneg _)).mpr + (ejResidualProjection_norm_le V 1 x) + have h2 : ‖ejResidualProjection (V 2) x‖ ^ 2 ≤ ‖x‖ ^ 2 := + (sq_le_sq₀ (norm_nonneg _) (norm_nonneg _)).mpr + (ejResidualProjection_norm_le V 2 x) + unfold ejThreeResidualEnergy + linarith + +private theorem ejResidualProjection_cross_inner (W : Submodule ℂ H) + [W.HasOrthogonalProjection] (x z : H) : + inner ℂ (ejResidualProjection W x) (ejResidualProjection W z) = + inner ℂ (ejResidualProjection W x) z := by + calc + inner ℂ (ejResidualProjection W x) (ejResidualProjection W z) = + inner ℂ (ejResidualProjection W + (ejResidualProjection W x)) z := + (ejResidualProjection_inner W (ejResidualProjection W x) z).symm + _ = inner ℂ (ejResidualProjection W x) z := by + rw [ejResidualProjection_idempotent W x] + +private theorem ejThreeResidual_cross_re_inner (x : H) : + RCLike.re (inner ℂ (ejResidualProjection (V 0) x) + (ejResidualProjection (V 0) (ejThreeResidualMap V x))) + + RCLike.re (inner ℂ (ejResidualProjection (V 1) x) + (ejResidualProjection (V 1) (ejThreeResidualMap V x))) + + RCLike.re (inner ℂ (ejResidualProjection (V 2) x) + (ejResidualProjection (V 2) (ejThreeResidualMap V x))) = + ‖ejThreeResidualMap V x‖ ^ 2 := by + calc + _ = RCLike.re (inner ℂ (ejResidualProjection (V 0) x) + (ejThreeResidualMap V x)) + + RCLike.re (inner ℂ (ejResidualProjection (V 1) x) + (ejThreeResidualMap V x)) + + RCLike.re (inner ℂ (ejResidualProjection (V 2) x) + (ejThreeResidualMap V x)) := by + rw [ejResidualProjection_cross_inner (V 0), + ejResidualProjection_cross_inner (V 1), + ejResidualProjection_cross_inner (V 2)] + _ = RCLike.re (inner ℂ + (ejResidualProjection (V 0) x + + ejResidualProjection (V 1) x + + ejResidualProjection (V 2) x) + (ejThreeResidualMap V x)) := by + simp only [inner_add_left, map_add] + _ = ‖ejThreeResidualMap V x‖ ^ 2 := by + rw [← ejThreeResidualMap_apply V x] + exact (norm_sq_eq_re_inner _).symm + +private theorem norm_sub_one_third_smul_sq (a b : H) : + ‖a - (3 : ℂ)⁻¹ • b‖ ^ 2 = + ‖a‖ ^ 2 - (2 / 3 : ℝ) * RCLike.re (inner ℂ a b) + + (1 / 9 : ℝ) * ‖b‖ ^ 2 := by + rw [norm_sub_sq (𝕜 := ℂ), inner_smul_right, norm_smul] + norm_num [Complex.mul_re] + ring + +private theorem ejResidualProjection_average_norm_sq + (W : Submodule ℂ H) [W.HasOrthogonalProjection] + (x z : H) : + ‖ejResidualProjection W (x - (3 : ℂ)⁻¹ • z)‖ ^ 2 = + ‖ejResidualProjection W x‖ ^ 2 - + (2 / 3 : ℝ) * RCLike.re + (inner ℂ (ejResidualProjection W x) + (ejResidualProjection W z)) + + (1 / 9 : ℝ) * ‖ejResidualProjection W z‖ ^ 2 := by + rw [map_sub, map_smul] + exact norm_sub_one_third_smul_sq + (ejResidualProjection W x) (ejResidualProjection W z) + +private theorem ejThreeResidualEnergy_average (x : H) : + ejThreeResidualEnergy V (ejThreeProjectionAverage V x) = + ejThreeResidualEnergy V x - + (2 / 3 : ℝ) * ‖ejThreeResidualMap V x‖ ^ 2 + + (1 / 9 : ℝ) * + ejThreeResidualEnergy V (ejThreeResidualMap V x) := by + unfold ejThreeResidualEnergy + rw [ejThreeProjectionAverage_apply, + ejResidualProjection_average_norm_sq (V 0), + ejResidualProjection_average_norm_sq (V 1), + ejResidualProjection_average_norm_sq (V 2)] + have hcross := ejThreeResidual_cross_re_inner V x + nlinarith + +private theorem ejThreeResidualMap_spectral_gap (x : H) (ε : ℝ) + (h01 : (1 - ε) * + (‖ejResidualProjection (V 0) x‖ ^ 2 + + ‖ejResidualProjection (V 1) x‖ ^ 2) ≤ + ‖ejResidualProjection (V 0) x + + ejResidualProjection (V 1) x‖ ^ 2) + (h12 : (1 - ε) * + (‖ejResidualProjection (V 1) x‖ ^ 2 + + ‖ejResidualProjection (V 2) x‖ ^ 2) ≤ + ‖ejResidualProjection (V 1) x + + ejResidualProjection (V 2) x‖ ^ 2) + (h20 : (1 - ε) * + (‖ejResidualProjection (V 2) x‖ ^ 2 + + ‖ejResidualProjection (V 0) x‖ ^ 2) ≤ + ‖ejResidualProjection (V 2) x + + ejResidualProjection (V 0) x‖ ^ 2) : + (1 - 2 * ε) * ejThreeResidualEnergy V x ≤ + ‖ejThreeResidualMap V x‖ ^ 2 := by + exact three_pairwise_residual_spectral_gap + (ejResidualProjection (V 0) x) + (ejResidualProjection (V 1) x) + (ejResidualProjection (V 2) x) + ε h01 h12 h20 + +private theorem ejThreeResidualEnergy_average_le + (x : H) (δ : ℝ) + (hgap : δ * ejThreeResidualEnergy V x ≤ + ‖ejThreeResidualMap V x‖ ^ 2) : + ejThreeResidualEnergy V (ejThreeProjectionAverage V x) ≤ + (1 - δ / 3) * ejThreeResidualEnergy V x := by + rw [ejThreeResidualEnergy_average] + have hupper := ejThreeResidualEnergy_le_three_norm_sq V + (ejThreeResidualMap V x) + nlinarith + +private theorem ejStarProjection_mem_inf_orthogonal + (U V : Submodule ℂ H) [U.HasOrthogonalProjection] + (w : H) (hw : w ∈ (U ⊓ V)ᗮ) : + U.starProjection w ∈ (U ⊓ V)ᗮ := by + intro q hq + calc + inner ℂ q (U.starProjection w) = + inner ℂ (U.starProjection q) w := + (Submodule.inner_starProjection_left_eq_right U q w).symm + _ = inner ℂ q w := by + rw [Submodule.starProjection_eq_self_iff.mpr hq.1] + _ = 0 := hw q hq + +private theorem ejTwoProjection_norm_sq_sum_le_of_angle + (U V : Submodule ℂ H) + [U.HasOrthogonalProjection] [V.HasOrthogonalProjection] + (c : ℝ) (hc : 0 ≤ c) + (hangle : ∀ (u v : H), + u ∈ U → u ∈ (U ⊓ V)ᗮ → + v ∈ V → v ∈ (U ⊓ V)ᗮ → + ‖inner ℂ u v‖ ≤ c * ‖u‖ * ‖v‖) + (w : H) (hw : w ∈ (U ⊓ V)ᗮ) : + ‖U.starProjection w‖ ^ 2 + ‖V.starProjection w‖ ^ 2 ≤ + (1 + c) * ‖w‖ ^ 2 := by + let u : H := U.starProjection w + let v : H := V.starProjection w + have hu : u ∈ U := Submodule.starProjection_apply_mem U w + have hv : v ∈ V := Submodule.starProjection_apply_mem V w + have huorth : u ∈ (U ⊓ V)ᗮ := + ejStarProjection_mem_inf_orthogonal U V w hw + have hvorth : v ∈ (U ⊓ V)ᗮ := by + have h := ejStarProjection_mem_inf_orthogonal V U w (by + simpa only [inf_comm] using hw) + simpa only [inf_comm] using h + have hre : RCLike.re (inner ℂ u v) ≤ c * ‖u‖ * ‖v‖ := + (RCLike.re_le_norm (inner ℂ u v)).trans + (hangle u v hu huorth hv hvorth) + have hsum : + ‖u + v‖ ^ 2 ≤ + (1 + c) * (‖u‖ ^ 2 + ‖v‖ ^ 2) := by + rw [norm_add_sq (𝕜 := ℂ)] + nlinarith [mul_nonneg hc (sq_nonneg (‖u‖ - ‖v‖))] + have huinner : + (inner ℂ (U.starProjection w) w).re = + ‖U.starProjection w‖ ^ 2 := by + change RCLike.re (inner ℂ (U.starProjection w) w) = _ + exact ejStarProjection_re_inner U w + have hvinner : + (inner ℂ (V.starProjection w) w).re = + ‖V.starProjection w‖ ^ 2 := by + change RCLike.re (inner ℂ (V.starProjection w) w) = _ + exact ejStarProjection_re_inner V w + have hlinear : + ‖u‖ ^ 2 + ‖v‖ ^ 2 ≤ ‖u + v‖ * ‖w‖ := by + calc + ‖u‖ ^ 2 + ‖v‖ ^ 2 = + RCLike.re (inner ℂ (u + v) w) := by + dsimp [u, v] + simp only [inner_add_left, Complex.add_re] + rw [huinner, hvinner] + _ ≤ ‖inner ℂ (u + v) w‖ := + RCLike.re_le_norm _ + _ ≤ ‖u + v‖ * ‖w‖ := + norm_inner_le_norm _ _ + have hsq : + (‖u‖ ^ 2 + ‖v‖ ^ 2) ^ 2 ≤ + (‖u + v‖ * ‖w‖) ^ 2 := + (sq_le_sq₀ (by positivity) (by positivity)).mpr hlinear + have hcancel : + (‖u‖ ^ 2 + ‖v‖ ^ 2) * + (‖u‖ ^ 2 + ‖v‖ ^ 2) ≤ + ((1 + c) * ‖w‖ ^ 2) * + (‖u‖ ^ 2 + ‖v‖ ^ 2) := by + calc + _ = (‖u‖ ^ 2 + ‖v‖ ^ 2) ^ 2 := by ring + _ ≤ (‖u + v‖ * ‖w‖) ^ 2 := hsq + _ = ‖u + v‖ ^ 2 * ‖w‖ ^ 2 := by ring + _ ≤ ((1 + c) * (‖u‖ ^ 2 + ‖v‖ ^ 2)) * + ‖w‖ ^ 2 := + mul_le_mul_of_nonneg_right hsum (sq_nonneg ‖w‖) + _ = ((1 + c) * ‖w‖ ^ 2) * + (‖u‖ ^ 2 + ‖v‖ ^ 2) := by ring + change ‖u‖ ^ 2 + ‖v‖ ^ 2 ≤ (1 + c) * ‖w‖ ^ 2 + by_cases hz : ‖u‖ ^ 2 + ‖v‖ ^ 2 = 0 + · rw [hz] + positivity + · have hpos : 0 < ‖u‖ ^ 2 + ‖v‖ ^ 2 := + lt_of_le_of_ne (by positivity) (Ne.symm hz) + apply (mul_le_mul_iff_right₀ hpos).mp + calc + _ ≤ ((1 + c) * ‖w‖ ^ 2) * + (‖u‖ ^ 2 + ‖v‖ ^ 2) := hcancel + _ = (‖u‖ ^ 2 + ‖v‖ ^ 2) * + ((1 + c) * ‖w‖ ^ 2) := by ring + +private theorem ejTwoResidualEnergy_ge_of_angle + (U V : Submodule ℂ H) + [U.HasOrthogonalProjection] [V.HasOrthogonalProjection] + (c : ℝ) (hc : 0 ≤ c) + (hangle : ∀ (u v : H), + u ∈ U → u ∈ (U ⊓ V)ᗮ → + v ∈ V → v ∈ (U ⊓ V)ᗮ → + ‖inner ℂ u v‖ ≤ c * ‖u‖ * ‖v‖) + (w : H) (hw : w ∈ (U ⊓ V)ᗮ) : + (1 - c) * ‖w‖ ^ 2 ≤ + ‖ejResidualProjection U w‖ ^ 2 + + ‖ejResidualProjection V w‖ ^ 2 := by + have hU := U.norm_sq_eq_add_norm_sq_starProjection w + have hV := V.norm_sq_eq_add_norm_sq_starProjection w + change ‖w‖ ^ 2 = + ‖U.starProjection w‖ ^ 2 + + ‖ejResidualProjection U w‖ ^ 2 at hU + change ‖w‖ ^ 2 = + ‖V.starProjection w‖ ^ 2 + + ‖ejResidualProjection V w‖ ^ 2 at hV + have hsum := + ejTwoProjection_norm_sq_sum_le_of_angle U V c hc hangle w hw + nlinarith + +private theorem ejTwoResidual_sum_re_inner + (U V : Submodule ℂ H) + [U.HasOrthogonalProjection] [V.HasOrthogonalProjection] + (w : H) : + RCLike.re (inner ℂ + (ejResidualProjection U w + ejResidualProjection V w) w) = + ‖ejResidualProjection U w‖ ^ 2 + + ‖ejResidualProjection V w‖ ^ 2 := by + have hU : + (inner ℂ (ejResidualProjection U w) w).re = + ‖ejResidualProjection U w‖ ^ 2 := by + change RCLike.re (inner ℂ (ejResidualProjection U w) w) = _ + exact ejResidualProjection_re_inner U w + have hV : + (inner ℂ (ejResidualProjection V w) w).re = + ‖ejResidualProjection V w‖ ^ 2 := by + change RCLike.re (inner ℂ (ejResidualProjection V w) w) = _ + exact ejResidualProjection_re_inner V w + change + (inner ℂ + (ejResidualProjection U w + ejResidualProjection V w) w).re = _ + simp only [inner_add_left, Complex.add_re] + rw [hU, hV] + +private theorem ejTwoResidual_spectral_gap_of_angle + (U V : Submodule ℂ H) + [U.HasOrthogonalProjection] [V.HasOrthogonalProjection] + [(U ⊓ V).HasOrthogonalProjection] + (c : ℝ) (hc : 0 ≤ c) (hc' : c ≤ 1) + (hangle : ∀ (u v : H), + u ∈ U → u ∈ (U ⊓ V)ᗮ → + v ∈ V → v ∈ (U ⊓ V)ᗮ → + ‖inner ℂ u v‖ ≤ c * ‖u‖ * ‖v‖) + (x : H) : + (1 - c) * + (‖ejResidualProjection U x‖ ^ 2 + + ‖ejResidualProjection V x‖ ^ 2) ≤ + ‖ejResidualProjection U x + + ejResidualProjection V x‖ ^ 2 := by + let q : H := (U ⊓ V).starProjection x + let w : H := x - q + have hw : w ∈ (U ⊓ V)ᗮ := + Submodule.sub_starProjection_mem_orthogonal x + have hq : q ∈ U ⊓ V := + Submodule.starProjection_apply_mem (U ⊓ V) x + have hqU : ejResidualProjection U q = 0 := by + rw [ejResidualProjection_apply, + Submodule.starProjection_eq_self_iff.mpr hq.1, sub_self] + have hqV : ejResidualProjection V q = 0 := by + rw [ejResidualProjection_apply, + Submodule.starProjection_eq_self_iff.mpr hq.2, sub_self] + have hwU : ejResidualProjection U w = + ejResidualProjection U x := by + dsimp [w] + rw [map_sub, hqU, sub_zero] + have hwV : ejResidualProjection V w = + ejResidualProjection V x := by + dsimp [w] + rw [map_sub, hqV, sub_zero] + let e : ℝ := + ‖ejResidualProjection U w‖ ^ 2 + + ‖ejResidualProjection V w‖ ^ 2 + let z : H := + ejResidualProjection U w + ejResidualProjection V w + have he : 0 ≤ e := by + dsimp [e] + positivity + have hcoercive : (1 - c) * ‖w‖ ^ 2 ≤ e := + ejTwoResidualEnergy_ge_of_angle U V c hc hangle w hw + have hlinear : e ≤ ‖z‖ * ‖w‖ := by + calc + e = RCLike.re (inner ℂ z w) := + (ejTwoResidual_sum_re_inner U V w).symm + _ ≤ ‖inner ℂ z w‖ := RCLike.re_le_norm _ + _ ≤ ‖z‖ * ‖w‖ := norm_inner_le_norm _ _ + have hsq : e ^ 2 ≤ (‖z‖ * ‖w‖) ^ 2 := + (sq_le_sq₀ he (by positivity)).mpr hlinear + have hgap : (1 - c) * e ≤ ‖z‖ ^ 2 := by + by_cases hz : e = 0 + · rw [hz, mul_zero] + positivity + · have hepos : 0 < e := lt_of_le_of_ne he (Ne.symm hz) + apply (mul_le_mul_iff_right₀ hepos).mp + calc + e * ((1 - c) * e) = (1 - c) * e ^ 2 := by ring + _ ≤ (1 - c) * (‖z‖ * ‖w‖) ^ 2 := + mul_le_mul_of_nonneg_left hsq (sub_nonneg.mpr hc') + _ = ‖z‖ ^ 2 * ((1 - c) * ‖w‖ ^ 2) := by ring + _ ≤ ‖z‖ ^ 2 * e := + mul_le_mul_of_nonneg_left hcoercive (sq_nonneg ‖z‖) + _ = e * ‖z‖ ^ 2 := by ring + change (1 - c) * e ≤ ‖z‖ ^ 2 at hgap + dsimp [e, z] at hgap + rw [hwU, hwV] at hgap + exact hgap + +private theorem ejThreeProjectionAverage_dist_sq (x : H) : + dist x (ejThreeProjectionAverage V x) ^ 2 = + (1 / 9 : ℝ) * ‖ejThreeResidualMap V x‖ ^ 2 := by + rw [dist_eq_norm, ejThreeProjectionAverage_apply] + have hsub : + x - (x - (3 : ℂ)⁻¹ • ejThreeResidualMap V x) = + (3 : ℂ)⁻¹ • ejThreeResidualMap V x := by + abel + rw [hsub, norm_smul, norm_inv] + norm_num + ring + +private theorem ejThreeProjectionAverage_dist_sq_le (x : H) : + dist x (ejThreeProjectionAverage V x) ^ 2 ≤ + ejThreeResidualEnergy V x / 3 := by + rw [ejThreeProjectionAverage_dist_sq] + have h := ejThreeResidualMap_norm_sq_le V x + nlinarith + +private theorem ejThreeResidualEnergy_iterate_le + (δ : ℝ) (hδ : δ ≤ 3) + (hgap : ∀ x : H, + δ * ejThreeResidualEnergy V x ≤ ‖ejThreeResidualMap V x‖ ^ 2) + (x : H) (n : ℕ) : + ejThreeResidualEnergy V + (((ejThreeProjectionAverage V : H → H)^[n]) x) ≤ + (1 - δ / 3) ^ n * ejThreeResidualEnergy V x := by + have hnonneg : 0 ≤ 1 - δ / 3 := by linarith + induction n with + | zero => simp only [Function.iterate_zero, id_eq, pow_zero, one_mul, Std.le_refl] + | succ n ih => + rw [Function.iterate_succ_apply'] + calc + ejThreeResidualEnergy V + (ejThreeProjectionAverage V + (((ejThreeProjectionAverage V : H → H)^[n]) x)) ≤ + (1 - δ / 3) * ejThreeResidualEnergy V + (((ejThreeProjectionAverage V : H → H)^[n]) x) := + ejThreeResidualEnergy_average_le V _ δ (hgap _) + _ ≤ (1 - δ / 3) * + ((1 - δ / 3) ^ n * ejThreeResidualEnergy V x) := + mul_le_mul_of_nonneg_left ih hnonneg + _ = (1 - δ / 3) ^ n.succ * + ejThreeResidualEnergy V x := by + rw [pow_succ] + ring + +private theorem ejThreeProjectionAverage_iterate_dist_le_geometric + (δ : ℝ) (hδ : δ ≤ 3) + (hgap : ∀ x : H, + δ * ejThreeResidualEnergy V x ≤ ‖ejThreeResidualMap V x‖ ^ 2) + (x : H) (n : ℕ) : + dist (((ejThreeProjectionAverage V : H → H)^[n]) x) + (((ejThreeProjectionAverage V : H → H)^[n + 1]) x) ≤ + Real.sqrt (ejThreeResidualEnergy V x / 3) * + (1 - δ / 6) ^ n := by + let q : ℝ := 1 - δ / 3 + let r : ℝ := 1 - δ / 6 + have hq : 0 ≤ q := by + dsimp [q] + linarith + have hr : 0 ≤ r := by + dsimp [r] + linarith + have hqr : q ≤ r ^ 2 := by + dsimp [q, r] + nlinarith [sq_nonneg δ] + let y : H := ((ejThreeProjectionAverage V : H → H)^[n]) x + have hiter : + ejThreeResidualEnergy V y ≤ + q ^ n * ejThreeResidualEnergy V x := + ejThreeResidualEnergy_iterate_le V δ hδ hgap x n + have hpow : q ^ n ≤ (r ^ 2) ^ n := + pow_le_pow_left₀ hq hqr n + have henergy : + ejThreeResidualEnergy V y ≤ + r ^ (2 * n) * ejThreeResidualEnergy V x := by + calc + ejThreeResidualEnergy V y ≤ + q ^ n * ejThreeResidualEnergy V x := hiter + _ ≤ (r ^ 2) ^ n * ejThreeResidualEnergy V x := + mul_le_mul_of_nonneg_right hpow + (ejThreeResidualEnergy_nonneg V x) + _ = r ^ (2 * n) * ejThreeResidualEnergy V x := by + rw [pow_mul] + have hstep := ejThreeProjectionAverage_dist_sq_le V y + have hsqrt : + (Real.sqrt (ejThreeResidualEnergy V x / 3)) ^ 2 = + ejThreeResidualEnergy V x / 3 := + Real.sq_sqrt + (div_nonneg (ejThreeResidualEnergy_nonneg V x) (by norm_num)) + have hsquared : + dist y (ejThreeProjectionAverage V y) ^ 2 ≤ + (Real.sqrt (ejThreeResidualEnergy V x / 3) * r ^ n) ^ 2 := by + rw [mul_pow, hsqrt] + have hpower : (r ^ n) ^ 2 = r ^ (2 * n) := by + rw [← pow_mul] + congr 1 + omega + rw [hpower] + nlinarith + have hdist : + dist y (ejThreeProjectionAverage V y) ≤ + Real.sqrt (ejThreeResidualEnergy V x / 3) * r ^ n := + (sq_le_sq₀ (dist_nonneg) (by positivity)).mp hsquared + change dist y + (((ejThreeProjectionAverage V : H → H)^[n + 1]) x) ≤ + Real.sqrt (ejThreeResidualEnergy V x / 3) * r ^ n + rw [Function.iterate_succ_apply'] + exact hdist + +private theorem ejThreeResidual_spectral_gap_of_pair_angles + [∀ i j : Fin 3, (V i ⊓ V j).HasOrthogonalProjection] + (c : ℝ) (hc : 0 ≤ c) (hc' : c ≤ 1) + (hangle : ∀ (i j : Fin 3) (u v : H), + u ∈ V i → u ∈ (V i ⊓ V j)ᗮ → + v ∈ V j → v ∈ (V i ⊓ V j)ᗮ → + ‖inner ℂ u v‖ ≤ c * ‖u‖ * ‖v‖) + (x : H) : + (1 - 2 * c) * ejThreeResidualEnergy V x ≤ + ‖ejThreeResidualMap V x‖ ^ 2 := by + apply ejThreeResidualMap_spectral_gap V x c + · exact ejTwoResidual_spectral_gap_of_angle + (V 0) (V 1) c hc hc' (hangle 0 1) x + · exact ejTwoResidual_spectral_gap_of_angle + (V 1) (V 2) c hc hc' (hangle 1 2) x + · exact ejTwoResidual_spectral_gap_of_angle + (V 2) (V 0) c hc hc' (hangle 2 0) x + +private theorem ejThreeProjectionAverage_iterate_dist_le_of_pair_angles + [∀ i j : Fin 3, (V i ⊓ V j).HasOrthogonalProjection] + (c : ℝ) (hc : 0 ≤ c) (hchalf : c < (1 / 2 : ℝ)) + (hangle : ∀ (i j : Fin 3) (u v : H), + u ∈ V i → u ∈ (V i ⊓ V j)ᗮ → + v ∈ V j → v ∈ (V i ⊓ V j)ᗮ → + ‖inner ℂ u v‖ ≤ c * ‖u‖ * ‖v‖) + (x : H) (n : ℕ) : + dist (((ejThreeProjectionAverage V : H → H)^[n]) x) + (((ejThreeProjectionAverage V : H → H)^[n + 1]) x) ≤ + Real.sqrt (ejThreeResidualEnergy V x / 3) * + (1 - (1 - 2 * c) / 6) ^ n := by + have hc' : c ≤ 1 := by linarith + apply ejThreeProjectionAverage_iterate_dist_le_geometric V + (1 - 2 * c) (by linarith) + intro y + exact ejThreeResidual_spectral_gap_of_pair_angles + V c hc hc' hangle y + +private theorem ejThreeResidualEnergy_sqrt_div_three_le + (x : H) (T : ℝ) (hT : 0 ≤ T) + (hbound : ∀ i : Fin 3, + ‖ejResidualProjection (V i) x‖ ≤ T) : + Real.sqrt (ejThreeResidualEnergy V x / 3) ≤ T := by + have h₀ : ‖ejResidualProjection (V 0) x‖ ^ 2 ≤ T ^ 2 := + (sq_le_sq₀ (norm_nonneg _) hT).mpr (hbound 0) + have h₁ : ‖ejResidualProjection (V 1) x‖ ^ 2 ≤ T ^ 2 := + (sq_le_sq₀ (norm_nonneg _) hT).mpr (hbound 1) + have h₂ : ‖ejResidualProjection (V 2) x‖ ^ 2 ≤ T ^ 2 := + (sq_le_sq₀ (norm_nonneg _) hT).mpr (hbound 2) + apply Real.sqrt_le_iff.mpr + refine ⟨hT, ?_⟩ + unfold ejThreeResidualEnergy + nlinarith + +private theorem ejThreeProjectionAverage_fixed_iff_residualMap_eq_zero (x : H) : + ejThreeProjectionAverage V x = x ↔ + ejThreeResidualMap V x = 0 := by + constructor + · intro h + rw [ejThreeProjectionAverage_apply] at h + have hz : (3 : ℂ)⁻¹ • ejThreeResidualMap V x = 0 := + sub_eq_self.mp h + exact (smul_eq_zero.mp hz).resolve_left (by norm_num) + · intro h + simp only [ejThreeProjectionAverage_apply, h, smul_zero, sub_zero] + +private theorem ejThreeResidualEnergy_eq_zero_iff (x : H) : + ejThreeResidualEnergy V x = 0 ↔ + ∀ i : Fin 3, ejResidualProjection (V i) x = 0 := by + constructor + · intro h i + have h₀ : 0 ≤ ‖ejResidualProjection (V 0) x‖ ^ 2 := + sq_nonneg _ + have h₁ : 0 ≤ ‖ejResidualProjection (V 1) x‖ ^ 2 := + sq_nonneg _ + have h₂ : 0 ≤ ‖ejResidualProjection (V 2) x‖ ^ 2 := + sq_nonneg _ + unfold ejThreeResidualEnergy at h + fin_cases i + · change ejResidualProjection (V 0) x = 0 + apply norm_eq_zero.mp + nlinarith [norm_nonneg (ejResidualProjection (V 0) x)] + · change ejResidualProjection (V 1) x = 0 + apply norm_eq_zero.mp + nlinarith [norm_nonneg (ejResidualProjection (V 1) x)] + · change ejResidualProjection (V 2) x = 0 + apply norm_eq_zero.mp + nlinarith [norm_nonneg (ejResidualProjection (V 2) x)] + · intro h + unfold ejThreeResidualEnergy + simp only [Fin.isValue, h 0, norm_zero, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, + h 1, + add_zero, h 2] + +private theorem ejThreeProjectionAverage_fixed_mem + (x : H) (hx : ejThreeProjectionAverage V x = x) + (i : Fin 3) : x ∈ V i := by + have hD : ejThreeResidualMap V x = 0 := + (ejThreeProjectionAverage_fixed_iff_residualMap_eq_zero V x).mp hx + have hE : ejThreeResidualEnergy V x = 0 := by + rw [ejThreeResidualEnergy_eq_re_inner V x, hD] + simp only [inner_zero_left, RCLike.re_to_complex, Complex.zero_re] + have hres : ejResidualProjection (V i) x = 0 := + (ejThreeResidualEnergy_eq_zero_iff V x).mp hE i + rw [ejResidualProjection_apply, sub_eq_zero] at hres + exact Submodule.starProjection_eq_self_iff.mp hres.symm + +end ThreeOrthogonalProjections + +section ThreeFiniteUnitaryFixedSpaces + +universe u₂ v₂ + +private def ejUnitaryFixedSubmodule + {G : Type u₂} {H : Type v₂} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) (K : Subgroup G) : + Submodule ℂ H where + carrier := {x : H | ∀ k : K, π (k : G) x = x} + zero_mem' k := by simp only [map_zero] + add_mem' hx hy k := by + simp only [map_add, hx k, hy k] + smul_mem' c x hx k := by + simp only [map_smul, hx k] + +@[simp] +private theorem mem_ejUnitaryFixedSubmodule + {G : Type u₂} {H : Type v₂} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) (K : Subgroup G) (x : H) : + x ∈ ejUnitaryFixedSubmodule π K ↔ + ∀ k : K, π (k : G) x = x := + Iff.rfl + +private theorem ejUnitaryFixedSubmodule_isClosed + {G : Type u₂} {H : Type v₂} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) (K : Subgroup G) : + IsClosed (ejUnitaryFixedSubmodule π K : Set H) := by + have hset : + (ejUnitaryFixedSubmodule π K : Set H) = + ⋂ k : K, {x : H | π (k : G) x = x} := by + ext x + simp only [SetLike.mem_coe, mem_ejUnitaryFixedSubmodule, Subtype.forall, Set.mem_iInter, + Set.mem_ofPred_eq] + rw [hset] + exact isClosed_iInter fun k => + isClosed_eq (π (k : G)).continuous continuous_id + +private theorem ejUnitaryFixedSubmodule_inf_isClosed + {G : Type u₂} {H : Type v₂} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) (K J : Subgroup G) : + IsClosed + ((ejUnitaryFixedSubmodule π K ⊓ + ejUnitaryFixedSubmodule π J : Submodule ℂ H) : Set H) := by + change IsClosed + ((ejUnitaryFixedSubmodule π K : Set H) ∩ + (ejUnitaryFixedSubmodule π J : Set H)) + exact (ejUnitaryFixedSubmodule_isClosed π K).inter + (ejUnitaryFixedSubmodule_isClosed π J) + +private instance ejUnitaryFixedSubmodule_completeSpace + {G : Type u₂} {H : Type v₂} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + (π : UnitaryRepresentation G H) (K : Subgroup G) : + CompleteSpace (ejUnitaryFixedSubmodule π K) := + (ejUnitaryFixedSubmodule_isClosed π K).isComplete.completeSpace_coe + +private instance ejUnitaryFixedSubmodule_inf_completeSpace + {G : Type u₂} {H : Type v₂} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + (π : UnitaryRepresentation G H) (K J : Subgroup G) : + CompleteSpace + (↑(ejUnitaryFixedSubmodule π K ⊓ + ejUnitaryFixedSubmodule π J : Submodule ℂ H) : Type v₂) := + (ejUnitaryFixedSubmodule_inf_isClosed π K J).isComplete.completeSpace_coe + +end ThreeFiniteUnitaryFixedSpaces + +end + +namespace ErshovJaikinFiniteSpectral + +open Filter Topology + +universe u v + +section FiniteUnitaryAveraging + +variable {G : Type u} {H : Type v} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + +private def finiteUnitarySubgroupAverage + (π : UnitaryRepresentation G H) + (K : Subgroup G) [Fintype K] (x : H) : H := + (Fintype.card K : ℂ)⁻¹ • ∑ k : K, π (k : G) x + +private theorem finiteUnitarySubgroupAverage_fixed + (π : UnitaryRepresentation G H) + (K : Subgroup G) [Fintype K] (x : H) (g : K) : + π (g : G) (finiteUnitarySubgroupAverage π K x) = + finiteUnitarySubgroupAverage π K x := by + classical + unfold finiteUnitarySubgroupAverage + rw [map_smul, map_sum] + congr 1 + calc + (∑ k : K, π (g : G) (π (k : G) x)) = + ∑ k : K, π ((g * k : K) : G) x := by + apply Finset.sum_congr rfl + intro k _ + simp only [Subgroup.coe_mul, map_mul, LinearIsometryEquiv.coe_mul, Function.comp_apply] + _ = ∑ k : K, π (k : G) x := + Function.Bijective.sum_comp (Group.mulLeft_bijective g) + (fun k : K => π (k : G) x) + +private theorem finiteUnitarySubgroupAverage_sub + (π : UnitaryRepresentation G H) + (K : Subgroup G) [Fintype K] (x : H) : + finiteUnitarySubgroupAverage π K x - x = + (Fintype.card K : ℂ)⁻¹ • + ∑ k : K, (π (k : G) x - x) := by + classical + have hcard : (Fintype.card K : ℂ) ≠ 0 := by + exact_mod_cast Fintype.card_ne_zero + unfold finiteUnitarySubgroupAverage + rw [Finset.sum_sub_distrib, smul_sub] + have hconst : + (Fintype.card K : ℂ)⁻¹ • (∑ _k : K, x) = x := by + simp only [Finset.sum_const, Finset.card_univ, ← Nat.cast_smul_eq_nsmul ℂ, smul_smul, ne_eq, + hcard, + not_false_eq_true, inv_mul_cancel₀, one_smul] + rw [hconst] + +private theorem norm_finiteUnitarySubgroupAverage_sub_le + (π : UnitaryRepresentation G H) + (K : Subgroup G) [Fintype K] (x : H) : + ‖finiteUnitarySubgroupAverage π K x - x‖ ≤ + (Fintype.card K : ℝ)⁻¹ * + ∑ k : K, ‖π (k : G) x - x‖ := by + classical + rw [finiteUnitarySubgroupAverage_sub, norm_smul, norm_inv, + Complex.norm_natCast] + exact mul_le_mul_of_nonneg_left + (norm_sum_le Finset.univ (fun k : K => π (k : G) x - x)) + (by positivity) + +private theorem norm_sub_starProjection_le_finiteUnitarySubgroupAverage + (π : UnitaryRepresentation G H) + (K : Subgroup G) [Fintype K] + (U : Submodule ℂ H) [U.HasOrthogonalProjection] + (x : H) (hmem : finiteUnitarySubgroupAverage π K x ∈ U) : + ‖x - U.starProjection x‖ ≤ + ‖finiteUnitarySubgroupAverage π K x - x‖ := by + rw [Submodule.starProjection_minimal] + have hbound : BddBelow + (Set.range fun z : U => ‖x - (z : H)‖) := + ⟨0, Set.forall_mem_range.mpr fun _ => norm_nonneg _⟩ + calc + (⨅ z : U, ‖x - (z : H)‖) ≤ + ‖x - (⟨finiteUnitarySubgroupAverage π K x, hmem⟩ : U)‖ := + ciInf_le hbound _ + _ = ‖finiteUnitarySubgroupAverage π K x - x‖ := + norm_sub_rev _ _ + +end FiniteUnitaryAveraging + +private theorem hasPropertyT_of_geometric_finite_averaging + {G : Type u} [Group G] (S : Finset G) (q : ℝ) + (hq1 : q < 1) + (haverage : + ∀ (H : Type v) [NormedAddCommGroup H] [InnerProductSpace ℂ H] + [CompleteSpace H] (π : UnitaryRepresentation G H), + ∃ A : H →L[ℂ] H, + (∀ (x : H) (n : ℕ), + dist ((A : H → H)^[n] x) + ((A : H → H)^[n + 1] x) ≤ + (∑ g ∈ S, ‖π g x - x‖) * q ^ n) ∧ + (∀ x : H, A x = x → ∀ g : G, π g x = x)) : + HasPropertyT.{u, v} G := by + classical + let δ : ℝ := (1 - q) / (2 * (S.card + 1)) + have hδ : 0 < δ := by + dsimp [δ] + apply div_pos (sub_pos.mpr hq1) + positivity + refine ⟨⟨{ + generators := S + kazhdanConstant := δ + positive := hδ + invariant := ?_ + }⟩⟩ + intro H _ _ _ π ξ hξ hsmall + obtain ⟨A, hstep, hfixed⟩ := haverage H π + let C : ℝ := ∑ g ∈ S, ‖π g ξ - ξ‖ + let f : ℕ → H := fun n => ((A : H → H)^[n]) ξ + have hgeometric : ∀ n : ℕ, + dist (f n) (f (n + 1)) ≤ C * q ^ n := by + intro n + exact hstep ξ n + have hcauchy : CauchySeq f := + cauchySeq_of_le_geometric q C hq1 hgeometric + obtain ⟨η, hηlim⟩ := cauchySeq_tendsto_of_complete hcauchy + have hηfixed : A η = η := + isFixedPt_of_tendsto_iterate hηlim A.continuous.continuousAt + have hdist : dist ξ η ≤ C / (1 - q) := by + simpa [f] using + (dist_le_of_le_geometric_of_tendsto₀ q C hq1 hgeometric hηlim) + have hsum : C ≤ S.card * δ := by + dsimp [C] + calc + (∑ g ∈ S, ‖π g ξ - ξ‖) ≤ ∑ _g ∈ S, δ := by + exact Finset.sum_le_sum fun g hg => (hsmall g hg).le + _ = S.card * δ := by simp only [Finset.sum_const, nsmul_eq_mul] + have hhalf : C < (1 - q) / 2 := by + calc + C ≤ S.card * δ := hsum + _ < (1 - q) / 2 := by + dsimp [δ] + have hpos : 0 < (1 - q) := sub_pos.mpr hq1 + have hc : (S.card : ℝ) < (S.card : ℝ) + 1 := by linarith + have hcpos : 0 < (S.card : ℝ) + 1 := by positivity + rw [show (2 * (↑S.card + 1) : ℝ) = + 2 * ((S.card : ℝ) + 1) by norm_cast] + calc + (S.card : ℝ) * + ((1 - q) / (2 * ((S.card : ℝ) + 1))) = + ((1 - q) / 2) * + ((S.card : ℝ) / ((S.card : ℝ) + 1)) := by + field_simp + _ < ((1 - q) / 2) * 1 := by + apply mul_lt_mul_of_pos_left + (div_lt_one hcpos |>.mpr hc) + positivity + _ = (1 - q) / 2 := mul_one _ + have hηne : η ≠ 0 := by + intro hzero + subst η + have hone : dist ξ (0 : H) = 1 := by simpa only [dist_zero_right] using hξ + rw [hone] at hdist + have hden : 0 < 1 - q := sub_pos.mpr hq1 + have hlt : C / (1 - q) < 1 / 2 := + (div_lt_iff₀ hden).mpr (by nlinarith [hhalf]) + linarith + exact ⟨η, hηne, hfixed η hηfixed⟩ + +private def threeFiniteSubgroupGenerators + {G : Type u} [Group G] (K : Fin 3 → Subgroup G) + [∀ i, Fintype (K i)] : Finset G := by + classical + exact Finset.univ.biUnion fun i : Fin 3 => + Finset.univ.image fun g : K i => (g : G) + +private theorem mem_threeFiniteSubgroupGenerators + {G : Type u} [Group G] (K : Fin 3 → Subgroup G) + [∀ i, Fintype (K i)] (g : G) : + g ∈ threeFiniteSubgroupGenerators K ↔ ∃ i : Fin 3, g ∈ K i := by + classical + simp only [threeFiniteSubgroupGenerators, Finset.mem_biUnion, Finset.mem_univ, Finset.mem_image, + true_and, + Subtype.exists, exists_prop, exists_eq_right] + +private def unitaryVectorStabilizer + {G : Type u} {H : Type v} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) + (x : H) : Subgroup G where + carrier := {g : G | π g x = x} + one_mem' := by simp only [Set.mem_ofPred_eq, map_one, LinearIsometryEquiv.coe_one, id_eq] + mul_mem' := by + intro g h hg hh + change π g x = x at hg + change π h x = x at hh + change π (g * h) x = x + simpa only [map_mul, LinearIsometryEquiv.coe_mul, Function.comp_apply, hh] using hg + inv_mem' := by + intro g hg + change π g x = x at hg + change π g⁻¹ x = x + have h := congrArg (fun z : H => π g⁻¹ z) hg + simpa only [map_inv, LinearIsometryEquiv.coe_inv, LinearIsometryEquiv.symm_apply_apply] using + h.symm + +private theorem hasPropertyT_of_three_finite_subgroups_geometric + {G : Type u} [Group G] + (K : Fin 3 → Subgroup G) [∀ i, Fintype (K i)] + (hgen : (⨆ i : Fin 3, K i) = ⊤) + (q : ℝ) (hq : q < 1) + (haverage : + ∀ (H : Type v) [NormedAddCommGroup H] [InnerProductSpace ℂ H] + [CompleteSpace H] (π : UnitaryRepresentation G H), + ∃ A : H →L[ℂ] H, + (∀ (x : H) (n : ℕ), + dist ((A : H → H)^[n] x) + ((A : H → H)^[n + 1] x) ≤ + (∑ g ∈ threeFiniteSubgroupGenerators K, + ‖π g x - x‖) * q ^ n) ∧ + (∀ x : H, A x = x → + ∀ (i : Fin 3) (g : K i), π (g : G) x = x)) : + HasPropertyT.{u, v} G := by + apply hasPropertyT_of_geometric_finite_averaging + (threeFiniteSubgroupGenerators K) q hq + intro H _ _ _ π + obtain ⟨A, hstep, hfixed⟩ := haverage H π + refine ⟨A, hstep, ?_⟩ + intro x hx g + have hK : ∀ i : Fin 3, + K i ≤ unitaryVectorStabilizer π x := by + intro i k hk + exact hfixed x hx i ⟨k, hk⟩ + have htop : (⊤ : Subgroup G) ≤ unitaryVectorStabilizer π x := by + rw [← hgen] + exact iSup_le hK + exact htop (show g ∈ (⊤ : Subgroup G) from Subgroup.mem_top g) + +private theorem inv_sqrt_eight_pos : 0 < (Real.sqrt (8 : ℝ))⁻¹ := by + positivity + +private theorem inv_sqrt_eight_lt_one_half : + (Real.sqrt (8 : ℝ))⁻¹ < (1 / 2 : ℝ) := by + have hsqrt : 2 < Real.sqrt (8 : ℝ) := by + have hsq := Real.sq_sqrt (show (0 : ℝ) ≤ 8 by norm_num) + have hnonneg := Real.sqrt_nonneg (8 : ℝ) + nlinarith + simpa only [one_div, gt_iff_lt] using (one_div_lt_one_div_of_lt (show (0 : ℝ) < 2 by norm_num) + hsqrt) + +private theorem norm_inner_le_inv_sqrt_eight_of_sq + {H : Type v} [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (a b : H) + (h : 8 * ‖inner ℂ a b‖ ^ 2 ≤ ‖a‖ ^ 2 * ‖b‖ ^ 2) : + ‖inner ℂ a b‖ ≤ + (Real.sqrt (8 : ℝ))⁻¹ * ‖a‖ * ‖b‖ := by + have hsqrt : 0 < Real.sqrt (8 : ℝ) := by positivity + have hsquare : Real.sqrt (8 : ℝ) ^ 2 = 8 := + Real.sq_sqrt (by norm_num) + have hsq : + ‖inner ℂ a b‖ ^ 2 ≤ + ((Real.sqrt (8 : ℝ))⁻¹ * ‖a‖ * ‖b‖) ^ 2 := by + calc + ‖inner ℂ a b‖ ^ 2 ≤ + (‖a‖ ^ 2 * ‖b‖ ^ 2) / 8 := by + apply (le_div_iff₀ (show (0 : ℝ) < 8 by norm_num)).mpr + nlinarith + _ = ((Real.sqrt (8 : ℝ))⁻¹ * ‖a‖ * ‖b‖) ^ 2 := by + field_simp + nlinarith + exact (sq_le_sq₀ (norm_nonneg _) (by positivity)).mp hsq + +private theorem hasPropertyT_of_three_finite_subgroups_friedrichs_angle + {G : Type u} [Group G] + (K : Fin 3 → Subgroup G) [∀ i, Finite (K i)] + (hgen : (⨆ i : Fin 3, K i) = ⊤) + (c : ℝ) (hc : 0 ≤ c) (hchalf : c < (1 / 2 : ℝ)) + (hangle : + ∀ (H : Type v) [NormedAddCommGroup H] + [InnerProductSpace ℂ H] [CompleteSpace H] + (π : UnitaryRepresentation G H) + (i j : Fin 3), i ≠ j → + ∀ (a b : H), + a ∈ ejUnitaryFixedSubmodule π (K i) → + a ∈ (ejUnitaryFixedSubmodule π (K i) ⊓ + ejUnitaryFixedSubmodule π (K j))ᗮ → + b ∈ ejUnitaryFixedSubmodule π (K j) → + b ∈ (ejUnitaryFixedSubmodule π (K i) ⊓ + ejUnitaryFixedSubmodule π (K j))ᗮ → + ‖inner ℂ a b‖ ≤ c * ‖a‖ * ‖b‖) : + HasPropertyT.{u, v} G := by + classical + let : ∀ i, Fintype (K i) := fun i => Fintype.ofFinite (K i) + let q : ℝ := 1 - (1 - 2 * c) / 6 + have hq : q < 1 := by + dsimp [q] + linarith + have hqnonneg : 0 ≤ q := by + dsimp [q] + linarith + apply hasPropertyT_of_three_finite_subgroups_geometric K hgen q hq + intro H _ _ _ π + let V : Fin 3 → Submodule ℂ H := + fun i => ejUnitaryFixedSubmodule π (K i) + let : ∀ i : Fin 3, (V i).HasOrthogonalProjection := fun i => by + dsimp [V] + infer_instance + let : ∀ i j : Fin 3, + (V i ⊓ V j).HasOrthogonalProjection := fun i j => by + dsimp [V] + infer_instance + refine ⟨ejThreeProjectionAverage V, ?_, ?_⟩ + · intro x n + let T : ℝ := ∑ g ∈ threeFiniteSubgroupGenerators K, + ‖π g x - x‖ + have hT : 0 ≤ T := by + dsimp [T] + positivity + have hpoint (i : Fin 3) (k : K i) : + ‖π (k : G) x - x‖ ≤ T := by + dsimp [T] + exact Finset.single_le_sum + (s := threeFiniteSubgroupGenerators K) + (f := fun g : G => ‖π g x - x‖) + (fun g _ => norm_nonneg _) + ((mem_threeFiniteSubgroupGenerators K (k : G)).mpr + ⟨i, k.property⟩) + have havgbound (i : Fin 3) : + ‖finiteUnitarySubgroupAverage π (K i) x - x‖ ≤ T := by + calc + ‖finiteUnitarySubgroupAverage π (K i) x - x‖ ≤ + (Fintype.card (K i) : ℝ)⁻¹ * + ∑ k : K i, ‖π (k : G) x - x‖ := + norm_finiteUnitarySubgroupAverage_sub_le π (K i) x + _ ≤ (Fintype.card (K i) : ℝ)⁻¹ * + ∑ _k : K i, T := by + apply mul_le_mul_of_nonneg_left + · exact Finset.sum_le_sum fun k _ => hpoint i k + · positivity + _ = T := by + have hcard : (Fintype.card (K i) : ℝ) ≠ 0 := by + exact_mod_cast Fintype.card_ne_zero + simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul, ne_eq, hcard, + not_false_eq_true, + inv_mul_cancel_left₀] + have hres (i : Fin 3) : + ‖ejResidualProjection (V i) x‖ ≤ T := by + rw [ejResidualProjection_apply] + apply le_trans + (norm_sub_starProjection_le_finiteUnitarySubgroupAverage + π (K i) (V i) x ?_) + (havgbound i) + exact (mem_ejUnitaryFixedSubmodule π (K i) _).mpr + (finiteUnitarySubgroupAverage_fixed π (K i) x) + have hfullangle : ∀ (i j : Fin 3) (a b : H), + a ∈ V i → a ∈ (V i ⊓ V j)ᗮ → + b ∈ V j → b ∈ (V i ⊓ V j)ᗮ → + ‖inner ℂ a b‖ ≤ c * ‖a‖ * ‖b‖ := by + intro i j a b ha haorth hb hborth + by_cases hij : i = j + · subst j + have hazero : a = 0 := + inner_self_eq_zero.mp (haorth a ⟨ha, ha⟩) + simp only [hazero, inner_zero_left, norm_zero, mul_zero, zero_mul, Std.le_refl] + · exact hangle H π i j hij a b ha haorth hb hborth + calc + dist (((ejThreeProjectionAverage V : H → H)^[n]) x) + (((ejThreeProjectionAverage V : H → H)^[n + 1]) x) + ≤ Real.sqrt (ejThreeResidualEnergy V x / 3) * + (1 - (1 - 2 * c) / 6) ^ n := + ejThreeProjectionAverage_iterate_dist_le_of_pair_angles + V c hc hchalf hfullangle x n + _ ≤ T * q ^ n := by + change Real.sqrt (ejThreeResidualEnergy V x / 3) * + q ^ n ≤ T * q ^ n + exact mul_le_mul_of_nonneg_right + (ejThreeResidualEnergy_sqrt_div_three_le + V x T hT hres) + (pow_nonneg hqnonneg n) + _ = (∑ g ∈ threeFiniteSubgroupGenerators K, + ‖π g x - x‖) * q ^ n := by + rfl + · intro x hx i k + have hxmem : x ∈ V i := + ejThreeProjectionAverage_fixed_mem V x hx i + exact (mem_ejUnitaryFixedSubmodule π (K i) x).mp + hxmem k + +end ErshovJaikinFiniteSpectral + +section + +open scoped BigOperators commutatorElement + +private abbrev finiteBlockGaloisField : Type := GaloisField 2 3 + +private def finiteBlockGaloisBasis : + Module.Basis (Fin 3) (ZMod 2) finiteBlockGaloisField := + Module.finBasisOfFinrankEq (ZMod 2) finiteBlockGaloisField + (GaloisField.finrank 2 (by decide)) + +private def finiteBlockGaloisMatrix : + finiteBlockGaloisField →ₐ[ZMod 2] + Matrix (Fin 3) (Fin 3) (ZMod 2) := + Algebra.leftMulMatrix finiteBlockGaloisBasis + +private theorem finiteBlockGaloisField_natCard : + Nat.card finiteBlockGaloisField = 8 := by + simpa only [Nat.reducePow] using (GaloisField.card 2 3 (by decide)) + +private def finiteBlockGaloisMatrixOver (R : Type*) [Ring R] + [Algebra (ZMod 2) R] : + finiteBlockGaloisField →+* Matrix (Fin 3) (Fin 3) R := + (RingHom.mapMatrix (algebraMap (ZMod 2) R)).comp + finiteBlockGaloisMatrix.toRingHom + +section ActualBlockRoots + +variable {R : Type*} [Ring R] [Algebra (ZMod 2) R] + +private theorem finiteBlockCoefficientMatrix_mul_binary_mem + (W : Submodule (ZMod 2) R) + (A : Matrix (Fin 3) (Fin 3) R) + (hA : ∀ i j, A i j ∈ W) + (B : Matrix (Fin 3) (Fin 3) (ZMod 2)) : + ∀ i j, + (A * RingHom.mapMatrix (algebraMap (ZMod 2) R) B) i j ∈ W := by + intro i j + rw [Matrix.mul_apply] + apply Submodule.sum_mem + intro k _ + rw [RingHom.mapMatrix_apply, Matrix.map_apply] + rw [← Algebra.commutes, ← Algebra.smul_def] + exact W.smul_mem (B k j) (hA i k) + +private theorem finiteBlockCoefficientMatrix_binary_mul_mem + (W : Submodule (ZMod 2) R) + (A : Matrix (Fin 3) (Fin 3) R) + (hA : ∀ i j, A i j ∈ W) + (B : Matrix (Fin 3) (Fin 3) (ZMod 2)) : + ∀ i j, + (RingHom.mapMatrix (algebraMap (ZMod 2) R) B * A) i j ∈ W := by + intro i j + rw [Matrix.mul_apply] + apply Submodule.sum_mem + intro k _ + rw [RingHom.mapMatrix_apply, Matrix.map_apply, ← Algebra.smul_def] + exact W.smul_mem (B i k) (hA k j) + +private theorem finiteBlockCoefficientMatrix_mul_galois_mem + (W : Submodule (ZMod 2) R) + (A : Matrix (Fin 3) (Fin 3) R) + (hA : ∀ i j, A i j ∈ W) + (t : finiteBlockGaloisField) : + ∀ i j, (A * finiteBlockGaloisMatrixOver R t) i j ∈ W := by + change ∀ i j, + (A * RingHom.mapMatrix (algebraMap (ZMod 2) R) + (finiteBlockGaloisMatrix t)) i j ∈ W + exact finiteBlockCoefficientMatrix_mul_binary_mem W A hA + (finiteBlockGaloisMatrix t) + +private theorem finiteBlockCoefficientMatrix_galois_mul_mem + (W : Submodule (ZMod 2) R) + (A : Matrix (Fin 3) (Fin 3) R) + (hA : ∀ i j, A i j ∈ W) + (t : finiteBlockGaloisField) : + ∀ i j, (finiteBlockGaloisMatrixOver R t * A) i j ∈ W := by + change ∀ i j, + (RingHom.mapMatrix (algebraMap (ZMod 2) R) + (finiteBlockGaloisMatrix t) * A) i j ∈ W + exact finiteBlockCoefficientMatrix_binary_mul_mem W A hA + (finiteBlockGaloisMatrix t) + +private def finiteBlockCoefficientMatrixHom + (W : Submodule (ZMod 2) R) : + Matrix (Fin 3) (Fin 3) W →+ + Matrix (Fin 3) (Fin 3) R := + W.subtype.toAddMonoidHom.mapMatrix + +private def finiteOuterBlockRootHom + (W : Submodule (ZMod 2) R) (i j : Fin 3) (hij : i ≠ j) : + Multiplicative (Matrix (Fin 3) (Fin 3) W) →* + elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R) := + (elementaryRootHom (R := Matrix (Fin 3) (Fin 3) R) i j hij).comp + (finiteBlockCoefficientMatrixHom W).toMultiplicative + +private def finiteOuterBlockRootSubgroup + (W : Submodule (ZMod 2) R) (i j : Fin 3) (hij : i ≠ j) : + Subgroup (elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) := + (finiteOuterBlockRootHom W i j hij).range + +private theorem finite_finiteOuterBlockRootSubgroup + (W : Submodule (ZMod 2) R) [Finite W] + (i j : Fin 3) (hij : i ≠ j) : + Finite (finiteOuterBlockRootSubgroup W i j hij) := by + let f : Multiplicative (Matrix (Fin 3) (Fin 3) W) → + finiteOuterBlockRootSubgroup W i j hij := + fun x => ⟨finiteOuterBlockRootHom W i j hij x, ⟨x, rfl⟩⟩ + apply Finite.of_surjective f + intro x + obtain ⟨a, ha⟩ := x.property + exact ⟨a, Subtype.ext ha⟩ + +omit [Algebra (ZMod 2) R] in +private theorem finiteOuterElementaryRoot_commutator + (i j k : Fin 3) (hij : i ≠ j) (hjk : j ≠ k) (hik : i ≠ k) + (A B : Matrix (Fin 3) (Fin 3) R) : + ⁅elementaryRootHom i j hij (Multiplicative.ofAdd A), + elementaryRootHom j k hjk (Multiplicative.ofAdd B)⁆ = + elementaryRootHom i k hik (Multiplicative.ofAdd (A * B)) := by + apply Subtype.ext + exact elementaryUnit_commutator i j k hij hjk hik A B + +omit [Algebra (ZMod 2) R] in +private theorem finiteOuterElementaryRoot_conjugate_by_successor + (i j k : Fin 3) (hij : i ≠ j) (hjk : j ≠ k) (hik : i ≠ k) + (A B : Matrix (Fin 3) (Fin 3) R) : + let x := elementaryRootHom i j hij (Multiplicative.ofAdd A) + let y := elementaryRootHom j k hjk (Multiplicative.ofAdd B) + let z := elementaryRootHom i k hik (Multiplicative.ofAdd (A * B)) + y * x * y⁻¹ = z⁻¹ * x := by + dsimp + rw [← finiteOuterElementaryRoot_commutator i j k hij hjk hik A B] + simp only [commutatorElement_def] + group + +omit [Algebra (ZMod 2) R] in +private theorem finiteOuterElementaryUnit_commute_of_nonadjacent + (i j k l : Fin 3) (hij : i ≠ j) (hkl : k ≠ l) + (hjk : j ≠ k) (hli : l ≠ i) + (A B : Matrix (Fin 3) (Fin 3) R) : + Commute (elementaryUnit i j hij A) (elementaryUnit k l hkl B) := by + apply Units.ext + change + (1 + Matrix.single i j A) * (1 + Matrix.single k l B) = + (1 + Matrix.single k l B) * (1 + Matrix.single i j A) + have hAB : Matrix.single i j A * Matrix.single k l B = 0 := + Matrix.single_mul_single_of_ne (c := A) i j k hjk B + have hBA : Matrix.single k l B * Matrix.single i j A = 0 := + Matrix.single_mul_single_of_ne (c := B) k l i hli A + noncomm_ring [hAB, hBA] + +omit [Algebra (ZMod 2) R] in +private theorem finiteOuterElementaryRoot_commute_of_nonadjacent + (i j k l : Fin 3) (hij : i ≠ j) (hkl : k ≠ l) + (hjk : j ≠ k) (hli : l ≠ i) + (A B : Matrix (Fin 3) (Fin 3) R) : + Commute + (elementaryRootHom i j hij (Multiplicative.ofAdd A)) + (elementaryRootHom k l hkl (Multiplicative.ofAdd B)) := by + apply Subtype.ext + exact (finiteOuterElementaryUnit_commute_of_nonadjacent + i j k l hij hkl hjk hli A B).eq + +omit [Algebra (ZMod 2) R] in +private theorem finiteOuterElementaryRoot_commute_same + (i j : Fin 3) (hij : i ≠ j) + (A B : Matrix (Fin 3) (Fin 3) R) : + Commute + (elementaryRootHom i j hij (Multiplicative.ofAdd A)) + (elementaryRootHom i j hij (Multiplicative.ofAdd B)) := by + change + elementaryRootHom i j hij (Multiplicative.ofAdd A) * + elementaryRootHom i j hij (Multiplicative.ofAdd B) = + elementaryRootHom i j hij (Multiplicative.ofAdd B) * + elementaryRootHom i j hij (Multiplicative.ofAdd A) + calc + _ = elementaryRootHom i j hij + (Multiplicative.ofAdd A * Multiplicative.ofAdd B) := + (map_mul (elementaryRootHom i j hij) + (Multiplicative.ofAdd A) (Multiplicative.ofAdd B)).symm + _ = elementaryRootHom i j hij + (Multiplicative.ofAdd B * Multiplicative.ofAdd A) := by + rw [mul_comm] + _ = _ := map_mul (elementaryRootHom i j hij) + (Multiplicative.ofAdd B) (Multiplicative.ofAdd A) + +private def finiteBlockCoefficientMatrixRightMul + (W : Submodule (ZMod 2) R) + (B : Matrix (Fin 3) (Fin 3) W) : + Matrix (Fin 3) (Fin 3) W →+ + Matrix (Fin 3) (Fin 3) R where + toFun A := + finiteBlockCoefficientMatrixHom W A * + finiteBlockCoefficientMatrixHom W B + map_zero' := by simp only [map_zero, zero_mul] + map_add' A C := by simp only [map_add, add_mul] + +private def finiteOuterBlockProductCentralRootHom + (W : Submodule (ZMod 2) R) + (i k : Fin 3) (hik : i ≠ k) + (B : Matrix (Fin 3) (Fin 3) W) : + Multiplicative (Matrix (Fin 3) (Fin 3) W) →* + elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R) := + (elementaryRootHom + (R := Matrix (Fin 3) (Fin 3) R) i k hik).comp + (finiteBlockCoefficientMatrixRightMul W B).toMultiplicative + +private def finiteOuterBlockProductCentralRootSubgroup + (W : Submodule (ZMod 2) R) + (i k : Fin 3) (hik : i ≠ k) + (B : Matrix (Fin 3) (Fin 3) W) : + Subgroup (elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) := + (finiteOuterBlockProductCentralRootHom W i k hik B).range + +private theorem finiteOuterBlockRoot_commutator_mem_productCentral + (W : Submodule (ZMod 2) R) + (i j k : Fin 3) (hij : i ≠ j) (hjk : j ≠ k) (hik : i ≠ k) + (A B : Matrix (Fin 3) (Fin 3) W) : + ⁅finiteOuterBlockRootHom W i j hij (Multiplicative.ofAdd A), + finiteOuterBlockRootHom W j k hjk (Multiplicative.ofAdd B)⁆ ∈ + finiteOuterBlockProductCentralRootSubgroup W i k hik B := by + refine ⟨Multiplicative.ofAdd A, ?_⟩ + change + elementaryRootHom i k hik + (Multiplicative.ofAdd + (finiteBlockCoefficientMatrixHom W A * + finiteBlockCoefficientMatrixHom W B)) = + ⁅elementaryRootHom i j hij + (Multiplicative.ofAdd (finiteBlockCoefficientMatrixHom W A)), + elementaryRootHom j k hjk + (Multiplicative.ofAdd (finiteBlockCoefficientMatrixHom W B))⁆ + exact (finiteOuterElementaryRoot_commutator i j k hij hjk hik + (finiteBlockCoefficientMatrixHom W A) + (finiteBlockCoefficientMatrixHom W B)).symm + +private theorem finiteOuterBlockRoot_commutator_exists_productCentral + (W : Submodule (ZMod 2) R) + (i j k : Fin 3) (hij : i ≠ j) (hjk : j ≠ k) (hik : i ≠ k) + (x y : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) + (hx : x ∈ finiteOuterBlockRootSubgroup W i j hij) + (hy : y ∈ finiteOuterBlockRootSubgroup W j k hjk) : + ∃ B : Matrix (Fin 3) (Fin 3) W, + ⁅x, y⁆ ∈ finiteOuterBlockProductCentralRootSubgroup W i k hik B := by + obtain ⟨A, rfl⟩ := hx + obtain ⟨B, rfl⟩ := hy + exact ⟨B.toAdd, + finiteOuterBlockRoot_commutator_mem_productCentral + W i j k hij hjk hik A.toAdd B.toAdd⟩ + +private theorem finiteOuterBlockProductCentralRoot_commute_left + (W : Submodule (ZMod 2) R) + (i j k : Fin 3) (hij : i ≠ j) (hik : i ≠ k) + (B : Matrix (Fin 3) (Fin 3) W) + (x z : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) + (hx : x ∈ finiteOuterBlockRootSubgroup W i j hij) + (hz : z ∈ finiteOuterBlockProductCentralRootSubgroup W i k hik B) : + Commute x z := by + obtain ⟨A, rfl⟩ := hx + obtain ⟨C, rfl⟩ := hz + exact finiteOuterElementaryRoot_commute_of_nonadjacent + i j i k hij hik hij.symm hik.symm + (finiteBlockCoefficientMatrixHom W A.toAdd) + (finiteBlockCoefficientMatrixRightMul W B C.toAdd) + +private theorem finiteOuterBlockProductCentralRoot_commute_right + (W : Submodule (ZMod 2) R) + (i j k : Fin 3) (hjk : j ≠ k) (hik : i ≠ k) + (B : Matrix (Fin 3) (Fin 3) W) + (y z : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) + (hy : y ∈ finiteOuterBlockRootSubgroup W j k hjk) + (hz : z ∈ finiteOuterBlockProductCentralRootSubgroup W i k hik B) : + Commute y z := by + obtain ⟨A, rfl⟩ := hy + obtain ⟨C, rfl⟩ := hz + exact finiteOuterElementaryRoot_commute_of_nonadjacent + j k i k hjk hik hik.symm hjk.symm + (finiteBlockCoefficientMatrixHom W A.toAdd) + (finiteBlockCoefficientMatrixRightMul W B C.toAdd) + +private theorem finiteOuterBlockProductCentralRoot_pair_le_centralizer + (W : Submodule (ZMod 2) R) + (i j k : Fin 3) (hij : i ≠ j) (hjk : j ≠ k) (hik : i ≠ k) + (B : Matrix (Fin 3) (Fin 3) W) : + finiteOuterBlockRootSubgroup W i j hij ⊔ + finiteOuterBlockRootSubgroup W j k hjk ≤ + Subgroup.centralizer + (finiteOuterBlockProductCentralRootSubgroup W i k hik B : + Set (elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R))) := by + apply sup_le + · intro x hx + rw [Subgroup.mem_centralizer_iff] + intro z hz + exact (finiteOuterBlockProductCentralRoot_commute_left + W i j k hij hik B x z hx hz).symm.eq + · intro y hy + rw [Subgroup.mem_centralizer_iff] + intro z hz + exact (finiteOuterBlockProductCentralRoot_commute_right + W i j k hjk hik B y z hy hz).symm.eq + +private theorem finiteOuterBlockProductCentralRoots_commute + (W : Submodule (ZMod 2) R) + (i k : Fin 3) (hik : i ≠ k) + (B C : Matrix (Fin 3) (Fin 3) W) + (z w : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) + (hz : z ∈ finiteOuterBlockProductCentralRootSubgroup W i k hik B) + (hw : w ∈ finiteOuterBlockProductCentralRootSubgroup W i k hik C) : + Commute z w := by + obtain ⟨A, rfl⟩ := hz + obtain ⟨D, rfl⟩ := hw + exact finiteOuterElementaryRoot_commute_same i k hik + (finiteBlockCoefficientMatrixRightMul W B A.toAdd) + (finiteBlockCoefficientMatrixRightMul W C D.toAdd) + +private def finiteBlockGaloisLeftProductCoefficientMatrix + (W : Submodule (ZMod 2) R) + (B : Matrix (Fin 3) (Fin 3) W) + (t : finiteBlockGaloisField) : + Matrix (Fin 3) (Fin 3) W := + fun p q => + ⟨(finiteBlockGaloisMatrixOver R t * + finiteBlockCoefficientMatrixHom W B) p q, + finiteBlockCoefficientMatrix_galois_mul_mem W + (finiteBlockCoefficientMatrixHom W B) + (fun i j => (B i j).property) t p q⟩ + +private theorem finiteBlockCoefficientMatrixHom_galoisLeftProduct + (W : Submodule (ZMod 2) R) + (B : Matrix (Fin 3) (Fin 3) W) + (t : finiteBlockGaloisField) : + finiteBlockCoefficientMatrixHom W + (finiteBlockGaloisLeftProductCoefficientMatrix W B t) = + finiteBlockGaloisMatrixOver R t * + finiteBlockCoefficientMatrixHom W B := by + ext p q + rfl + +private def finiteOuterBlockGaloisConjugatorWithCoefficient + (W : Submodule (ZMod 2) R) + (j k : Fin 3) (hjk : j ≠ k) + (B : Matrix (Fin 3) (Fin 3) W) + (t : finiteBlockGaloisField) : + elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R) := + elementaryRootHom j k hjk + (Multiplicative.ofAdd + (finiteBlockGaloisMatrixOver R t * + finiteBlockCoefficientMatrixHom W B)) + +private theorem finiteOuterBlockGaloisConjugatorWithCoefficient_mem + (W : Submodule (ZMod 2) R) + (j k : Fin 3) (hjk : j ≠ k) + (B : Matrix (Fin 3) (Fin 3) W) + (t : finiteBlockGaloisField) : + finiteOuterBlockGaloisConjugatorWithCoefficient W j k hjk B t ∈ + finiteOuterBlockRootSubgroup W j k hjk := by + refine ⟨Multiplicative.ofAdd + (finiteBlockGaloisLeftProductCoefficientMatrix W B t), ?_⟩ + change + elementaryRootHom j k hjk + (Multiplicative.ofAdd + (finiteBlockCoefficientMatrixHom W + (finiteBlockGaloisLeftProductCoefficientMatrix W B t))) = + elementaryRootHom j k hjk + (Multiplicative.ofAdd + (finiteBlockGaloisMatrixOver R t * + finiteBlockCoefficientMatrixHom W B)) + rw [finiteBlockCoefficientMatrixHom_galoisLeftProduct] + +private def finiteOuterBlockGaloisConjugateRootWithCoefficient + (W : Submodule (ZMod 2) R) + (i j k : Fin 3) (hij : i ≠ j) (hjk : j ≠ k) + (B : Matrix (Fin 3) (Fin 3) W) + (t : finiteBlockGaloisField) : + Subgroup (elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) := + (finiteOuterBlockRootSubgroup W i j hij).map + (MulAut.conj + (finiteOuterBlockGaloisConjugatorWithCoefficient + W j k hjk B t)).toMonoidHom + +omit [Algebra (ZMod 2) R] in +private theorem finiteOuterElementaryRootConjugates_commute + (i j k : Fin 3) (hij : i ≠ j) (hjk : j ≠ k) (hik : i ≠ k) + (A C P Q : Matrix (Fin 3) (Fin 3) R) : + Commute + (MulAut.conj + (elementaryRootHom j k hjk (Multiplicative.ofAdd P)) + (elementaryRootHom i j hij (Multiplicative.ofAdd A))) + (MulAut.conj + (elementaryRootHom j k hjk (Multiplicative.ofAdd Q)) + (elementaryRootHom i j hij (Multiplicative.ofAdd C))) := by + rw [MulAut.conj_apply, MulAut.conj_apply, + finiteOuterElementaryRoot_conjugate_by_successor + i j k hij hjk hik A P, + finiteOuterElementaryRoot_conjugate_by_successor + i j k hij hjk hik C Q] + have hzz := finiteOuterElementaryRoot_commute_same + i k hik (A * P) (C * Q) + have hzx := finiteOuterElementaryRoot_commute_of_nonadjacent + i k i j hik hij hik.symm hij.symm (A * P) C + have hxz := finiteOuterElementaryRoot_commute_of_nonadjacent + i j i k hij hik hij.symm hik.symm A (C * Q) + have hxx := finiteOuterElementaryRoot_commute_same i j hij A C + exact (hzz.inv_inv.mul_right hzx.inv_left).mul_left + (hxz.inv_right.mul_right hxx) + +private theorem finiteOuterBlockGaloisConjugateRootsWithCoefficient_commute + (W : Submodule (ZMod 2) R) + (i j k : Fin 3) (hij : i ≠ j) (hjk : j ≠ k) (hik : i ≠ k) + (B : Matrix (Fin 3) (Fin 3) W) + (s t : finiteBlockGaloisField) + (x y : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) + (hx : x ∈ finiteOuterBlockGaloisConjugateRootWithCoefficient + W i j k hij hjk B s) + (hy : y ∈ finiteOuterBlockGaloisConjugateRootWithCoefficient + W i j k hij hjk B t) : + Commute x y := by + obtain ⟨_, ⟨A, rfl⟩, rfl⟩ := hx + obtain ⟨_, ⟨C, rfl⟩, rfl⟩ := hy + exact finiteOuterElementaryRootConjugates_commute + i j k hij hjk hik + (finiteBlockCoefficientMatrixHom W A.toAdd) + (finiteBlockCoefficientMatrixHom W C.toAdd) + (finiteBlockGaloisMatrixOver R s * + finiteBlockCoefficientMatrixHom W B) + (finiteBlockGaloisMatrixOver R t * + finiteBlockCoefficientMatrixHom W B) + +private def finiteBlockGaloisRightInverseCoefficientMatrix + (W : Submodule (ZMod 2) R) + (A : Matrix (Fin 3) (Fin 3) W) + (s t : finiteBlockGaloisField) : + Matrix (Fin 3) (Fin 3) W := + fun p q => + ⟨(finiteBlockCoefficientMatrixHom W A * + finiteBlockGaloisMatrixOver R (t - s)⁻¹) p q, + finiteBlockCoefficientMatrix_mul_galois_mem W + (finiteBlockCoefficientMatrixHom W A) + (fun i j => (A i j).property) (t - s)⁻¹ p q⟩ + +private theorem finiteBlockCoefficientMatrixHom_galoisRightInverse + (W : Submodule (ZMod 2) R) + (A : Matrix (Fin 3) (Fin 3) W) + (s t : finiteBlockGaloisField) : + finiteBlockCoefficientMatrixHom W + (finiteBlockGaloisRightInverseCoefficientMatrix W A s t) = + finiteBlockCoefficientMatrixHom W A * + finiteBlockGaloisMatrixOver R (t - s)⁻¹ := by + ext p q + rfl + +private theorem finiteBlockGalois_right_inverse_difference + (s t : finiteBlockGaloisField) (hst : s ≠ t) + (C : Matrix (Fin 3) (Fin 3) R) : + (C * finiteBlockGaloisMatrixOver R (t - s)⁻¹) * + finiteBlockGaloisMatrixOver R t - + (C * finiteBlockGaloisMatrixOver R (t - s)⁻¹) * + finiteBlockGaloisMatrixOver R s = C := by + rw [← mul_sub, ← map_sub, mul_assoc, ← map_mul, + inv_mul_cancel₀ (sub_ne_zero.mpr hst.symm), map_one, mul_one] + +private theorem finiteOuterBlockProductCentralRoot_le_galoisConjugates + (W : Submodule (ZMod 2) R) + (i j k : Fin 3) (hij : i ≠ j) (hjk : j ≠ k) (hik : i ≠ k) + (B : Matrix (Fin 3) (Fin 3) W) + (s t : finiteBlockGaloisField) (hst : s ≠ t) : + finiteOuterBlockProductCentralRootSubgroup W i k hik B ≤ + finiteOuterBlockGaloisConjugateRootWithCoefficient + W i j k hij hjk B s ⊔ + finiteOuterBlockGaloisConjugateRootWithCoefficient + W i j k hij hjk B t := by + intro z hz + obtain ⟨A, rfl⟩ := hz + let D : Matrix (Fin 3) (Fin 3) W := + finiteBlockGaloisRightInverseCoefficientMatrix W A.toAdd s t + let x : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R) := + finiteOuterBlockRootHom W i j hij (Multiplicative.ofAdd D) + let ys : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R) := + finiteOuterBlockGaloisConjugatorWithCoefficient W j k hjk B s + let yt : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R) := + finiteOuterBlockGaloisConjugatorWithCoefficient W j k hjk B t + let J : Subgroup (elementaryGroup (Fin 3) + (Matrix (Fin 3) (Fin 3) R)) := + finiteOuterBlockGaloisConjugateRootWithCoefficient + W i j k hij hjk B s ⊔ + finiteOuterBlockGaloisConjugateRootWithCoefficient + W i j k hij hjk B t + have hx : x ∈ finiteOuterBlockRootSubgroup W i j hij := + ⟨Multiplicative.ofAdd D, rfl⟩ + have hs : MulAut.conj ys x ∈ + finiteOuterBlockGaloisConjugateRootWithCoefficient + W i j k hij hjk B s := + ⟨x, hx, rfl⟩ + have ht : MulAut.conj yt x ∈ + finiteOuterBlockGaloisConjugateRootWithCoefficient + W i j k hij hjk B t := + ⟨x, hx, rfl⟩ + have hprod : MulAut.conj ys x * (MulAut.conj yt x)⁻¹ ∈ J := + J.mul_mem (Subgroup.mem_sup_left hs) + (J.inv_mem (Subgroup.mem_sup_right ht)) + let C₀ : Matrix (Fin 3) (Fin 3) R := + finiteBlockCoefficientMatrixHom W A.toAdd + let B₀ : Matrix (Fin 3) (Fin 3) R := + finiteBlockCoefficientMatrixHom W B + let D₀ : Matrix (Fin 3) (Fin 3) R := + finiteBlockCoefficientMatrixHom W D + let P : Matrix (Fin 3) (Fin 3) R := + finiteBlockGaloisMatrixOver R s * B₀ + let Q : Matrix (Fin 3) (Fin 3) R := + finiteBlockGaloisMatrixOver R t * B₀ + have hD : D₀ = C₀ * finiteBlockGaloisMatrixOver R (t - s)⁻¹ := + finiteBlockCoefficientMatrixHom_galoisRightInverse W A.toAdd s t + have hdiff : - (D₀ * P) + D₀ * Q = C₀ * B₀ := by + calc + - (D₀ * P) + D₀ * Q = + (D₀ * finiteBlockGaloisMatrixOver R t - + D₀ * finiteBlockGaloisMatrixOver R s) * B₀ := by + dsimp [P, Q] + noncomm_ring + _ = C₀ * B₀ := by + rw [hD, finiteBlockGalois_right_inverse_difference s t hst C₀] + have hroot : + (elementaryRootHom i k hik (Multiplicative.ofAdd (D₀ * P)))⁻¹ * + elementaryRootHom i k hik (Multiplicative.ofAdd (D₀ * Q)) = + finiteOuterBlockProductCentralRootHom W i k hik B A := by + calc + _ = elementaryRootHom i k hik + ((Multiplicative.ofAdd (D₀ * P))⁻¹ * + Multiplicative.ofAdd (D₀ * Q)) := by + simp only [map_mul, map_inv] + _ = elementaryRootHom i k hik + (Multiplicative.ofAdd (C₀ * B₀)) := by + congr 1 + _ = finiteOuterBlockProductCentralRootHom W i k hik B A := by + rfl + change + MulAut.conj + (elementaryRootHom j k hjk (Multiplicative.ofAdd P)) + (elementaryRootHom i j hij (Multiplicative.ofAdd D₀)) * + (MulAut.conj + (elementaryRootHom j k hjk (Multiplicative.ofAdd Q)) + (elementaryRootHom i j hij (Multiplicative.ofAdd D₀)))⁻¹ ∈ J + at hprod + simp only [MulAut.conj_apply] at hprod + rw [finiteOuterElementaryRoot_conjugate_by_successor + i j k hij hjk hik D₀ P, + finiteOuterElementaryRoot_conjugate_by_successor + i j k hij hjk hik D₀ Q] at hprod + have hcancel : + ((elementaryRootHom i k hik (Multiplicative.ofAdd (D₀ * P)))⁻¹ * + elementaryRootHom i j hij (Multiplicative.ofAdd D₀)) * + ((elementaryRootHom i k hik (Multiplicative.ofAdd (D₀ * Q)))⁻¹ * + elementaryRootHom i j hij (Multiplicative.ofAdd D₀))⁻¹ = + (elementaryRootHom i k hik (Multiplicative.ofAdd (D₀ * P)))⁻¹ * + elementaryRootHom i k hik (Multiplicative.ofAdd (D₀ * Q)) := by + group + rw [hcancel, hroot] at hprod + exact hprod + +end ActualBlockRoots + +universe u₁ v₁ + +private def UnitaryRepresentation.toRepresentation + {G : Type u₁} {H : Type v₁} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) : Representation ℂ G H where + toFun g := (π g).toLinearEquiv.toLinearMap + map_one' := by + ext x + simp only [map_one, LinearEquiv.coe_coe, LinearIsometryEquiv.coe_toLinearEquiv, + LinearIsometryEquiv.coe_one, + id_eq, Module.End.one_apply] + map_mul' g h := by + ext x + simp only [map_mul, LinearEquiv.coe_coe, LinearIsometryEquiv.coe_toLinearEquiv, + LinearIsometryEquiv.coe_mul, + Function.comp_apply, Module.End.mul_apply] + +private def unitaryFixedSubmodule + {G : Type u₁} {H : Type v₁} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) (K : Subgroup G) : Submodule ℂ H := + Representation.invariants (π.toRepresentation.comp K.subtype) + +@[simp] private theorem mem_unitaryFixedSubmodule + {G : Type u₁} {H : Type v₁} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) (K : Subgroup G) (x : H) : + x ∈ unitaryFixedSubmodule π K ↔ ∀ g : K, π (g : G) x = x := + Iff.rfl + +private def unitaryVectorStabilizer + {G : Type u₁} {H : Type v₁} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) (x : H) : Subgroup G where + carrier := {g : G | π g x = x} + one_mem' := by simp only [Set.mem_ofPred_eq, map_one, LinearIsometryEquiv.coe_one, id_eq] + mul_mem' := by + intro g h hg hh + change π g x = x at hg + change π h x = x at hh + change π (g * h) x = x + simpa only [map_mul, LinearIsometryEquiv.coe_mul, Function.comp_apply, hh] using hg + inv_mem' := by + intro g hg + change π g x = x at hg + change π g⁻¹ x = x + have heq := congrArg (fun y : H => π g⁻¹ y) hg + simpa only [map_inv, LinearIsometryEquiv.coe_inv, LinearIsometryEquiv.symm_apply_apply] using + heq.symm + +private theorem unitaryFixedSubmodule_sup + {G : Type u₁} {H : Type v₁} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) (K J : Subgroup G) : + unitaryFixedSubmodule π (K ⊔ J) = + unitaryFixedSubmodule π K ⊓ unitaryFixedSubmodule π J := by + ext x + constructor + · intro hx + refine ⟨?_, ?_⟩ + · change x ∈ unitaryFixedSubmodule π K + rw [mem_unitaryFixedSubmodule] + intro k + exact (mem_unitaryFixedSubmodule π (K ⊔ J) x).mp hx + ⟨k, Subgroup.mem_sup_left k.property⟩ + · change x ∈ unitaryFixedSubmodule π J + rw [mem_unitaryFixedSubmodule] + intro j + exact (mem_unitaryFixedSubmodule π (K ⊔ J) x).mp hx + ⟨j, Subgroup.mem_sup_right j.property⟩ + · rintro ⟨hxK, hxJ⟩ + have hK : K ≤ unitaryVectorStabilizer π x := by + intro k hk + exact (mem_unitaryFixedSubmodule π K x).mp hxK ⟨k, hk⟩ + have hJ : J ≤ unitaryVectorStabilizer π x := by + intro j hj + exact (mem_unitaryFixedSubmodule π J x).mp hxJ ⟨j, hj⟩ + rw [mem_unitaryFixedSubmodule] + intro g + exact (sup_le hK hJ) g.property + +private theorem unitaryFixedSubmodule_isClosed + {G : Type u₁} {H : Type v₁} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) (K : Subgroup G) : + IsClosed (unitaryFixedSubmodule π K : Set H) := by + have hset : + (unitaryFixedSubmodule π K : Set H) = + ⋂ g : K, {x : H | π (g : G) x = x} := by + ext x + simp only [SetLike.mem_coe, mem_unitaryFixedSubmodule, Subtype.forall, Set.mem_iInter, + Set.mem_ofPred_eq] + rw [hset] + exact isClosed_iInter fun g => + isClosed_eq (π (g : G)).continuous continuous_id + +private instance unitaryFixedSubmodule_completeSpace + {G : Type u₁} {H : Type v₁} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + (π : UnitaryRepresentation G H) (K : Subgroup G) : + CompleteSpace (unitaryFixedSubmodule π K) := + (unitaryFixedSubmodule_isClosed π K).isComplete.completeSpace_coe + +private theorem unitaryFixedSubmodule_map_of_centralizes + {G : Type u₁} {H : Type v₁} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) (K : Subgroup G) (g : G) + (hg : ∀ k : K, Commute g (k : G)) : + (unitaryFixedSubmodule π K).map (π g).toLinearEquiv.toLinearMap = + unitaryFixedSubmodule π K := by + ext z + constructor + · rintro ⟨x, hx, rfl⟩ + rw [mem_unitaryFixedSubmodule] + intro k + have hk := (mem_unitaryFixedSubmodule π K x).mp hx k + calc + π (k : G) (π g x) = π ((k : G) * g) x := by simp only [map_mul, LinearIsometryEquiv.coe_mul, + Function.comp_apply] + _ = π (g * (k : G)) x := by rw [(hg k).eq] + _ = π g (π (k : G) x) := by simp only [map_mul, LinearIsometryEquiv.coe_mul, + Function.comp_apply] + _ = π g x := by rw [hk] + · intro hz + refine ⟨π g⁻¹ z, ?_, ?_⟩ + · change π g⁻¹ z ∈ unitaryFixedSubmodule π K + rw [mem_unitaryFixedSubmodule] + intro k + have hk := (mem_unitaryFixedSubmodule π K z).mp hz k + calc + π (k : G) (π g⁻¹ z) = π ((k : G) * g⁻¹) z := by simp only [map_inv, + LinearIsometryEquiv.coe_inv, map_mul, LinearIsometryEquiv.coe_mul, Function.comp_apply] + _ = π (g⁻¹ * (k : G)) z := by rw [(hg k).inv_left.eq] + _ = π g⁻¹ (π (k : G) z) := by simp only [map_mul, map_inv, LinearIsometryEquiv.coe_mul, + LinearIsometryEquiv.coe_inv, Function.comp_apply] + _ = π g⁻¹ z := by rw [hk] + · simp only [map_inv, LinearIsometryEquiv.coe_inv, LinearEquiv.coe_coe, + LinearIsometryEquiv.coe_toLinearEquiv, + LinearIsometryEquiv.apply_symm_apply] + +private theorem unitaryFixedSubmodule_starProjection_commute + {G : Type u₁} {H : Type v₁} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + (π : UnitaryRepresentation G H) (K : Subgroup G) (g : G) + (hg : ∀ k : K, Commute g (k : G)) (x : H) : + (unitaryFixedSubmodule π K).starProjection (π g x) = + π g ((unitaryFixedSubmodule π K).starProjection x) := by + let : CompleteSpace (unitaryFixedSubmodule π K) := + unitaryFixedSubmodule_completeSpace π K + have hmap := unitaryFixedSubmodule_map_of_centralizes π K g hg + simpa only [hmap, LinearIsometryEquiv.symm_apply_apply] using + Submodule.starProjection_map_apply (π g) (unitaryFixedSubmodule π K) (π g x) + +private theorem unitaryFixedSubmodule_starProjection_mem_of_commute + {G : Type u₁} {H : Type v₁} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + (π : UnitaryRepresentation G H) (K J : Subgroup G) + (hcomm : ∀ k : K, ∀ j : J, Commute (k : G) (j : G)) + {x : H} (hx : x ∈ unitaryFixedSubmodule π J) : + (unitaryFixedSubmodule π K).starProjection x ∈ + unitaryFixedSubmodule π J := by + let : CompleteSpace (unitaryFixedSubmodule π K) := + unitaryFixedSubmodule_completeSpace π K + rw [mem_unitaryFixedSubmodule] + intro j + have hj := (mem_unitaryFixedSubmodule π J x).mp hx j + have he := unitaryFixedSubmodule_starProjection_commute π K (j : G) + (fun k => (hcomm k j).symm) x + simpa only [hj] using he.symm + +private theorem norm_finset_sum_sq_eq_of_pairwise_inner_zero + {ι H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (f : ι → H) (s : Finset ι) + (horth : ∀ ⦃i j : ι⦄, i ≠ j → inner ℂ (f i) (f j) = 0) : + ‖∑ i ∈ s, f i‖ ^ 2 = ∑ i ∈ s, ‖f i‖ ^ 2 := by + classical + induction s using Finset.induction_on with + | empty => simp only [Finset.sum_empty, norm_zero, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, + zero_pow] + | @insert i s hi ih => + simp only [Finset.sum_insert hi] + rw [norm_add_sq (𝕜 := ℂ)] + have hzero : inner ℂ (f i) (∑ j ∈ s, f j) = 0 := by + rw [inner_sum] + apply Finset.sum_eq_zero + intro j hj + exact horth (by + intro h + subst j + exact hi hj) + simp only [hzero, RCLike.re_to_complex, Complex.zero_re, mul_zero, add_zero, ih] + +private theorem unitaryImages_inner_sq_mul_card_le + {ι H : Type*} [Fintype ι] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (U : ι → H ≃ₗᵢ[ℂ] H) (a b : H) + (hb : ∀ i : ι, U i b = b) + (horth : ∀ ⦃i j : ι⦄, i ≠ j → + inner ℂ (U i a) (U j a) = 0) : + (Fintype.card ι : ℝ) * ‖inner ℂ a b‖ ^ 2 ≤ + ‖a‖ ^ 2 * ‖b‖ ^ 2 := by + classical + have hnorm : + ‖∑ i : ι, U i a‖ ^ 2 = + (Fintype.card ι : ℝ) * ‖a‖ ^ 2 := by + calc + ‖∑ i : ι, U i a‖ ^ 2 = + ∑ i : ι, ‖U i a‖ ^ 2 := by + simpa only [norm_map, Finset.sum_const, Finset.card_univ, nsmul_eq_mul] using + norm_finset_sum_sq_eq_of_pairwise_inner_zero (fun i : ι => U i a) Finset.univ horth + _ = (Fintype.card ι : ℝ) * ‖a‖ ^ 2 := by simp only [norm_map, Finset.sum_const, + Finset.card_univ, nsmul_eq_mul] + have hterm (i : ι) : inner ℂ (U i a) b = inner ℂ a b := by + calc + inner ℂ (U i a) b = inner ℂ (U i a) (U i b) := by rw [hb i] + _ = inner ℂ a b := (U i).inner_map_map a b + have hinner : + inner ℂ (∑ i : ι, U i a) b = + (Fintype.card ι : ℂ) * inner ℂ a b := by + rw [sum_inner] + simp_rw [hterm] + simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + have hcs : + (Fintype.card ι : ℝ) * ‖inner ℂ a b‖ ≤ + ‖∑ i : ι, U i a‖ * ‖b‖ := by + have h := norm_inner_le_norm (𝕜 := ℂ) (∑ i : ι, U i a) b + rw [hinner, norm_mul, Complex.norm_natCast] at h + exact h + have hsq : + ((Fintype.card ι : ℝ) * ‖inner ℂ a b‖) ^ 2 ≤ + (‖∑ i : ι, U i a‖ * ‖b‖) ^ 2 := + (sq_le_sq₀ (by positivity) (by positivity)).mpr hcs + rw [mul_pow, mul_pow, hnorm] at hsq + by_cases hcard : Fintype.card ι = 0 + · simp only [hcard, Nat.cast_zero, zero_mul] + positivity + · have hpos : 0 < (Fintype.card ι : ℝ) := by + exact_mod_cast Nat.pos_of_ne_zero hcard + apply (mul_le_mul_iff_right₀ hpos).mp + calc + (Fintype.card ι : ℝ) * + ((Fintype.card ι : ℝ) * ‖inner ℂ a b‖ ^ 2) = + (Fintype.card ι : ℝ) ^ 2 * ‖inner ℂ a b‖ ^ 2 := by ring + _ ≤ ((Fintype.card ι : ℝ) * ‖a‖ ^ 2) * ‖b‖ ^ 2 := hsq + _ = (Fintype.card ι : ℝ) * (‖a‖ ^ 2 * ‖b‖ ^ 2) := by ring + +private theorem unitaryFixedSubmodule_starProjection_mem_orthogonal_of_commute + {G : Type u₁} {H : Type v₁} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + (π : UnitaryRepresentation G H) (K Z : Subgroup G) + (hcomm : ∀ k : K, ∀ z : Z, Commute (k : G) (z : G)) + {x : H} (hx : x ∈ (unitaryFixedSubmodule π Z)ᗮ) : + (unitaryFixedSubmodule π K).starProjection x ∈ + (unitaryFixedSubmodule π Z)ᗮ := by + let : CompleteSpace (unitaryFixedSubmodule π K) := + unitaryFixedSubmodule_completeSpace π K + rw [Submodule.mem_orthogonal] + intro z hz + have hpz := unitaryFixedSubmodule_starProjection_mem_of_commute + π K Z hcomm hz + calc + inner ℂ z ((unitaryFixedSubmodule π K).starProjection x) = + inner ℂ ((unitaryFixedSubmodule π K).starProjection z) x := + (Submodule.inner_starProjection_left_eq_right + (unitaryFixedSubmodule π K) z x).symm + _ = 0 := + (Submodule.mem_orthogonal (unitaryFixedSubmodule π Z) x).mp hx + ((unitaryFixedSubmodule π K).starProjection z) hpz + +private theorem unitaryFixedSubmodule_orthogonal_map_of_centralizes + {G : Type u₁} {H : Type v₁} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) (Z : Subgroup G) (g : G) + (hg : ∀ z : Z, Commute g (z : G)) + {x : H} (hx : x ∈ (unitaryFixedSubmodule π Z)ᗮ) : + π g x ∈ (unitaryFixedSubmodule π Z)ᗮ := by + rw [Submodule.mem_orthogonal] + intro z hz + have hmap := unitaryFixedSubmodule_map_of_centralizes + π Z g⁻¹ (fun k => (hg k).inv_left) + have hzpre : π g⁻¹ z ∈ unitaryFixedSubmodule π Z := by + rw [← hmap] + exact ⟨z, hz, rfl⟩ + calc + inner ℂ z (π g x) = + inner ℂ (π g (π g⁻¹ z)) (π g x) := by simp only [map_inv, LinearIsometryEquiv.coe_inv, + LinearIsometryEquiv.apply_symm_apply] + _ = inner ℂ (π g⁻¹ z) x := (π g).inner_map_map (π g⁻¹ z) x + _ = 0 := + (Submodule.mem_orthogonal (unitaryFixedSubmodule π Z) x).mp + hx (π g⁻¹ z) hzpre + +private theorem unitaryFixedSubmodules_inner_eq_zero_of_commute_centerComplement + {G : Type u₁} {H : Type v₁} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + (π : UnitaryRepresentation G H) (K J Z : Subgroup G) + (hcomm : ∀ k : K, ∀ j : J, Commute (k : G) (j : G)) + (hKZ : ∀ k : K, ∀ z : Z, Commute (k : G) (z : G)) + (hcenter : Z ≤ K ⊔ J) + {a b : H} + (ha : a ∈ unitaryFixedSubmodule π K) + (hb : b ∈ unitaryFixedSubmodule π J) + (hbZ : b ∈ (unitaryFixedSubmodule π Z)ᗮ) : + inner ℂ a b = 0 := by + let : CompleteSpace (unitaryFixedSubmodule π K) := + unitaryFixedSubmodule_completeSpace π K + let p : H := (unitaryFixedSubmodule π K).starProjection b + have hpK : p ∈ unitaryFixedSubmodule π K := + Submodule.starProjection_apply_mem _ _ + have hpJ : p ∈ unitaryFixedSubmodule π J := + unitaryFixedSubmodule_starProjection_mem_of_commute + π K J hcomm hb + have hpJoin : p ∈ unitaryFixedSubmodule π (K ⊔ J) := by + rw [unitaryFixedSubmodule_sup] + exact ⟨hpK, hpJ⟩ + have hpZ : p ∈ unitaryFixedSubmodule π Z := by + rw [mem_unitaryFixedSubmodule] + intro z + exact (mem_unitaryFixedSubmodule π (K ⊔ J) p).mp + hpJoin ⟨z, hcenter z.property⟩ + have hpZorth : p ∈ (unitaryFixedSubmodule π Z)ᗮ := + unitaryFixedSubmodule_starProjection_mem_orthogonal_of_commute + π K Z hKZ hbZ + have hpzero : p = 0 := by + exact (inner_self_eq_zero (𝕜 := ℂ)).mp + ((Submodule.mem_orthogonal (unitaryFixedSubmodule π Z) p).mp + hpZorth p hpZ) + apply inner_eq_zero_symm.mp + simpa [p, hpzero] using + (Submodule.starProjection_inner_eq_zero + (K := unitaryFixedSubmodule π K) b a ha) + +private def heisenbergConjugateSubgroup + {G : Type*} [Group G] (X : Subgroup G) (g : G) : + Subgroup G := + X.map (MulAut.conj g).toMonoidHom + +private theorem heisenbergFiniteFamily_centerComplement_inner_sq_le + {G : Type u₁} {H : Type v₁} {ι : Type*} + [Group G] [Fintype ι] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + (π : UnitaryRepresentation G H) + (X Z : Subgroup G) (y : ι → G) + (hXZ : ∀ x : X, ∀ z : Z, Commute (x : G) (z : G)) + (hyZ : ∀ i : ι, ∀ z : Z, Commute (y i) (z : G)) + (hcomm : ∀ ⦃i j : ι⦄, i ≠ j → + ∀ x : heisenbergConjugateSubgroup X (y i), + ∀ x' : heisenbergConjugateSubgroup X (y j), + Commute (x : G) (x' : G)) + (hcenter : ∀ ⦃i j : ι⦄, i ≠ j → + Z ≤ heisenbergConjugateSubgroup X (y i) ⊔ + heisenbergConjugateSubgroup X (y j)) + {a b : H} + (ha : a ∈ unitaryFixedSubmodule π X) + (haZ : a ∈ (unitaryFixedSubmodule π Z)ᗮ) + (hb : ∀ i : ι, π (y i) b = b) : + (Fintype.card ι : ℝ) * ‖inner ℂ a b‖ ^ 2 ≤ + ‖a‖ ^ 2 * ‖b‖ ^ 2 := by + have hfix (i : ι) : + π (y i) a ∈ unitaryFixedSubmodule π + (heisenbergConjugateSubgroup X (y i)) := by + rw [mem_unitaryFixedSubmodule] + rintro ⟨_, ⟨g, hg, rfl⟩⟩ + have hga := (mem_unitaryFixedSubmodule π X a).mp ha ⟨g, hg⟩ + simp only [MulEquiv.toMonoidHom_eq_coe, MonoidHom.coe_coe, MulAut.conj_apply, map_mul, map_inv, + LinearIsometryEquiv.coe_mul, LinearIsometryEquiv.coe_inv, Function.comp_apply, + LinearIsometryEquiv.symm_apply_apply, + hga] + have horthZ (i : ι) : + π (y i) a ∈ (unitaryFixedSubmodule π Z)ᗮ := + unitaryFixedSubmodule_orthogonal_map_of_centralizes + π Z (y i) (hyZ i) haZ + have hJZ (i : ι) : + ∀ x : heisenbergConjugateSubgroup X (y i), + ∀ z : Z, Commute (x : G) (z : G) := by + rintro ⟨_, ⟨g, hg, rfl⟩⟩ z + change Commute (y i * g * (y i)⁻¹) (z : G) + exact ((hyZ i z).mul_left (hXZ ⟨g, hg⟩ z)).mul_left + (hyZ i z).inv_left + apply unitaryImages_inner_sq_mul_card_le + (fun i : ι => π (y i)) a b hb + intro i j hij + exact unitaryFixedSubmodules_inner_eq_zero_of_commute_centerComplement + π (heisenbergConjugateSubgroup X (y i)) + (heisenbergConjugateSubgroup X (y j)) Z + (hcomm hij) (hJZ i) (hcenter hij) + (hfix i) (hfix j) (horthZ j) + +private theorem finiteOuterBlockProductCentral_centerComplement_inner_sq_le + {R : Type*} [Ring R] [Algebra (ZMod 2) R] + {H : Type v₁} [NormedAddCommGroup H] + [InnerProductSpace ℂ H] [CompleteSpace H] + (W : Submodule (ZMod 2) R) + (i j k : Fin 3) (hij : i ≠ j) (hjk : j ≠ k) (hik : i ≠ k) + (B : Matrix (Fin 3) (Fin 3) W) + (π : UnitaryRepresentation + (elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) H) + {a b : H} + (ha : a ∈ unitaryFixedSubmodule π + (finiteOuterBlockRootSubgroup W i j hij)) + (haZ : a ∈ + (unitaryFixedSubmodule π + (finiteOuterBlockProductCentralRootSubgroup W i k hik B))ᗮ) + (hb : b ∈ unitaryFixedSubmodule π + (finiteOuterBlockRootSubgroup W j k hjk)) : + 8 * ‖inner ℂ a b‖ ^ 2 ≤ ‖a‖ ^ 2 * ‖b‖ ^ 2 := by + let : Fintype finiteBlockGaloisField := + Fintype.ofFinite finiteBlockGaloisField + have hcard : Fintype.card finiteBlockGaloisField = 8 := by + simpa only [Nat.card_eq_fintype_card] using + finiteBlockGaloisField_natCard + have hbound := heisenbergFiniteFamily_centerComplement_inner_sq_le + π + (finiteOuterBlockRootSubgroup W i j hij) + (finiteOuterBlockProductCentralRootSubgroup W i k hik B) + (fun t : finiteBlockGaloisField => + finiteOuterBlockGaloisConjugatorWithCoefficient W j k hjk B t) + (by + intro x z + exact finiteOuterBlockProductCentralRoot_commute_left + W i j k hij hik B x z x.property z.property) + (by + intro t z + exact finiteOuterBlockProductCentralRoot_commute_right + W i j k hjk hik B + (finiteOuterBlockGaloisConjugatorWithCoefficient + W j k hjk B t) z + (finiteOuterBlockGaloisConjugatorWithCoefficient_mem + W j k hjk B t) z.property) + (by + intro s t hst x x' + exact finiteOuterBlockGaloisConjugateRootsWithCoefficient_commute + W i j k hij hjk hik B s t x x' x.property x'.property) + (by + intro s t hst + exact finiteOuterBlockProductCentralRoot_le_galoisConjugates + W i j k hij hjk hik B s t hst) + ha haZ + (by + intro t + exact + (mem_unitaryFixedSubmodule π + (finiteOuterBlockRootSubgroup W j k hjk) b).mp hb + ⟨finiteOuterBlockGaloisConjugatorWithCoefficient + W j k hjk B t, + finiteOuterBlockGaloisConjugatorWithCoefficient_mem + W j k hjk B t⟩) + simpa only [ge_iff_le, hcard, Nat.cast_ofNat] using hbound + +section FiniteSubgroupAveraging + +variable {G : Type*} {H : Type*} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + +private def finiteUnitarySubgroupAverage + (π : UnitaryRepresentation G H) + (K : Subgroup G) [Fintype K] (x : H) : H := + (Fintype.card K : ℂ)⁻¹ • ∑ k : K, π (k : G) x + +private theorem finiteUnitarySubgroupAverage_fixed + (π : UnitaryRepresentation G H) + (K : Subgroup G) [Fintype K] (x : H) (g : K) : + π (g : G) (finiteUnitarySubgroupAverage π K x) = + finiteUnitarySubgroupAverage π K x := by + classical + unfold finiteUnitarySubgroupAverage + rw [map_smul, map_sum] + congr 1 + calc + (∑ k : K, π (g : G) (π (k : G) x)) = + ∑ k : K, π ((g * k : K) : G) x := by + apply Finset.sum_congr rfl + intro k _ + simp only [Subgroup.coe_mul, map_mul, LinearIsometryEquiv.coe_mul, Function.comp_apply] + _ = ∑ k : K, π (k : G) x := + Function.Bijective.sum_comp (Group.mulLeft_bijective g) + (fun k : K => π (k : G) x) + +private theorem inner_finiteUnitarySubgroupAverage_of_fixed_left + (π : UnitaryRepresentation G H) + (K : Subgroup G) [Fintype K] (a b : H) + (ha : ∀ k : K, π (k : G) a = a) : + inner ℂ a (finiteUnitarySubgroupAverage π K b) = + inner ℂ a b := by + classical + have hcard : (Fintype.card K : ℂ) ≠ 0 := by + exact_mod_cast Fintype.card_ne_zero + have hterm (k : K) : + inner ℂ a (π (k : G) b) = inner ℂ a b := by + calc + inner ℂ a (π (k : G) b) = + inner ℂ (π (k : G) a) (π (k : G) b) := by rw [ha k] + _ = inner ℂ a b := (π (k : G)).inner_map_map a b + unfold finiteUnitarySubgroupAverage + rw [inner_smul_right, inner_sum] + simp_rw [hterm] + simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul, ne_eq, hcard, not_false_eq_true, + inv_mul_cancel_left₀] + +private theorem finiteUnitarySubgroupAverage_fixed_of_orbit_fixed + (π : UnitaryRepresentation G H) + (K J : Subgroup G) [Fintype K] (b : H) + (horbit : ∀ (k : K) (j : J), + π (j : G) (π (k : G) b) = π (k : G) b) + (j : J) : + π (j : G) (finiteUnitarySubgroupAverage π K b) = + finiteUnitarySubgroupAverage π K b := by + classical + unfold finiteUnitarySubgroupAverage + rw [map_smul, map_sum] + congr 1 + apply Finset.sum_congr rfl + intro k _ + exact horbit k j + +private theorem inner_eq_zero_of_finite_subgroupAverage_pair_orthogonal + (π : UnitaryRepresentation G H) + (K J : Subgroup G) [Finite K] (a b : H) + (ha : ∀ k : K, π (k : G) a = a) + (horbit : ∀ (k : K) (j : J), + π (j : G) (π (k : G) b) = π (k : G) b) + (horth : ∀ z : H, + (∀ k : K, π (k : G) z = z) → + (∀ j : J, π (j : G) z = z) → + inner ℂ a z = 0) : + inner ℂ a b = 0 := by + let : Fintype K := Fintype.ofFinite K + let z : H := finiteUnitarySubgroupAverage π K b + have hzK : ∀ k : K, π (k : G) z = z := + finiteUnitarySubgroupAverage_fixed π K b + have hzJ : ∀ j : J, π (j : G) z = z := + finiteUnitarySubgroupAverage_fixed_of_orbit_fixed + π K J b horbit + calc + inner ℂ a b = inner ℂ a z := + (inner_finiteUnitarySubgroupAverage_of_fixed_left + π K a b ha).symm + _ = 0 := horth z hzK hzJ + +end FiniteSubgroupAveraging + +private theorem finiteOuterBlockRootSubgroups_pair_inner_sq_le + {R : Type*} [Ring R] [Algebra (ZMod 2) R] + {H : Type v₁} [NormedAddCommGroup H] + [InnerProductSpace ℂ H] [CompleteSpace H] + (W : Submodule (ZMod 2) R) [Finite W] + (i j k : Fin 3) + (hij : i ≠ j) (hjk : j ≠ k) (hik : i ≠ k) + (π : UnitaryRepresentation + (elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) H) + {a b : H} + (ha : a ∈ unitaryFixedSubmodule π + (finiteOuterBlockRootSubgroup W i j hij)) + (hb : b ∈ unitaryFixedSubmodule π + (finiteOuterBlockRootSubgroup W j k hjk)) + (haQ : a ∈ + (unitaryFixedSubmodule π + (finiteOuterBlockRootSubgroup W i j hij) ⊓ + unitaryFixedSubmodule π + (finiteOuterBlockRootSubgroup W j k hjk))ᗮ) + (hbQ : b ∈ + (unitaryFixedSubmodule π + (finiteOuterBlockRootSubgroup W i j hij) ⊓ + unitaryFixedSubmodule π + (finiteOuterBlockRootSubgroup W j k hjk))ᗮ) : + 8 * ‖inner ℂ a b‖ ^ 2 ≤ ‖a‖ ^ 2 * ‖b‖ ^ 2 := by + classical + let : Fintype W := Fintype.ofFinite W + let X := finiteOuterBlockRootSubgroup W i j hij + let Y := finiteOuterBlockRootSubgroup W j k hjk + let Z (B : Matrix (Fin 3) (Fin 3) W) := + finiteOuterBlockProductCentralRootSubgroup W i k hik B + let Q : Submodule ℂ H := + unitaryFixedSubmodule π X ⊓ unitaryFixedSubmodule π Y + let U : Submodule ℂ H := unitaryFixedSubmodule π X ⊓ Qᗮ + let V : Submodule ℂ H := unitaryFixedSubmodule π Y ⊓ Qᗮ + let F (B : Matrix (Fin 3) (Fin 3) W) := + unitaryFixedSubmodule π (Z B) + let : Finite X := finite_finiteOuterBlockRootSubgroup W i j hij + let : Fintype X := Fintype.ofFinite X + let (B : Matrix (Fin 3) (Fin 3) W) : CompleteSpace (F B) := + unitaryFixedSubmodule_completeSpace π (Z B) + have hpairCentral (B : Matrix (Fin 3) (Fin 3) W) : + ∀ z : Z B, ∀ g : + (X ⊔ Y : Subgroup + (elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R))), + Commute + (z : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) + (g : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) := by + intro z g + have hg := finiteOuterBlockProductCentralRoot_pair_le_centralizer + W i j k hij hjk hik B g.property + rw [Subgroup.mem_centralizer_iff] at hg + change (z : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) * + (g : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) = + (g : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) * + (z : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) + exact hg z z.property + refine inner_sq_le_of_finite_orthogonal_sector_splitting + F U V ?_ ?_ ?_ ?_ ?_ a b ⟨ha, haQ⟩ ⟨hb, hbQ⟩ + · intro B x hx + change (unitaryFixedSubmodule π (Z B)).starProjection x ∈ + unitaryFixedSubmodule π X ⊓ Qᗮ + refine ⟨?_, ?_⟩ + · exact unitaryFixedSubmodule_starProjection_mem_of_commute + π (Z B) X + (fun z x => + (finiteOuterBlockProductCentralRoot_commute_left + W i j k hij hik B x z x.property z.property).symm) + hx.1 + · have hq : x ∈ (unitaryFixedSubmodule π (X ⊔ Y))ᗮ := by + rw [unitaryFixedSubmodule_sup] + exact hx.2 + have hp := unitaryFixedSubmodule_starProjection_mem_orthogonal_of_commute + π (Z B) (X ⊔ Y) (hpairCentral B) hq + rw [unitaryFixedSubmodule_sup] at hp + exact hp + · intro B x hx + change (unitaryFixedSubmodule π (Z B)).starProjection x ∈ + unitaryFixedSubmodule π Y ⊓ Qᗮ + refine ⟨?_, ?_⟩ + · exact unitaryFixedSubmodule_starProjection_mem_of_commute + π (Z B) Y + (fun z y => + (finiteOuterBlockProductCentralRoot_commute_right + W i j k hjk hik B y z y.property z.property).symm) + hx.1 + · have hq : x ∈ (unitaryFixedSubmodule π (X ⊔ Y))ᗮ := by + rw [unitaryFixedSubmodule_sup] + exact hx.2 + have hp := unitaryFixedSubmodule_starProjection_mem_orthogonal_of_commute + π (Z B) (X ⊔ Y) (hpairCentral B) hq + rw [unitaryFixedSubmodule_sup] at hp + exact hp + · intro B C x hx + change (unitaryFixedSubmodule π (Z B)).starProjection x ∈ + unitaryFixedSubmodule π (Z C) + exact unitaryFixedSubmodule_starProjection_mem_of_commute + π (Z B) (Z C) + (fun z w => finiteOuterBlockProductCentralRoots_commute + W i k hik B C z w z.property w.property) + hx + · intro B x y hx hy hxZ _ + exact finiteOuterBlockProductCentral_centerComplement_inner_sq_le + W i j k hij hjk hik B π hx.1 hxZ hy.1 + · intro x y hx hy _ hyF + apply inner_eq_zero_of_finite_subgroupAverage_pair_orthogonal + π X Y x y + · exact (mem_unitaryFixedSubmodule π X x).mp hx.1 + · intro s t + obtain ⟨B, hB⟩ := + finiteOuterBlockRoot_commutator_exists_productCentral + W i j k hij hjk hik s t s.property t.property + let c : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R) := + ⁅(s : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)), + (t : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R))⁆ + have hcb : π c⁻¹ y = y := + (mem_unitaryFixedSubmodule π (Z B) y).mp (hyF B) + ⟨c⁻¹, (Z B).inv_mem hB⟩ + have htb : π (t : elementaryGroup (Fin 3) + (Matrix (Fin 3) (Fin 3) R)) y = y := + (mem_unitaryFixedSubmodule π Y y).mp hy.1 t + have hsc : Commute + (s : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) c := + finiteOuterBlockProductCentralRoot_commute_left + W i j k hij hik B s c s.property hB + have hgroup : + (t : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) * + (s : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) = + (s : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) * + c⁻¹ * + (t : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) := by + calc + (t : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) * + (s : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) = + c⁻¹ * + (s : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) * + (t : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) := by + dsimp [c] + simp only [commutatorElement_def] + group + _ = (s : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) * + c⁻¹ * + (t : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) := by + rw [hsc.inv_right.eq] + calc + π (t : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) + (π (s : elementaryGroup (Fin 3) + (Matrix (Fin 3) (Fin 3) R)) y) = + π ((t : elementaryGroup (Fin 3) + (Matrix (Fin 3) (Fin 3) R)) * s) y := by + simp only [map_mul, LinearIsometryEquiv.coe_mul, Function.comp_apply] + _ = π ((s : elementaryGroup (Fin 3) + (Matrix (Fin 3) (Fin 3) R)) * c⁻¹ * t) y := by + rw [hgroup] + _ = π (s : elementaryGroup (Fin 3) + (Matrix (Fin 3) (Fin 3) R)) + (π c⁻¹ (π (t : elementaryGroup (Fin 3) + (Matrix (Fin 3) (Fin 3) R)) y)) := by + simp only [map_mul, map_inv, LinearIsometryEquiv.coe_mul, LinearIsometryEquiv.coe_inv, + Function.comp_apply] + _ = π (s : elementaryGroup (Fin 3) + (Matrix (Fin 3) (Fin 3) R)) y := by + rw [htb, hcb] + · intro z hzX hzY + apply (Submodule.mem_orthogonal' Q x).mp hx.2 + exact ⟨(mem_unitaryFixedSubmodule π X z).mpr hzX, + (mem_unitaryFixedSubmodule π Y z).mpr hzY⟩ + +private def finiteOuterBlockCyclicRootFamily + {R : Type*} [Ring R] [Algebra (ZMod 2) R] + (W : Submodule (ZMod 2) R) (i : Fin 3) : + Subgroup (elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) := + finiteOuterBlockRootSubgroup W i (i + 1) (by + fin_cases i <;> decide) + +private theorem finiteOuterBlockCyclicRootFamily_pair_inner_sq_le + {R : Type*} [Ring R] [Algebra (ZMod 2) R] + {H : Type v₁} [NormedAddCommGroup H] + [InnerProductSpace ℂ H] [CompleteSpace H] + (W : Submodule (ZMod 2) R) [Finite W] + (π : UnitaryRepresentation + (elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) H) + (i j : Fin 3) (hij : i ≠ j) (a b : H) + (ha : a ∈ unitaryFixedSubmodule π + (finiteOuterBlockCyclicRootFamily W i)) + (haQ : a ∈ + (unitaryFixedSubmodule π (finiteOuterBlockCyclicRootFamily W i) ⊓ + unitaryFixedSubmodule π (finiteOuterBlockCyclicRootFamily W j))ᗮ) + (hb : b ∈ unitaryFixedSubmodule π + (finiteOuterBlockCyclicRootFamily W j)) + (hbQ : b ∈ + (unitaryFixedSubmodule π (finiteOuterBlockCyclicRootFamily W i) ⊓ + unitaryFixedSubmodule π (finiteOuterBlockCyclicRootFamily W j))ᗮ) : + 8 * ‖inner ℂ a b‖ ^ 2 ≤ ‖a‖ ^ 2 * ‖b‖ ^ 2 := by + fin_cases i <;> fin_cases j + · exact (hij rfl).elim + · exact finiteOuterBlockRootSubgroups_pair_inner_sq_le + W 0 1 2 (by decide) (by decide) (by decide) + π ha hb haQ hbQ + · rw [inf_comm] at haQ hbQ + have h := finiteOuterBlockRootSubgroups_pair_inner_sq_le + W 2 0 1 (by decide) (by decide) (by decide) + π hb ha hbQ haQ + calc + 8 * ‖inner ℂ a b‖ ^ 2 = 8 * ‖inner ℂ b a‖ ^ 2 := by + rw [norm_inner_symm a b] + _ ≤ ‖b‖ ^ 2 * ‖a‖ ^ 2 := h + _ = ‖a‖ ^ 2 * ‖b‖ ^ 2 := by rw [mul_comm] + · rw [inf_comm] at haQ hbQ + have h := finiteOuterBlockRootSubgroups_pair_inner_sq_le + W 0 1 2 (by decide) (by decide) (by decide) + π hb ha hbQ haQ + calc + 8 * ‖inner ℂ a b‖ ^ 2 = 8 * ‖inner ℂ b a‖ ^ 2 := by + rw [norm_inner_symm a b] + _ ≤ ‖b‖ ^ 2 * ‖a‖ ^ 2 := h + _ = ‖a‖ ^ 2 * ‖b‖ ^ 2 := by rw [mul_comm] + · exact (hij rfl).elim + · exact finiteOuterBlockRootSubgroups_pair_inner_sq_le + W 1 2 0 (by decide) (by decide) (by decide) + π ha hb haQ hbQ + · exact finiteOuterBlockRootSubgroups_pair_inner_sq_le + W 2 0 1 (by decide) (by decide) (by decide) + π ha hb haQ hbQ + · rw [inf_comm] at haQ hbQ + have h := finiteOuterBlockRootSubgroups_pair_inner_sq_le + W 1 2 0 (by decide) (by decide) (by decide) + π hb ha hbQ haQ + calc + 8 * ‖inner ℂ a b‖ ^ 2 = 8 * ‖inner ℂ b a‖ ^ 2 := by + rw [norm_inner_symm a b] + _ ≤ ‖b‖ ^ 2 * ‖a‖ ^ 2 := h + _ = ‖a‖ ^ 2 * ‖b‖ ^ 2 := by rw [mul_comm] + · exact (hij rfl).elim + +end + +section + +open scoped BigOperators commutatorElement + +universe u + +section BinaryCoefficientSpan + +variable {R : Type u} [Ring R] [Algebra (ZMod 2) R] + +private def finiteBlockCoefficientSpan (s : Finset R) : Submodule (ZMod 2) R := + Submodule.span (ZMod 2) ({1} ∪ (↑s : Set R)) + +private theorem one_mem_finiteBlockCoefficientSpan (s : Finset R) : + (1 : R) ∈ finiteBlockCoefficientSpan s := by + apply Submodule.subset_span + exact Set.mem_union_left _ (Set.mem_singleton 1) + +private theorem mem_finiteBlockCoefficientSpan_of_mem + (s : Finset R) {a : R} (ha : a ∈ s) : + a ∈ finiteBlockCoefficientSpan s := by + apply Submodule.subset_span + exact Set.mem_union_right _ ha + +private instance finiteBlockCoefficientSpan_finite (s : Finset R) : + Finite (finiteBlockCoefficientSpan s) := by + let : Module.Finite (ZMod 2) (finiteBlockCoefficientSpan s) := + Module.Finite.span_of_finite (ZMod 2) + (Set.finite_singleton 1 |>.union s.finite_toSet) + exact Module.finite_of_finite (ZMod 2) + +end BinaryCoefficientSpan + +section FiniteBlockRoots + +variable {R : Type u} [Ring R] [Algebra (ZMod 2) R] + +private def finiteBlockIndex (i p : Fin 3) : Fin 9 := + finProdFinEquiv (i, p) + +private theorem finiteBlockIndex_ne_of_ne + {i j : Fin 3} (hij : i ≠ j) (p q : Fin 3) : + finiteBlockIndex i p ≠ finiteBlockIndex j q := by + intro h + exact hij (congrArg Prod.fst (finProdFinEquiv.injective h)) + +private def finiteBlockFlattenRingEquiv : + Matrix (Fin 3) (Fin 3) (Matrix (Fin 3) (Fin 3) R) ≃+* + Matrix (Fin 9) (Fin 9) R := + (Matrix.compRingEquiv (Fin 3) (Fin 3) R).trans + (Matrix.reindexRingEquiv R finProdFinEquiv) + +private def finiteBlockRootHom + (W : Submodule (ZMod 2) R) (i j : Fin 3) (hij : i ≠ j) : + Multiplicative (Matrix (Fin 3) (Fin 3) W) →* + (Matrix (Fin 9) (Fin 9) R)ˣ := + (Units.mapEquiv (finiteBlockFlattenRingEquiv (R := R)).toMulEquiv).toMonoidHom.comp + (((elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)).subtype.comp + (elementaryRootHom (R := Matrix (Fin 3) (Fin 3) R) i j hij)).comp + (finiteBlockCoefficientMatrixHom W).toMultiplicative) + +private def finiteBlockRootSubgroup + (W : Submodule (ZMod 2) R) (i j : Fin 3) (hij : i ≠ j) : + Subgroup (Matrix (Fin 9) (Fin 9) R)ˣ := + (finiteBlockRootHom W i j hij).range + +private theorem finiteBlockRootHom_single + (W : Submodule (ZMod 2) R) + (i j : Fin 3) (hij : i ≠ j) (p q : Fin 3) (a : W) : + finiteBlockRootHom W i j hij + (Multiplicative.ofAdd (Matrix.single p q a)) = + elementaryUnit (finiteBlockIndex i p) (finiteBlockIndex j q) + (finiteBlockIndex_ne_of_ne hij p q) (a : R) := by + apply Units.ext + change + finiteBlockFlattenRingEquiv + (1 + Matrix.single i j + ((finiteBlockCoefficientMatrixHom W) (Matrix.single p q a))) = + 1 + Matrix.single (finiteBlockIndex i p) (finiteBlockIndex j q) (a : R) + have hsingle : + finiteBlockCoefficientMatrixHom W (Matrix.single p q a) = + Matrix.single p q (a : R) := by + ext k l + by_cases hp : p = k + · subst k + by_cases hq : q = l + · subst l + simp only [finiteBlockCoefficientMatrixHom, AddMonoidHom.mapMatrix_apply, + LinearMap.toAddMonoidHom_coe, + Submodule.coe_subtype, Matrix.map_apply, Matrix.single_apply_same] + · simp only [finiteBlockCoefficientMatrixHom, AddMonoidHom.mapMatrix_apply, + LinearMap.toAddMonoidHom_coe, + Submodule.coe_subtype, Matrix.map_apply, hq, and_false, not_false_eq_true, + Matrix.single_apply_of_ne, + ZeroMemClass.coe_zero] + · simp only [finiteBlockCoefficientMatrixHom, AddMonoidHom.mapMatrix_apply, + LinearMap.toAddMonoidHom_coe, + Submodule.coe_subtype, Matrix.map_apply, hp, false_and, not_false_eq_true, + Matrix.single_apply_of_ne, + ZeroMemClass.coe_zero] + rw [hsingle] + rw [map_add, map_one] + congr 1 + change + Matrix.reindex finProdFinEquiv finProdFinEquiv + (Matrix.comp (Fin 3) (Fin 3) (Fin 3) (Fin 3) R + (Matrix.single i j (Matrix.single p q (a : R)))) = + Matrix.single (finiteBlockIndex i p) (finiteBlockIndex j q) (a : R) + rw [Matrix.comp_single_single] + ext x y + simp only [Nat.reduceMul, Matrix.reindex, Equiv.coe_fn_mk, Matrix.submatrix_apply, + Matrix.single_apply, + Equiv.eq_symm_apply, finiteBlockIndex] + +private theorem elementaryUnit_mem_finiteBlockRootSubgroup + (W : Submodule (ZMod 2) R) + (i j : Fin 3) (hij : i ≠ j) (p q : Fin 3) + (a : R) (ha : a ∈ W) : + elementaryUnit (finiteBlockIndex i p) (finiteBlockIndex j q) + (finiteBlockIndex_ne_of_ne hij p q) a ∈ + finiteBlockRootSubgroup W i j hij := by + refine ⟨Multiplicative.ofAdd (Matrix.single p q (⟨a, ha⟩ : W)), ?_⟩ + exact finiteBlockRootHom_single W i j hij p q ⟨a, ha⟩ + +private theorem finiteBlockRootSubgroup_le_elementaryGroup + (W : Submodule (ZMod 2) R) + (i j : Fin 3) (hij : i ≠ j) : + finiteBlockRootSubgroup W i j hij ≤ + elementaryGroup (Fin 9) R := by + rintro _ ⟨A, rfl⟩ + change + finiteBlockRootHom W i j hij + (Multiplicative.ofAdd A.toAdd) ∈ + elementaryGroup (Fin 9) R + refine Matrix.induction_on' + (P := fun M : Matrix (Fin 3) (Fin 3) W => + finiteBlockRootHom W i j hij (Multiplicative.ofAdd M) ∈ + elementaryGroup (Fin 9) R) + A.toAdd ?_ ?_ ?_ + · change finiteBlockRootHom W i j hij 1 ∈ elementaryGroup (Fin 9) R + rw [map_one] + exact (elementaryGroup (Fin 9) R).one_mem + · intro P Q hP hQ + change + finiteBlockRootHom W i j hij + (Multiplicative.ofAdd (P + Q)) ∈ + elementaryGroup (Fin 9) R + change + finiteBlockRootHom W i j hij + (Multiplicative.ofAdd P * Multiplicative.ofAdd Q) ∈ + elementaryGroup (Fin 9) R + rw [map_mul] + exact (elementaryGroup (Fin 9) R).mul_mem hP hQ + · intro p q a + rw [finiteBlockRootHom_single] + exact elementaryUnit_mem _ _ _ (a : R) + +private def cyclicFiniteBlockRootSubgroup + (W : Submodule (ZMod 2) R) : + Subgroup (Matrix (Fin 9) (Fin 9) R)ˣ := + finiteBlockRootSubgroup W 0 1 (by decide) ⊔ + finiteBlockRootSubgroup W 1 2 (by decide) ⊔ + finiteBlockRootSubgroup W 2 0 (by decide) + +private theorem cyclicFiniteBlockRootSubgroup_le_elementaryGroup + (W : Submodule (ZMod 2) R) : + cyclicFiniteBlockRootSubgroup W ≤ elementaryGroup (Fin 9) R := by + unfold cyclicFiniteBlockRootSubgroup + exact sup_le + (sup_le + (finiteBlockRootSubgroup_le_elementaryGroup W 0 1 (by decide)) + (finiteBlockRootSubgroup_le_elementaryGroup W 1 2 (by decide))) + (finiteBlockRootSubgroup_le_elementaryGroup W 2 0 (by decide)) + +private theorem elementaryUnit_mem_cyclicFiniteBlockRootSubgroup_of_block_ne + (W : Submodule (ZMod 2) R) (hW : (1 : R) ∈ W) + (i j : Fin 3) (hij : i ≠ j) (p q : Fin 3) + (a : R) (ha : a ∈ W) : + elementaryUnit (finiteBlockIndex i p) (finiteBlockIndex j q) + (finiteBlockIndex_ne_of_ne hij p q) a ∈ + cyclicFiniteBlockRootSubgroup W := by + let H : Subgroup (Matrix (Fin 9) (Fin 9) R)ˣ := + cyclicFiniteBlockRootSubgroup W + have h01 (p q : Fin 3) (a : R) (ha : a ∈ W) : + elementaryUnit (finiteBlockIndex 0 p) (finiteBlockIndex 1 q) + (finiteBlockIndex_ne_of_ne (by decide) p q) a ∈ H := by + apply (show finiteBlockRootSubgroup W 0 1 (by decide) ≤ H from + (show finiteBlockRootSubgroup W 0 1 (by decide) ≤ + (finiteBlockRootSubgroup W 0 1 (by decide) ⊔ + finiteBlockRootSubgroup W 1 2 (by decide)) ⊔ + finiteBlockRootSubgroup W 2 0 (by decide) from + le_trans le_sup_left le_sup_left)) + exact elementaryUnit_mem_finiteBlockRootSubgroup + W 0 1 (by decide) p q a ha + have h12 (p q : Fin 3) (a : R) (ha : a ∈ W) : + elementaryUnit (finiteBlockIndex 1 p) (finiteBlockIndex 2 q) + (finiteBlockIndex_ne_of_ne (by decide) p q) a ∈ H := by + apply (show finiteBlockRootSubgroup W 1 2 (by decide) ≤ H from + (show finiteBlockRootSubgroup W 1 2 (by decide) ≤ + (finiteBlockRootSubgroup W 0 1 (by decide) ⊔ + finiteBlockRootSubgroup W 1 2 (by decide)) ⊔ + finiteBlockRootSubgroup W 2 0 (by decide) from + le_trans le_sup_right le_sup_left)) + exact elementaryUnit_mem_finiteBlockRootSubgroup + W 1 2 (by decide) p q a ha + have h20 (p q : Fin 3) (a : R) (ha : a ∈ W) : + elementaryUnit (finiteBlockIndex 2 p) (finiteBlockIndex 0 q) + (finiteBlockIndex_ne_of_ne (by decide) p q) a ∈ H := by + apply (show finiteBlockRootSubgroup W 2 0 (by decide) ≤ H from + (show finiteBlockRootSubgroup W 2 0 (by decide) ≤ + (finiteBlockRootSubgroup W 0 1 (by decide) ⊔ + finiteBlockRootSubgroup W 1 2 (by decide)) ⊔ + finiteBlockRootSubgroup W 2 0 (by decide) from le_sup_right)) + exact elementaryUnit_mem_finiteBlockRootSubgroup + W 2 0 (by decide) p q a ha + have h02 (p q : Fin 3) (a : R) (ha : a ∈ W) : + elementaryUnit (finiteBlockIndex 0 p) (finiteBlockIndex 2 q) + (finiteBlockIndex_ne_of_ne (by decide) p q) a ∈ H := + elementaryUnit_mem_of_two_step H + (finiteBlockIndex 0 p) (finiteBlockIndex 1 0) + (finiteBlockIndex 2 q) + (finiteBlockIndex_ne_of_ne (by decide) p 0) + (finiteBlockIndex_ne_of_ne (by decide) 0 q) + (finiteBlockIndex_ne_of_ne (by decide) p q) a + (h01 p 0 a ha) (h12 0 q 1 hW) + have h10 (p q : Fin 3) (a : R) (ha : a ∈ W) : + elementaryUnit (finiteBlockIndex 1 p) (finiteBlockIndex 0 q) + (finiteBlockIndex_ne_of_ne (by decide) p q) a ∈ H := + elementaryUnit_mem_of_two_step H + (finiteBlockIndex 1 p) (finiteBlockIndex 2 0) + (finiteBlockIndex 0 q) + (finiteBlockIndex_ne_of_ne (by decide) p 0) + (finiteBlockIndex_ne_of_ne (by decide) 0 q) + (finiteBlockIndex_ne_of_ne (by decide) p q) a + (h12 p 0 a ha) (h20 0 q 1 hW) + have h21 (p q : Fin 3) (a : R) (ha : a ∈ W) : + elementaryUnit (finiteBlockIndex 2 p) (finiteBlockIndex 1 q) + (finiteBlockIndex_ne_of_ne (by decide) p q) a ∈ H := + elementaryUnit_mem_of_two_step H + (finiteBlockIndex 2 p) (finiteBlockIndex 0 0) + (finiteBlockIndex 1 q) + (finiteBlockIndex_ne_of_ne (by decide) p 0) + (finiteBlockIndex_ne_of_ne (by decide) 0 q) + (finiteBlockIndex_ne_of_ne (by decide) p q) a + (h20 p 0 a ha) (h01 0 q 1 hW) + change + elementaryUnit (finiteBlockIndex i p) (finiteBlockIndex j q) + (finiteBlockIndex_ne_of_ne hij p q) a ∈ H + fin_cases i <;> fin_cases j + · exact (hij rfl).elim + · exact h01 p q a ha + · exact h02 p q a ha + · exact h10 p q a ha + · exact (hij rfl).elim + · exact h12 p q a ha + · exact h20 p q a ha + · exact h21 p q a ha + · exact (hij rfl).elim + +private theorem elementaryUnit_mem_cyclicFiniteBlockRootSubgroup + (W : Submodule (ZMod 2) R) (hW : (1 : R) ∈ W) + (x y : Fin 9) (hxy : x ≠ y) (a : R) (ha : a ∈ W) : + elementaryUnit x y hxy a ∈ cyclicFiniteBlockRootSubgroup W := by + obtain ⟨⟨i, p⟩, rfl⟩ := + (finProdFinEquiv : Fin 3 × Fin 3 ≃ Fin 9).surjective x + obtain ⟨⟨j, q⟩, rfl⟩ := + (finProdFinEquiv : Fin 3 × Fin 3 ≃ Fin 9).surjective y + change + elementaryUnit (finiteBlockIndex i p) (finiteBlockIndex j q) hxy a ∈ + cyclicFiniteBlockRootSubgroup W + by_cases hij : i = j + · subst j + let k : Fin 3 := i + 1 + have hik : i ≠ k := by + dsimp [k] + fin_cases i <;> decide + exact elementaryUnit_mem_of_two_step + (cyclicFiniteBlockRootSubgroup W) + (finiteBlockIndex i p) (finiteBlockIndex k 0) + (finiteBlockIndex i q) + (finiteBlockIndex_ne_of_ne hik p 0) + (finiteBlockIndex_ne_of_ne hik.symm 0 q) + hxy a + (elementaryUnit_mem_cyclicFiniteBlockRootSubgroup_of_block_ne + W hW i k hik p 0 a ha) + (elementaryUnit_mem_cyclicFiniteBlockRootSubgroup_of_block_ne + W hW k i hik.symm 0 q 1 hW) + · exact elementaryUnit_mem_cyclicFiniteBlockRootSubgroup_of_block_ne + W hW i j hij p q a ha + +private theorem cyclicFiniteBlockRootSubgroup_eq_elementaryGroup + (s : Finset R) + (hs : Algebra.adjoin (ZMod 2) (↑s : Set R) = ⊤) : + cyclicFiniteBlockRootSubgroup (finiteBlockCoefficientSpan s) = + elementaryGroup (Fin 9) R := by + let W : Submodule (ZMod 2) R := finiteBlockCoefficientSpan s + let H : Subgroup (Matrix (Fin 9) (Fin 9) R)ˣ := + cyclicFiniteBlockRootSubgroup W + have hW : (1 : R) ∈ W := one_mem_finiteBlockCoefficientSpan s + have hunit : ∀ (i j : Fin 9) (hij : i ≠ j), + elementaryUnit i j hij (1 : R) ∈ H := by + intro i j hij + exact elementaryUnit_mem_cyclicFiniteBlockRootSubgroup + W hW i j hij 1 hW + let C : Subalgebra (ZMod 2) R := + elementaryCoefficientSubalgebra 9 (by decide) H hunit + have hgen : (↑s : Set R) ⊆ (C : Set R) := by + intro a ha + change ∀ (i j : Fin 9) (hij : i ≠ j), + elementaryUnit i j hij a ∈ H + intro i j hij + exact elementaryUnit_mem_cyclicFiniteBlockRootSubgroup + W hW i j hij a + (mem_finiteBlockCoefficientSpan_of_mem s ha) + have hC : C = ⊤ := by + apply top_unique + rw [← hs] + exact Algebra.adjoin_le hgen + change H = elementaryGroup (Fin 9) R + apply le_antisymm + · exact cyclicFiniteBlockRootSubgroup_le_elementaryGroup W + · rw [elementaryGroup, Subgroup.closure_le] + rintro _ ⟨i, j, hij, a, rfl⟩ + have ha : a ∈ C := by simp only [hC, Algebra.mem_top] + exact ha i j hij + +end FiniteBlockRoots + +end + +section + +open scoped BigOperators + +universe vSharp + +private theorem hasPropertyT_of_finiteOuterBlockCyclicRootFamily_generate + {R : Type*} [Ring R] [Algebra (ZMod 2) R] + (W : Submodule (ZMod 2) R) [Finite W] + (hgen : + (⨆ i : Fin 3, finiteOuterBlockCyclicRootFamily W i) = ⊤) : + HasPropertyT.{_, vSharp} + (elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) := by + classical + have hfinite (i : Fin 3) : + Finite (finiteOuterBlockCyclicRootFamily W i) := by + fin_cases i + · exact finite_finiteOuterBlockRootSubgroup W 0 1 (by decide) + · exact finite_finiteOuterBlockRootSubgroup W 1 2 (by decide) + · exact finite_finiteOuterBlockRootSubgroup W 2 0 (by decide) + let (i : Fin 3) : Finite (finiteOuterBlockCyclicRootFamily W i) := + hfinite i + let (i : Fin 3) : Fintype (finiteOuterBlockCyclicRootFamily W i) := + Fintype.ofFinite _ + apply ErshovJaikinFiniteSpectral.hasPropertyT_of_three_finite_subgroups_friedrichs_angle + (finiteOuterBlockCyclicRootFamily W) hgen + (Real.sqrt (8 : ℝ))⁻¹ + (le_of_lt ErshovJaikinFiniteSpectral.inv_sqrt_eight_pos) + ErshovJaikinFiniteSpectral.inv_sqrt_eight_lt_one_half + intro H _ _ _ π i j hij a b ha haQ hb hbQ + have hfixed + (K : Subgroup + (elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R))) : + unitaryFixedSubmodule π K = ejUnitaryFixedSubmodule π K := by + ext z + rfl + rw [← hfixed] at ha haQ hb hbQ + exact ErshovJaikinFiniteSpectral.norm_inner_le_inv_sqrt_eight_of_sq a b + (finiteOuterBlockCyclicRootFamily_pair_inner_sq_le + W π i j hij a b ha haQ hb hbQ) + +end + +section + +open scoped BigOperators + +universe vSharp + +private def finiteOuterBlockFlattenHom + {R : Type*} [Ring R] : + elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R) →* + (Matrix (Fin 9) (Fin 9) R)ˣ := + (Units.mapEquiv (finiteBlockFlattenRingEquiv (R := R)).toMulEquiv).toMonoidHom.comp + (elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)).subtype + +private theorem finiteOuterBlockRootSubgroup_map_flatten + {R : Type*} [Ring R] [Algebra (ZMod 2) R] + (W : Submodule (ZMod 2) R) + (i j : Fin 3) (hij : i ≠ j) : + (finiteOuterBlockRootSubgroup W i j hij).map + (finiteOuterBlockFlattenHom (R := R)) = + finiteBlockRootSubgroup W i j hij := by + change (finiteOuterBlockRootHom W i j hij).range.map + (finiteOuterBlockFlattenHom (R := R)) = + (finiteBlockRootHom W i j hij).range + rw [MonoidHom.map_range] + rfl + +private theorem finiteOuterBlockCyclicRootFamily_iSup_eq_top + {R : Type*} [Ring R] [Algebra (ZMod 2) R] + (s : Finset R) + (hs : Algebra.adjoin (ZMod 2) (↑s : Set R) = ⊤) : + (⨆ i : Fin 3, + finiteOuterBlockCyclicRootFamily (finiteBlockCoefficientSpan s) i) = + ⊤ := by + let W : Submodule (ZMod 2) R := finiteBlockCoefficientSpan s + let L : Subgroup + (elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) := + finiteOuterBlockRootSubgroup W 0 1 (by decide) ⊔ + finiteOuterBlockRootSubgroup W 1 2 (by decide) ⊔ + finiteOuterBlockRootSubgroup W 2 0 (by decide) + let φ := finiteOuterBlockFlattenHom (R := R) + have hmap : + L.map φ = elementaryGroup (Fin 9) R := by + calc + L.map φ = cyclicFiniteBlockRootSubgroup W := by + dsimp [L, φ] + rw [Subgroup.map_sup, Subgroup.map_sup, + finiteOuterBlockRootSubgroup_map_flatten, + finiteOuterBlockRootSubgroup_map_flatten, + finiteOuterBlockRootSubgroup_map_flatten] + rfl + _ = elementaryGroup (Fin 9) R := by + exact cyclicFiniteBlockRootSubgroup_eq_elementaryGroup s hs + let e : + elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R) ≃* + elementaryGroup (Fin 9) R := + (LeavittElementaryMorita.elementaryBlockGroupEquiv + (ι := Fin 3) (κ := Fin 3) (R := R)).trans + (LeavittElementaryMorita.elementaryReindexGroupEquiv + (R := R) (finProdFinEquiv : Fin 3 × Fin 3 ≃ Fin 9)) + have hcompat + (x : elementaryGroup (Fin 3) (Matrix (Fin 3) (Fin 3) R)) : + (e x : (Matrix (Fin 9) (Fin 9) R)ˣ) = φ x := by + rfl + have hinj : Function.Injective φ := by + intro x y hxy + apply Subtype.ext + exact (Units.mapEquiv + (finiteBlockFlattenRingEquiv (R := R)).toMulEquiv).injective hxy + have hLtop : L = ⊤ := by + apply top_unique + intro x _ + have hx : + φ x ∈ elementaryGroup (Fin 9) R := by + rw [← hcompat] + exact (e x).property + rw [← hmap] at hx + obtain ⟨z, hz, hzx⟩ := hx + have heq : z = x := hinj hzx + simpa only [heq, SetLike.mem_coe] using hz + apply top_unique + rw [← hLtop] + dsimp [L, W] + exact sup_le + (sup_le + (le_iSup (finiteOuterBlockCyclicRootFamily + (finiteBlockCoefficientSpan s)) 0) + (le_iSup (finiteOuterBlockCyclicRootFamily + (finiteBlockCoefficientSpan s)) 1)) + (le_iSup (finiteOuterBlockCyclicRootFamily + (finiteBlockCoefficientSpan s)) 2) + +private theorem binaryLeavittElementaryNine_hasPropertyT_unconditional : + HasPropertyT.{0, vSharp} (binaryLeavittElementaryGroup 9) := by + classical + obtain ⟨s, hs⟩ := + Algebra.FiniteType.out (R := ZMod 2) (A := BinaryLeavitt) + let : HasPropertyT.{0, vSharp} + (elementaryGroup (Fin 3) + (Matrix (Fin 3) (Fin 3) BinaryLeavitt)) := + hasPropertyT_of_finiteOuterBlockCyclicRootFamily_generate + (finiteBlockCoefficientSpan s) + (finiteOuterBlockCyclicRootFamily_iSup_eq_top s hs) + exact hasPropertyT_of_mulEquiv + ((LeavittElementaryMorita.elementaryBlockGroupEquiv + (ι := Fin 3) (κ := Fin 3) (R := BinaryLeavitt)).trans + (LeavittElementaryMorita.elementaryReindexGroupEquiv + (R := BinaryLeavitt) + (finProdFinEquiv : Fin 3 × Fin 3 ≃ Fin 9))) + +public +theorem alphaPrefixElementaryGroup_hasPropertyT_unconditional : + HasPropertyT.{0, vSharp} (prefixElementaryGroup alphaPrefixCode) := by + let : HasPropertyT.{0, vSharp} (binaryLeavittElementaryGroup 9) := + binaryLeavittElementaryNine_hasPropertyT_unconditional + exact LeavittElementaryMorita.alphaPrefixElementaryGroup_hasPropertyT_of_nine + +public +theorem alphaZeroPrefixElementaryGroup_hasPropertyT_unconditional : + HasPropertyT.{0, vSharp} (prefixElementaryGroup alphaZeroPrefixCode) := by + let : HasPropertyT.{0, vSharp} (binaryLeavittElementaryGroup 9) := + binaryLeavittElementaryNine_hasPropertyT_unconditional + exact LeavittElementaryMorita.alphaZeroPrefixElementaryGroup_hasPropertyT_of_nine + +public +theorem ninePrefixElementaryGroup_hasPropertyT_unconditional : + HasPropertyT.{0, vSharp} (prefixElementaryGroup ninePrefixCode) := by + let : HasPropertyT.{0, vSharp} (binaryLeavittElementaryGroup 9) := + binaryLeavittElementaryNine_hasPropertyT_unconditional + exact hasPropertyT_of_mulEquiv ninePrefixElementaryGroupEquiv + +end + +namespace KunThomFiberCoarea + +private def firstFiber {V : Type*} [DecidableEq V] + (U : Finset (V × V)) (x : V) : Finset (V × V) := + U.filter (fun z => z.1 = x) + +private def secondFiber {V : Type*} [DecidableEq V] + (U : Finset (V × V)) (x : V) : Finset (V × V) := + U.filter (fun z => z.2 = x) + +private def firstMultiplicity {V : Type*} [DecidableEq V] + (U : Finset (V × V)) (x : V) : ℕ := + (firstFiber U x).card + +private def secondMultiplicity {V : Type*} [DecidableEq V] + (U : Finset (V × V)) (x : V) : ℕ := + (secondFiber U x).card + +private def projFiber {V : Type*} [DecidableEq V] (π : V × V → V) + (U : Finset (V × V)) (x : V) : Finset (V × V) := + U.filter (fun z => π z = x) + +private theorem sum_projFiber_card {V : Type*} [Fintype V] [DecidableEq V] + (π : V × V → V) (U : Finset (V × V)) : + (∑ x : V, (projFiber π U x).card) = U.card := by + classical + simpa only [projFiber] using + (Finset.card_eq_sum_card_fiberwise (f := π) (s := U) (t := Finset.univ) (fun _ _ => + Finset.mem_univ _)).symm + +private theorem sum_firstFiber_card {V : Type*} [Fintype V] [DecidableEq V] + (U : Finset (V × V)) : + (∑ x : V, (firstFiber U x).card) = U.card := + sum_projFiber_card Prod.fst U + +private theorem sum_secondFiber_card {V : Type*} [Fintype V] [DecidableEq V] + (U : Finset (V × V)) : + (∑ x : V, (secondFiber U x).card) = U.card := + sum_projFiber_card Prod.snd U + +private theorem natDist_card_le_sdiff {α : Type*} [DecidableEq α] + (A B : Finset α) : + Nat.dist A.card B.card ≤ (A \ B).card + (B \ A).card := by + have hA := Finset.card_sdiff_add_card_inter A B + have hB := Finset.card_sdiff_add_card_inter B A + have hinter : (A ∩ B).card = (B ∩ A).card := by + rw [Finset.inter_comm] + by_cases h : A.card ≤ B.card + · rw [Nat.dist_eq_sub_of_le h] + omega + · rw [Nat.dist_eq_sub_of_le_right (Nat.le_of_not_ge h)] + omega + +private theorem projFiber_sdiff {V : Type*} [DecidableEq V] + (π : V × V → V) (U W : Finset (V × V)) (x : V) : + projFiber π (U \ W) x = projFiber π U x \ projFiber π W x := by + classical + ext z + simp only [projFiber, Finset.mem_filter, Finset.mem_sdiff] + aesop + +private theorem projMultiplicity_variation_le_relation_difference + {V : Type*} [Fintype V] [DecidableEq V] + (π : V × V → V) (U W : Finset (V × V)) : + (∑ x : V, Nat.dist (projFiber π U x).card + (projFiber π W x).card) ≤ + (U \ W).card + (W \ U).card := by + classical + calc + (∑ x : V, Nat.dist (projFiber π U x).card + (projFiber π W x).card) ≤ + ∑ x : V, + ((projFiber π U x \ projFiber π W x).card + + (projFiber π W x \ projFiber π U x).card) := by + apply Finset.sum_le_sum + intro x _ + exact natDist_card_le_sdiff (projFiber π U x) (projFiber π W x) + _ = (∑ x : V, (projFiber π (U \ W) x).card) + + (∑ x : V, (projFiber π (W \ U) x).card) := by + simp_rw [projFiber_sdiff] + rw [Finset.sum_add_distrib] + _ = (U \ W).card + (W \ U).card := by + rw [sum_projFiber_card, sum_projFiber_card] + +private theorem firstMultiplicity_variation_le_relation_difference + {V : Type*} [Fintype V] [DecidableEq V] + (U W : Finset (V × V)) : + (∑ x : V, Nat.dist (firstMultiplicity U x) + (firstMultiplicity W x)) ≤ + (U \ W).card + (W \ U).card := + projMultiplicity_variation_le_relation_difference Prod.fst U W + +private theorem secondMultiplicity_variation_le_relation_difference + {V : Type*} [Fintype V] [DecidableEq V] + (U W : Finset (V × V)) : + (∑ x : V, Nat.dist (secondMultiplicity U x) + (secondMultiplicity W x)) ≤ + (U \ W).card + (W \ U).card := + projMultiplicity_variation_le_relation_difference Prod.snd U W + +private def diagonalImage {V : Type*} [DecidableEq V] + (p : Equiv.Perm V) (U : Finset (V × V)) : Finset (V × V) := + U.image (p.prodCongr p) + +private def diagonalExit {V : Type*} [DecidableEq V] + (p : Equiv.Perm V) (U : Finset (V × V)) : ℕ := + (U.filter fun z => (p.prodCongr p) z ∉ U).card + +private theorem diagonalImage_card {V : Type*} [DecidableEq V] + (p : Equiv.Perm V) (U : Finset (V × V)) : + (diagonalImage p U).card = U.card := by + exact Finset.card_image_of_injective U (p.prodCongr p).injective + +private theorem projFiber_diagonalImage {V : Type*} [DecidableEq V] + (π : V × V → V) (p : Equiv.Perm V) + (hπ : ∀ z : V × V, π ((p.prodCongr p) z) = p (π z)) + (U : Finset (V × V)) (x : V) : + projFiber π (diagonalImage p U) (p x) = + (projFiber π U x).image (p.prodCongr p) := by + classical + ext z + simp only [projFiber, diagonalImage, Finset.mem_filter, + Finset.mem_image] + constructor + · rintro ⟨⟨w, hw, hzw⟩, hzproj⟩ + refine ⟨w, ⟨hw, ?_⟩, hzw⟩ + apply p.injective + rw [← hπ w, hzw] + exact hzproj + · rintro ⟨w, ⟨hw, hwproj⟩, hzw⟩ + refine ⟨⟨w, hw, hzw⟩, ?_⟩ + rw [← hzw, hπ w, hwproj] + +private theorem projMultiplicity_diagonalImage {V : Type*} [DecidableEq V] + (π : V × V → V) (p : Equiv.Perm V) + (hπ : ∀ z : V × V, π ((p.prodCongr p) z) = p (π z)) + (U : Finset (V × V)) (x : V) : + (projFiber π (diagonalImage p U) (p x)).card = + (projFiber π U x).card := by + rw [projFiber_diagonalImage π p hπ U x] + exact Finset.card_image_of_injective _ (p.prodCongr p).injective + +private theorem diagonalImage_sdiff_eq_image_exit {V : Type*} [DecidableEq V] + (p : Equiv.Perm V) (U : Finset (V × V)) : + diagonalImage p U \ U = + (U.filter fun z => (p.prodCongr p) z ∉ U).image + (p.prodCongr p) := by + classical + ext z + simp only [diagonalImage, Finset.mem_sdiff, Finset.mem_image, + Finset.mem_filter] + constructor + · rintro ⟨⟨w, hw, hzw⟩, hzout⟩ + exact ⟨w, ⟨hw, by simpa only [hzw] using hzout⟩, hzw⟩ + · rintro ⟨w, ⟨hw, hwout⟩, hzw⟩ + exact ⟨⟨w, hw, hzw⟩, by simpa only [← hzw, Equiv.prodCongr_apply] using hwout⟩ + +private theorem diagonalImage_sdiff_cards {V : Type*} [DecidableEq V] + (p : Equiv.Perm V) (U : Finset (V × V)) : + (diagonalImage p U \ U).card = diagonalExit p U ∧ + (U \ diagonalImage p U).card = diagonalExit p U := by + have hforward : (diagonalImage p U \ U).card = diagonalExit p U := by + rw [diagonalImage_sdiff_eq_image_exit] + exact Finset.card_image_of_injective _ (p.prodCongr p).injective + have hU := Finset.card_sdiff_add_card_inter U (diagonalImage p U) + have hI := Finset.card_sdiff_add_card_inter (diagonalImage p U) U + have hinter : (U ∩ diagonalImage p U).card = + (diagonalImage p U ∩ U).card := by + rw [Finset.inter_comm] + have hcard := diagonalImage_card p U + exact ⟨hforward, by omega⟩ + +private theorem projMultiplicity_diagonal_variation_le_twice_exit + {V : Type*} [Fintype V] [DecidableEq V] + (π : V × V → V) (p : Equiv.Perm V) + (hπ : ∀ z : V × V, π ((p.prodCongr p) z) = p (π z)) + (U : Finset (V × V)) : + (∑ x : V, Nat.dist (projFiber π U (p x)).card + (projFiber π U x).card) ≤ 2 * diagonalExit p U := by + classical + calc + (∑ x : V, Nat.dist (projFiber π U (p x)).card + (projFiber π U x).card) = + ∑ x : V, Nat.dist (projFiber π U (p x)).card + (projFiber π (diagonalImage p U) (p x)).card := by + apply Finset.sum_congr rfl + intro x _ + rw [projMultiplicity_diagonalImage π p hπ U x] + _ = ∑ x : V, Nat.dist (projFiber π U x).card + (projFiber π (diagonalImage p U) x).card := + Equiv.sum_comp p (fun x => + Nat.dist (projFiber π U x).card + (projFiber π (diagonalImage p U) x).card) + _ ≤ (U \ diagonalImage p U).card + + (diagonalImage p U \ U).card := + projMultiplicity_variation_le_relation_difference + π U (diagonalImage p U) + _ = 2 * diagonalExit p U := by + obtain ⟨hforward, hbackward⟩ := diagonalImage_sdiff_cards p U + rw [hforward, hbackward] + omega + +private theorem projMultiplicity_totalVariation_le_twice_diagonalBoundary + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (π : V × V → V) (σ : ι → Equiv.Perm V) + (hπ : ∀ (p : Equiv.Perm V) (z : V × V), + π ((p.prodCongr p) z) = p (π z)) + (U : Finset (V × V)) : + (∑ i : ι, ∑ x : V, + Nat.dist (projFiber π U (σ i x)).card + (projFiber π U x).card) ≤ + 2 * boundary + (fun i => (σ i).prodCongr (σ i)) U := by + classical + calc + (∑ i : ι, ∑ x : V, + Nat.dist (projFiber π U (σ i x)).card + (projFiber π U x).card) ≤ + ∑ i : ι, 2 * diagonalExit (σ i) U := by + apply Finset.sum_le_sum + intro i _ + exact projMultiplicity_diagonal_variation_le_twice_exit + π (σ i) (hπ (σ i)) U + _ = 2 * boundary + (fun i => (σ i).prodCongr (σ i)) U := by + simp only [diagonalExit, Equiv.prodCongr_apply, boundary, Finset.mul_sum] + +private theorem firstMultiplicity_totalVariation_le_twice_diagonalBoundary + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (U : Finset (V × V)) : + (∑ i : ι, ∑ x : V, + Nat.dist (firstMultiplicity U (σ i x)) + (firstMultiplicity U x)) ≤ + 2 * boundary + (fun i => (σ i).prodCongr (σ i)) U := + projMultiplicity_totalVariation_le_twice_diagonalBoundary + Prod.fst σ (fun _ _ => rfl) U + +private theorem secondMultiplicity_totalVariation_le_twice_diagonalBoundary + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (U : Finset (V × V)) : + (∑ i : ι, ∑ x : V, + Nat.dist (secondMultiplicity U (σ i x)) + (secondMultiplicity U x)) ≤ + 2 * boundary + (fun i => (σ i).prodCongr (σ i)) U := + projMultiplicity_totalVariation_le_twice_diagonalBoundary + Prod.snd σ (fun _ _ => rfl) U + +private def permutationVariation {V ι : Type*} [Fintype V] [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℕ) : ℕ := + ∑ i : ι, ∑ x : V, Nat.dist (f (σ i x)) (f x) + +private def positiveNatSupport {V : Type*} [Fintype V] + (f : V → ℕ) : Finset V := + Finset.univ.filter (fun x => 0 < f x) + +@[simp] +private theorem mem_positiveNatSupport {V : Type*} [Fintype V] + (f : V → ℕ) (x : V) : + x ∈ positiveNatSupport f ↔ 0 < f x := by + simp only [positiveNatSupport, Finset.mem_filter, Finset.mem_univ, true_and] + +public +theorem card_entering_eq_card_exiting + {V : Type*} [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) (A : Finset V) : + (Finset.univ.filter fun x => x ∉ A ∧ p x ∈ A).card = + (A.filter fun x => p x ∉ A).card := by + classical + let P : Finset V := Finset.univ.filter fun x => p x ∈ A + have hP : P.card = A.card := by + apply Finset.card_bij (fun x _ => p x) + · intro x hx + exact (Finset.mem_filter.mp hx).2 + · intro x _ y _ hxy + exact p.injective hxy + · intro y hy + refine ⟨p.symm y, ?_, by simp only [Equiv.apply_symm_apply]⟩ + exact Finset.mem_filter.mpr + ⟨Finset.mem_univ _, by simpa only [Equiv.apply_symm_apply] using hy⟩ + have hsplitA := + Finset.card_filter_add_card_filter_not (s := A) + (fun x => p x ∈ A) + have hsplitP := + Finset.card_filter_add_card_filter_not (s := P) + (fun x => x ∈ A) + have hinternal : + (P.filter fun x => x ∈ A).card = + (A.filter fun x => p x ∈ A).card := by + congr 1 + ext x + simp only [Finset.mem_filter, Finset.mem_univ, true_and, and_comm, P] + have henter : + (P.filter fun x => x ∉ A).card = + (Finset.univ.filter fun x => x ∉ A ∧ p x ∈ A).card := by + congr 1 + ext x + simp only [Finset.mem_filter, Finset.mem_univ, true_and, and_comm, P] + omega + +private theorem sum_indicator_nat_eq_mul_card + {V : Type*} + (A : Finset V) (q : V → Prop) [DecidablePred q] (m : ℕ) : + (∑ x ∈ A, if q x then m else 0) = + m * (A.filter q).card := by + calc + (∑ x ∈ A, if q x then m else 0) = + m * (∑ x ∈ A, if q x then 1 else 0) := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro x _ + split <;> simp + _ = m * (A.filter q).card := by + congr 1 + exact Finset.sum_boole (R := ℕ) q A + +private theorem permutationVariation_subtract_layer + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (f : V → ℕ) + (A : Finset V) (m : ℕ) + (hinside : ∀ x ∈ A, m ≤ f x) + (houtside : ∀ x, x ∉ A → f x = 0) : + permutationVariation σ f = + permutationVariation σ + (fun x => if x ∈ A then f x - m else 0) + + 2 * m * boundary σ A := by + classical + let g : V → ℕ := fun x => if x ∈ A then f x - m else 0 + have hpair (i : ι) (x : V) : + Nat.dist (f (σ i x)) (f x) = + Nat.dist (g (σ i x)) (g x) + + (if x ∈ A ∧ σ i x ∉ A then m else 0) + + (if x ∉ A ∧ σ i x ∈ A then m else 0) := by + by_cases hx : x ∈ A + · by_cases hy : σ i x ∈ A + · have hxlow := hinside x hx + have hylow := hinside (σ i x) hy + simp only [Nat.dist, hy, ↓reduceIte, hx, not_true_eq_false, and_false, add_zero, and_true, + g] + omega + · have hyzero := houtside (σ i x) hy + have hxlow := hinside x hx + simp only [Nat.dist, hyzero, zero_tsub, tsub_zero, zero_add, hy, ↓reduceIte, hx, + not_false_eq_true, and_self, + not_true_eq_false, add_zero, g] + omega + · by_cases hy : σ i x ∈ A + · have hxzero := houtside x hx + have hylow := hinside (σ i x) hy + simp only [Nat.dist, hxzero, tsub_zero, zero_tsub, add_zero, hy, ↓reduceIte, hx, + not_true_eq_false, and_self, + not_false_eq_true, g] + omega + · simp only [houtside (σ i x) hy, houtside x hx, Nat.dist_self, hy, ↓reduceIte, hx, + not_false_eq_true, and_true, + add_zero, and_false, g] + have hone (i : ι) : + (∑ x : V, Nat.dist (f (σ i x)) (f x)) = + (∑ x : V, Nat.dist (g (σ i x)) (g x)) + + 2 * m * (A.filter fun x => σ i x ∉ A).card := by + have hexit : + (∑ x : V, if x ∈ A ∧ σ i x ∉ A then m else 0) = + m * (A.filter fun x => σ i x ∉ A).card := by + have hset : + Finset.univ.filter + (fun x : V => x ∈ A ∧ σ i x ∉ A) = + A.filter fun x => σ i x ∉ A := by + ext x + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + simpa only [hset] using + sum_indicator_nat_eq_mul_card Finset.univ + (fun x : V => x ∈ A ∧ σ i x ∉ A) m + have henter : + (∑ x : V, if x ∉ A ∧ σ i x ∈ A then m else 0) = + m * (Finset.univ.filter fun x => + x ∉ A ∧ σ i x ∈ A).card := + sum_indicator_nat_eq_mul_card + Finset.univ (fun x => x ∉ A ∧ σ i x ∈ A) m + calc + (∑ x : V, Nat.dist (f (σ i x)) (f x)) = + ∑ x : V, + (Nat.dist (g (σ i x)) (g x) + + (if x ∈ A ∧ σ i x ∉ A then m else 0) + + (if x ∉ A ∧ σ i x ∈ A then m else 0)) := by + apply Finset.sum_congr rfl + intro x _ + exact hpair i x + _ = (∑ x : V, Nat.dist (g (σ i x)) (g x)) + + (∑ x : V, if x ∈ A ∧ σ i x ∉ A then m else 0) + + (∑ x : V, if x ∉ A ∧ σ i x ∈ A then m else 0) := by + simp_rw [Finset.sum_add_distrib] + _ = (∑ x : V, Nat.dist (g (σ i x)) (g x)) + + m * (A.filter fun x => σ i x ∉ A).card + + m * (Finset.univ.filter fun x => + x ∉ A ∧ σ i x ∈ A).card := by + rw [hexit, henter] + _ = (∑ x : V, Nat.dist (g (σ i x)) (g x)) + + 2 * m * (A.filter fun x => σ i x ∉ A).card := by + rw [card_entering_eq_card_exiting] + ring + unfold permutationVariation boundary + calc + (∑ i : ι, ∑ x : V, Nat.dist (f (σ i x)) (f x)) = + ∑ i : ι, + ((∑ x : V, Nat.dist (g (σ i x)) (g x)) + + 2 * m * (A.filter fun x => σ i x ∉ A).card) := by + apply Finset.sum_congr rfl + intro i _ + exact hone i + _ = (∑ i : ι, ∑ x : V, + Nat.dist (g (σ i x)) (g x)) + + 2 * m * + ∑ i : ι, (A.filter fun x => σ i x ∉ A).card := by + simp only [Finset.sum_add_distrib, Finset.mul_sum] + +private theorem permutation_small_support_coarea + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (h : ℝ) + (hexp : ∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ)) + (f : V → ℕ) + (hhalf : 2 * (positiveNatSupport f).card ≤ Fintype.card V) : + 2 * h * (∑ x : V, f x) ≤ + (permutationVariation σ f : ℝ) := by + classical + generalize hn : (positiveNatSupport f).card = n + induction n using Nat.strong_induction_on generalizing f with + | h n ih => + by_cases hnonempty : (positiveNatSupport f).Nonempty + · let A : Finset V := positiveNatSupport f + have hA : A.Nonempty := hnonempty + have himage : (A.image f).Nonempty := Finset.image_nonempty.mpr hA + let m : ℕ := (A.image f).min' himage + have hm_mem : m ∈ A.image f := Finset.min'_mem _ _ + obtain ⟨z, hzA, hzm⟩ := Finset.mem_image.mp hm_mem + have hmpos : 0 < m := by + rw [← hzm] + exact (mem_positiveNatSupport f z).mp hzA + have hm_le : ∀ x ∈ A, m ≤ f x := by + intro x hx + exact Finset.min'_le (A.image f) (f x) + (Finset.mem_image.mpr ⟨x, hx, rfl⟩) + let g : V → ℕ := fun x => if x ∈ A then f x - m else 0 + have hg_sub : positiveNatSupport g ⊆ A := by + intro x hx + have hxpos := (mem_positiveNatSupport g x).mp hx + by_contra hxA + simp only [hxA, ↓reduceIte, lt_self_iff_false, g] at hxpos + have hz_not : z ∉ positiveNatSupport g := by + intro hz + have hzpos := (mem_positiveNatSupport g z).mp hz + have hzero : g z = 0 := by + simp only [hzA, ↓reduceIte, hzm, tsub_self, g] + simp only [hzero, lt_self_iff_false] at hzpos + have hstrict : positiveNatSupport g ⊂ A := by + apply Finset.ssubset_iff_subset_ne.mpr + refine ⟨hg_sub, ?_⟩ + intro heq + exact hz_not (heq.symm ▸ hzA) + have hg_card : (positiveNatSupport g).card < n := by + rw [← hn] + exact Finset.card_lt_card hstrict + have hg_half : + 2 * (positiveNatSupport g).card ≤ Fintype.card V := + (Nat.mul_le_mul_left 2 (Finset.card_le_card hg_sub)).trans hhalf + have hg_bound : + 2 * h * (∑ x : V, g x) ≤ + (permutationVariation σ g : ℝ) := + ih (positiveNatSupport g).card hg_card g hg_half rfl + have hg_bound' : + 2 * h * (∑ x : V, (g x : ℝ)) ≤ + (permutationVariation σ g : ℝ) := by + simpa only [Nat.cast_sum] using hg_bound + have hhalf_real : + (2 : ℝ) * A.card ≤ Fintype.card V := by + exact_mod_cast hhalf + have hmin : + (A.card : ℝ) ≤ (Fintype.card V : ℝ) - A.card := by + linarith + have hcut : + h * (A.card : ℝ) ≤ + (boundary σ A : ℝ) := by + simpa only [min_eq_left hmin] using hexp A + have houtside : ∀ x, x ∉ A → f x = 0 := by + intro x hx + have hxnot : ¬ 0 < f x := by + intro hpos + exact hx ((mem_positiveNatSupport f x).mpr hpos) + omega + have hsum : + (∑ x : V, f x) = + (∑ x : V, g x) + m * A.card := by + calc + (∑ x : V, f x) = + ∑ x : V, (g x + if x ∈ A then m else 0) := by + apply Finset.sum_congr rfl + intro x _ + by_cases hx : x ∈ A + · have hxlow := hm_le x hx + simp only [hx, ↓reduceIte, g] + omega + · simp only [houtside x hx, hx, ↓reduceIte, add_zero, g] + _ = (∑ x : V, g x) + + (∑ x : V, if x ∈ A then m else 0) := by + rw [Finset.sum_add_distrib] + _ = (∑ x : V, g x) + m * A.card := by + rw [sum_indicator_nat_eq_mul_card] + simp only [Finset.subset_univ, Finset.filter_mem_eq_of_subset] + have hvar : + permutationVariation σ f = + permutationVariation σ g + + 2 * m * boundary σ A := + permutationVariation_subtract_layer + σ f A m hm_le houtside + calc + 2 * h * (∑ x : V, f x) = + 2 * h * + ((∑ x : V, (g x : ℝ)) + + (m : ℝ) * (A.card : ℝ)) := by + rw [hsum] + simp only [Nat.cast_add, Nat.cast_mul, Nat.cast_sum] + _ = 2 * h * (∑ x : V, (g x : ℝ)) + + (2 * (m : ℝ)) * (h * (A.card : ℝ)) := by + ring + _ ≤ (permutationVariation σ g : ℝ) + + (2 * (m : ℝ)) * + (boundary σ A : ℝ) := by + apply add_le_add hg_bound' + exact mul_le_mul_of_nonneg_left hcut (by positivity) + _ = (permutationVariation σ f : ℝ) := by + exact_mod_cast hvar.symm + · have hzero : ∀ x, f x = 0 := by + intro x + by_contra hx + apply hnonempty + refine ⟨x, (mem_positiveNatSupport f x).mpr ?_⟩ + exact Nat.pos_of_ne_zero hx + simp only [hzero, Finset.sum_const_zero, CharP.cast_eq_zero, mul_zero, permutationVariation, + Nat.dist_self, + Std.le_refl] + +private theorem natDist_sub_one_le (a b : ℕ) : + Nat.dist (a - 1) (b - 1) ≤ Nat.dist a b := by + simp only [Nat.dist] + omega + +private theorem natDist_zero_indicator_le (a b : ℕ) : + Nat.dist (if a = 0 then 1 else 0) + (if b = 0 then 1 else 0) ≤ Nat.dist a b := by + by_cases ha : a = 0 + · by_cases hb : b = 0 + · simp only [ha, ↓reduceIte, hb, Nat.dist_self, Std.le_refl] + · simp only [Nat.dist, ha, ↓reduceIte, hb, tsub_zero, zero_tsub, add_zero, zero_add] + omega + · by_cases hb : b = 0 + · simp only [Nat.dist, ha, ↓reduceIte, hb, zero_tsub, tsub_zero, zero_add, add_zero] + omega + · simp only [ha, ↓reduceIte, hb, Nat.dist_self, zero_le] + +private theorem permutationVariation_sub_one_le + {V ι : Type*} [Fintype V] [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℕ) : + permutationVariation σ (fun x => f x - 1) ≤ + permutationVariation σ f := by + unfold permutationVariation + apply Finset.sum_le_sum + intro i _ + apply Finset.sum_le_sum + intro x _ + exact natDist_sub_one_le (f (σ i x)) (f x) + +private theorem permutationVariation_zero_indicator_le + {V ι : Type*} [Fintype V] [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℕ) : + permutationVariation σ (fun x => if f x = 0 then 1 else 0) ≤ + permutationVariation σ f := by + unfold permutationVariation + apply Finset.sum_le_sum + intro i _ + apply Finset.sum_le_sum + intro x _ + exact natDist_zero_indicator_le (f (σ i x)) (f x) + +private def singletonSupport {V : Type*} [Fintype V] + (f : V → ℕ) : Finset V := + Finset.univ.filter (fun x => f x = 1) + +@[simp] +private theorem mem_singletonSupport {V : Type*} [Fintype V] + (f : V → ℕ) (x : V) : + x ∈ singletonSupport f ↔ f x = 1 := by + simp only [singletonSupport, Finset.mem_filter, Finset.mem_univ, true_and] + +private theorem excess_support_card_le_half_of_singletons + {V : Type*} [Fintype V] + (f : V → ℕ) + (hsingle : Fintype.card V ≤ 2 * (singletonSupport f).card) : + 2 * (positiveNatSupport (fun x => f x - 1)).card ≤ + Fintype.card V := by + classical + have hsub : + positiveNatSupport (fun x => f x - 1) ⊆ + Finset.univ \ singletonSupport f := by + intro x hx + have hxpos := + (mem_positiveNatSupport (fun x => f x - 1) x).mp hx + apply Finset.mem_sdiff.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + intro hxone + have hone := (mem_singletonSupport f x).mp hxone + simp only [hone, tsub_self, lt_self_iff_false] at hxpos + have hcard := Finset.card_le_card hsub + have hpartition := Finset.card_sdiff_add_card_inter + (Finset.univ : Finset V) (singletonSupport f) + have hinter : + ((Finset.univ : Finset V) ∩ singletonSupport f).card = + (singletonSupport f).card := by + simp only [Finset.univ_inter] + have huniv : (Finset.univ : Finset V).card = Fintype.card V := by + rfl + omega + +private theorem zero_support_card_le_half_of_singletons + {V : Type*} [Fintype V] + (f : V → ℕ) + (hsingle : Fintype.card V ≤ 2 * (singletonSupport f).card) : + 2 * (positiveNatSupport + (fun x => if f x = 0 then 1 else 0)).card ≤ + Fintype.card V := by + classical + have hsub : + positiveNatSupport (fun x => if f x = 0 then 1 else 0) ⊆ + Finset.univ \ singletonSupport f := by + intro x hx + have hxpos := + (mem_positiveNatSupport + (fun x => if f x = 0 then 1 else 0) x).mp hx + apply Finset.mem_sdiff.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + intro hxone + have hone := (mem_singletonSupport f x).mp hxone + simp only [hone, one_ne_zero, ↓reduceIte, lt_self_iff_false] at hxpos + have hcard := Finset.card_le_card hsub + have hpartition := Finset.card_sdiff_add_card_inter + (Finset.univ : Finset V) (singletonSupport f) + have hinter : + ((Finset.univ : Finset V) ∩ singletonSupport f).card = + (singletonSupport f).card := by + simp only [Finset.univ_inter] + have huniv : (Finset.univ : Finset V).card = Fintype.card V := by + rfl + omega + +private theorem excess_mass_le_of_diagonal_variation + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (h : ℝ) + (hexp : ∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ)) + (f : V → ℕ) (B : ℕ) + (hsingle : Fintype.card V ≤ 2 * (singletonSupport f).card) + (hvariation : permutationVariation σ f ≤ 2 * B) : + h * (∑ x : V, (f x - 1 : ℕ)) ≤ (B : ℝ) := by + have hhalf := excess_support_card_le_half_of_singletons f hsingle + have hcoarea := permutation_small_support_coarea + σ h hexp (fun x => f x - 1) hhalf + have hcontract := permutationVariation_sub_one_le σ f + have htotal : + permutationVariation σ (fun x => f x - 1) ≤ 2 * B := + hcontract.trans hvariation + have htotal_real : + (permutationVariation σ (fun x => f x - 1) : ℝ) ≤ + 2 * (B : ℝ) := by + exact_mod_cast htotal + linarith + +private theorem zero_mass_le_of_diagonal_variation + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (h : ℝ) + (hexp : ∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ)) + (f : V → ℕ) (B : ℕ) + (hsingle : Fintype.card V ≤ 2 * (singletonSupport f).card) + (hvariation : permutationVariation σ f ≤ 2 * B) : + h * (Finset.univ.filter fun x : V => f x = 0).card ≤ + (B : ℝ) := by + have hhalf := zero_support_card_le_half_of_singletons f hsingle + have hcoarea := permutation_small_support_coarea + σ h hexp (fun x => if f x = 0 then 1 else 0) hhalf + have hcontract := permutationVariation_zero_indicator_le σ f + have htotal : + permutationVariation σ (fun x => if f x = 0 then 1 else 0) ≤ + 2 * B := hcontract.trans hvariation + have htotal_real : + (permutationVariation σ + (fun x => if f x = 0 then 1 else 0) : ℝ) ≤ + 2 * (B : ℝ) := by + exact_mod_cast htotal + have hsum : + (∑ x : V, if f x = 0 then 1 else 0) = + (Finset.univ.filter fun x : V => f x = 0).card := by + simp only [Finset.sum_boole, Nat.cast_id] + rw [hsum] at hcoarea + linarith + +private theorem first_excess_mass_le_diagonalBoundary + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (U : Finset (V × V)) (h : ℝ) + (hexp : ∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ)) + (hsingle : Fintype.card V ≤ + 2 * (singletonSupport (firstMultiplicity U)).card) : + h * (∑ x : V, (firstMultiplicity U x - 1 : ℕ)) ≤ + (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) := by + apply excess_mass_le_of_diagonal_variation + σ h hexp (firstMultiplicity U) + (boundary + (fun i => (σ i).prodCongr (σ i)) U) hsingle + exact firstMultiplicity_totalVariation_le_twice_diagonalBoundary + σ U + +private theorem second_excess_mass_le_diagonalBoundary + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (U : Finset (V × V)) (h : ℝ) + (hexp : ∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ)) + (hsingle : Fintype.card V ≤ + 2 * (singletonSupport (secondMultiplicity U)).card) : + h * (∑ x : V, (secondMultiplicity U x - 1 : ℕ)) ≤ + (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) := by + apply excess_mass_le_of_diagonal_variation + σ h hexp (secondMultiplicity U) + (boundary + (fun i => (σ i).prodCongr (σ i)) U) hsingle + exact secondMultiplicity_totalVariation_le_twice_diagonalBoundary + σ U + +private theorem first_zero_mass_le_diagonalBoundary + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (U : Finset (V × V)) (h : ℝ) + (hexp : ∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ)) + (hsingle : Fintype.card V ≤ + 2 * (singletonSupport (firstMultiplicity U)).card) : + h * (Finset.univ.filter fun x : V => + firstMultiplicity U x = 0).card ≤ + (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) := by + apply zero_mass_le_of_diagonal_variation + σ h hexp (firstMultiplicity U) + (boundary + (fun i => (σ i).prodCongr (σ i)) U) hsingle + exact firstMultiplicity_totalVariation_le_twice_diagonalBoundary + σ U + +private def nonSingletonFirstEdges {V : Type*} [DecidableEq V] + (U : Finset (V × V)) : Finset (V × V) := + U.filter (fun z => firstMultiplicity U z.1 ≠ 1) + +private def nonSingletonSecondEdges {V : Type*} [DecidableEq V] + (U : Finset (V × V)) : Finset (V × V) := + U.filter (fun z => secondMultiplicity U z.2 ≠ 1) + +private def matchedFiberEdges {V : Type*} [DecidableEq V] + (U : Finset (V × V)) : Finset (V × V) := + U.filter (fun z => + firstMultiplicity U z.1 = 1 ∧ secondMultiplicity U z.2 = 1) + +private theorem firstFiber_nonSingletonFirstEdges + {V : Type*} [DecidableEq V] + (U : Finset (V × V)) (x : V) : + firstFiber (nonSingletonFirstEdges U) x = + if firstMultiplicity U x ≠ 1 then firstFiber U x else ∅ := by + classical + ext z + by_cases hz : z.1 = x + · by_cases hx : firstMultiplicity U x = 1 + · simp only [firstFiber, nonSingletonFirstEdges, ne_eq, Finset.mem_filter, hz, hx, + not_true_eq_false, and_false, + and_true, ↓reduceIte, Finset.notMem_empty] + · simp only [firstFiber, nonSingletonFirstEdges, ne_eq, Finset.mem_filter, hz, hx, + not_false_eq_true, and_true, + ↓reduceIte] + · by_cases hx : firstMultiplicity U x = 1 + · simp only [firstFiber, nonSingletonFirstEdges, ne_eq, Finset.mem_filter, hz, and_false, hx, + not_true_eq_false, + ↓reduceIte, Finset.notMem_empty] + · simp only [firstFiber, nonSingletonFirstEdges, ne_eq, Finset.mem_filter, hz, and_false, hx, + not_false_eq_true, + ↓reduceIte] + +private theorem secondFiber_nonSingletonSecondEdges + {V : Type*} [DecidableEq V] + (U : Finset (V × V)) (x : V) : + secondFiber (nonSingletonSecondEdges U) x = + if secondMultiplicity U x ≠ 1 then secondFiber U x else ∅ := by + classical + ext z + by_cases hz : z.2 = x + · by_cases hx : secondMultiplicity U x = 1 + · simp only [secondFiber, nonSingletonSecondEdges, ne_eq, Finset.mem_filter, hz, hx, + not_true_eq_false, + and_false, and_true, ↓reduceIte, Finset.notMem_empty] + · simp only [secondFiber, nonSingletonSecondEdges, ne_eq, Finset.mem_filter, hz, hx, + not_false_eq_true, + and_true, ↓reduceIte] + · by_cases hx : secondMultiplicity U x = 1 + · simp only [secondFiber, nonSingletonSecondEdges, ne_eq, Finset.mem_filter, hz, and_false, hx, + not_true_eq_false, ↓reduceIte, Finset.notMem_empty] + · simp only [secondFiber, nonSingletonSecondEdges, ne_eq, Finset.mem_filter, hz, and_false, hx, + not_false_eq_true, ↓reduceIte] + +private theorem card_nonSingletonFirstEdges_le_twice_excess + {V : Type*} [Fintype V] [DecidableEq V] + (U : Finset (V × V)) : + (nonSingletonFirstEdges U).card ≤ + 2 * ∑ x : V, (firstMultiplicity U x - 1 : ℕ) := by + classical + calc + (nonSingletonFirstEdges U).card = + ∑ x : V, (firstFiber (nonSingletonFirstEdges U) x).card := + (sum_firstFiber_card (nonSingletonFirstEdges U)).symm + _ = ∑ x : V, + if firstMultiplicity U x ≠ 1 + then firstMultiplicity U x else 0 := by + apply Finset.sum_congr rfl + intro x _ + rw [firstFiber_nonSingletonFirstEdges] + split <;> simp [firstMultiplicity] + _ ≤ ∑ x : V, 2 * (firstMultiplicity U x - 1) := by + apply Finset.sum_le_sum + intro x _ + split <;> rename_i hx + · omega + · omega + _ = 2 * ∑ x : V, (firstMultiplicity U x - 1) := by + rw [Finset.mul_sum] + +private theorem card_nonSingletonSecondEdges_le_twice_excess + {V : Type*} [Fintype V] [DecidableEq V] + (U : Finset (V × V)) : + (nonSingletonSecondEdges U).card ≤ + 2 * ∑ x : V, (secondMultiplicity U x - 1 : ℕ) := by + classical + calc + (nonSingletonSecondEdges U).card = + ∑ x : V, (secondFiber (nonSingletonSecondEdges U) x).card := + (sum_secondFiber_card (nonSingletonSecondEdges U)).symm + _ = ∑ x : V, + if secondMultiplicity U x ≠ 1 + then secondMultiplicity U x else 0 := by + apply Finset.sum_congr rfl + intro x _ + rw [secondFiber_nonSingletonSecondEdges] + split <;> simp [secondMultiplicity] + _ ≤ ∑ x : V, 2 * (secondMultiplicity U x - 1) := by + apply Finset.sum_le_sum + intro x _ + split <;> rename_i hx + · omega + · omega + _ = 2 * ∑ x : V, (secondMultiplicity U x - 1) := by + rw [Finset.mul_sum] + +private theorem nonmatchedFiberEdges_subset + {V : Type*} [DecidableEq V] + (U : Finset (V × V)) : + U \ matchedFiberEdges U ⊆ + nonSingletonFirstEdges U ∪ nonSingletonSecondEdges U := by + classical + intro z hz + obtain ⟨hzU, hznot⟩ := Finset.mem_sdiff.mp hz + have hnot : ¬ (firstMultiplicity U z.1 = 1 ∧ + secondMultiplicity U z.2 = 1) := by + intro h + apply hznot + exact Finset.mem_filter.mpr ⟨hzU, h⟩ + by_cases hfirst : firstMultiplicity U z.1 = 1 + · apply Finset.mem_union_right + apply Finset.mem_filter.mpr + exact ⟨hzU, fun hsecond => hnot ⟨hfirst, hsecond⟩⟩ + · apply Finset.mem_union_left + exact Finset.mem_filter.mpr ⟨hzU, hfirst⟩ + +private theorem card_nonmatchedFiberEdges_le_twice_excess + {V : Type*} [Fintype V] [DecidableEq V] + (U : Finset (V × V)) : + (U \ matchedFiberEdges U).card ≤ + 2 * (∑ x : V, (firstMultiplicity U x - 1 : ℕ)) + + 2 * (∑ x : V, (secondMultiplicity U x - 1 : ℕ)) := by + calc + (U \ matchedFiberEdges U).card ≤ + (nonSingletonFirstEdges U ∪ nonSingletonSecondEdges U).card := + Finset.card_le_card (nonmatchedFiberEdges_subset U) + _ ≤ (nonSingletonFirstEdges U).card + + (nonSingletonSecondEdges U).card := + Finset.card_union_le _ _ + _ ≤ 2 * (∑ x : V, (firstMultiplicity U x - 1 : ℕ)) + + 2 * (∑ x : V, (secondMultiplicity U x - 1 : ℕ)) := + Nat.add_le_add + (card_nonSingletonFirstEdges_le_twice_excess U) + (card_nonSingletonSecondEdges_le_twice_excess U) + +private def singletonFirstEdges {V : Type*} [DecidableEq V] + (U : Finset (V × V)) : Finset (V × V) := + U.filter (fun z => firstMultiplicity U z.1 = 1) + +private theorem firstFiber_singletonFirstEdges + {V : Type*} [DecidableEq V] + (U : Finset (V × V)) (x : V) : + firstFiber (singletonFirstEdges U) x = + if firstMultiplicity U x = 1 then firstFiber U x else ∅ := by + classical + ext z + by_cases hz : z.1 = x + · by_cases hx : firstMultiplicity U x = 1 + · simp only [firstFiber, singletonFirstEdges, Finset.mem_filter, hz, hx, and_true, ↓reduceIte] + · simp only [firstFiber, singletonFirstEdges, Finset.mem_filter, hz, hx, and_false, and_true, + ↓reduceIte, + Finset.notMem_empty] + · by_cases hx : firstMultiplicity U x = 1 + · simp only [firstFiber, singletonFirstEdges, Finset.mem_filter, hz, and_false, hx, ↓reduceIte] + · simp only [firstFiber, singletonFirstEdges, Finset.mem_filter, hz, and_false, hx, ↓reduceIte, + Finset.notMem_empty] + +private theorem card_singletonFirstEdges + {V : Type*} [Fintype V] [DecidableEq V] + (U : Finset (V × V)) : + (singletonFirstEdges U).card = + (singletonSupport (firstMultiplicity U)).card := by + classical + calc + (singletonFirstEdges U).card = + ∑ x : V, (firstFiber (singletonFirstEdges U) x).card := + (sum_firstFiber_card (singletonFirstEdges U)).symm + _ = ∑ x : V, if firstMultiplicity U x = 1 then 1 else 0 := by + apply Finset.sum_congr rfl + intro x _ + rw [firstFiber_singletonFirstEdges] + split <;> rename_i hx + · simpa only [firstMultiplicity] using hx + · simp only [Finset.card_empty] + _ = (singletonSupport (firstMultiplicity U)).card := by + simp only [Finset.sum_boole, Nat.cast_id, singletonSupport] + +private theorem singletonFirstEdges_subset_matching_union + {V : Type*} [DecidableEq V] + (U : Finset (V × V)) : + singletonFirstEdges U ⊆ + matchedFiberEdges U ∪ nonSingletonSecondEdges U := by + classical + intro z hz + obtain ⟨hzU, hrow⟩ := Finset.mem_filter.mp hz + by_cases hcol : secondMultiplicity U z.2 = 1 + · apply Finset.mem_union_left + exact Finset.mem_filter.mpr ⟨hzU, hrow, hcol⟩ + · apply Finset.mem_union_right + exact Finset.mem_filter.mpr ⟨hzU, hcol⟩ + +private theorem card_singletonSupport_le_matching_add_column_excess + {V : Type*} [Fintype V] [DecidableEq V] + (U : Finset (V × V)) : + (singletonSupport (firstMultiplicity U)).card ≤ + (matchedFiberEdges U).card + + 2 * (∑ x : V, (secondMultiplicity U x - 1 : ℕ)) := by + rw [← card_singletonFirstEdges U] + calc + (singletonFirstEdges U).card ≤ + (matchedFiberEdges U ∪ nonSingletonSecondEdges U).card := + Finset.card_le_card (singletonFirstEdges_subset_matching_union U) + _ ≤ (matchedFiberEdges U).card + + (nonSingletonSecondEdges U).card := + Finset.card_union_le _ _ + _ ≤ (matchedFiberEdges U).card + + 2 * (∑ x : V, (secondMultiplicity U x - 1 : ℕ)) := + Nat.add_le_add_left + (card_nonSingletonSecondEdges_le_twice_excess U) _ + +private theorem card_le_zero_singleton_excess + {V : Type*} [Fintype V] + (f : V → ℕ) : + Fintype.card V ≤ + (Finset.univ.filter fun x : V => f x = 0).card + + (singletonSupport f).card + + ∑ x : V, (f x - 1 : ℕ) := by + classical + calc + Fintype.card V = ∑ _ : V, (1 : ℕ) := by + simp only [Finset.sum_const, Finset.card_univ, smul_eq_mul, mul_one] + _ ≤ ∑ x : V, + ((if f x = 0 then 1 else 0) + + (if f x = 1 then 1 else 0) + (f x - 1)) := by + apply Finset.sum_le_sum + intro x _ + by_cases hzero : f x = 0 + · simp only [hzero, ↓reduceIte, zero_ne_one, add_zero, zero_tsub, Std.le_refl] + · by_cases hone : f x = 1 + · simp only [hone, one_ne_zero, ↓reduceIte, zero_add, tsub_self, add_zero, Std.le_refl] + · simp only [hzero, ↓reduceIte, hone, add_zero, zero_add] + omega + _ = (Finset.univ.filter fun x : V => f x = 0).card + + (singletonSupport f).card + + ∑ x : V, (f x - 1 : ℕ) := by + simp only [Finset.sum_add_distrib, Finset.sum_boole, Nat.cast_id, singletonSupport] + +private theorem unmatched_vertices_le_zero_and_excess + {V : Type*} [Fintype V] [DecidableEq V] + (U : Finset (V × V)) : + Fintype.card V - (matchedFiberEdges U).card ≤ + (Finset.univ.filter fun x : V => firstMultiplicity U x = 0).card + + (∑ x : V, (firstMultiplicity U x - 1 : ℕ)) + + 2 * (∑ x : V, (secondMultiplicity U x - 1 : ℕ)) := by + have hpopulation := card_le_zero_singleton_excess + (firstMultiplicity U) + have hsingle := card_singletonSupport_le_matching_add_column_excess U + omega + +private theorem matchedFiberEdges_relation_loss_bound + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (U : Finset (V × V)) + (h : ℝ) (hpositive : 0 < h) + (hexp : ∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ)) + (hfirst : Fintype.card V ≤ + 2 * (singletonSupport (firstMultiplicity U)).card) + (hsecond : Fintype.card V ≤ + 2 * (singletonSupport (secondMultiplicity U)).card) : + h * ((U \ matchedFiberEdges U).card : ℝ) ≤ + 4 * (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) := by + have hcount := card_nonmatchedFiberEdges_le_twice_excess U + have hcount_real : + ((U \ matchedFiberEdges U).card : ℝ) ≤ + 2 * ((∑ x : V, (firstMultiplicity U x - 1 : ℕ)) : ℝ) + + 2 * ((∑ x : V, (secondMultiplicity U x - 1 : ℕ)) : ℝ) := by + exact_mod_cast hcount + have hrow := first_excess_mass_le_diagonalBoundary + σ U h hexp hfirst + have hcol := second_excess_mass_le_diagonalBoundary + σ U h hexp hsecond + have hrow' : + h * (∑ x : V, ((firstMultiplicity U x - 1 : ℕ) : ℝ)) ≤ + (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) := by + simpa only [Nat.cast_sum] using hrow + have hcol' : + h * (∑ x : V, ((secondMultiplicity U x - 1 : ℕ) : ℝ)) ≤ + (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) := by + simpa only [Nat.cast_sum] using hcol + calc + h * ((U \ matchedFiberEdges U).card : ℝ) ≤ + h * + (2 * ((∑ x : V, (firstMultiplicity U x - 1 : ℕ)) : ℝ) + + 2 * ((∑ x : V, (secondMultiplicity U x - 1 : ℕ)) : ℝ)) := + mul_le_mul_of_nonneg_left hcount_real hpositive.le + _ = 2 * + (h * (∑ x : V, ((firstMultiplicity U x - 1 : ℕ) : ℝ))) + + 2 * + (h * (∑ x : V, ((secondMultiplicity U x - 1 : ℕ) : ℝ))) := by + ring + _ ≤ 4 * (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) := by + linarith + +private theorem matchedFiberEdges_vertex_loss_bound + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (U : Finset (V × V)) + (h : ℝ) (hpositive : 0 < h) + (hexp : ∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ)) + (hfirst : Fintype.card V ≤ + 2 * (singletonSupport (firstMultiplicity U)).card) + (hsecond : Fintype.card V ≤ + 2 * (singletonSupport (secondMultiplicity U)).card) : + h * ((Fintype.card V - (matchedFiberEdges U).card : ℕ) : ℝ) ≤ + 4 * (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) := by + have hcount := unmatched_vertices_le_zero_and_excess U + have hcount_real : + ((Fintype.card V - (matchedFiberEdges U).card : ℕ) : ℝ) ≤ + ((Finset.univ.filter fun x : V => + firstMultiplicity U x = 0).card : ℝ) + + ((∑ x : V, (firstMultiplicity U x - 1 : ℕ)) : ℝ) + + 2 * ((∑ x : V, (secondMultiplicity U x - 1 : ℕ)) : ℝ) := by + exact_mod_cast hcount + have hzero := first_zero_mass_le_diagonalBoundary + σ U h hexp hfirst + have hrow := first_excess_mass_le_diagonalBoundary + σ U h hexp hfirst + have hcol := second_excess_mass_le_diagonalBoundary + σ U h hexp hsecond + have hrow' : + h * (∑ x : V, ((firstMultiplicity U x - 1 : ℕ) : ℝ)) ≤ + (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) := by + simpa only [Nat.cast_sum] using hrow + have hcol' : + h * (∑ x : V, ((secondMultiplicity U x - 1 : ℕ) : ℝ)) ≤ + (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) := by + simpa only [Nat.cast_sum] using hcol + calc + h * ((Fintype.card V - (matchedFiberEdges U).card : ℕ) : ℝ) ≤ + h * + (((Finset.univ.filter fun x : V => + firstMultiplicity U x = 0).card : ℝ) + + ((∑ x : V, (firstMultiplicity U x - 1 : ℕ)) : ℝ) + + 2 * ((∑ x : V, (secondMultiplicity U x - 1 : ℕ)) : ℝ)) := + mul_le_mul_of_nonneg_left hcount_real hpositive.le + _ = h * ((Finset.univ.filter fun x : V => + firstMultiplicity U x = 0).card : ℝ) + + h * (∑ x : V, ((firstMultiplicity U x - 1 : ℕ) : ℝ)) + + 2 * + (h * (∑ x : V, ((secondMultiplicity U x - 1 : ℕ) : ℝ))) := by + ring + _ ≤ 4 * (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) := by + linarith + +private theorem exists_permutation_extending_matchedFiberEdges + {V : Type*} [DecidableEq V] (U : Finset (V × V)) : + ∃ p : Equiv.Perm V, + ∀ z ∈ matchedFiberEdges U, p z.1 = z.2 := by + classical + let A := {z : V × V // z ∈ matchedFiberEdges U} + let f : A → V := fun z => z.1.1 + let g : A → V := fun z => z.1.2 + have hf : Function.Injective f := by + intro z w h + have hz := Finset.mem_filter.mp z.property + have hw := Finset.mem_filter.mp w.property + have hcard : + (U.filter fun t => t.1 = z.1.1).card ≤ 1 := by + have heq : firstMultiplicity U z.1.1 = 1 := hz.2.1 + simpa only [ge_iff_le, firstMultiplicity, firstFiber] using Nat.le_of_eq heq + have hzmem : z.1 ∈ U.filter fun t => t.1 = z.1.1 := + Finset.mem_filter.mpr ⟨hz.1, rfl⟩ + have hwmem : w.1 ∈ U.filter fun t => t.1 = z.1.1 := by + apply Finset.mem_filter.mpr + refine ⟨hw.1, ?_⟩ + exact h.symm + exact Subtype.ext + ((Finset.card_le_one_iff.mp hcard) hzmem hwmem) + have hg : Function.Injective g := by + intro z w h + have hz := Finset.mem_filter.mp z.property + have hw := Finset.mem_filter.mp w.property + have hcard : + (U.filter fun t => t.2 = z.1.2).card ≤ 1 := by + have heq : secondMultiplicity U z.1.2 = 1 := hz.2.2 + simpa only [ge_iff_le, secondMultiplicity, secondFiber] using Nat.le_of_eq heq + have hzmem : z.1 ∈ U.filter fun t => t.2 = z.1.2 := + Finset.mem_filter.mpr ⟨hz.1, rfl⟩ + have hwmem : w.1 ∈ U.filter fun t => t.2 = z.1.2 := by + apply Finset.mem_filter.mpr + refine ⟨hw.1, ?_⟩ + exact h.symm + exact Subtype.ext + ((Finset.card_le_one_iff.mp hcard) hzmem hwmem) + obtain ⟨p, hp⟩ := Equiv.Perm.exists_extending_pair f g hf hg + refine ⟨p, ?_⟩ + intro z hz + exact hp ⟨z, hz⟩ + +private theorem exists_permutationGraph_containing_matchedFiberEdges + {V : Type*} [Fintype V] [DecidableEq V] + (U : Finset (V × V)) : + ∃ p : Equiv.Perm V, + matchedFiberEdges U ⊆ permutationGraph p := by + obtain ⟨p, hp⟩ := exists_permutation_extending_matchedFiberEdges U + refine ⟨p, ?_⟩ + intro z hz + have h := + (mem_permutationGraph p z.1 z.2).mpr (hp z hz).symm + simpa only [Prod.mk.eta] using h + +public +theorem permutationGraph_card + {V : Type*} [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) : + (permutationGraph p).card = Fintype.card V := by + classical + have hinj : Function.Injective (fun x : V => (x, p x)) := by + intro x y h + exact congrArg Prod.fst h + simpa only [permutationGraph, Finset.card_univ] using (Finset.card_image_of_injective Finset.univ + hinj) + +private theorem permutationGraph_sdiff_bounds_of_matchedFiberEdges + {V : Type*} [Fintype V] [DecidableEq V] + (U : Finset (V × V)) (p : Equiv.Perm V) + (hp : matchedFiberEdges U ⊆ permutationGraph p) : + (permutationGraph p \ U).card ≤ + Fintype.card V - (matchedFiberEdges U).card ∧ + (U \ permutationGraph p).card ≤ + (U \ matchedFiberEdges U).card := by + classical + have hGU : matchedFiberEdges U ⊆ U := by + intro z hz + exact (Finset.mem_filter.mp hz).1 + have hleftsub : + matchedFiberEdges U ⊆ U ∩ permutationGraph p := by + intro z hz + exact Finset.mem_inter.mpr ⟨hGU hz, hp hz⟩ + have hrightsub : + matchedFiberEdges U ⊆ permutationGraph p ∩ U := by + intro z hz + exact Finset.mem_inter.mpr ⟨hp hz, hGU hz⟩ + have hleftcard := Finset.card_le_card hleftsub + have hrightcard := Finset.card_le_card hrightsub + have hgraph := permutationGraph_card p + have hleft := Finset.card_sdiff_add_card_inter + (permutationGraph p) U + have hright := Finset.card_sdiff_add_card_inter + U (permutationGraph p) + have hmatched := Finset.card_sdiff_add_card_inter U (matchedFiberEdges U) + have hinter : + (U ∩ matchedFiberEdges U).card = + (matchedFiberEdges U).card := by + have hset : U ∩ matchedFiberEdges U = matchedFiberEdges U := by + exact Finset.inter_eq_right.mpr hGU + rw [hset] + have hswap : + (U ∩ permutationGraph p).card = + (permutationGraph p ∩ U).card := by + rw [Finset.inter_comm] + constructor <;> omega + +private theorem boundary_le_boundary_add_sdiff + {V ι : Type*} [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (U W : Finset V) : + boundary σ U ≤ boundary σ W + + Fintype.card ι * ((U \ W).card + (W \ U).card) := by + classical + have hpoint (i : ι) : + (U.filter fun x => σ i x ∉ U).card ≤ + (W.filter fun x => σ i x ∉ W).card + + (U \ W).card + (W \ U).card := by + let BU := U.filter fun x => σ i x ∉ U + let BW := W.filter fun x => σ i x ∉ W + let E := U \ W + let C := (W \ U).image (σ i).symm + have hC : C.card = (W \ U).card := by + dsimp [C] + exact Finset.card_image_of_injective _ (σ i).symm.injective + have hsub : BU ⊆ (BW ∪ E) ∪ C := by + intro x hx + obtain ⟨hxU, hxout⟩ := Finset.mem_filter.mp hx + by_cases hxW : x ∈ W + · by_cases himage : σ i x ∈ W + · apply Finset.mem_union_right + apply Finset.mem_image.mpr + refine ⟨σ i x, Finset.mem_sdiff.mpr ⟨himage, hxout⟩, ?_⟩ + simp only [Equiv.symm_apply_apply] + · apply Finset.mem_union_left + apply Finset.mem_union_left + exact Finset.mem_filter.mpr ⟨hxW, himage⟩ + · apply Finset.mem_union_left + apply Finset.mem_union_right + exact Finset.mem_sdiff.mpr ⟨hxU, hxW⟩ + change BU.card ≤ BW.card + (U \ W).card + (W \ U).card + calc + BU.card ≤ ((BW ∪ E) ∪ C).card := Finset.card_le_card hsub + _ ≤ (BW ∪ E).card + C.card := Finset.card_union_le _ _ + _ ≤ (BW.card + E.card) + C.card := + Nat.add_le_add_right (Finset.card_union_le _ _) _ + _ = BW.card + (U \ W).card + (W \ U).card := by + rw [hC] + unfold boundary + calc + (∑ i : ι, (U.filter fun x => σ i x ∉ U).card) ≤ + ∑ i : ι, + ((W.filter fun x => σ i x ∉ W).card + + (U \ W).card + (W \ U).card) := by + apply Finset.sum_le_sum + intro i _ + exact hpoint i + _ = (∑ i : ι, (W.filter fun x => σ i x ∉ W).card) + + Fintype.card ι * ((U \ W).card + (W \ U).card) := by + simp only [add_assoc, Finset.sum_add_distrib, Finset.sum_const, Finset.card_univ, + smul_eq_mul, + mul_add] + +private theorem exists_boundary_controlled_permutation_repair + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (U : Finset (V × V)) + (h : ℝ) (hpositive : 0 < h) + (hexp : ∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ)) + (hfirst : Fintype.card V ≤ + 2 * (singletonSupport (firstMultiplicity U)).card) + (hsecond : Fintype.card V ≤ + 2 * (singletonSupport (secondMultiplicity U)).card) : + ∃ q : Equiv.Perm V, + matchedFiberEdges U ⊆ permutationGraph q ∧ + h * (permutationCommutationDefect σ q : ℝ) ≤ + (h + 8 * (Fintype.card ι : ℝ)) * + (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) := by + classical + obtain ⟨q, hq⟩ := + exists_permutationGraph_containing_matchedFiberEdges U + obtain ⟨hgraphleft, hgraphright⟩ := + permutationGraph_sdiff_bounds_of_matchedFiberEdges U q hq + have hboundary := boundary_le_boundary_add_sdiff + (fun i => (σ i).prodCongr (σ i)) + (permutationGraph q) U + have hdefect : + permutationCommutationDefect σ q ≤ + boundary + (fun i => (σ i).prodCongr (σ i)) U + + Fintype.card ι * + ((Fintype.card V - (matchedFiberEdges U).card) + + (U \ matchedFiberEdges U).card) := by + rw [← boundary_permutationGraph_eq_commutationDefect] + apply hboundary.trans + exact Nat.add_le_add_left + (Nat.mul_le_mul_left (Fintype.card ι) + (Nat.add_le_add hgraphleft hgraphright)) _ + have hdefect_real : + (permutationCommutationDefect σ q : ℝ) ≤ + (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) + + (Fintype.card ι : ℝ) * + (((Fintype.card V - (matchedFiberEdges U).card : ℕ) : ℝ) + + ((U \ matchedFiberEdges U).card : ℝ)) := by + exact_mod_cast hdefect + have hvertex := matchedFiberEdges_vertex_loss_bound + σ U h hpositive hexp hfirst hsecond + have hrelation := matchedFiberEdges_relation_loss_bound + σ U h hpositive hexp hfirst hsecond + have hsum : + h * + (((Fintype.card V - (matchedFiberEdges U).card : ℕ) : ℝ) + + ((U \ matchedFiberEdges U).card : ℝ)) ≤ + 8 * (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) := by + nlinarith + have hdnonneg : (0 : ℝ) ≤ Fintype.card ι := by + positivity + have hscaled := mul_le_mul_of_nonneg_left hsum hdnonneg + refine ⟨q, hq, ?_⟩ + calc + h * (permutationCommutationDefect σ q : ℝ) ≤ + h * + ((boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) + + (Fintype.card ι : ℝ) * + (((Fintype.card V - (matchedFiberEdges U).card : ℕ) : ℝ) + + ((U \ matchedFiberEdges U).card : ℝ))) := + mul_le_mul_of_nonneg_left hdefect_real hpositive.le + _ ≤ (h + 8 * (Fintype.card ι : ℝ)) * + (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) := by + nlinarith + +private theorem permutationDistance_eq_card_permutationGraph_sdiff + {V : Type*} [Fintype V] [DecidableEq V] + (p q : Equiv.Perm V) : + permutationDistance p q = + (permutationGraph p \ + permutationGraph q).card := by + classical + unfold permutationDistance hammingDist + apply Finset.card_bij (fun x _ => (x, p x)) + · intro x hx + obtain ⟨_, hne⟩ := Finset.mem_filter.mp hx + apply Finset.mem_sdiff.mpr + refine ⟨(mem_permutationGraph p x (p x)).mpr rfl, ?_⟩ + intro hxq + exact hne ((mem_permutationGraph q x (p x)).mp hxq) + · intro x _ y _ h + exact congrArg Prod.fst h + · intro z hz + obtain ⟨hzp, hzq⟩ := Finset.mem_sdiff.mp hz + have hzsecond := + (mem_permutationGraph p z.1 z.2).mp hzp + refine ⟨z.1, ?_, ?_⟩ + · apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + intro heq + apply hzq + exact (mem_permutationGraph q z.1 z.2).mpr + (hzsecond.trans heq) + · exact Prod.ext rfl hzsecond.symm + +private theorem permutationDistance_le_matching_loss_add_reference + {V : Type*} [Fintype V] [DecidableEq V] + (U : Finset (V × V)) (q p : Equiv.Perm V) + (hq : matchedFiberEdges U ⊆ permutationGraph q) : + permutationDistance q p ≤ + Fintype.card V - (matchedFiberEdges U).card + + (U \ permutationGraph p).card := by + classical + obtain ⟨hleft, _⟩ := + permutationGraph_sdiff_bounds_of_matchedFiberEdges U q hq + have hsub : + permutationGraph q \ + permutationGraph p ⊆ + (permutationGraph q \ U) ∪ + (U \ permutationGraph p) := by + intro z hz + obtain ⟨hzq, hznot⟩ := Finset.mem_sdiff.mp hz + by_cases hzU : z ∈ U + · apply Finset.mem_union_right + exact Finset.mem_sdiff.mpr ⟨hzU, hznot⟩ + · apply Finset.mem_union_left + exact Finset.mem_sdiff.mpr ⟨hzq, hzU⟩ + rw [permutationDistance_eq_card_permutationGraph_sdiff] + calc + (permutationGraph q \ + permutationGraph p).card ≤ + ((permutationGraph q \ U) ∪ + (U \ permutationGraph p)).card := + Finset.card_le_card hsub + _ ≤ (permutationGraph q \ U).card + + (U \ permutationGraph p).card := + Finset.card_union_le _ _ + _ ≤ Fintype.card V - (matchedFiberEdges U).card + + (U \ permutationGraph p).card := + Nat.add_le_add_right hleft _ + +private theorem exists_boundary_controlled_permutation_repair_close_to_reference + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (U : Finset (V × V)) + (p : Equiv.Perm V) (h : ℝ) (hpositive : 0 < h) + (hexp : ∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ)) + (hfirst : Fintype.card V ≤ + 2 * (singletonSupport (firstMultiplicity U)).card) + (hsecond : Fintype.card V ≤ + 2 * (singletonSupport (secondMultiplicity U)).card) : + ∃ q : Equiv.Perm V, + h * (permutationDistance q p : ℝ) ≤ + 4 * (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) + + h * ((U \ permutationGraph p).card : ℝ) ∧ + h * (permutationCommutationDefect σ q : ℝ) ≤ + (h + 8 * (Fintype.card ι : ℝ)) * + (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) := by + obtain ⟨q, hq, hdefect⟩ := + exists_boundary_controlled_permutation_repair + σ U h hpositive hexp hfirst hsecond + have hdistance := + permutationDistance_le_matching_loss_add_reference U q p hq + have hdistance_real : + (permutationDistance q p : ℝ) ≤ + ((Fintype.card V - (matchedFiberEdges U).card : ℕ) : ℝ) + + ((U \ permutationGraph p).card : ℝ) := by + exact_mod_cast hdistance + have hvertex := matchedFiberEdges_vertex_loss_bound + σ U h hpositive hexp hfirst hsecond + refine ⟨q, ?_, hdefect⟩ + have hscaled := mul_le_mul_of_nonneg_left hdistance_real hpositive.le + nlinarith + +private theorem hasAlmostCentralizerImprovement_of_expanding_diagonal_cuts + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (tolerance : ℕ) + (h : ℝ) (hpositive : 0 < h) + (hexp : ∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ)) + (hcut : ∀ p : Equiv.Perm V, + permutationCommutationDefect σ p ≤ 2 * tolerance → + ∃ U : Finset (V × V), + Fintype.card V ≤ + 2 * (singletonSupport (firstMultiplicity U)).card ∧ + Fintype.card V ≤ + 2 * (singletonSupport (secondMultiplicity U)).card ∧ + (h + 8 * (Fintype.card ι : ℝ)) * + (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) ≤ + h * (tolerance : ℝ) ∧ + (5 : ℝ) * + (4 * (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) + + h * ((U \ permutationGraph p).card : ℝ)) ≤ + h * (Fintype.card V : ℝ)) : + HasAlmostCentralizerImprovement σ tolerance := by + refine ⟨?_⟩ + intro p hp + obtain ⟨U, hfirst, hsecond, hcutdefect, hcutdistance⟩ := hcut p hp + obtain ⟨q, hqdistance, hqdefect⟩ := + exists_boundary_controlled_permutation_repair_close_to_reference + σ U p h hpositive hexp hfirst hsecond + have hdefect_real : + (permutationCommutationDefect σ q : ℝ) ≤ + (tolerance : ℝ) := by + nlinarith + have hdefect : + permutationCommutationDefect σ q ≤ tolerance := by + exact_mod_cast hdefect_real + have hscaled := mul_le_mul_of_nonneg_left hqdistance + (show (0 : ℝ) ≤ 5 by norm_num) + have hdistance_real : + (5 : ℝ) * (permutationDistance q p : ℝ) ≤ + (Fintype.card V : ℝ) := by + nlinarith + have hdistance : + 5 * permutationDistance q p ≤ Fintype.card V := by + exact_mod_cast hdistance_real + exact ⟨q, hdefect, hdistance⟩ + +private theorem projMultiplicity_permutationGraph + {V : Type*} [Fintype V] [DecidableEq V] + (π : V × V → V) (p : Equiv.Perm V) (w : V → V × V) + (hmem : ∀ x, w x ∈ permutationGraph p) + (hproj : ∀ x, π (w x) = x) + (hpoint : ∀ z ∈ permutationGraph p, w (π z) = z) + (x : V) : + (projFiber π (permutationGraph p) x).card = 1 := by + classical + have hset : + projFiber π (permutationGraph p) x = {w x} := by + ext z + simp only [projFiber, Finset.mem_filter, Finset.mem_singleton] + constructor + · rintro ⟨hz, hzx⟩ + rw [← hpoint z hz, hzx] + · rintro rfl + exact ⟨hmem x, hproj x⟩ + rw [hset, Finset.card_singleton] + +private theorem firstMultiplicity_permutationGraph + {V : Type*} [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) (x : V) : + firstMultiplicity (permutationGraph p) x = 1 := + projMultiplicity_permutationGraph Prod.fst p (fun y => (y, p y)) + (fun y => (mem_permutationGraph p y (p y)).mpr rfl) + (fun _ => rfl) + (fun z hz => Prod.ext rfl + ((mem_permutationGraph p z.1 z.2).mp hz).symm) + x + +private theorem secondMultiplicity_permutationGraph + {V : Type*} [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) (x : V) : + secondMultiplicity (permutationGraph p) x = 1 := + projMultiplicity_permutationGraph Prod.snd p (fun y => (p.symm y, y)) + (fun y => (mem_permutationGraph p (p.symm y) y).mpr + (p.apply_symm_apply y).symm) + (fun _ => rfl) + (fun z hz => Prod.ext + (by rw [(mem_permutationGraph p z.1 z.2).mp hz, + p.symm_apply_apply]) + rfl) + x + +private theorem card_nonSingletonMultiplicity_le_total_distance + {V : Type*} [Fintype V] + (f : V → ℕ) : + (Finset.univ.filter fun x : V => f x ≠ 1).card ≤ + ∑ x : V, Nat.dist (f x) 1 := by + classical + calc + (Finset.univ.filter fun x : V => f x ≠ 1).card = + ∑ x : V, if f x ≠ 1 then 1 else 0 := by + exact + (Finset.sum_boole (R := ℕ) + (fun x : V => f x ≠ 1) Finset.univ).symm + _ ≤ ∑ x : V, Nat.dist (f x) 1 := by + apply Finset.sum_le_sum + intro x _ + by_cases hx : f x = 1 + · simp only [hx, ne_eq, not_true_eq_false, ↓reduceIte, Nat.dist_self, Std.le_refl] + · simp only [ne_eq, hx, not_false_eq_true, ↓reduceIte, Nat.dist] + omega + +private theorem card_nonSingletonFirstMultiplicity_le_reference_difference + {V : Type*} [Fintype V] [DecidableEq V] + (U : Finset (V × V)) (p : Equiv.Perm V) : + (Finset.univ.filter fun x : V => + firstMultiplicity U x ≠ 1).card ≤ + (U \ permutationGraph p).card + + (permutationGraph p \ U).card := by + have hcount := card_nonSingletonMultiplicity_le_total_distance + (firstMultiplicity U) + have hvariation := firstMultiplicity_variation_le_relation_difference + U (permutationGraph p) + simp_rw [firstMultiplicity_permutationGraph] at hvariation + exact hcount.trans hvariation + +private theorem card_nonSingletonSecondMultiplicity_le_reference_difference + {V : Type*} [Fintype V] [DecidableEq V] + (U : Finset (V × V)) (p : Equiv.Perm V) : + (Finset.univ.filter fun x : V => + secondMultiplicity U x ≠ 1).card ≤ + (U \ permutationGraph p).card + + (permutationGraph p \ U).card := by + have hcount := card_nonSingletonMultiplicity_le_total_distance + (secondMultiplicity U) + have hvariation := secondMultiplicity_variation_le_relation_difference + U (permutationGraph p) + simp_rw [secondMultiplicity_permutationGraph] at hvariation + exact hcount.trans hvariation + +private theorem first_singleton_half_of_reference_difference + {V : Type*} [Fintype V] [DecidableEq V] + (U : Finset (V × V)) (p : Equiv.Perm V) + (hnear : + 2 * ((U \ permutationGraph p).card + + (permutationGraph p \ U).card) ≤ + Fintype.card V) : + Fintype.card V ≤ + 2 * (singletonSupport (firstMultiplicity U)).card := by + have hbad := card_nonSingletonFirstMultiplicity_le_reference_difference + U p + have hpartition : + (singletonSupport (firstMultiplicity U)).card + + (Finset.univ.filter fun x : V => + firstMultiplicity U x ≠ 1).card = Fintype.card V := by + simpa only [singletonSupport, ne_eq, Finset.card_univ] using + (Finset.card_filter_add_card_filter_not (s := (Finset.univ : Finset V)) (fun x => + firstMultiplicity U x = 1)) + omega + +private theorem second_singleton_half_of_reference_difference + {V : Type*} [Fintype V] [DecidableEq V] + (U : Finset (V × V)) (p : Equiv.Perm V) + (hnear : + 2 * ((U \ permutationGraph p).card + + (permutationGraph p \ U).card) ≤ + Fintype.card V) : + Fintype.card V ≤ + 2 * (singletonSupport (secondMultiplicity U)).card := by + have hbad := card_nonSingletonSecondMultiplicity_le_reference_difference + U p + have hpartition : + (singletonSupport (secondMultiplicity U)).card + + (Finset.univ.filter fun x : V => + secondMultiplicity U x ≠ 1).card = Fintype.card V := by + simpa only [singletonSupport, ne_eq, Finset.card_univ] using + (Finset.card_filter_add_card_filter_not (s := (Finset.univ : Finset V)) (fun x => + secondMultiplicity U x = 1)) + omega + +public +theorem hasAlmostCentralizerImprovement_of_rooted_reference_cuts + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (tolerance : ℕ) + (h : ℝ) (hpositive : 0 < h) + (hexp : ∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ)) + (hcut : ∀ p : Equiv.Perm V, + permutationCommutationDefect σ p ≤ 2 * tolerance → + ∃ U : Finset (V × V), + 2 * ((U \ permutationGraph p).card + + (permutationGraph p \ U).card) ≤ + Fintype.card V ∧ + (h + 8 * (Fintype.card ι : ℝ)) * + (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) ≤ + h * (tolerance : ℝ) ∧ + (5 : ℝ) * + (4 * (boundary + (fun i => (σ i).prodCongr (σ i)) U : ℝ) + + h * ((U \ permutationGraph p).card : ℝ)) ≤ + h * (Fintype.card V : ℝ)) : + HasAlmostCentralizerImprovement σ tolerance := by + apply hasAlmostCentralizerImprovement_of_expanding_diagonal_cuts + σ tolerance h hpositive hexp + intro p hp + obtain ⟨U, hnear, hdefect, hdistance⟩ := hcut p hp + exact ⟨U, + first_singleton_half_of_reference_difference U p hnear, + second_singleton_half_of_reference_difference U p hnear, + hdefect, hdistance⟩ + +end KunThomFiberCoarea + +namespace KunRootedIndicatorCrossing + +universe u + +open Filter +open scoped BigOperators ComplexOrder InnerProductSpace Topology + +private theorem sum_sq_le_sq_sum_of_same_sign + {ι : Type*} [Fintype ι] (a : ι → ℝ) + (h : (∀ i, 0 ≤ a i) ∨ (∀ i, a i ≤ 0)) : + (∑ i, a i ^ 2) ≤ (∑ i, a i) ^ 2 := by + rcases h with h | h + · exact Finset.sum_sq_le_sq_sum_of_nonneg (fun i _ => h i) + · have hn := Finset.sum_sq_le_sq_sum_of_nonneg + (s := Finset.univ) (f := fun i : ι => -a i) + (fun i _ => neg_nonneg.mpr (h i)) + simpa only [sq, ge_iff_le, mul_neg, neg_mul, neg_neg, Finset.sum_neg_distrib] using hn + +private theorem indicator_displacements_same_sign + {ι V : Type*} (p : ι → V → V) (f : V → ℝ) + (hf : ∀ x, f x = 0 ∨ f x = 1) (x : V) : + (∀ i, 0 ≤ f (p i x) - f x) ∨ + (∀ i, f (p i x) - f x ≤ 0) := by + rcases hf x with hx | hx + · left + intro i + rcases hf (p i x) with hi | hi <;> simp [hx, hi] + · right + intro i + rcases hf (p i x) with hi | hi <;> simp [hx, hi] + +private theorem sum_indicator_displacement_sq_le + {ι V : Type*} [Fintype ι] (p : ι → V → V) (f : V → ℝ) + (hf : ∀ x, f x = 0 ∨ f x = 1) (x : V) : + (∑ i, (f (p i x) - f x) ^ 2) ≤ + (∑ i, (f (p i x) - f x)) ^ 2 := + sum_sq_le_sq_sum_of_same_sign _ + (indicator_displacements_same_sign p f hf x) + +private theorem sum_sum_indicator_displacement_sq_le + {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → V → V) (f : V → ℝ) + (hf : ∀ x, f x = 0 ∨ f x = 1) : + (∑ i, ∑ x, (f (p i x) - f x) ^ 2) ≤ + ∑ x, (∑ i, (f (p i x) - f x)) ^ 2 := by + rw [Finset.sum_comm] + exact Finset.sum_le_sum fun x _ => + sum_indicator_displacement_sq_le p f hf x + +private theorem sum_sum_indicator_displacement_sq_le_card_sq_mul_markov_defect + {ι V : Type*} [Fintype ι] [Nonempty ι] [Fintype V] + (p : ι → V → V) (f : V → ℝ) + (hf : ∀ x, f x = 0 ∨ f x = 1) : + (∑ i, ∑ x, (f (p i x) - f x) ^ 2) ≤ + (Fintype.card ι : ℝ) ^ 2 * + ∑ x, ((∑ i, f (p i x)) / (Fintype.card ι : ℝ) - f x) ^ 2 := by + have hd : (Fintype.card ι : ℝ) ≠ 0 := by + exact_mod_cast Fintype.card_ne_zero + have hpoint (x : V) : + (Fintype.card ι : ℝ) ^ 2 * + ((∑ i, f (p i x)) / (Fintype.card ι : ℝ) - f x) ^ 2 = + (∑ i, (f (p i x) - f x)) ^ 2 := by + rw [← mul_pow] + congr 1 + rw [mul_sub, mul_div_cancel₀ _ hd, Finset.sum_sub_distrib] + simp only [mul_comm, Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + calc + (∑ i, ∑ x, (f (p i x) - f x) ^ 2) ≤ + ∑ x, (∑ i, (f (p i x) - f x)) ^ 2 := + sum_sum_indicator_displacement_sq_le p f hf + _ = (Fintype.card ι : ℝ) ^ 2 * + ∑ x, ((∑ i, f (p i x)) / (Fintype.card ι : ℝ) - f x) ^ 2 := by + rw [Finset.mul_sum] + exact Finset.sum_congr rfl fun x _ => (hpoint x).symm + +private def permutationUnitary {V : Type*} [Fintype V] (p : Equiv.Perm V) : + EuclideanSpace ℂ V ≃ₗᵢ[ℂ] EuclideanSpace ℂ V := + LinearIsometryEquiv.piLpCongrLeft 2 ℂ ℂ p + +private theorem permutationUnitary_mul {V : Type*} [Fintype V] + (p q : Equiv.Perm V) (ξ : EuclideanSpace ℂ V) : + permutationUnitary (p * q) ξ = + permutationUnitary p (permutationUnitary q ξ) := by + ext x + change ξ ((p * q).symm x) = ξ (q.symm (p.symm x)) + rw [Equiv.Perm.mul_def, Equiv.symm_trans_apply] + +@[simp] +private theorem permutationUnitary_one {V : Type*} [Fintype V] + (ξ : EuclideanSpace ℂ V) : + permutationUnitary (1 : Equiv.Perm V) ξ = ξ := by + ext x + change ξ x = ξ x + rfl + +private theorem permutationUnitary_eq_of_agree_on_support + {V : Type*} [Fintype V] (p q : Equiv.Perm V) + (ξ : EuclideanSpace ℂ V) + (h : ∀ x : V, ξ x ≠ 0 → p x = q x) : + permutationUnitary p ξ = permutationUnitary q ξ := by + ext y + change ξ (p.symm y) = ξ (q.symm y) + by_cases hp : ξ (p.symm y) = 0 + · rw [hp] + have hzero : ξ (q.symm y) = 0 := by + by_contra hq + have hsame : q.symm y = p.symm y := by + apply p.injective + simpa only [Equiv.apply_symm_apply] using h (q.symm y) hq + apply hq + rw [hsame] + exact hp + exact hzero.symm + · have hsame : p.symm y = q.symm y := by + apply q.injective + simpa only [Equiv.apply_symm_apply] using (h (p.symm y) hp).symm + rw [hsame] + +private theorem permutationUnitary_model_mul_of_agree_on_support + {G V : Type*} [Group G] [Fintype V] + (σ : G → Equiv.Perm V) (a g : G) (ξ : EuclideanSpace ℂ V) + (hroot : ∀ x : V, ξ x ≠ 0 → + σ (a * g) x = (σ a * σ g) x) : + permutationUnitary (σ (a * g)) ξ = + permutationUnitary (σ a) (permutationUnitary (σ g) ξ) := by + rw [permutationUnitary_eq_of_agree_on_support + (σ (a * g)) (σ a * σ g) ξ hroot, + permutationUnitary_mul] + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def indicatorVector {V : Type*} + (f : V → ℝ) : EuclideanSpace ℂ V := + WithLp.toLp 2 fun x => (f x : ℂ) + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def permutationMarkov {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (ξ : EuclideanSpace ℂ V) : + EuclideanSpace ℂ V := + (Fintype.card ι : ℂ)⁻¹ • ∑ i, permutationUnitary (p i) ξ + +@[simp] +private theorem permutationMarkov_apply {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (ξ : EuclideanSpace ℂ V) (x : V) : + permutationMarkov p ξ x = + (∑ i, ξ ((p i).symm x)) / (Fintype.card ι : ℂ) := by + simp only [permutationMarkov, permutationUnitary, PiLp.smul_apply, WithLp.ofLp_sum, + LinearIsometryEquiv.piLpCongrLeft_apply, Finset.sum_apply, Equiv.piCongrLeft'_apply, + smul_eq_mul, div_eq_mul_inv, + mul_comm] + +private theorem permutation_indicator_displacement_norm_sq + {V : Type*} [Fintype V] (p : Equiv.Perm V) (f : V → ℝ) : + ‖permutationUnitary p (indicatorVector f) - indicatorVector f‖ ^ 2 = + ∑ x, (f (p.symm x) - f x) ^ 2 := by + rw [EuclideanSpace.norm_sq_eq] + apply Finset.sum_congr rfl + intro x _ + change ‖(f (p.symm x) : ℂ) - (f x : ℂ)‖ ^ 2 = + (f (p.symm x) - f x) ^ 2 + rw [← Complex.ofReal_sub, Complex.norm_real, Real.norm_eq_abs, + sq_abs] + +private theorem permutation_indicator_markov_defect_norm_sq + {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) : + ‖permutationMarkov p (indicatorVector f) - indicatorVector f‖ ^ 2 = + ∑ x, ((∑ i, f ((p i).symm x)) / + (Fintype.card ι : ℝ) - f x) ^ 2 := by + rw [EuclideanSpace.norm_sq_eq] + apply Finset.sum_congr rfl + intro x _ + change ‖permutationMarkov p (indicatorVector f) x - + indicatorVector f x‖ ^ 2 = _ + rw [permutationMarkov_apply] + change ‖(∑ i, (f ((p i).symm x) : ℂ)) / + (Fintype.card ι : ℂ) - (f x : ℂ)‖ ^ 2 = _ + have hcast : + (∑ i, (f ((p i).symm x) : ℂ)) / + (Fintype.card ι : ℂ) - (f x : ℂ) = + (((∑ i, f ((p i).symm x)) / + (Fintype.card ι : ℝ) - f x : ℝ) : ℂ) := by + norm_cast + rw [hcast, Complex.norm_real, Real.norm_eq_abs, sq_abs] + +private theorem sum_permutation_indicator_displacement_norm_sq_le + {ι V : Type*} [Fintype ι] [Nonempty ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) + (hf : ∀ x, f x = 0 ∨ f x = 1) : + (∑ i, ‖permutationUnitary (p i) (indicatorVector f) - + indicatorVector f‖ ^ 2) ≤ + (Fintype.card ι : ℝ) ^ 2 * + ‖permutationMarkov p (indicatorVector f) - + indicatorVector f‖ ^ 2 := by + simp_rw [permutation_indicator_displacement_norm_sq, + permutation_indicator_markov_defect_norm_sq] + exact sum_sum_indicator_displacement_sq_le_card_sq_mul_markov_defect + (fun i x => (p i).symm x) f hf + +private theorem permutation_indicator_displacement_norm_le_card_mul_markov_defect + {ι V : Type*} [Fintype ι] [Nonempty ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) + (hf : ∀ x, f x = 0 ∨ f x = 1) (i : ι) : + ‖permutationUnitary (p i) (indicatorVector f) - indicatorVector f‖ ≤ + (Fintype.card ι : ℝ) * + ‖permutationMarkov p (indicatorVector f) - indicatorVector f‖ := by + have hsingle : + ‖permutationUnitary (p i) (indicatorVector f) - + indicatorVector f‖ ^ 2 ≤ + ∑ j, ‖permutationUnitary (p j) (indicatorVector f) - + indicatorVector f‖ ^ 2 := + Finset.single_le_sum + (f := fun j : ι => + ‖permutationUnitary (p j) (indicatorVector f) - + indicatorVector f‖ ^ 2) + (fun j _ => sq_nonneg _) (Finset.mem_univ i) + have htotal := + sum_permutation_indicator_displacement_norm_sq_le p f hf + have hsq : + ‖permutationUnitary (p i) (indicatorVector f) - + indicatorVector f‖ ^ 2 ≤ + ((Fintype.card ι : ℝ) * + ‖permutationMarkov p (indicatorVector f) - + indicatorVector f‖) ^ 2 := by + rw [mul_pow] + exact hsingle.trans htotal + exact (sq_le_sq₀ (norm_nonneg _) (mul_nonneg (by positivity) + (norm_nonneg _))).mp hsq + +private def normalizedIndicatorDisplacement + {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) (q : Equiv.Perm V) : + EuclideanSpace ℂ V := + ((‖permutationMarkov p (indicatorVector f) - + indicatorVector f‖ : ℝ) : ℂ)⁻¹ • + (permutationUnitary q (indicatorVector f) - indicatorVector f) + +private theorem norm_normalizedIndicatorDisplacement_generator_le + {ι V : Type*} [Fintype ι] [Nonempty ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) + (hf : ∀ x, f x = 0 ∨ f x = 1) + (hdefect : permutationMarkov p (indicatorVector f) ≠ + indicatorVector f) (i : ι) : + ‖normalizedIndicatorDisplacement p f (p i)‖ ≤ + (Fintype.card ι : ℝ) := by + have hpos : 0 < ‖permutationMarkov p (indicatorVector f) - + indicatorVector f‖ := + norm_pos_iff.mpr (sub_ne_zero.mpr hdefect) + rw [normalizedIndicatorDisplacement, norm_smul, norm_inv, + Complex.norm_real, Real.norm_of_nonneg (norm_nonneg _)] + apply (inv_mul_le_iff₀ hpos).mpr + simpa only [mul_comm] using permutation_indicator_displacement_norm_le_card_mul_markov_defect p f + hf i + +private theorem normalizedIndicatorDisplacement_mul + {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) + (q r : Equiv.Perm V) : + normalizedIndicatorDisplacement p f (q * r) = + normalizedIndicatorDisplacement p f q + + permutationUnitary q (normalizedIndicatorDisplacement p f r) := by + unfold normalizedIndicatorDisplacement + rw [permutationUnitary_mul] + simp only [map_smul, map_sub, smul_sub] + abel + +private theorem norm_normalizedIndicatorDisplacement_list_prod_le + {ι V : Type*} [Fintype ι] [Nonempty ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) + (hf : ∀ x, f x = 0 ∨ f x = 1) + (hdefect : permutationMarkov p (indicatorVector f) ≠ + indicatorVector f) (w : List ι) : + ‖normalizedIndicatorDisplacement p f (w.map p).prod‖ ≤ + (Fintype.card ι : ℝ) * w.length := by + induction w with + | nil => + simp only [normalizedIndicatorDisplacement, List.map_nil, List.prod_nil, + permutationUnitary_one, sub_self, + smul_zero, norm_zero, List.length_nil, CharP.cast_eq_zero, mul_zero, Std.le_refl] + | cons i w ih => + rw [List.map_cons, List.prod_cons, + normalizedIndicatorDisplacement_mul] + calc + ‖normalizedIndicatorDisplacement p f (p i) + + permutationUnitary (p i) + (normalizedIndicatorDisplacement p f (w.map p).prod)‖ ≤ + ‖normalizedIndicatorDisplacement p f (p i)‖ + + ‖permutationUnitary (p i) + (normalizedIndicatorDisplacement p f (w.map p).prod)‖ := + norm_add_le _ _ + _ = ‖normalizedIndicatorDisplacement p f (p i)‖ + + ‖normalizedIndicatorDisplacement p f (w.map p).prod‖ := by + rw [(permutationUnitary (p i)).norm_map] + _ ≤ (Fintype.card ι : ℝ) + + (Fintype.card ι : ℝ) * w.length := + add_le_add + (norm_normalizedIndicatorDisplacement_generator_le + p f hf hdefect i) ih + _ = (Fintype.card ι : ℝ) * (i :: w).length := by + simp only [List.length_cons, Nat.cast_add, Nat.cast_one] + ring + +private def normalizedIndicatorDefect + {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) : + EuclideanSpace ℂ V := + ((‖permutationMarkov p (indicatorVector f) - + indicatorVector f‖ : ℝ) : ℂ)⁻¹ • + (permutationMarkov p (indicatorVector f) - indicatorVector f) + +private theorem norm_normalizedIndicatorDefect + {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) + (hdefect : permutationMarkov p (indicatorVector f) ≠ + indicatorVector f) : + ‖normalizedIndicatorDefect p f‖ = 1 := by + have hne : ‖permutationMarkov p (indicatorVector f) - + indicatorVector f‖ ≠ 0 := + norm_ne_zero_iff.mpr (sub_ne_zero.mpr hdefect) + simp only [normalizedIndicatorDefect, norm_smul, norm_inv, Complex.norm_real, norm_norm, ne_eq, + hne, + not_false_eq_true, inv_mul_cancel₀] + +private theorem average_permutation_indicator_displacement + {ι V : Type*} [Fintype ι] [Nonempty ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) : + (Fintype.card ι : ℂ)⁻¹ • + (∑ i, (permutationUnitary (p i) (indicatorVector f) - + indicatorVector f)) = + permutationMarkov p (indicatorVector f) - indicatorVector f := by + have hd : (Fintype.card ι : ℂ) ≠ 0 := by + exact_mod_cast Fintype.card_ne_zero + rw [Finset.sum_sub_distrib, Finset.sum_const, Finset.card_univ, + ← Nat.cast_smul_eq_nsmul ℂ] + simp only [smul_sub, smul_smul, ne_eq, hd, not_false_eq_true, inv_mul_cancel₀, one_smul, + permutationMarkov] + +private theorem average_normalizedIndicatorDisplacement + {ι V : Type*} [Fintype ι] [Nonempty ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) : + (Fintype.card ι : ℂ)⁻¹ • + (∑ i, normalizedIndicatorDisplacement p f (p i)) = + normalizedIndicatorDefect p f := by + simp_rw [normalizedIndicatorDisplacement] + rw [← Finset.smul_sum, smul_comm, + average_permutation_indicator_displacement] + rfl + +private theorem normalizedIndicatorDisplacement_cocycle_of_agree_on_support + {G ι V : Type*} [Group G] [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) + (σ : G → Equiv.Perm V) (a g : G) + (hroot : ∀ x : V, indicatorVector f x ≠ 0 → + σ (a * g) x = (σ a * σ g) x) : + normalizedIndicatorDisplacement p f (σ (a * g)) = + normalizedIndicatorDisplacement p f (σ a) + + permutationUnitary (σ a) + (normalizedIndicatorDisplacement p f (σ g)) := by + unfold normalizedIndicatorDisplacement + rw [permutationUnitary_model_mul_of_agree_on_support + σ a g (indicatorVector f) hroot] + simp only [map_smul, map_sub, smul_sub] + abel + +private def normalizedPairDisplacement + {G ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) + (σ : G → Equiv.Perm V) (q : G × G) : + EuclideanSpace ℂ V := + normalizedIndicatorDisplacement p f (σ q.1) - + normalizedIndicatorDisplacement p f (σ q.2) + +private theorem normalizedPairDisplacement_diagonal + {G ι V : Type*} [Group G] [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) + (σ : G → Equiv.Perm V) (a g h : G) + (hg : ∀ x : V, indicatorVector f x ≠ 0 → + σ (a * g) x = (σ a * σ g) x) + (hh : ∀ x : V, indicatorVector f x ≠ 0 → + σ (a * h) x = (σ a * σ h) x) : + normalizedPairDisplacement p f σ (a * g, a * h) = + permutationUnitary (σ a) + (normalizedPairDisplacement p f σ (g, h)) := by + unfold normalizedPairDisplacement + rw [normalizedIndicatorDisplacement_cocycle_of_agree_on_support + p f σ a g hg, + normalizedIndicatorDisplacement_cocycle_of_agree_on_support + p f σ a h hh, map_sub] + abel + +private theorem normalizedPairDisplacement_inner_diagonal + {G ι V : Type*} [Group G] [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) + (σ : G → Equiv.Perm V) (a g h j k : G) + (hg : ∀ x : V, indicatorVector f x ≠ 0 → + σ (a * g) x = (σ a * σ g) x) + (hh : ∀ x : V, indicatorVector f x ≠ 0 → + σ (a * h) x = (σ a * σ h) x) + (hj : ∀ x : V, indicatorVector f x ≠ 0 → + σ (a * j) x = (σ a * σ j) x) + (hk : ∀ x : V, indicatorVector f x ≠ 0 → + σ (a * k) x = (σ a * σ k) x) : + @inner ℂ (EuclideanSpace ℂ V) _ + (normalizedPairDisplacement p f σ (a * g, a * h)) + (normalizedPairDisplacement p f σ (a * j, a * k)) = + @inner ℂ (EuclideanSpace ℂ V) _ + (normalizedPairDisplacement p f σ (g, h)) + (normalizedPairDisplacement p f σ (j, k)) := by + rw [normalizedPairDisplacement_diagonal p f σ a g h hg hh, + normalizedPairDisplacement_diagonal p f σ a j k hj hk] + exact (permutationUnitary (σ a)).inner_map_map _ _ + +private theorem normalizedPairDisplacement_add + {G ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) + (σ : G → Equiv.Perm V) (g h j : G) : + normalizedPairDisplacement p f σ (g, h) + + normalizedPairDisplacement p f σ (h, j) = + normalizedPairDisplacement p f σ (g, j) := by + unfold normalizedPairDisplacement + abel + +private theorem norm_normalizedPairDisplacement_le_of_words + {G ι V : Type*} [Fintype ι] [Nonempty ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) + (hf : ∀ x, f x = 0 ∨ f x = 1) + (hdefect : permutationMarkov p (indicatorVector f) ≠ + indicatorVector f) + (σ : G → Equiv.Perm V) (w : G → List ι) + (hw : ∀ g, σ g = ((w g).map p).prod) (g h : G) : + ‖normalizedPairDisplacement p f σ (g, h)‖ ≤ + (Fintype.card ι : ℝ) * + ((w g).length + (w h).length) := by + unfold normalizedPairDisplacement + calc + ‖normalizedIndicatorDisplacement p f (σ g) - + normalizedIndicatorDisplacement p f (σ h)‖ ≤ + ‖normalizedIndicatorDisplacement p f (σ g)‖ + + ‖normalizedIndicatorDisplacement p f (σ h)‖ := + norm_sub_le _ _ + _ ≤ (Fintype.card ι : ℝ) * (w g).length + + (Fintype.card ι : ℝ) * (w h).length := by + rw [hw g, hw h] + exact add_le_add + (norm_normalizedIndicatorDisplacement_list_prod_le + p f hf hdefect (w g)) + (norm_normalizedIndicatorDisplacement_list_prod_le + p f hf hdefect (w h)) + _ = (Fintype.card ι : ℝ) * + ((w g).length + (w h).length) := by + ring + +private theorem exists_hyperfilter_gram_limit_of_pointwise_bound + {I : Type*} {H : ℕ → Type*} + [∀ n, SeminormedAddCommGroup (H n)] + [∀ n, InnerProductSpace ℂ (H n)] + (v : ∀ n, I → H n) (B : I → ℝ) + (hbound : ∀ n i, ‖v n i‖ ≤ B i) : + ∃ K : Matrix I I ℂ, + ∀ i j, Tendsto (fun n => ⟪v n i, v n j⟫_ℂ) + (Filter.hyperfilter ℕ) (𝓝 (K i j)) := by + have hinnerbound (n : ℕ) (i j : I) : + ‖⟪v n i, v n j⟫_ℂ‖ ≤ B i * B j := by + calc + ‖⟪v n i, v n j⟫_ℂ‖ ≤ ‖v n i‖ * ‖v n j‖ := + norm_inner_le_norm _ _ + _ ≤ B i * B j := + mul_le_mul (hbound n i) (hbound n j) + (norm_nonneg _) ((norm_nonneg _).trans (hbound n i)) + let b : ℕ → (q : I × I) → + Metric.closedBall (0 : ℂ) (B q.1 * B q.2) := + fun n q => + ⟨⟪v n q.1, v n q.2⟫_ℂ, + by simpa only [Metric.mem_closedBall, dist_zero_right] using hinnerbound n q.1 q.2⟩ + let u := Ultrafilter.map b (Filter.hyperfilter ℕ) + let L : (q : I × I) → + Metric.closedBall (0 : ℂ) (B q.1 * B q.2) := u.lim + let K : Matrix I I ℂ := fun i j => (L (i, j) : ℂ) + refine ⟨K, ?_⟩ + have hu : Tendsto b (Filter.hyperfilter ℕ) (𝓝 L) := by + change Filter.map b (↑(Filter.hyperfilter ℕ) : Filter ℕ) ≤ + 𝓝 u.lim + simpa only [u, Ultrafilter.coe_map] using u.le_nhds_lim + intro i j + have heval : + Tendsto + (fun f : (q : I × I) → + Metric.closedBall (0 : ℂ) (B q.1 * B q.2) => f (i, j)) + (𝓝 L) (𝓝 (L (i, j))) := + (continuous_apply (i, j)).tendsto L + have hval : + Tendsto + (fun z : Metric.closedBall (0 : ℂ) (B i * B j) => (z : ℂ)) + (𝓝 (L (i, j))) (𝓝 (L (i, j) : ℂ)) := + continuous_subtype_val.tendsto (L (i, j)) + have hcomp := hval.comp (heval.comp hu) + change Tendsto (fun n => ⟪v n i, v n j⟫_ℂ) + (Filter.hyperfilter ℕ) (𝓝 (L (i, j) : ℂ)) at hcomp + exact hcomp + +private theorem gram_posSemidef_infinite + {I H : Type*} [SeminormedAddCommGroup H] + [InnerProductSpace ℂ H] (v : I → H) : + (Matrix.gram ℂ v).PosSemidef := by + refine ⟨Matrix.isHermitian_gram ℂ v, ?_⟩ + intro c + calc + (0 : ℂ) ≤ + ⟪c.sum (fun i z => z • v i), + c.sum (fun i z => z • v i)⟫_ℂ := + RCLike.nonneg_iff.mpr ⟨inner_self_nonneg, inner_self_im _⟩ + _ = c.sum (fun i z => + c.sum (fun j w => star z * (Matrix.gram ℂ v) i j * w)) := by + rw [Finsupp.sum_inner] + apply Finsupp.sum_congr + intro i hi + rw [Finsupp.inner_sum] + apply Finsupp.sum_congr + intro j hj + simp only [inner_smul_left, inner_smul_right, + Matrix.gram_apply, RCLike.star_def] + ring + +private theorem exists_hyperfilter_positive_gram_kernel_of_pointwise_bound + {I : Type*} {H : ℕ → Type*} + [∀ n, SeminormedAddCommGroup (H n)] + [∀ n, InnerProductSpace ℂ (H n)] + (v : ∀ n, I → H n) (B : I → ℝ) + (hbound : ∀ n i, ‖v n i‖ ≤ B i) : + ∃ K : Matrix I I ℂ, + K.PosSemidef ∧ + ∀ i j, Tendsto (fun n => ⟪v n i, v n j⟫_ℂ) + (Filter.hyperfilter ℕ) (𝓝 (K i j)) := by + obtain ⟨K, hconv⟩ := + exists_hyperfilter_gram_limit_of_pointwise_bound v B hbound + have hhermitian : K.IsHermitian := by + apply Matrix.IsHermitian.ext + intro i j + apply tendsto_nhds_unique (hconv j i).star + have hsymm : + (fun n => star ⟪v n j, v n i⟫_ℂ) = + (fun n => ⟪v n i, v n j⟫_ℂ) := by + funext n + exact inner_conj_symm _ _ + rw [hsymm] + exact hconv i j + refine ⟨K, ⟨hhermitian, ?_⟩, hconv⟩ + intro c + have hquadratic : + Tendsto + (fun n => c.sum fun i z => + c.sum fun j w => star z * ⟪v n i, v n j⟫_ℂ * w) + (Filter.hyperfilter ℕ) + (𝓝 (c.sum fun i z => + c.sum fun j w => star z * K i j * w)) := by + simpa only [Finsupp.sum] using + tendsto_finsetSum c.support (fun i _ => + tendsto_finsetSum c.support (fun j _ => + (tendsto_const_nhds.mul (hconv i j)).mul + tendsto_const_nhds)) + apply ge_of_tendsto hquadratic + exact Eventually.of_forall fun n => + (gram_posSemidef_infinite (v n)).2 c + +private theorem exists_hyperfilter_diagonal_positive_pair_kernel + {G : Type*} [Group G] {H : ℕ → Type*} + [∀ n, SeminormedAddCommGroup (H n)] + [∀ n, InnerProductSpace ℂ (H n)] + (v : ∀ n, G × G → H n) (B : G × G → ℝ) + (hbound : ∀ n q, ‖v n q‖ ≤ B q) + (hdiagonal : ∀ a g h j k : G, + ∀ᶠ n in Filter.atTop, + ⟪v n (a * g, a * h), v n (a * j, a * k)⟫_ℂ = + ⟪v n (g, h), v n (j, k)⟫_ℂ) + (hadd : ∀ n (g h j : G), + v n (g, h) + v n (h, j) = v n (g, j)) : + ∃ K : Matrix (G × G) (G × G) ℂ, + K.PosSemidef ∧ + (∀ a g h j k : G, + K (a * g, a * h) (a * j, a * k) = K (g, h) (j, k)) ∧ + (∀ g h j : G, ∀ q : G × G, + K (g, h) q + K (h, j) q = K (g, j) q) ∧ + ∀ q r, Tendsto (fun n => ⟪v n q, v n r⟫_ℂ) + (Filter.hyperfilter ℕ) (𝓝 (K q r)) := by + obtain ⟨K, hpositive, hconv⟩ := + exists_hyperfilter_positive_gram_kernel_of_pointwise_bound + v B hbound + refine ⟨K, hpositive, ?_, ?_, hconv⟩ + · intro a g h j k + have hevent : + (fun n => + ⟪v n (a * g, a * h), v n (a * j, a * k)⟫_ℂ) =ᶠ[ + (Filter.hyperfilter ℕ : Filter ℕ)] + (fun n => ⟪v n (g, h), v n (j, k)⟫_ℂ) := + (hdiagonal a g h j k).filter_mono Nat.hyperfilter_le_atTop + exact tendsto_nhds_unique + (hconv (a * g, a * h) (a * j, a * k)) + (Tendsto.congr' hevent.symm (hconv (g, h) (j, k))) + · intro g h j q + have haddconv := + (hconv (g, h) q).add (hconv (h, j) q) + have hfunctions : + (fun n => + ⟪v n (g, h), v n q⟫_ℂ + + ⟪v n (h, j), v n q⟫_ℂ) = + (fun n => ⟪v n (g, j), v n q⟫_ℂ) := by + funext n + rw [← inner_add_left, hadd] + exact tendsto_nhds_unique haddconv + (by rw [hfunctions]; exact hconv (g, j) q) + +private theorem exists_hyperfilter_diagonal_positive_pair_kernel_of_rooted_indicators + {G ι : Type*} [Group G] [Fintype ι] [Nonempty ι] + {V : ℕ → Type*} [∀ n, Fintype (V n)] + (p : ∀ n, ι → Equiv.Perm (V n)) + (f : ∀ n, V n → ℝ) + (σ : ∀ n, G → Equiv.Perm (V n)) + (w : G → List ι) + (hf : ∀ n x, f n x = 0 ∨ f n x = 1) + (hdefect : ∀ n, permutationMarkov (p n) (indicatorVector (f n)) ≠ + indicatorVector (f n)) + (hw : ∀ n g, σ n g = ((w g).map (p n)).prod) + (hroot : ∀ a g : G, ∀ᶠ n in Filter.atTop, + ∀ x : V n, indicatorVector (f n) x ≠ 0 → + σ n (a * g) x = (σ n a * σ n g) x) : + ∃ K : Matrix (G × G) (G × G) ℂ, + K.PosSemidef ∧ + (∀ a g h j k : G, + K (a * g, a * h) (a * j, a * k) = K (g, h) (j, k)) ∧ + (∀ g h j : G, ∀ q : G × G, + K (g, h) q + K (h, j) q = K (g, j) q) ∧ + ∀ q r, + Tendsto + (fun n => + ⟪normalizedPairDisplacement (p n) (f n) (σ n) q, + normalizedPairDisplacement (p n) (f n) (σ n) r⟫_ℂ) + (Filter.hyperfilter ℕ) (𝓝 (K q r)) := by + let v : ∀ n, G × G → EuclideanSpace ℂ (V n) := + fun n q => normalizedPairDisplacement (p n) (f n) (σ n) q + let B : G × G → ℝ := fun q => + (Fintype.card ι : ℝ) * ((w q.1).length + (w q.2).length) + apply exists_hyperfilter_diagonal_positive_pair_kernel v B + · intro n q + exact norm_normalizedPairDisplacement_le_of_words + (p n) (f n) (hf n) (hdefect n) (σ n) w (hw n) q.1 q.2 + · intro a g h j k + filter_upwards [hroot a g, hroot a h, hroot a j, hroot a k] + with n hg hh hj hk + exact normalizedPairDisplacement_inner_diagonal + (p n) (f n) (σ n) a g h j k hg hh hj hk + · intro n g h j + exact normalizedPairDisplacement_add (p n) (f n) (σ n) g h j + +private def scalarOperatorKernel {I : Type u} (K : Matrix I I ℂ) : + Matrix I I (ℂ →L[ℂ] ℂ) := + fun g h => ContinuousLinearMap.toSpanSingleton ℂ (K g h) + +private theorem scalarOperatorKernel_posSemidef {I : Type u} + (K : Matrix I I ℂ) (hK : K.PosSemidef) : + (scalarOperatorKernel K).PosSemidef := by + apply ((RKHS.posSemidef_tfae + (K := scalarOperatorKernel K)).out 2 0).mp + constructor + · apply Matrix.IsHermitian.ext + intro g h + change star (ContinuousLinearMap.toSpanSingleton ℂ (K h g)) = + ContinuousLinearMap.toSpanSingleton ℂ (K g h) + rw [ContinuousLinearMap.star_eq_adjoint, + ContinuousLinearMap.adjoint_toSpanSingleton] + apply ContinuousLinearMap.ext + intro z + calc + (innerSL ℂ (K h g)) z = star (K h g) * z := by + simp only [innerSL_apply_apply, RCLike.inner_apply', + RCLike.star_def] + _ = K g h * z := by rw [hK.isHermitian.apply g h] + _ = z * K g h := mul_comm _ _ + _ = (ContinuousLinearMap.toSpanSingleton ℂ (K g h)) z := by + simp only [ContinuousLinearMap.toSpanSingleton_apply, + smul_eq_mul] + · intro c + have hc := hK.2 c + have hreal : + 0 ≤ RCLike.re (c.sum fun g z => + c.sum fun h w => star z * K g h * w) := + (RCLike.nonneg_iff.mp hc).1 + simp only [scalarOperatorKernel, + ContinuousLinearMap.toSpanSingleton_apply, + RCLike.inner_apply', smul_eq_mul, map_mul] + simpa only [← RCLike.star_def, hK.isHermitian.apply, + mul_assoc, mul_left_comm, mul_comm] using hreal + +private theorem preKernel_inner_single {I : Type u} + (K : Matrix I I ℂ) + [Fact (scalarOperatorKernel K).PosSemidef] + (i j : I × ℂ) (z w : ℂ) : + ⟪(Finsupp.single i z : RKHS.H₀ (scalarOperatorKernel K)), + (Finsupp.single j w : RKHS.H₀ (scalarOperatorKernel K))⟫_ℂ = + star z * w * + ⟪scalarOperatorKernel K j.1 i.1 i.2, j.2⟫_ℂ := by + change + (Finsupp.single i z).sum (fun yu c => + (Finsupp.single j w).sum (fun xv d => + star c * d * + ⟪scalarOperatorKernel K xv.1 yu.1 yu.2, xv.2⟫_ℂ)) = _ + simp only [RCLike.star_def, RCLike.inner_apply, mul_zero, zero_mul, Finsupp.sum_single_index, + map_zero] + +private def actionPreKernelTranslation {G I : Type u} [Group G] + (K : Matrix I I ℂ) (ρ : G →* Equiv.Perm I) (a : G) : + RKHS.H₀ (scalarOperatorKernel K) ≃ₗ[ℂ] + RKHS.H₀ (scalarOperatorKernel K) := + Finsupp.domLCongr ((ρ a).prodCongr (Equiv.refl ℂ)) + +private theorem actionPreKernelTranslation_inner {G I : Type u} [Group G] + (K : Matrix I I ℂ) + [Fact (scalarOperatorKernel K).PosSemidef] + (ρ : G →* Equiv.Perm I) + (hinv : ∀ a i j, K (ρ a i) (ρ a j) = K i j) + (a : G) (f g : RKHS.H₀ (scalarOperatorKernel K)) : + ⟪actionPreKernelTranslation K ρ a f, + actionPreKernelTranslation K ρ a g⟫_ℂ = ⟪f, g⟫_ℂ := by + induction f using Finsupp.induction_linear generalizing g with + | zero => simp only [map_zero, inner_zero_left] + | add f₁ f₂ ih₁ ih₂ => + simp only [map_add, inner_add_left, ih₁ g, ih₂ g] + | single i z => + induction g using Finsupp.induction_linear with + | zero => simp only [map_zero, inner_zero_right] + | add g₁ g₂ ih₁ ih₂ => + simp only [map_add, inner_add_right, ih₁, ih₂] + | single j w => + simp only [actionPreKernelTranslation, + Finsupp.domLCongr_single, preKernel_inner_single, + scalarOperatorKernel, + ContinuousLinearMap.toSpanSingleton_apply] + change + star z * w * ⟪i.2 • K (ρ a j.1) (ρ a i.1), j.2⟫_ℂ = + star z * w * ⟪i.2 • K j.1 i.1, j.2⟫_ℂ + rw [hinv] + +private def actionPreKernelTranslationIsometry {G I : Type u} [Group G] + (K : Matrix I I ℂ) + [Fact (scalarOperatorKernel K).PosSemidef] + (ρ : G →* Equiv.Perm I) + (hinv : ∀ a i j, K (ρ a i) (ρ a j) = K i j) + (a : G) : + RKHS.H₀ (scalarOperatorKernel K) ≃ₗᵢ[ℂ] + RKHS.H₀ (scalarOperatorKernel K) := + (actionPreKernelTranslation K ρ a).isometryOfInner + (actionPreKernelTranslation_inner K ρ hinv a) + +private def actionKernelTranslationMap {G I : Type u} [Group G] + (K : Matrix I I ℂ) + [Fact (scalarOperatorKernel K).PosSemidef] + (ρ : G →* Equiv.Perm I) + (hinv : ∀ a i j, K (ρ a i) (ρ a j) = K i j) + (a : G) : + RKHS.OfKernel (scalarOperatorKernel K) →L[ℂ] + RKHS.OfKernel (scalarOperatorKernel K) := + ContinuousLinearMap.completion + ((actionPreKernelTranslationIsometry K ρ hinv a).toLinearIsometry.toContinuousLinearMap) + +@[simp] +private theorem actionKernelTranslationMap_coe {G I : Type u} [Group G] + (K : Matrix I I ℂ) + [Fact (scalarOperatorKernel K).PosSemidef] + (ρ : G →* Equiv.Perm I) + (hinv : ∀ a i j, K (ρ a i) (ρ a j) = K i j) + (a : G) (f : RKHS.H₀ (scalarOperatorKernel K)) : + actionKernelTranslationMap K ρ hinv a + (f : RKHS.OfKernel (scalarOperatorKernel K)) = + (actionPreKernelTranslation K ρ a f : + RKHS.OfKernel (scalarOperatorKernel K)) := by + exact ContinuousLinearMap.completion_apply_coe + ((actionPreKernelTranslationIsometry K ρ hinv a).toLinearIsometry.toContinuousLinearMap) f + +private theorem actionKernelTranslationMap_isometry {G I : Type u} [Group G] + (K : Matrix I I ℂ) + [Fact (scalarOperatorKernel K).PosSemidef] + (ρ : G →* Equiv.Perm I) + (hinv : ∀ a i j, K (ρ a i) (ρ a j) = K i j) + (a : G) : Isometry (actionKernelTranslationMap K ρ hinv a) := by + change Isometry (UniformSpace.Completion.map + (actionPreKernelTranslationIsometry K ρ hinv a)) + exact (actionPreKernelTranslationIsometry K ρ hinv a).isometry.completion_map + +private theorem actionPreKernelTranslation_mul_apply {G I : Type u} [Group G] + (K : Matrix I I ℂ) (ρ : G →* Equiv.Perm I) + (a b : G) (f : RKHS.H₀ (scalarOperatorKernel K)) : + actionPreKernelTranslation K ρ (a * b) f = + actionPreKernelTranslation K ρ a + (actionPreKernelTranslation K ρ b f) := by + induction f using Finsupp.induction_linear with + | zero => simp only [map_zero] + | add f g hf hg => simp only [map_add, hf, hg] + | single i z => + simp only [actionPreKernelTranslation, + Finsupp.domLCongr_single] + change Finsupp.single (ρ (a * b) i.1, i.2) z = + Finsupp.single (ρ a (ρ b i.1), i.2) z + rw [map_mul] + rfl + +@[simp] +private theorem actionPreKernelTranslation_one_apply {G I : Type u} [Group G] + (K : Matrix I I ℂ) (ρ : G →* Equiv.Perm I) + (f : RKHS.H₀ (scalarOperatorKernel K)) : + actionPreKernelTranslation K ρ 1 f = f := by + induction f using Finsupp.induction_linear with + | zero => simp only [map_zero] + | add f g hf hg => simp only [map_add, hf, hg] + | single i z => + simp only [actionPreKernelTranslation, + Finsupp.domLCongr_single] + change Finsupp.single (ρ 1 i.1, i.2) z = + Finsupp.single (i.1, i.2) z + simp only [map_one, Equiv.Perm.coe_one, id_eq, Prod.mk.eta] + +private theorem actionKernelTranslationMap_mul_apply {G I : Type u} [Group G] + (K : Matrix I I ℂ) + [Fact (scalarOperatorKernel K).PosSemidef] + (ρ : G →* Equiv.Perm I) + (hinv : ∀ a i j, K (ρ a i) (ρ a j) = K i j) + (a b : G) (x : RKHS.OfKernel (scalarOperatorKernel K)) : + actionKernelTranslationMap K ρ hinv (a * b) x = + actionKernelTranslationMap K ρ hinv a + (actionKernelTranslationMap K ρ hinv b x) := by + induction x using UniformSpace.Completion.induction_on with + | hp => + exact isClosed_eq + (actionKernelTranslationMap K ρ hinv (a * b)).continuous + ((actionKernelTranslationMap K ρ hinv a).continuous.comp + (actionKernelTranslationMap K ρ hinv b).continuous) + | ih f => + simp only [actionKernelTranslationMap_coe, + actionPreKernelTranslation_mul_apply] + +@[simp] +private theorem actionKernelTranslationMap_one_apply {G I : Type u} [Group G] + (K : Matrix I I ℂ) + [Fact (scalarOperatorKernel K).PosSemidef] + (ρ : G →* Equiv.Perm I) + (hinv : ∀ a i j, K (ρ a i) (ρ a j) = K i j) + (x : RKHS.OfKernel (scalarOperatorKernel K)) : + actionKernelTranslationMap K ρ hinv 1 x = x := by + induction x using UniformSpace.Completion.induction_on with + | hp => + exact isClosed_eq + (actionKernelTranslationMap K ρ hinv 1).continuous + continuous_id + | ih f => + simp only [actionKernelTranslationMap_coe, + actionPreKernelTranslation_one_apply] + +private def actionKernelTranslationLinearEquiv {G I : Type u} [Group G] + (K : Matrix I I ℂ) + [Fact (scalarOperatorKernel K).PosSemidef] + (ρ : G →* Equiv.Perm I) + (hinv : ∀ a i j, K (ρ a i) (ρ a j) = K i j) + (a : G) : + RKHS.OfKernel (scalarOperatorKernel K) ≃ₗ[ℂ] + RKHS.OfKernel (scalarOperatorKernel K) where + toLinearMap := (actionKernelTranslationMap K ρ hinv a).toLinearMap + invFun := actionKernelTranslationMap K ρ hinv a⁻¹ + left_inv x := by + calc + actionKernelTranslationMap K ρ hinv a⁻¹ + (actionKernelTranslationMap K ρ hinv a x) = + actionKernelTranslationMap K ρ hinv (a⁻¹ * a) x := + (actionKernelTranslationMap_mul_apply + K ρ hinv a⁻¹ a x).symm + _ = x := by simp only [inv_mul_cancel, actionKernelTranslationMap_one_apply] + right_inv x := by + calc + actionKernelTranslationMap K ρ hinv a + (actionKernelTranslationMap K ρ hinv a⁻¹ x) = + actionKernelTranslationMap K ρ hinv (a * a⁻¹) x := + (actionKernelTranslationMap_mul_apply + K ρ hinv a a⁻¹ x).symm + _ = x := by simp only [mul_inv_cancel, actionKernelTranslationMap_one_apply] + +private def actionKernelTranslationUnitary {G I : Type u} [Group G] + (K : Matrix I I ℂ) + [Fact (scalarOperatorKernel K).PosSemidef] + (ρ : G →* Equiv.Perm I) + (hinv : ∀ a i j, K (ρ a i) (ρ a j) = K i j) + (a : G) : + RKHS.OfKernel (scalarOperatorKernel K) ≃ₗᵢ[ℂ] + RKHS.OfKernel (scalarOperatorKernel K) where + toLinearEquiv := actionKernelTranslationLinearEquiv K ρ hinv a + norm_map' := + (actionKernelTranslationMap_isometry K ρ hinv a).norm_map_of_map_zero + (map_zero (actionKernelTranslationMap K ρ hinv a)) + +private def actionKernelUnitaryRepresentation {G I : Type u} [Group G] + (K : Matrix I I ℂ) + [Fact (scalarOperatorKernel K).PosSemidef] + (ρ : G →* Equiv.Perm I) + (hinv : ∀ a i j, K (ρ a i) (ρ a j) = K i j) : + G →* (RKHS.OfKernel (scalarOperatorKernel K) ≃ₗᵢ[ℂ] + RKHS.OfKernel (scalarOperatorKernel K)) where + toFun := actionKernelTranslationUnitary K ρ hinv + map_one' := by + apply LinearIsometryEquiv.ext + intro x + change actionKernelTranslationMap K ρ hinv 1 x = x + exact actionKernelTranslationMap_one_apply K ρ hinv x + map_mul' a b := by + apply LinearIsometryEquiv.ext + intro x + change actionKernelTranslationMap K ρ hinv (a * b) x = + actionKernelTranslationMap K ρ hinv a + (actionKernelTranslationMap K ρ hinv b x) + exact actionKernelTranslationMap_mul_apply K ρ hinv a b x + +private def diagonalPairAction (G : Type u) [Group G] : + G →* Equiv.Perm (G × G) where + toFun a := (Equiv.mulLeft a).prodCongr (Equiv.mulLeft a) + map_one' := by + apply Equiv.ext + intro x + exact Prod.ext (one_mul x.1) (one_mul x.2) + map_mul' a b := by + apply Equiv.ext + intro x + apply Prod.ext + · exact mul_assoc a b x.1 + · exact mul_assoc a b x.2 + +private def diagonalPairKernelUnitaryRepresentation {G : Type u} [Group G] + (K : Matrix (G × G) (G × G) ℂ) + [Fact (scalarOperatorKernel K).PosSemidef] + (hinv : ∀ a g h j k : G, + K (a * g, a * h) (a * j, a * k) = K (g, h) (j, k)) : + G →* (RKHS.OfKernel (scalarOperatorKernel K) ≃ₗᵢ[ℂ] + RKHS.OfKernel (scalarOperatorKernel K)) := + actionKernelUnitaryRepresentation K (diagonalPairAction G) + (fun a x y => hinv a x.1 x.2 y.1 y.2) + +private theorem ofKernel_kerFun_one_eq_coe_single + {I : Type u} (L : Matrix I I (ℂ →L[ℂ] ℂ)) + [Fact L.PosSemidef] (i : I) : + RKHS.kerFun (RKHS.OfKernel L) i (1 : ℂ) = + ((Finsupp.single (i, (1 : ℂ)) (1 : ℂ) : RKHS.H₀ L) : + RKHS.OfKernel L) := by + simp only [RKHS.kerFun, RKHS.coeCLM, ContinuousLinearMap.proj_pi, + ContinuousLinearMap.adjoint_adjoint, + LinearMap.mkContinuous_apply, LinearMap.coe_mk, AddHom.coe_mk] + +private theorem actionKernelUnitaryRepresentation_kerFun_one + {G I : Type u} [Group G] + (K : Matrix I I ℂ) + [Fact (scalarOperatorKernel K).PosSemidef] + (ρ : G →* Equiv.Perm I) + (hinv : ∀ a i j, K (ρ a i) (ρ a j) = K i j) + (a : G) (i : I) : + actionKernelUnitaryRepresentation K ρ hinv a + (RKHS.kerFun (RKHS.OfKernel (scalarOperatorKernel K)) i + (1 : ℂ)) = + RKHS.kerFun (RKHS.OfKernel (scalarOperatorKernel K)) + (ρ a i) (1 : ℂ) := by + rw [ofKernel_kerFun_one_eq_coe_single + (scalarOperatorKernel K) i, + ofKernel_kerFun_one_eq_coe_single + (scalarOperatorKernel K) (ρ a i)] + change + actionKernelTranslationMap K ρ hinv a + ((Finsupp.single (i, (1 : ℂ)) (1 : ℂ) : + RKHS.H₀ (scalarOperatorKernel K)) : + RKHS.OfKernel (scalarOperatorKernel K)) = _ + rw [actionKernelTranslationMap_coe] + simp only [actionPreKernelTranslation, Finsupp.domLCongr_apply, Finsupp.domCongr_apply, + Finsupp.equivMapDomain_single, Equiv.prodCongr_apply, Equiv.coe_refl, Prod.map_apply, id_eq] + +private theorem diagonalPairKernelUnitaryRepresentation_kerFun_one + {G : Type u} [Group G] + (K : Matrix (G × G) (G × G) ℂ) + [Fact (scalarOperatorKernel K).PosSemidef] + (hinv : ∀ a g h j k : G, + K (a * g, a * h) (a * j, a * k) = K (g, h) (j, k)) + (a g h : G) : + diagonalPairKernelUnitaryRepresentation K hinv a + (RKHS.kerFun (RKHS.OfKernel (scalarOperatorKernel K)) + (g, h) (1 : ℂ)) = + RKHS.kerFun (RKHS.OfKernel (scalarOperatorKernel K)) + (a * g, a * h) (1 : ℂ) := by + exact actionKernelUnitaryRepresentation_kerFun_one K + (diagonalPairAction G) + (fun a x y => hinv a x.1 x.2 y.1 y.2) a (g, h) + +private structure HilbertKernelRealization {I : Type u} + (K : Matrix I I ℂ) where + carrier : Type u + [normed : NormedAddCommGroup carrier] + [inner : InnerProductSpace ℂ carrier] + [complete : CompleteSpace carrier] + vector : I → carrier + gram : ∀ g h, ⟪vector g, vector h⟫_ℂ = K g h + +private instance hilbertKernelRealizationNormedAddCommGroup + {I : Type u} {K : Matrix I I ℂ} + (R : HilbertKernelRealization K) : NormedAddCommGroup R.carrier := + R.normed + +private instance hilbertKernelRealizationInnerProductSpace + {I : Type u} {K : Matrix I I ℂ} + (R : HilbertKernelRealization K) : InnerProductSpace ℂ R.carrier := + R.inner + +private instance hilbertKernelRealizationCompleteSpace + {I : Type u} {K : Matrix I I ℂ} + (R : HilbertKernelRealization K) : CompleteSpace R.carrier := + R.complete + +private theorem hilbertKernelRealization_pair_vector_add + {G : Type u} (K : Matrix (G × G) (G × G) ℂ) + (R : HilbertKernelRealization K) + (hadd : ∀ g h j : G, ∀ q : G × G, + K (g, h) q + K (h, j) q = K (g, j) q) + (g h j : G) : + R.vector (g, h) + R.vector (h, j) = R.vector (g, j) := by + have horth (q : G × G) : + ⟪R.vector (g, h) + R.vector (h, j) - R.vector (g, j), + R.vector q⟫_ℂ = 0 := by + rw [inner_sub_left, inner_add_left, + R.gram, R.gram, R.gram, hadd] + exact sub_self _ + apply sub_eq_zero.mp + apply (inner_self_eq_zero (𝕜 := ℂ)).mp + rw [inner_sub_right, inner_add_right, + horth (g, h), horth (h, j), horth (g, j)] + simp only [add_zero, sub_self] + +private structure EquivariantHilbertKernelRealization + {G : Type u} [Group G] + (K : Matrix (G × G) (G × G) ℂ) where + realization : HilbertKernelRealization K + representation : G →* + (realization.carrier ≃ₗᵢ[ℂ] realization.carrier) + equivariant : ∀ a g h : G, + representation a (realization.vector (g, h)) = + realization.vector (a * g, a * h) + +private theorem exists_equivariantHilbertKernelRealization + {G : Type u} [Group G] + (K : Matrix (G × G) (G × G) ℂ) + (hpositive : K.PosSemidef) + (hdiagonal : ∀ a g h j k : G, + K (a * g, a * h) (a * j, a * k) = K (g, h) (j, k)) : + Nonempty (EquivariantHilbertKernelRealization K) := by + let : Fact (scalarOperatorKernel K).PosSemidef := + ⟨scalarOperatorKernel_posSemidef K hpositive⟩ + let H := RKHS.OfKernel (scalarOperatorKernel K) + let R : HilbertKernelRealization K := { + carrier := H + vector := fun q => RKHS.kerFun H q (1 : ℂ) + gram := by + intro q r + rw [RKHS.kerFun_inner, RKHS.kerFun_apply, + RKHS.OfKernel.kernel_ofKernel] + simp only [scalarOperatorKernel, ContinuousLinearMap.toSpanSingleton_apply, smul_eq_mul, + one_mul, + RCLike.inner_apply, map_one, mul_one] + } + refine ⟨{ + realization := R + representation := diagonalPairKernelUnitaryRepresentation K hdiagonal + equivariant := ?_ + }⟩ + intro a g h + exact diagonalPairKernelUnitaryRepresentation_kerFun_one + K hdiagonal a g h + +private def equivariantPairCocycle {G : Type u} [Group G] + {K : Matrix (G × G) (G × G) ℂ} + (R : EquivariantHilbertKernelRealization K) (g : G) : + R.realization.carrier := + R.realization.vector (g, 1) + +private theorem equivariantPairCocycle_mul {G : Type u} [Group G] + (K : Matrix (G × G) (G × G) ℂ) + (R : EquivariantHilbertKernelRealization K) + (hadd : ∀ g h j : G, ∀ q : G × G, + K (g, h) q + K (h, j) q = K (g, j) q) + (a g : G) : + equivariantPairCocycle R (a * g) = + equivariantPairCocycle R a + + R.representation a (equivariantPairCocycle R g) := by + unfold equivariantPairCocycle + rw [R.equivariant] + simp only [mul_one] + rw [add_comm] + exact (hilbertKernelRealization_pair_vector_add K R.realization + hadd (a * g) a 1).symm + +private theorem normalizedPairDisplacement_generator_of_model + {G ι V : Type*} [Group G] [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) + (σ : G → Equiv.Perm V) (s : ι → G) + (hone : σ 1 = 1) (hgenerator : ∀ i, σ (s i) = p i) + (i : ι) : + normalizedPairDisplacement p f σ (s i, 1) = + normalizedIndicatorDisplacement p f (p i) := by + simp only [normalizedPairDisplacement, normalizedIndicatorDisplacement, hgenerator, hone, + permutationUnitary_one, sub_self, smul_zero, sub_zero] + +private theorem norm_average_normalizedPairDisplacement_of_model + {G ι V : Type*} [Group G] [Fintype ι] [Nonempty ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) + (σ : G → Equiv.Perm V) (s : ι → G) + (hone : σ 1 = 1) (hgenerator : ∀ i, σ (s i) = p i) + (hdefect : permutationMarkov p (indicatorVector f) ≠ + indicatorVector f) : + ‖(Fintype.card ι : ℂ)⁻¹ • + ∑ i, normalizedPairDisplacement p f σ (s i, 1)‖ = 1 := by + simp_rw [normalizedPairDisplacement_generator_of_model + p f σ s hone hgenerator] + rw [average_normalizedIndicatorDisplacement, + norm_normalizedIndicatorDefect p f hdefect] + +private theorem inner_smul_finset_sum_self + {I E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℂ E] + (z : I → E) (F : Finset I) (c : ℂ) : + ⟪c • ∑ i ∈ F, z i, c • ∑ i ∈ F, z i⟫_ℂ = + star c * (∑ i ∈ F, ∑ j ∈ F, ⟪z i, z j⟫_ℂ) * c := by + rw [inner_smul_left, inner_smul_right, sum_inner] + simp_rw [inner_sum] + simp only [RCLike.star_def] + ring + +private theorem tendsto_norm_sq_smul_finset_sum_of_gram + {N I H : Type*} {E : N → Type*} + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + [∀ n, NormedAddCommGroup (E n)] + [∀ n, InnerProductSpace ℂ (E n)] + (l : Filter N) (z : ∀ n, I → E n) (v : I → H) + (hgram : ∀ i j, + Tendsto (fun n => ⟪z n i, z n j⟫_ℂ) l + (𝓝 ⟪v i, v j⟫_ℂ)) + (F : Finset I) (c : ℂ) : + Tendsto (fun n => ‖c • ∑ i ∈ F, z n i‖ ^ 2) l + (𝓝 (‖c • ∑ i ∈ F, v i‖ ^ 2)) := by + have hsum : + Tendsto + (fun n => ∑ i ∈ F, ∑ j ∈ F, ⟪z n i, z n j⟫_ℂ) l + (𝓝 (∑ i ∈ F, ∑ j ∈ F, ⟪v i, v j⟫_ℂ)) := + tendsto_finsetSum F fun i _ => + tendsto_finsetSum F fun j _ => hgram i j + have hinner : + Tendsto + (fun n => ⟪c • ∑ i ∈ F, z n i, + c • ∑ i ∈ F, z n i⟫_ℂ) l + (𝓝 ⟪c • ∑ i ∈ F, v i, + c • ∑ i ∈ F, v i⟫_ℂ) := by + simpa only [inner_smul_finset_sum_self] using + (tendsto_const_nhds.mul hsum).mul tendsto_const_nhds + have hreal := (Complex.continuous_re.tendsto _).comp hinner + change Tendsto + (fun n => (⟪c • ∑ i ∈ F, z n i, + c • ∑ i ∈ F, z n i⟫_ℂ).re) l + (𝓝 (⟪c • ∑ i ∈ F, v i, + c • ∑ i ∈ F, v i⟫_ℂ).re) at hreal + convert hreal using 1 + · funext n + exact norm_sq_eq_re_inner (𝕜 := ℂ) (c • ∑ i ∈ F, z n i) + · congr 1 + exact norm_sq_eq_re_inner (𝕜 := ℂ) (c • ∑ i ∈ F, v i) + +private theorem norm_smul_finset_sum_eq_one_of_gram + {N I H : Type*} {E : N → Type*} + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + [∀ n, NormedAddCommGroup (E n)] + [∀ n, InnerProductSpace ℂ (E n)] + (l : Filter N) [NeBot l] + (z : ∀ n, I → E n) (v : I → H) + (hgram : ∀ i j, + Tendsto (fun n => ⟪z n i, z n j⟫_ℂ) l + (𝓝 ⟪v i, v j⟫_ℂ)) + (F : Finset I) (c : ℂ) + (hnorm : ∀ n, ‖c • ∑ i ∈ F, z n i‖ = 1) : + ‖c • ∑ i ∈ F, v i‖ = 1 := by + have hlimit := + tendsto_norm_sq_smul_finset_sum_of_gram l z v hgram F c + have hone : + Tendsto (fun n => ‖c • ∑ i ∈ F, z n i‖ ^ 2) l + (𝓝 (1 : ℝ)) := by + simpa only [hnorm, one_pow] using + (tendsto_const_nhds : + Tendsto (fun _ : N => (1 : ℝ)) l (𝓝 1)) + have hsq : ‖c • ∑ i ∈ F, v i‖ ^ 2 = 1 := + tendsto_nhds_unique hlimit hone + nlinarith [norm_nonneg (c • ∑ i ∈ F, v i)] + +private theorem exists_equivariant_hilbert_normalized_rooted_pair_realization + {G ι : Type u} [Group G] [Fintype ι] [Nonempty ι] + {V : ℕ → Type u} [∀ n, Fintype (V n)] + (p : ∀ n, ι → Equiv.Perm (V n)) + (f : ∀ n, V n → ℝ) + (σ : ∀ n, G → Equiv.Perm (V n)) + (s : ι → G) (w : G → List ι) + (hf : ∀ n x, f n x = 0 ∨ f n x = 1) + (hdefect : ∀ n, permutationMarkov (p n) (indicatorVector (f n)) ≠ + indicatorVector (f n)) + (hw : ∀ n g, σ n g = ((w g).map (p n)).prod) + (hone : ∀ n, σ n 1 = 1) + (hgenerator : ∀ n i, σ n (s i) = p n i) + (hroot : ∀ a g : G, ∀ᶠ n in Filter.atTop, + ∀ x : V n, indicatorVector (f n) x ≠ 0 → + σ n (a * g) x = (σ n a * σ n g) x) : + ∃ (K : Matrix (G × G) (G × G) ℂ) + (R : EquivariantHilbertKernelRealization K), + K.PosSemidef ∧ + (∀ a g h j k : G, + K (a * g, a * h) (a * j, a * k) = K (g, h) (j, k)) ∧ + (∀ a g h : G, + R.representation a (R.realization.vector (g, h)) = + R.realization.vector (a * g, a * h)) ∧ + (∀ g h j : G, + R.realization.vector (g, h) + + R.realization.vector (h, j) = + R.realization.vector (g, j)) ∧ + (∀ a g : G, + equivariantPairCocycle R (a * g) = + equivariantPairCocycle R a + + R.representation a (equivariantPairCocycle R g)) ∧ + ‖(Fintype.card ι : ℂ)⁻¹ • + ∑ i, equivariantPairCocycle R (s i)‖ = 1 ∧ + ∀ q r, + Tendsto + (fun n => + ⟪normalizedPairDisplacement (p n) (f n) (σ n) q, + normalizedPairDisplacement (p n) (f n) (σ n) r⟫_ℂ) + (Filter.hyperfilter ℕ) + (𝓝 ⟪R.realization.vector q, + R.realization.vector r⟫_ℂ) := by + obtain ⟨K, hpositive, hdiagonal, hadd, hconv⟩ := + exists_hyperfilter_diagonal_positive_pair_kernel_of_rooted_indicators + p f σ w hf hdefect hw hroot + obtain ⟨R⟩ := + exists_equivariantHilbertKernelRealization K hpositive hdiagonal + refine ⟨K, R, hpositive, hdiagonal, R.equivariant, ?_, ?_, ?_, ?_⟩ + · exact hilbertKernelRealization_pair_vector_add + K R.realization hadd + · exact equivariantPairCocycle_mul K R hadd + · apply norm_smul_finset_sum_eq_one_of_gram + (Filter.hyperfilter ℕ) + (fun n i => normalizedPairDisplacement (p n) (f n) (σ n) + (s i, 1)) + (fun i => equivariantPairCocycle R (s i)) + (F := Finset.univ) (c := (Fintype.card ι : ℂ)⁻¹) + · intro i j + simpa only [equivariantPairCocycle, R.realization.gram] using + hconv (s i, 1) (s j, 1) + · intro n + simpa only using + norm_average_normalizedPairDisplacement_of_model (p n) (f n) (σ n) s (hone n) (hgenerator n) + (hdefect n) + · intro q r + simpa only [R.realization.gram] using hconv q r + +end KunRootedIndicatorCrossing + +namespace KunThomInvariantOrthogonal + +section + +open Filter Topology +open scoped ComplexConjugate Pointwise + +universe u v + +variable {G : Type u} {H : Type v} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + +private def invariantSubmodule (π : UnitaryRepresentation G H) : + Submodule ℂ H where + carrier := {x | ∀ g : G, π g x = x} + zero_mem' := by + intro g + exact map_zero (π g) + add_mem' := by + intro x y hx hy g + rw [map_add, hx g, hy g] + smul_mem' := by + intro c x hx g + rw [map_smul, hx g] + +private theorem map_mem_invariantSubmodule_orthogonal + (π : UnitaryRepresentation G H) (g : G) {x : H} + (hx : x ∈ (invariantSubmodule π)ᗮ) : + π g x ∈ (invariantSubmodule π)ᗮ := by + rw [Submodule.mem_orthogonal] + intro y hy + have hysymm : (π g).symm y = y := by + have hyinv : π g⁻¹ y = y := hy g⁻¹ + simpa only [map_inv, LinearIsometryEquiv.inv_def] using hyinv + calc + @inner ℂ H _ y (π g x) = + @inner ℂ H _ ((π g).symm y) x := by + simpa only [LinearIsometryEquiv.symm_apply_apply] using ((π g).symm.inner_map_map y (π g + x)).symm + _ = @inner ℂ H _ y x := by rw [hysymm] + _ = 0 := (Submodule.mem_orthogonal _ _).mp hx y hy + +private def orthogonalLinearIsometryEquiv + (π : UnitaryRepresentation G H) (g : G) : + (invariantSubmodule π)ᗮ ≃ₗᵢ[ℂ] (invariantSubmodule π)ᗮ where + toFun x := ⟨π g x, map_mem_invariantSubmodule_orthogonal π g x.property⟩ + invFun x := + ⟨π g⁻¹ x, map_mem_invariantSubmodule_orthogonal π g⁻¹ x.property⟩ + left_inv x := by + apply Subtype.ext + change π g⁻¹ (π g (x : H)) = x + simp only [map_inv, LinearIsometryEquiv.inv_def, LinearIsometryEquiv.symm_apply_apply] + right_inv x := by + apply Subtype.ext + change π g (π g⁻¹ (x : H)) = x + simp only [map_inv, LinearIsometryEquiv.inv_def, LinearIsometryEquiv.apply_symm_apply] + map_add' x y := by + apply Subtype.ext + exact map_add (π g) (x : H) (y : H) + map_smul' c x := by + apply Subtype.ext + exact map_smul (π g) c (x : H) + norm_map' x := (π g).norm_map (x : H) + +private def orthogonalRepresentation (π : UnitaryRepresentation G H) : + UnitaryRepresentation G ((invariantSubmodule π)ᗮ) where + toFun := orthogonalLinearIsometryEquiv π + map_one' := by + ext x + change π 1 (x : H) = x + simp only [map_one, LinearIsometryEquiv.coe_one, id_eq] + map_mul' g h := by + ext x + change π (g * h) (x : H) = π g (π h (x : H)) + rw [map_mul] + rfl + +private theorem orthogonalRepresentation_no_fixed + (π : UnitaryRepresentation G H) + (x : (invariantSubmodule π)ᗮ) + (hx : ∀ g : G, orthogonalRepresentation π g x = x) : + x = 0 := by + have hxinv : (x : H) ∈ invariantSubmodule π := by + intro g + exact congrArg Subtype.val (hx g) + have hinner : @inner ℂ H _ (x : H) (x : H) = 0 := + Submodule.inner_right_of_mem_orthogonal hxinv x.property + apply Subtype.ext + change (x : H) = 0 + exact inner_self_eq_zero.mp hinner + +private theorem cocycle_one + (π : UnitaryRepresentation G H) (b : G → H) + (hb : ∀ g h : G, b (g * h) = b g + π g (b h)) : + b 1 = 0 := by + have hcancel : b 1 + b 1 = b 1 + 0 := by + simpa only [add_zero, add_eq_left, map_one, LinearIsometryEquiv.coe_one, id_eq, mul_one] using + (hb 1 1).symm + exact add_left_cancel hcancel + +private theorem inner_cocycle_inv_of_invariant + (π : UnitaryRepresentation G H) (b : G → H) + (hb : ∀ g h : G, b (g * h) = b g + π g (b h)) + (y : H) (hy : ∀ g : G, π g y = y) (g : G) : + @inner ℂ H _ y (b g⁻¹) = -@inner ℂ H _ y (b g) := by + have hysymm : (π g).symm y = y := by + have hyinv := hy g⁻¹ + simpa only [map_inv, LinearIsometryEquiv.inv_def] using hyinv + have htransport : + @inner ℂ H _ y (π g (b g⁻¹)) = @inner ℂ H _ y (b g⁻¹) := by + calc + @inner ℂ H _ y (π g (b g⁻¹)) = + @inner ℂ H _ ((π g).symm y) (b g⁻¹) := by + simpa only [LinearIsometryEquiv.symm_apply_apply] using ((π g).symm.inner_map_map y (π g + (b g⁻¹))).symm + _ = @inner ℂ H _ y (b g⁻¹) := by rw [hysymm] + have hsum : b g + π g (b g⁻¹) = 0 := by + calc + b g + π g (b g⁻¹) = b (g * g⁻¹) := (hb g g⁻¹).symm + _ = b 1 := by rw [mul_inv_cancel] + _ = 0 := cocycle_one π b hb + have hinner : + @inner ℂ H _ y (b g) + @inner ℂ H _ y (b g⁻¹) = 0 := by + have h := congrArg (fun x : H => @inner ℂ H _ y x) hsum + simpa only [CStarModule.inner_add_right, htransport, inner_zero_right] using h + apply (add_eq_zero_iff_eq_neg).mp + simpa only [add_comm] using hinner + +private theorem inner_cocycle_sum_eq_zero_of_invariant + (π : UnitaryRepresentation G H) (b : G → H) + (hb : ∀ g h : G, b (g * h) = b g + π g (b h)) + (S : Finset G) (hS : ∀ g ∈ S, g⁻¹ ∈ S) + (y : H) (hy : ∀ g : G, π g y = y) : + @inner ℂ H _ y (∑ g ∈ S, b g) = 0 := by + classical + rw [inner_sum] + have hsymmetric : S⁻¹ = S := by + ext g + constructor + · intro hg + obtain ⟨a, ha, rfl⟩ := Finset.mem_inv.mp hg + exact hS a ha + · intro hg + apply Finset.mem_inv.mpr + exact ⟨g⁻¹, hS g hg, inv_inv g⟩ + have hneg : + (∑ g ∈ S, @inner ℂ H _ y (b g)) = + -(∑ g ∈ S, @inner ℂ H _ y (b g)) := by + calc + (∑ g ∈ S, @inner ℂ H _ y (b g)) = + ∑ g ∈ S⁻¹, @inner ℂ H _ y (b g) := by rw [hsymmetric] + _ = ∑ g ∈ S, @inner ℂ H _ y (b g⁻¹) := + Finset.sum_inv_index S (fun g => @inner ℂ H _ y (b g)) + _ = ∑ g ∈ S, -@inner ℂ H _ y (b g) := by + apply Finset.sum_congr rfl + intro g hg + exact inner_cocycle_inv_of_invariant π b hb y hy g + _ = -(∑ g ∈ S, @inner ℂ H _ y (b g)) := by + rw [Finset.sum_neg_distrib] + have hdouble : + (2 : ℂ) * (∑ g ∈ S, @inner ℂ H _ y (b g)) = 0 := by + calc + (2 : ℂ) * (∑ g ∈ S, @inner ℂ H _ y (b g)) = + (∑ g ∈ S, @inner ℂ H _ y (b g)) + + (∑ g ∈ S, @inner ℂ H _ y (b g)) := two_mul _ + _ = (∑ g ∈ S, @inner ℂ H _ y (b g)) + + -(∑ g ∈ S, @inner ℂ H _ y (b g)) := + congrArg (fun z : ℂ => (∑ g ∈ S, @inner ℂ H _ y (b g)) + z) hneg + _ = 0 := add_neg_cancel _ + exact (mul_eq_zero.mp hdouble).resolve_left (by norm_num) + +private theorem inner_smul_cocycle_sum_eq_zero_of_invariant + (π : UnitaryRepresentation G H) (b : G → H) + (hb : ∀ g h : G, b (g * h) = b g + π g (b h)) + (S : Finset G) (hS : ∀ g ∈ S, g⁻¹ ∈ S) (c : ℂ) + (y : H) (hy : ∀ g : G, π g y = y) : + @inner ℂ H _ y (c • ∑ g ∈ S, b g) = 0 := by + rw [inner_smul_right, inner_cocycle_sum_eq_zero_of_invariant π b hb S hS y hy, + mul_zero] + +private theorem norm_add_le_two_sub_sq_div_four + (x y : H) (δ : ℝ) + (hδ : 0 ≤ δ) (hδtwo : δ ≤ 2) + (hnorm : ‖y‖ = ‖x‖) + (hseparated : δ * ‖x‖ ≤ ‖x - y‖) : + ‖x + y‖ ≤ (2 - δ ^ 2 / 4) * ‖x‖ := by + have hpar := parallelogram_law_with_norm ℂ x y + have hsq : (δ * ‖x‖) ^ 2 ≤ ‖x - y‖ ^ 2 := + (sq_le_sq₀ (mul_nonneg hδ (norm_nonneg x)) + (norm_nonneg (x - y))).mpr hseparated + have hδsq : δ ^ 2 ≤ 4 := by + nlinarith [sq_nonneg (2 - δ), sq_nonneg δ] + have htarget : 0 ≤ (2 - δ ^ 2 / 4) * ‖x‖ := + mul_nonneg (by nlinarith) (norm_nonneg x) + have hadd : + ‖x + y‖ ^ 2 ≤ ((2 - δ ^ 2 / 4) * ‖x‖) ^ 2 := by + rw [hnorm] at hpar + nlinarith [sq_nonneg (δ ^ 2 * ‖x‖)] + exact (sq_le_sq₀ (norm_nonneg (x + y)) htarget).mp hadd + +omit [InnerProductSpace ℂ H] in +private theorem norm_finset_sum_le_pair_add + {X : Type*} (S : Finset X) (f : X → H) + (a b : X) (ha : a ∈ S) (hb : b ∈ S) (hab : a ≠ b) + (r : ℝ) (hnorm : ∀ s ∈ S, ‖f s‖ = r) : + ‖∑ s ∈ S, f s‖ ≤ + ‖f a + f b‖ + ((S.card : ℝ) - 2) * r := by + classical + let T : Finset X := (S.erase a).erase b + have hb' : b ∈ S.erase a := + Finset.mem_erase.mpr ⟨Ne.symm hab, hb⟩ + have hsum : + (∑ s ∈ S, f s) = f a + f b + ∑ s ∈ T, f s := by + calc + (∑ s ∈ S, f s) = f a + ∑ s ∈ S.erase a, f s := + (Finset.add_sum_erase S f ha).symm + _ = f a + (f b + ∑ s ∈ T, f s) := by + congr 1 + exact (Finset.add_sum_erase (S.erase a) f hb').symm + _ = f a + f b + ∑ s ∈ T, f s := by abel + have hcard : (T.card : ℝ) = (S.card : ℝ) - 2 := by + dsimp [T] + rw [Finset.cast_card_erase_of_mem hb', + Finset.cast_card_erase_of_mem ha] + ring + have htail : (∑ s ∈ T, ‖f s‖) = (T.card : ℝ) * r := by + calc + (∑ s ∈ T, ‖f s‖) = ∑ _s ∈ T, r := by + apply Finset.sum_congr rfl + intro s hs + exact hnorm s + (Finset.mem_of_mem_erase (Finset.mem_of_mem_erase hs)) + _ = (T.card : ℝ) * r := by simp only [Finset.sum_const, nsmul_eq_mul] + calc + ‖∑ s ∈ S, f s‖ = ‖(f a + f b) + ∑ s ∈ T, f s‖ := by + rw [hsum] + _ ≤ ‖f a + f b‖ + ‖∑ s ∈ T, f s‖ := + norm_add_le _ _ + _ ≤ ‖f a + f b‖ + ∑ s ∈ T, ‖f s‖ := by + exact add_le_add (le_refl _) (norm_sum_le T f) + _ = ‖f a + f b‖ + (T.card : ℝ) * r := by rw [htail] + _ = ‖f a + f b‖ + ((S.card : ℝ) - 2) * r := by + rw [hcard] + +end + +section + +open Filter Topology +open scoped ComplexConjugate Pointwise + +universe u v + +variable {G : Type u} {H : Type v} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + +private theorem kazhdan_generator_displacement_of_orthogonal_invariants + [CompleteSpace H] (P : KazhdanPair.{u, v} G) + (π : UnitaryRepresentation G H) (x : H) + (hx : x ≠ 0) + (horth : ∀ y : H, + (∀ g : G, π g y = y) → @inner ℂ H _ y x = 0) : + ∃ g ∈ P.generators, + P.kazhdanConstant * ‖x‖ ≤ ‖π g x - x‖ := by + let z : (invariantSubmodule π)ᗮ := + ⟨x, (Submodule.mem_orthogonal _ _).mpr + (fun y hy => horth y hy)⟩ + have hz : z ≠ 0 := by + intro h + apply hx + exact congrArg Subtype.val h + obtain ⟨g, hg, hgap⟩ := + kazhdan_generator_displacement P + (orthogonalRepresentation π) + (orthogonalRepresentation_no_fixed π) z hz + refine ⟨g, hg, ?_⟩ + simpa only [Submodule.coe_norm, orthogonalRepresentation, MonoidHom.coe_mk, OneHom.coe_mk, + orthogonalLinearIsometryEquiv, map_inv, LinearIsometryEquiv.coe_inv, LinearIsometryEquiv.coe_mk, + LinearEquiv.coe_mk, + LinearMap.coe_mk, AddHom.coe_mk, AddSubgroupClass.coe_sub] using hgap + +private theorem kazhdan_generator_sum_contraction + [CompleteSpace H] (P : KazhdanPair.{u, v} G) + (π : UnitaryRepresentation G H) + (S : Finset G) (hone : 1 ∈ S) + (hsub : P.generators ⊆ S) (x : H) + (horth : ∀ y : H, + (∀ g : G, π g y = y) → @inner ℂ H _ y x = 0) : + ‖∑ g ∈ S, π g x‖ ≤ + ((S.card : ℝ) - P.kazhdanConstant ^ 2 / 4) * ‖x‖ := by + classical + by_cases hx : x = 0 + · subst x + simp only [map_zero, Finset.sum_const_zero, norm_zero, mul_zero, Std.le_refl] + obtain ⟨g, hg, hgap⟩ := + kazhdan_generator_displacement_of_orthogonal_invariants + P π x hx horth + have hnormpos : 0 < ‖x‖ := norm_pos_iff.mpr hx + have hupper : ‖π g x - x‖ ≤ 2 * ‖x‖ := by + calc + ‖π g x - x‖ ≤ ‖π g x‖ + ‖x‖ := norm_sub_le _ _ + _ = 2 * ‖x‖ := by rw [(π g).norm_map]; ring + have hκtwo : P.kazhdanConstant ≤ 2 := + le_of_mul_le_mul_right (hgap.trans hupper) hnormpos + have hgone : g ≠ 1 := by + intro h + subst g + have hpos : 0 < P.kazhdanConstant * ‖x‖ := + mul_pos P.positive hnormpos + have hbad : P.kazhdanConstant * ‖x‖ ≤ 0 := by + simpa only [map_one, LinearIsometryEquiv.coe_one, id_eq, sub_self, norm_zero] using hgap + exact not_le_of_gt hpos hbad + have hpair : + ‖x + π g x‖ ≤ + (2 - P.kazhdanConstant ^ 2 / 4) * ‖x‖ := by + apply norm_add_le_two_sub_sq_div_four x (π g x) + P.kazhdanConstant P.positive.le hκtwo + ((π g).norm_map x) + rw [norm_sub_rev] + exact hgap + have hsum := norm_finset_sum_le_pair_add + S (fun a : G => π a x) 1 g hone (hsub hg) (Ne.symm hgone) + ‖x‖ (fun a _ => (π a).norm_map x) + calc + ‖∑ a ∈ S, π a x‖ ≤ + ‖π 1 x + π g x‖ + ((S.card : ℝ) - 2) * ‖x‖ := hsum + _ = ‖x + π g x‖ + ((S.card : ℝ) - 2) * ‖x‖ := by + simp only [map_one, LinearIsometryEquiv.coe_one, id_eq] + _ ≤ (2 - P.kazhdanConstant ^ 2 / 4) * ‖x‖ + + ((S.card : ℝ) - 2) * ‖x‖ := + add_le_add hpair (le_refl _) + _ = ((S.card : ℝ) - P.kazhdanConstant ^ 2 / 4) * ‖x‖ := by + ring + +private def unitaryFinsetMarkov + (π : UnitaryRepresentation G H) + (S : Finset G) (x : H) : H := + ((S.card : ℂ)⁻¹) • S.sum (fun g => π g x) + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def kazhdanMarkovContractionFactor + (P : KazhdanPair.{u, v} G) (S : Finset G) : ℝ := + max 0 (1 - P.kazhdanConstant ^ 2 / (4 * (S.card : ℝ))) + +public +theorem kazhdanMarkovContractionFactor_lt_one + (P : KazhdanPair.{u, v} G) + (S : Finset G) (hS : S.Nonempty) : + kazhdanMarkovContractionFactor P S < 1 := by + have hcard : 0 < (S.card : ℝ) := by + exact_mod_cast Finset.card_pos.mpr hS + have hpositive : + 0 < P.kazhdanConstant ^ 2 / (4 * (S.card : ℝ)) := by + exact div_pos (sq_pos_of_pos P.positive) + (mul_pos (by norm_num) hcard) + unfold kazhdanMarkovContractionFactor + exact max_lt (by norm_num) (by linarith) + +public +theorem kazhdanMarkovContractionFactor_nonneg + (P : KazhdanPair.{u, v} G) (S : Finset G) : + 0 ≤ kazhdanMarkovContractionFactor P S := + le_max_left _ _ + +private theorem unitaryFinsetMarkov_norm_le + [CompleteSpace H] (P : KazhdanPair.{u, v} G) + (π : UnitaryRepresentation G H) + (S : Finset G) (hone : 1 ∈ S) + (hsub : P.generators ⊆ S) (x : H) + (horth : ∀ y : H, + (∀ g : G, π g y = y) → @inner ℂ H _ y x = 0) : + ‖unitaryFinsetMarkov π S x‖ ≤ + kazhdanMarkovContractionFactor P S * ‖x‖ := by + have hcard : 0 < (S.card : ℝ) := by + exact_mod_cast Finset.card_pos.mpr ⟨1, hone⟩ + have hsum := kazhdan_generator_sum_contraction + P π S hone hsub x horth + calc + ‖unitaryFinsetMarkov π S x‖ = + (S.card : ℝ)⁻¹ * ‖∑ g ∈ S, π g x‖ := by + simp only [unitaryFinsetMarkov, norm_smul, norm_inv, RCLike.norm_natCast] + _ ≤ (S.card : ℝ)⁻¹ * + (((S.card : ℝ) - P.kazhdanConstant ^ 2 / 4) * ‖x‖) := + mul_le_mul_of_nonneg_left hsum (inv_nonneg.mpr hcard.le) + _ = (1 - P.kazhdanConstant ^ 2 / + (4 * (S.card : ℝ))) * ‖x‖ := by + field_simp + _ ≤ kazhdanMarkovContractionFactor P S * ‖x‖ := by + apply mul_le_mul_of_nonneg_right _ (norm_nonneg x) + exact le_max_right 0 _ + +private theorem unitaryFinsetMarkov_orthogonal_invariants + (π : UnitaryRepresentation G H) + (S : Finset G) (x : H) + (horth : ∀ y : H, + (∀ g : G, π g y = y) → @inner ℂ H _ y x = 0) : + ∀ y : H, (∀ g : G, π g y = y) → + @inner ℂ H _ y (unitaryFinsetMarkov π S x) = 0 := by + have hx : x ∈ (invariantSubmodule π)ᗮ := + (Submodule.mem_orthogonal _ _).mpr (fun y hy => horth y hy) + have hsum : (∑ g ∈ S, π g x) ∈ (invariantSubmodule π)ᗮ := by + apply Submodule.sum_mem + intro g hg + exact map_mem_invariantSubmodule_orthogonal π g hx + have hmarkov : + unitaryFinsetMarkov π S x ∈ (invariantSubmodule π)ᗮ := by + exact (invariantSubmodule π)ᗮ.smul_mem _ hsum + intro y hy + exact (Submodule.mem_orthogonal _ _).mp hmarkov y hy + +private theorem unitaryFinsetMarkov_iterate_norm_le + [CompleteSpace H] (P : KazhdanPair.{u, v} G) + (π : UnitaryRepresentation G H) + (S : Finset G) (hone : 1 ∈ S) + (hsub : P.generators ⊆ S) (x : H) + (horth : ∀ y : H, + (∀ g : G, π g y = y) → @inner ℂ H _ y x = 0) + (n : ℕ) : + ‖((unitaryFinsetMarkov π S)^[n]) x‖ ≤ + kazhdanMarkovContractionFactor P S ^ n * ‖x‖ := by + have horthn (k : ℕ) : + ∀ y : H, (∀ g : G, π g y = y) → + @inner ℂ H _ y (((unitaryFinsetMarkov π S)^[k]) x) = 0 := by + induction k with + | zero => simpa only [Function.iterate_zero, id_eq] using horth + | succ k ih => + rw [Function.iterate_succ_apply'] + exact unitaryFinsetMarkov_orthogonal_invariants + π S (((unitaryFinsetMarkov π S)^[k]) x) ih + induction n with + | zero => simp only [Function.iterate_zero, id_eq, pow_zero, one_mul, Std.le_refl] + | succ n ih => + rw [Function.iterate_succ_apply'] + calc + ‖unitaryFinsetMarkov π S + (((unitaryFinsetMarkov π S)^[n]) x)‖ ≤ + kazhdanMarkovContractionFactor P S * + ‖((unitaryFinsetMarkov π S)^[n]) x‖ := + unitaryFinsetMarkov_norm_le P π S hone hsub _ (horthn n) + _ ≤ kazhdanMarkovContractionFactor P S * + (kazhdanMarkovContractionFactor P S ^ n * ‖x‖) := + mul_le_mul_of_nonneg_left ih + (kazhdanMarkovContractionFactor_nonneg P S) + _ = kazhdanMarkovContractionFactor P S ^ n.succ * ‖x‖ := by + rw [pow_succ] + ring + +end + +end KunThomInvariantOrthogonal + +namespace KunRootedWordPower + +open Filter Topology +open KunRootedIndicatorCrossing +open KunThomInvariantOrthogonal +open scoped BigOperators ComplexConjugate ComplexOrder InnerProductSpace Pointwise + +universe u v w + +private def pairedWordAverage + {G ι E : Type*} [Group G] [Fintype ι] + [AddCommMonoid E] [Module ℂ E] + (s : ι → G) (z : G × G → E) : + ℕ → G × G → E + | 0, q => z q + | k + 1, q => + (Fintype.card ι : ℂ)⁻¹ • + ∑ i, pairedWordAverage s z k (s i * q.1, s i * q.2) + +private def pairedDefectWordAverage + {G ι E : Type*} [Group G] [Fintype ι] + [AddCommMonoid E] [Module ℂ E] + (s : ι → G) (z : G × G → E) (k : ℕ) : E := + (Fintype.card ι : ℂ)⁻¹ • + ∑ i, pairedWordAverage s z k (s i, 1) + +private theorem inner_smul_fintype_sum + {ι E : Type*} [Fintype ι] + [NormedAddCommGroup E] [InnerProductSpace ℂ E] + (x y : ι → E) (c : ℂ) : + ⟪c • ∑ i, x i, c • ∑ j, y j⟫_ℂ = + star c * (∑ i, ∑ j, ⟪x i, y j⟫_ℂ) * c := by + rw [inner_smul_left, inner_smul_right, sum_inner] + simp_rw [inner_sum] + simp only [RCLike.star_def] + ring + +private theorem tendsto_inner_pairedWordAverage_of_gram + {G ι N H : Type*} [Group G] [Fintype ι] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + {E : N → Type*} + [∀ n, NormedAddCommGroup (E n)] + [∀ n, InnerProductSpace ℂ (E n)] + (l : Filter N) (s : ι → G) + (z : ∀ n, G × G → E n) (v : G × G → H) + (hgram : ∀ q r, + Tendsto (fun n => ⟪z n q, z n r⟫_ℂ) l + (𝓝 ⟪v q, v r⟫_ℂ)) + (k : ℕ) (q r : G × G) : + Tendsto + (fun n => + ⟪pairedWordAverage s (z n) k q, + pairedWordAverage s (z n) k r⟫_ℂ) + l + (𝓝 ⟪pairedWordAverage s v k q, + pairedWordAverage s v k r⟫_ℂ) := by + induction k generalizing q r with + | zero => + simpa only [pairedWordAverage] using hgram q r + | succ k ih => + have hsum : + Tendsto + (fun n => + ∑ i : ι, ∑ j : ι, + ⟪pairedWordAverage s (z n) k + (s i * q.1, s i * q.2), + pairedWordAverage s (z n) k + (s j * r.1, s j * r.2)⟫_ℂ) + l + (𝓝 (∑ i : ι, ∑ j : ι, + ⟪pairedWordAverage s v k + (s i * q.1, s i * q.2), + pairedWordAverage s v k + (s j * r.1, s j * r.2)⟫_ℂ)) := + tendsto_finsetSum Finset.univ fun i _ => + tendsto_finsetSum Finset.univ fun j _ => + ih (s i * q.1, s i * q.2) + (s j * r.1, s j * r.2) + simpa only [pairedWordAverage, inner_smul_fintype_sum] using + (tendsto_const_nhds.mul hsum).mul tendsto_const_nhds + +private theorem tendsto_norm_pairedDefectWordAverage_of_gram + {G ι N H : Type*} [Group G] [Fintype ι] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + {E : N → Type*} + [∀ n, NormedAddCommGroup (E n)] + [∀ n, InnerProductSpace ℂ (E n)] + (l : Filter N) (s : ι → G) + (z : ∀ n, G × G → E n) (v : G × G → H) + (hgram : ∀ q r, + Tendsto (fun n => ⟪z n q, z n r⟫_ℂ) l + (𝓝 ⟪v q, v r⟫_ℂ)) + (k : ℕ) : + Tendsto + (fun n => ‖pairedDefectWordAverage s (z n) k‖) + l + (𝓝 ‖pairedDefectWordAverage s v k‖) := by + have hsq : + Tendsto + (fun n => ‖pairedDefectWordAverage s (z n) k‖ ^ 2) + l + (𝓝 (‖pairedDefectWordAverage s v k‖ ^ 2)) := by + simpa only [pairedDefectWordAverage] using + KunRootedIndicatorCrossing.tendsto_norm_sq_smul_finset_sum_of_gram + l + (fun n (i : ι) => + pairedWordAverage s (z n) k (s i, 1)) + (fun i : ι => pairedWordAverage s v k (s i, 1)) + (fun i j => + tendsto_inner_pairedWordAverage_of_gram l s z v hgram k + (s i, 1) (s j, 1)) + Finset.univ (Fintype.card ι : ℂ)⁻¹ + have hroot := + (Real.continuous_sqrt.tendsto + (‖pairedDefectWordAverage s v k‖ ^ 2)).comp hsq + convert hroot using 1 + · funext n + change ‖pairedDefectWordAverage s (z n) k‖ = + Real.sqrt (‖pairedDefectWordAverage s (z n) k‖ ^ 2) + exact (Real.sqrt_sq (norm_nonneg _)).symm + · congr 1 + rw [Real.sqrt_sq (norm_nonneg _)] + +private def permutationMarkovLinear + {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) : + EuclideanSpace ℂ V →ₗ[ℂ] EuclideanSpace ℂ V := + (Fintype.card ι : ℂ)⁻¹ • + ∑ i, (permutationUnitary (p i)).toLinearEquiv.toLinearMap + +@[simp] +private theorem permutationMarkovLinear_apply + {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (x : EuclideanSpace ℂ V) : + permutationMarkovLinear p x = permutationMarkov p x := by + simp only [permutationMarkovLinear, LinearMap.smul_apply, LinearMap.coe_sum, LinearEquiv.coe_coe, + LinearIsometryEquiv.coe_toLinearEquiv, Finset.sum_apply, permutationMarkov] + +private theorem permutationMarkovLinear_pow_apply + {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (k : ℕ) + (x : EuclideanSpace ℂ V) : + ((permutationMarkovLinear p) ^ k) x = + ((permutationMarkov p)^[k]) x := by + induction k with + | zero => simp only [pow_zero, Module.End.one_apply, Function.iterate_zero, id_eq] + | succ k ih => + rw [pow_succ', Module.End.mul_apply, + Function.iterate_succ_apply'] + rw [ih, permutationMarkovLinear_apply] + +private theorem permutationMarkov_pair_of_rooted + {G ι V : Type*} [Group G] [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) + (σ : G → Equiv.Perm V) (s : ι → G) + (hgenerator : ∀ i, σ (s i) = p i) + (q : G × G) + (hroot : ∀ i, + (∀ x : V, indicatorVector f x ≠ 0 → + σ (s i * q.1) x = (σ (s i) * σ q.1) x) ∧ + (∀ x : V, indicatorVector f x ≠ 0 → + σ (s i * q.2) x = (σ (s i) * σ q.2) x)) : + permutationMarkov p (normalizedPairDisplacement p f σ q) = + pairedWordAverage s (normalizedPairDisplacement p f σ) 1 q := by + simp only [permutationMarkov, pairedWordAverage] + apply congrArg (fun x => (Fintype.card ι : ℂ)⁻¹ • x) + apply Finset.sum_congr rfl + intro i _ + rw [← hgenerator i] + exact (normalizedPairDisplacement_diagonal p f σ + (s i) q.1 q.2 (hroot i).1 (hroot i).2).symm + +private theorem eventually_permutationMarkov_pair_of_rooted + {G ι : Type*} [Group G] [Fintype ι] + {V : ℕ → Type*} [∀ n, Fintype (V n)] + (p : ∀ n, ι → Equiv.Perm (V n)) + (f : ∀ n, V n → ℝ) + (σ : ∀ n, G → Equiv.Perm (V n)) + (s : ι → G) + (hgenerator : ∀ n i, σ n (s i) = p n i) + (hroot : ∀ a g : G, ∀ᶠ n in Filter.atTop, + ∀ x : V n, indicatorVector (f n) x ≠ 0 → + σ n (a * g) x = (σ n a * σ n g) x) + (q : G × G) : + ∀ᶠ n in Filter.atTop, + permutationMarkov (p n) + (normalizedPairDisplacement (p n) (f n) (σ n) q) = + pairedWordAverage s + (normalizedPairDisplacement (p n) (f n) (σ n)) 1 q := by + have hnodes : + ∀ᶠ n in Filter.atTop, ∀ i : ι, + (∀ x : V n, indicatorVector (f n) x ≠ 0 → + σ n (s i * q.1) x = + (σ n (s i) * σ n q.1) x) ∧ + (∀ x : V n, indicatorVector (f n) x ≠ 0 → + σ n (s i * q.2) x = + (σ n (s i) * σ n q.2) x) := + (Filter.eventually_all).2 fun i => + (hroot (s i) q.1).and (hroot (s i) q.2) + filter_upwards [hnodes] with n hn + exact permutationMarkov_pair_of_rooted + (p n) (f n) (σ n) s (hgenerator n) q hn + +private theorem eventually_linear_pairedWordAverage_pow + {G ι N : Type*} [Group G] [Fintype ι] + {E : N → Type*} + [∀ n, AddCommMonoid (E n)] + [∀ n, Module ℂ (E n)] + (l : Filter N) (s : ι → G) + (L : ∀ n, E n →ₗ[ℂ] E n) + (z : ∀ n, G × G → E n) + (hbase : ∀ q, ∀ᶠ n in l, + L n (z n q) = pairedWordAverage s (z n) 1 q) + (k : ℕ) (q : G × G) : + ∀ᶠ n in l, + ((L n) ^ k) (z n q) = pairedWordAverage s (z n) k q := by + induction k generalizing q with + | zero => + exact Filter.Eventually.of_forall fun n => by + simp only [pow_zero, Module.End.one_apply, pairedWordAverage] + | succ k ih => + have hnodes : + ∀ᶠ n in l, ∀ i : ι, + ((L n) ^ k) (z n (s i * q.1, s i * q.2)) = + pairedWordAverage s (z n) k + (s i * q.1, s i * q.2) := + (Filter.eventually_all).2 fun i => + ih (s i * q.1, s i * q.2) + filter_upwards [hbase q, hnodes] with n hn hnode + rw [pow_succ, Module.End.mul_apply, hn, + pairedWordAverage, pairedWordAverage, map_smul, map_sum] + apply congrArg (fun x => (Fintype.card ι : ℂ)⁻¹ • x) + exact Finset.sum_congr rfl fun i _ => hnode i + +private theorem eventually_linear_pairedDefectWordAverage_pow + {G ι N : Type*} [Group G] [Fintype ι] + {E : N → Type*} + [∀ n, AddCommMonoid (E n)] + [∀ n, Module ℂ (E n)] + (l : Filter N) (s : ι → G) + (L : ∀ n, E n →ₗ[ℂ] E n) + (z : ∀ n, G × G → E n) + (hbase : ∀ q, ∀ᶠ n in l, + L n (z n q) = pairedWordAverage s (z n) 1 q) + (k : ℕ) : + ∀ᶠ n in l, + ((L n) ^ k) (pairedDefectWordAverage s (z n) 0) = + pairedDefectWordAverage s (z n) k := by + have hnodes : + ∀ᶠ n in l, ∀ i : ι, + ((L n) ^ k) (z n (s i, 1)) = + pairedWordAverage s (z n) k (s i, 1) := + (Filter.eventually_all).2 fun i => + eventually_linear_pairedWordAverage_pow l s L z hbase k + (s i, 1) + filter_upwards [hnodes] with n hn + simp only [pairedDefectWordAverage, pairedWordAverage, + map_smul, map_sum] + exact congrArg (fun x => (Fintype.card ι : ℂ)⁻¹ • x) + (Finset.sum_congr rfl fun i _ => hn i) + +private theorem pairedDefectWordAverage_zero_eq_normalizedIndicatorDefect + {G ι V : Type*} [Group G] [Fintype ι] [Nonempty ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) + (σ : G → Equiv.Perm V) (s : ι → G) + (hone : σ 1 = 1) (hgenerator : ∀ i, σ (s i) = p i) : + pairedDefectWordAverage s + (normalizedPairDisplacement p f σ) 0 = + normalizedIndicatorDefect p f := by + simp only [pairedDefectWordAverage, pairedWordAverage] + simp_rw [normalizedPairDisplacement_generator_of_model + p f σ s hone hgenerator] + exact average_normalizedIndicatorDisplacement p f + +private theorem tendsto_norm_normalizedIndicatorDefect_markov_pow + {G ι H : Type*} [Group G] [Fintype ι] [Nonempty ι] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + {V : ℕ → Type*} [∀ n, Fintype (V n)] + (p : ∀ n, ι → Equiv.Perm (V n)) + (f : ∀ n, V n → ℝ) + (σ : ∀ n, G → Equiv.Perm (V n)) + (s : ι → G) + (v : G × G → H) + (hone : ∀ n, σ n 1 = 1) + (hgenerator : ∀ n i, σ n (s i) = p n i) + (hroot : ∀ a g : G, ∀ᶠ n in Filter.atTop, + ∀ x : V n, indicatorVector (f n) x ≠ 0 → + σ n (a * g) x = (σ n a * σ n g) x) + (hgram : ∀ q r, + Tendsto + (fun n => + ⟪normalizedPairDisplacement (p n) (f n) (σ n) q, + normalizedPairDisplacement (p n) (f n) (σ n) r⟫_ℂ) + (Filter.hyperfilter ℕ) + (𝓝 ⟪v q, v r⟫_ℂ)) + (k : ℕ) : + Tendsto + (fun n => + ‖((permutationMarkov (p n))^[k]) + (normalizedIndicatorDefect (p n) (f n))‖) + (Filter.hyperfilter ℕ) + (𝓝 ‖pairedDefectWordAverage s v k‖) := by + let z : ∀ n, G × G → EuclideanSpace ℂ (V n) := + fun n => normalizedPairDisplacement (p n) (f n) (σ n) + let L : ∀ n, EuclideanSpace ℂ (V n) →ₗ[ℂ] + EuclideanSpace ℂ (V n) := + fun n => permutationMarkovLinear (p n) + have hbase : ∀ q, ∀ᶠ n in Filter.atTop, + L n (z n q) = pairedWordAverage s (z n) 1 q := by + intro q + simpa only [L, permutationMarkovLinear_apply, z] using + eventually_permutationMarkov_pair_of_rooted + p f σ s hgenerator hroot q + have hp := eventually_linear_pairedDefectWordAverage_pow + Filter.atTop s L z hbase k + have hpow : + ∀ᶠ n in Filter.atTop, + ((permutationMarkov (p n))^[k]) + (normalizedIndicatorDefect (p n) (f n)) = + pairedDefectWordAverage s (z n) k := by + filter_upwards [hp] with n hn + rw [← permutationMarkovLinear_pow_apply] + change ((L n) ^ k) (normalizedIndicatorDefect (p n) (f n)) = + pairedDefectWordAverage s (z n) k + rw [← pairedDefectWordAverage_zero_eq_normalizedIndicatorDefect + (p n) (f n) (σ n) s (hone n) (hgenerator n)] + exact hn + have hlimit := + tendsto_norm_pairedDefectWordAverage_of_gram + (Filter.hyperfilter ℕ) s z v hgram k + have heq : + (fun n => + ‖((permutationMarkov (p n))^[k]) + (normalizedIndicatorDefect (p n) (f n))‖) =ᶠ[ + (Filter.hyperfilter ℕ : Filter ℕ)] + (fun n => ‖pairedDefectWordAverage s (z n) k‖) := + (hpow.filter_mono Nat.hyperfilter_le_atTop).mono + fun n hn => congrArg norm hn + exact hlimit.congr' heq.symm + +private def representationFamilyMarkovLinear + {G ι H : Type*} [Group G] [Fintype ι] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) (s : ι → G) : + H →ₗ[ℂ] H := + (Fintype.card ι : ℂ)⁻¹ • + ∑ i, (π (s i)).toLinearEquiv.toLinearMap + +private theorem representationFamilyMarkovLinear_subtype_apply + {G H : Type*} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) + (S : Finset G) (x : H) : + representationFamilyMarkovLinear π (fun i : ↥S => (i : G)) x = + unitaryFinsetMarkov π S x := by + simp only [representationFamilyMarkovLinear, Fintype.card_coe, Finset.univ_eq_attach, + LinearMap.smul_apply, + LinearMap.coe_sum, LinearEquiv.coe_coe, LinearIsometryEquiv.coe_toLinearEquiv, Finset.sum_apply, + unitaryFinsetMarkov, ← Finset.sum_coe_sort S] + +private theorem representationFamilyMarkovLinear_subtype_pow_apply + {G H : Type*} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) + (S : Finset G) (k : ℕ) (x : H) : + (representationFamilyMarkovLinear π + (fun i : ↥S => (i : G)) ^ k) x = + ((unitaryFinsetMarkov π S)^[k]) x := by + induction k with + | zero => simp only [pow_zero, Module.End.one_apply, Function.iterate_zero, id_eq] + | succ k ih => + rw [pow_succ', Module.End.mul_apply, + Function.iterate_succ_apply', ih, + representationFamilyMarkovLinear_subtype_apply] + +private theorem representationFamilyMarkovLinear_pair_of_equivariant + {G ι H : Type*} [Group G] [Fintype ι] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) + (s : ι → G) (v : G × G → H) + (hequivariant : ∀ a g h : G, + π a (v (g, h)) = v (a * g, a * h)) + (q : G × G) : + representationFamilyMarkovLinear π s (v q) = + pairedWordAverage s v 1 q := by + rcases q with ⟨g, h⟩ + simp only [representationFamilyMarkovLinear, LinearMap.smul_apply, LinearMap.coe_sum, + LinearEquiv.coe_coe, + LinearIsometryEquiv.coe_toLinearEquiv, Finset.sum_apply, hequivariant, pairedWordAverage] + +private theorem linear_pairedWordAverage_pow + {G ι E : Type*} [Group G] [Fintype ι] + [AddCommMonoid E] [Module ℂ E] + (s : ι → G) (L : E →ₗ[ℂ] E) + (z : G × G → E) + (hbase : ∀ q, L (z q) = pairedWordAverage s z 1 q) + (k : ℕ) (q : G × G) : + (L ^ k) (z q) = pairedWordAverage s z k q := by + induction k generalizing q with + | zero => simp only [pow_zero, Module.End.one_apply, pairedWordAverage] + | succ k ih => + rw [pow_succ, Module.End.mul_apply, hbase q, + pairedWordAverage, pairedWordAverage, + map_smul, map_sum] + apply congrArg (fun x => (Fintype.card ι : ℂ)⁻¹ • x) + exact Finset.sum_congr rfl fun i _ => + ih (s i * q.1, s i * q.2) + +private theorem pairedDefectWordAverage_eq_unitaryFinsetMarkov_iterate + {G H : Type*} [Group G] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (π : UnitaryRepresentation G H) + (S : Finset G) (v : G × G → H) + (hequivariant : ∀ a g h : G, + π a (v (g, h)) = v (a * g, a * h)) + (k : ℕ) : + pairedDefectWordAverage (fun i : ↥S => (i : G)) v k = + ((unitaryFinsetMarkov π S)^[k]) + (pairedDefectWordAverage (fun i : ↥S => (i : G)) v 0) := by + let s : ↥S → G := fun i => (i : G) + let L : H →ₗ[ℂ] H := representationFamilyMarkovLinear π s + have hbase : ∀ q, L (v q) = pairedWordAverage s v 1 q := + fun q => representationFamilyMarkovLinear_pair_of_equivariant + π s v hequivariant q + have hpow : + (L ^ k) (pairedDefectWordAverage s v 0) = + pairedDefectWordAverage s v k := by + simp only [pairedDefectWordAverage, pairedWordAverage, + map_smul, map_sum] + apply congrArg (fun x => (Fintype.card (↥S) : ℂ)⁻¹ • x) + exact Finset.sum_congr rfl fun i _ => + linear_pairedWordAverage_pow s L v hbase k (s i, 1) + have hrewrite := + representationFamilyMarkovLinear_subtype_pow_apply + π S k (pairedDefectWordAverage s v 0) + exact hpow.symm.trans hrewrite + +private theorem eventually_normalizedIndicatorDefect_markov_pow_lt_of_rooted + {G : Type u} [Group G] + (P : KazhdanPair.{u, u} G) + (S : Finset G) (honeS : 1 ∈ S) + (hcover : P.generators ⊆ S) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + {V : ℕ → Type u} [∀ n, Fintype (V n)] + (p : ∀ n, ↥S → Equiv.Perm (V n)) + (f : ∀ n, V n → ℝ) + (σ : ∀ n, G → Equiv.Perm (V n)) + (w : G → List ↥S) + (hf : ∀ n x, f n x = 0 ∨ f n x = 1) + (hdefect : ∀ n, + permutationMarkov (p n) (indicatorVector (f n)) ≠ + indicatorVector (f n)) + (hw : ∀ n g, σ n g = ((w g).map (p n)).prod) + (hone : ∀ n, σ n 1 = 1) + (hgenerator : ∀ n (i : ↥S), σ n (i : G) = p n i) + (hroot : ∀ a g : G, ∀ᶠ n in Filter.atTop, + ∀ x : V n, indicatorVector (f n) x ≠ 0 → + σ n (a * g) x = (σ n a * σ n g) x) + (k : ℕ) (ε : ℝ) (hε : 0 < ε) : + ∀ᶠ n in (Filter.hyperfilter ℕ : Filter ℕ), + ‖((permutationMarkov (p n))^[k]) + (normalizedIndicatorDefect (p n) (f n))‖ < + kazhdanMarkovContractionFactor P S ^ k + ε := by + let : Nonempty (↥S) := ⟨⟨1, honeS⟩⟩ + let s : ↥S → G := fun i => (i : G) + obtain ⟨K, R, _hpositive, _hdiagonal, hequivariant, + _hadd, hcocycle, hunit, hgram⟩ := + exists_equivariant_hilbert_normalized_rooted_pair_realization + p f σ s w hf hdefect hw hone hgenerator hroot + let z : R.realization.carrier := + pairedDefectWordAverage s R.realization.vector 0 + have hzone : ‖z‖ = 1 := by + simpa only [z, pairedDefectWordAverage, pairedWordAverage, + equivariantPairCocycle] using hunit + have hzform : + z = (S.card : ℂ)⁻¹ • + ∑ g ∈ S, equivariantPairCocycle R g := by + change + (Fintype.card (↥S) : ℂ)⁻¹ • + (∑ i : ↥S, R.realization.vector ((i : G), 1)) = + (S.card : ℂ)⁻¹ • + ∑ g ∈ S, equivariantPairCocycle R g + rw [Fintype.card_coe, ← Finset.sum_coe_sort S] + rfl + have horth : ∀ y : R.realization.carrier, + (∀ g : G, R.representation g y = y) → + @inner ℂ R.realization.carrier _ y z = 0 := by + intro y hy + rw [hzform] + exact inner_smul_cocycle_sum_eq_zero_of_invariant + R.representation (equivariantPairCocycle R) hcocycle + S hsymmetric (S.card : ℂ)⁻¹ y hy + have hbound : + ‖pairedDefectWordAverage s R.realization.vector k‖ ≤ + kazhdanMarkovContractionFactor P S ^ k := by + rw [pairedDefectWordAverage_eq_unitaryFinsetMarkov_iterate + R.representation S R.realization.vector hequivariant k] + change ‖((unitaryFinsetMarkov R.representation S)^[k]) z‖ ≤ _ + calc + ‖((unitaryFinsetMarkov R.representation S)^[k]) z‖ ≤ + kazhdanMarkovContractionFactor P S ^ k * ‖z‖ := + unitaryFinsetMarkov_iterate_norm_le + P R.representation S honeS hcover z horth k + _ = kazhdanMarkovContractionFactor P S ^ k := by + rw [hzone, mul_one] + have hstrict : + ‖pairedDefectWordAverage s R.realization.vector k‖ < + kazhdanMarkovContractionFactor P S ^ k + ε := + hbound.trans_lt (lt_add_of_pos_right _ hε) + have hlimit := tendsto_norm_normalizedIndicatorDefect_markov_pow + p f σ s R.realization.vector hone hgenerator hroot hgram k + exact hlimit.eventually (Iio_mem_nhds hstrict) + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +structure RootedIndicatorMarkovModel (G ι : Type u) where + /-- Internal interface connecting the split non-sofic proof modules. -/ + carrier : Type u + /-- Internal interface connecting the split non-sofic proof modules. -/ + [fintype : Fintype carrier] + /-- Internal interface connecting the split non-sofic proof modules. -/ + generator : ι → Equiv.Perm carrier + /-- Internal interface connecting the split non-sofic proof modules. -/ + indicator : carrier → ℝ + /-- Internal interface connecting the split non-sofic proof modules. -/ + evaluation : G → Equiv.Perm carrier + +public +instance rootedIndicatorMarkovModelFintype + {G ι : Type u} (X : RootedIndicatorMarkovModel G ι) : Fintype X.carrier := + X.fintype + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +structure RootedIndicatorMarkovModel.IsGenerated + {G ι : Type u} [Group G] [Fintype ι] + (X : RootedIndicatorMarkovModel G ι) + (s : ι → G) (w : G → List ι) : Prop where + indicator_mem : ∀ x, X.indicator x = 0 ∨ X.indicator x = 1 + word_evaluation : ∀ g, + X.evaluation g = ((w g).map X.generator).prod + identity_evaluation : X.evaluation 1 = 1 + generator_evaluation : ∀ i, X.evaluation (s i) = X.generator i + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +structure RootedIndicatorMarkovModel.IsRootedAtRadius + {G ι : Type u} [Group G] + (X : RootedIndicatorMarkovModel G ι) + (w : G → List ι) (r : ℕ) : Prop where + out : ∀ a g : G, + (w a).length + (w g).length + (w (a * g)).length ≤ r → + ∀ x : X.carrier, indicatorVector X.indicator x ≠ 0 → + X.evaluation (a * g) x = + (X.evaluation a * X.evaluation g) x + +private theorem eventually_rooted_of_growing_word_radius + {G ι : Type u} [Group G] + (X : ℕ → RootedIndicatorMarkovModel G ι) + (w : G → List ι) + (hroot : ∀ n, (X n).IsRootedAtRadius w n) + (a g : G) : + ∀ᶠ n in Filter.atTop, + ∀ x : (X n).carrier, + indicatorVector (X n).indicator x ≠ 0 → + (X n).evaluation (a * g) x = + ((X n).evaluation a * (X n).evaluation g) x := by + filter_upwards [Filter.eventually_ge_atTop + ((w a).length + (w g).length + (w (a * g)).length)] + with n hn + exact (hroot n).out a g hn + +private theorem exists_rooted_word_radius_normalized_markov_contraction + {G : Type u} [Group G] + (P : KazhdanPair.{u, u} G) + (S : Finset G) (honeS : 1 ∈ S) + (hcover : P.generators ⊆ S) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (w : G → List ↥S) + (k : ℕ) (ε : ℝ) (hε : 0 < ε) : + ∃ r : ℕ, ∀ X : RootedIndicatorMarkovModel G ↥S, + X.IsGenerated (fun i : ↥S => (i : G)) w → + X.IsRootedAtRadius w r → + permutationMarkov X.generator (indicatorVector X.indicator) ≠ + indicatorVector X.indicator → + ‖((permutationMarkov X.generator)^[k]) + (normalizedIndicatorDefect X.generator X.indicator)‖ < + kazhdanMarkovContractionFactor P S ^ k + ε := by + classical + let : Nonempty (↥S) := ⟨⟨1, honeS⟩⟩ + by_contra h + push Not at h + choose X hgenerated hradius hdefect hbad using h + let V : ℕ → Type u := fun n => (X n).carrier + let p : ∀ n, ↥S → Equiv.Perm (V n) := + fun n => (X n).generator + let f : ∀ n, V n → ℝ := fun n => (X n).indicator + let σ : ∀ n, G → Equiv.Perm (V n) := + fun n => (X n).evaluation + have hf : ∀ n x, f n x = 0 ∨ f n x = 1 := + fun n => (hgenerated n).indicator_mem + have hw : ∀ n g, σ n g = ((w g).map (p n)).prod := + fun n => (hgenerated n).word_evaluation + have hone : ∀ n, σ n 1 = 1 := + fun n => (hgenerated n).identity_evaluation + have hgenerator : ∀ n (i : ↥S), σ n (i : G) = p n i := + fun n => (hgenerated n).generator_evaluation + have hroots : ∀ a g : G, ∀ᶠ n in Filter.atTop, + ∀ x : V n, indicatorVector (f n) x ≠ 0 → + σ n (a * g) x = (σ n a * σ n g) x := by + intro a g + exact eventually_rooted_of_growing_word_radius + X w hradius a g + have hstrict := + eventually_normalizedIndicatorDefect_markov_pow_lt_of_rooted + P S honeS hcover hsymmetric p f σ w hf hdefect + hw hone hgenerator hroots k ε hε + have hbad' : ∀ n, + kazhdanMarkovContractionFactor P S ^ k + ε ≤ + ‖((permutationMarkov (p n))^[k]) + (normalizedIndicatorDefect (p n) (f n))‖ := + hbad + obtain ⟨n, hlt, hge⟩ := + (hstrict.and (Filter.Eventually.of_forall hbad')).exists + exact (not_lt_of_ge hge) hlt + +private theorem permutationMarkov_iterate_difference + {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (x : EuclideanSpace ℂ V) + (k : ℕ) : + ((permutationMarkov p)^[k + 1]) x - + ((permutationMarkov p)^[k]) x = + ((permutationMarkovLinear p) ^ k) + (permutationMarkov p x - x) := by + rw [Function.iterate_succ_apply] + rw [← permutationMarkovLinear_pow_apply p k + (permutationMarkov p x), + ← permutationMarkovLinear_pow_apply p k x, + ← map_sub] + +private theorem norm_normalizedIndicatorDefect_markov_pow + {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) (k : ℕ) : + ‖((permutationMarkov p)^[k]) + (normalizedIndicatorDefect p f)‖ = + ‖((permutationMarkovLinear p) ^ k) + (permutationMarkov p (indicatorVector f) - + indicatorVector f)‖ / + ‖permutationMarkov p (indicatorVector f) - + indicatorVector f‖ := by + rw [← permutationMarkovLinear_pow_apply] + simp only [normalizedIndicatorDefect, map_smul, map_sub, norm_smul, norm_inv, Complex.norm_real, + norm_norm, + div_eq_mul_inv, mul_comm] + +public +theorem exists_rooted_word_radius_markov_iterate_contraction + {G : Type u} [Group G] + (P : KazhdanPair.{u, u} G) + (S : Finset G) (honeS : 1 ∈ S) + (hcover : P.generators ⊆ S) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (w : G → List ↥S) + (k : ℕ) (ε : ℝ) (hε : 0 < ε) : + ∃ r : ℕ, ∀ X : RootedIndicatorMarkovModel G ↥S, + X.IsGenerated (fun i : ↥S => (i : G)) w → + X.IsRootedAtRadius w r → + ‖((permutationMarkov X.generator)^[k + 1]) + (indicatorVector X.indicator) - + ((permutationMarkov X.generator)^[k]) + (indicatorVector X.indicator)‖ ≤ + (kazhdanMarkovContractionFactor P S ^ k + ε) * + ‖permutationMarkov X.generator + (indicatorVector X.indicator) - + indicatorVector X.indicator‖ := by + obtain ⟨r, hr⟩ := + exists_rooted_word_radius_normalized_markov_contraction + P S honeS hcover hsymmetric w k ε hε + refine ⟨r, ?_⟩ + intro X hgenerated hroot + by_cases hfixed : + permutationMarkov X.generator + (indicatorVector X.indicator) = + indicatorVector X.indicator + · rw [Function.iterate_fixed hfixed (k + 1), + Function.iterate_fixed hfixed k, hfixed] + simp only [sub_self, norm_zero, mul_zero, Std.le_refl] + · have hpositive : + 0 < ‖permutationMarkov X.generator + (indicatorVector X.indicator) - + indicatorVector X.indicator‖ := + norm_pos_iff.mpr (sub_ne_zero.mpr hfixed) + have hnormalized := hr X hgenerated hroot hfixed + rw [norm_normalizedIndicatorDefect_markov_pow] + at hnormalized + have hdenormalized := + (div_lt_iff₀ hpositive).mp hnormalized + rw [permutationMarkov_iterate_difference] + exact hdenormalized.le + +end KunRootedWordPower + +namespace KunActualSoficRootRadius + +open Filter Topology +open scoped BigOperators Pointwise + +private def modelMultiplicationBad {G : Type*} [Group G] + (M : PermutationModel G) (g h : G) : + Finset (Fin M.size) := + Finset.univ.filter (fun x => + M.action (g * h) x ≠ (M.action g * M.action h) x) + +@[simp] +private theorem mem_modelMultiplicationBad {G : Type*} [Group G] + (M : PermutationModel G) (g h : G) + (x : Fin M.size) : + x ∈ modelMultiplicationBad M g h ↔ + M.action (g * h) x ≠ (M.action g * M.action h) x := by + simp only [modelMultiplicationBad, Finset.mem_filter, + Finset.mem_univ, true_and] + +private theorem modelMultiplicationBad_density_tendsto_zero + {G : Type*} [Group G] + (A : SoficApproximation G) (g h : G) : + Tendsto + (fun n => + ((modelMultiplicationBad (A.model n) g h).card : ℝ) / + (A.model n).size) + atTop (𝓝 0) := by + simpa only [modelMultiplicationBad, Equiv.Perm.coe_mul, Function.comp_apply, ne_eq, + normalizedHamming, + hammingDist, Fintype.card_fin] using A.multiplicative g h + +private def modelSeparationBad {G : Type*} [Group G] + (M : PermutationModel G) (g h : G) : + Finset (Fin M.size) := + agreementSet (M.action g) (M.action h) + +@[simp] +private theorem mem_modelSeparationBad {G : Type*} [Group G] + (M : PermutationModel G) (g h : G) + (x : Fin M.size) : + x ∈ modelSeparationBad M g h ↔ M.action g x = M.action h x := by + simp only [modelSeparationBad, agreementSet, Finset.mem_filter, Finset.mem_univ, true_and] + +private theorem modelSeparationBad_density_tendsto_zero + {G : Type*} [Group G] + (A : SoficApproximation G) + {g h : G} (hne : g ≠ h) : + Tendsto + (fun n => + ((modelSeparationBad (A.model n) g h).card : ℝ) / + (A.model n).size) + atTop (𝓝 0) := by + have hdist := + CompressionCriterion.normalizedHamming_distinct_tendsto + A hne + have hlimit : + Tendsto + (fun n => + (1 : ℝ) - normalizedHamming + ((A.model n).action g) ((A.model n).action h)) + atTop (𝓝 0) := by + have hone : + Tendsto (fun _ : ℕ => (1 : ℝ)) atTop (𝓝 1) := + tendsto_const_nhds + simpa only [sub_self] using hone.sub hdist + convert hlimit using 1 + funext n + have hcard : + (agreementSet + ((A.model n).action g) ((A.model n).action h)).card + + hammingDist + (fun x => (A.model n).action g x) + (fun x => (A.model n).action h x) = + (A.model n).size := by + simpa only [Fintype.card_fin] using + agreementSet_card_add_hammingDist ((A.model n).action g) ((A.model n).action h) + have hreal : + ((agreementSet + ((A.model n).action g) ((A.model n).action h)).card : ℝ) + + (hammingDist + (fun x => (A.model n).action g x) + (fun x => (A.model n).action h x) : ℝ) = + (A.model n).size := by + exact_mod_cast hcard + have hden : ((A.model n).size : ℝ) ≠ 0 := by + exact_mod_cast (A.model n).size_pos.ne' + simp only [modelSeparationBad, normalizedHamming, + Fintype.card_fin] + field_simp + linarith + +private def finiteMultiplicationBad {G : Type*} [Group G] + (M : PermutationModel G) (F : Finset G) : + Finset (Fin M.size) := by + classical + exact (F.product F).biUnion fun q => + modelMultiplicationBad M q.1 q.2 + +private def finiteSeparationBad {G : Type*} [Group G] + (M : PermutationModel G) (F : Finset G) : + Finset (Fin M.size) := by + classical + exact ((F.product F).filter fun q => q.1 ≠ q.2).biUnion fun q => + modelSeparationBad M q.1 q.2 + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def finiteRootBad {G : Type*} [Group G] + (M : PermutationModel G) (F : Finset G) : + Finset (Fin M.size) := + finiteMultiplicationBad M F ∪ finiteSeparationBad M F + +private theorem finiteMultiplicationBad_density_tendsto_zero + {G : Type*} [Group G] + (A : SoficApproximation G) (F : Finset G) : + Tendsto + (fun n => + ((finiteMultiplicationBad (A.model n) F).card : ℝ) / + (A.model n).size) + atTop (𝓝 0) := by + classical + have h := finite_union_bad_density_tendsto_zero + (F.product F) + (fun n => (Finset.univ : Finset (Fin (A.model n).size))) + (fun n (q : G × G) => + modelMultiplicationBad (A.model n) q.1 q.2) + (fun q _ => by + simpa only [Finset.univ_inter, Finset.card_univ, + Fintype.card_fin] using + modelMultiplicationBad_density_tendsto_zero A q.1 q.2) + simpa only [finiteMultiplicationBad, Finset.univ_inter, + Finset.card_univ, Fintype.card_fin] using h + +private theorem finiteSeparationBad_density_tendsto_zero + {G : Type*} [Group G] + (A : SoficApproximation G) (F : Finset G) : + Tendsto + (fun n => + ((finiteSeparationBad (A.model n) F).card : ℝ) / + (A.model n).size) + atTop (𝓝 0) := by + classical + have h := finite_union_bad_density_tendsto_zero + ((F.product F).filter fun q : G × G => q.1 ≠ q.2) + (fun n => (Finset.univ : Finset (Fin (A.model n).size))) + (fun n (q : G × G) => + modelSeparationBad (A.model n) q.1 q.2) + (fun q hq => by + simpa only [Finset.univ_inter, Finset.card_univ, + Fintype.card_fin] using + modelSeparationBad_density_tendsto_zero + A (Finset.mem_filter.mp hq).2) + simpa only [finiteSeparationBad, Finset.univ_inter, + Finset.card_univ, Fintype.card_fin] using h + +public +theorem finiteRootBad_density_tendsto_zero + {G : Type*} [Group G] + (A : SoficApproximation G) (F : Finset G) : + Tendsto + (fun n => + ((finiteRootBad (A.model n) F).card : ℝ) / + (A.model n).size) + atTop (𝓝 0) := by + have hsum : + Tendsto + (fun n => + ((finiteMultiplicationBad (A.model n) F).card : ℝ) / + (A.model n).size + + ((finiteSeparationBad (A.model n) F).card : ℝ) / + (A.model n).size) + atTop (𝓝 0) := by + simpa only [add_zero] using + (finiteMultiplicationBad_density_tendsto_zero A F).add + (finiteSeparationBad_density_tendsto_zero A F) + refine squeeze_zero (fun n => by positivity) ?_ hsum + intro n + have hcard : + ((finiteRootBad (A.model n) F).card : ℝ) ≤ + (finiteMultiplicationBad (A.model n) F).card + + (finiteSeparationBad (A.model n) F).card := by + exact_mod_cast Finset.card_union_le + (finiteMultiplicationBad (A.model n) F) + (finiteSeparationBad (A.model n) F) + calc + ((finiteRootBad (A.model n) F).card : ℝ) / + (A.model n).size ≤ + (((finiteMultiplicationBad (A.model n) F).card : ℝ) + + (finiteSeparationBad (A.model n) F).card) / + (A.model n).size := + div_le_div_of_nonneg_right hcard (by positivity) + _ = ((finiteMultiplicationBad (A.model n) F).card : ℝ) / + (A.model n).size + + ((finiteSeparationBad (A.model n) F).card : ℝ) / + (A.model n).size := by + rw [add_div] + +public +theorem finiteRootBad_multiplicative + {G : Type*} [Group G] + (M : PermutationModel G) (F : Finset G) + {g h : G} (hg : g ∈ F) (hh : h ∈ F) + {x : Fin M.size} (hx : x ∉ finiteRootBad M F) : + M.action (g * h) x = (M.action g * M.action h) x := by + classical + have hnot : x ∉ modelMultiplicationBad M g h := by + intro hbad + apply hx + apply Finset.mem_union_left + exact Finset.mem_biUnion.mpr + ⟨(g, h), Finset.mem_product.mpr ⟨hg, hh⟩, hbad⟩ + simpa only [Equiv.Perm.coe_mul, Function.comp_apply, mem_modelMultiplicationBad, ne_eq, + Decidable.not_not] using hnot + +public +theorem finiteRootBad_separated + {G : Type*} [Group G] + (M : PermutationModel G) (F : Finset G) + {g h : G} (hg : g ∈ F) (hh : h ∈ F) (hne : g ≠ h) + {x : Fin M.size} (hx : x ∉ finiteRootBad M F) : + M.action g x ≠ M.action h x := by + classical + intro heq + apply hx + apply Finset.mem_union_right + exact Finset.mem_biUnion.mpr + ⟨(g, h), Finset.mem_filter.mpr + ⟨Finset.mem_product.mpr ⟨hg, hh⟩, hne⟩, + (mem_modelSeparationBad M g h x).mpr heq⟩ + +private theorem finiteRootBad_injective_word_evaluation + {G : Type*} [Group G] + (M : PermutationModel G) (F : Finset G) + {x : Fin M.size} (hx : x ∉ finiteRootBad M F) : + Set.InjOn (fun g : G => M.action g x) (↑F : Set G) := by + intro g hg h hh heq + by_contra hne + exact finiteRootBad_separated M F hg hh hne hx heq + +public +theorem normalizedHamming_mul_le + {V : Type*} [Fintype V] [DecidableEq V] + (p p' q q' : Equiv.Perm V) : + normalizedHamming (p * q) (p' * q') ≤ + normalizedHamming p p' + + normalizedHamming q q' := by + calc + normalizedHamming (p * q) (p' * q') ≤ + normalizedHamming (p * q) (p' * q) + + normalizedHamming (p' * q) (p' * q') := + normalizedHamming_triangle _ _ _ + _ = normalizedHamming p p' + + normalizedHamming q q' := by + rw [normalizedHamming_mul_right, + normalizedHamming_mul_left] + +private theorem action_list_prod_tendsto + {G : Type*} [Group G] + (A : SoficApproximation G) (l : List G) : + Tendsto + (fun n => + normalizedHamming + ((A.model n).action l.prod) + ((l.map (A.model n).action).prod)) + atTop (𝓝 0) := by + induction l with + | nil => + simp only [List.prod_nil, PermutationModel.map_one, List.map_nil, normalizedHamming_self, + tendsto_const_nhds_iff] + | cons g l ih => + simp only [List.map_cons, List.prod_cons] + have hmul := A.multiplicative g l.prod + have hupper : + Tendsto + (fun n => + normalizedHamming + ((A.model n).action (g * l.prod)) + ((A.model n).action g * (A.model n).action l.prod) + + normalizedHamming + ((A.model n).action l.prod) + ((l.map (A.model n).action).prod)) + atTop (𝓝 0) := by + simpa only [add_zero] using hmul.add ih + refine squeeze_zero + (fun n => normalizedHamming_nonneg _ _) ?_ hupper + intro n + have htriangle := normalizedHamming_triangle + ((A.model n).action (g * l.prod)) + ((A.model n).action g * (A.model n).action l.prod) + ((A.model n).action g * + (l.map (A.model n).action).prod) + rw [normalizedHamming_mul_left] at htriangle + exact htriangle + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def chosenWordEvaluation + {G ι : Type*} [Group G] + (A : SoficApproximation G) + (s : ι → G) (w : G → List ι) (n : ℕ) (g : G) : + Equiv.Perm (Fin (A.model n).size) := + ((w g).map fun i => (A.model n).action (s i)).prod + +private theorem chosenWordEvaluation_tendsto_action + {G ι : Type*} [Group G] + (A : SoficApproximation G) + (s : ι → G) (w : G → List ι) + (hw : ∀ g, ((w g).map s).prod = g) (g : G) : + Tendsto + (fun n => + normalizedHamming + ((A.model n).action g) + (chosenWordEvaluation A s w n g)) + atTop (𝓝 0) := by + have h := action_list_prod_tendsto A ((w g).map s) + simpa only [chosenWordEvaluation, hw g, List.map_map, Function.comp_def] using h + +private theorem chosenWordEvaluation_multiplicative_tendsto + {G ι : Type*} [Group G] + (A : SoficApproximation G) + (s : ι → G) (w : G → List ι) + (hw : ∀ g, ((w g).map s).prod = g) (g h : G) : + Tendsto + (fun n => + normalizedHamming + (chosenWordEvaluation A s w n (g * h)) + (chosenWordEvaluation A s w n g * + chosenWordEvaluation A s w n h)) + atTop (𝓝 0) := by + have hgh := chosenWordEvaluation_tendsto_action A s w hw (g * h) + have hgh' : + Tendsto + (fun n => + normalizedHamming + (chosenWordEvaluation A s w n (g * h)) + ((A.model n).action (g * h))) + atTop (𝓝 0) := by + convert hgh using 1 + funext n + exact normalizedHamming_comm _ _ + have hg := chosenWordEvaluation_tendsto_action A s w hw g + have hh := chosenWordEvaluation_tendsto_action A s w hw h + have hmul := A.multiplicative g h + have hupper : + Tendsto + (fun n => + normalizedHamming + (chosenWordEvaluation A s w n (g * h)) + ((A.model n).action (g * h)) + + normalizedHamming + ((A.model n).action (g * h)) + ((A.model n).action g * (A.model n).action h) + + (normalizedHamming + ((A.model n).action g) + (chosenWordEvaluation A s w n g) + + normalizedHamming + ((A.model n).action h) + (chosenWordEvaluation A s w n h))) + atTop (𝓝 0) := by + simpa only [add_zero] using (hgh'.add hmul).add (hg.add hh) + refine squeeze_zero + (fun n => normalizedHamming_nonneg _ _) ?_ hupper + intro n + have hfirst := normalizedHamming_triangle + (chosenWordEvaluation A s w n (g * h)) + ((A.model n).action (g * h)) + (chosenWordEvaluation A s w n g * + chosenWordEvaluation A s w n h) + have hsecond := normalizedHamming_triangle + ((A.model n).action (g * h)) + ((A.model n).action g * (A.model n).action h) + (chosenWordEvaluation A s w n g * + chosenWordEvaluation A s w n h) + have hproduct := normalizedHamming_mul_le + ((A.model n).action g) (chosenWordEvaluation A s w n g) + ((A.model n).action h) (chosenWordEvaluation A s w n h) + linarith + +private def chosenWordMultiplicationBad + {G ι : Type*} [Group G] + (A : SoficApproximation G) + (s : ι → G) (w : G → List ι) (n : ℕ) (g h : G) : + Finset (Fin (A.model n).size) := + Finset.univ.filter (fun x => + chosenWordEvaluation A s w n (g * h) x ≠ + (chosenWordEvaluation A s w n g * + chosenWordEvaluation A s w n h) x) + +@[simp] +private theorem mem_chosenWordMultiplicationBad + {G ι : Type*} [Group G] + (A : SoficApproximation G) + (s : ι → G) (w : G → List ι) (n : ℕ) (g h : G) + (x : Fin (A.model n).size) : + x ∈ chosenWordMultiplicationBad A s w n g h ↔ + chosenWordEvaluation A s w n (g * h) x ≠ + (chosenWordEvaluation A s w n g * + chosenWordEvaluation A s w n h) x := by + simp only [chosenWordMultiplicationBad, Finset.mem_filter, + Finset.mem_univ, true_and] + +private theorem chosenWordMultiplicationBad_density_tendsto_zero + {G ι : Type*} [Group G] + (A : SoficApproximation G) + (s : ι → G) (w : G → List ι) + (hw : ∀ g, ((w g).map s).prod = g) (g h : G) : + Tendsto + (fun n => + ((chosenWordMultiplicationBad A s w n g h).card : ℝ) / + (A.model n).size) + atTop (𝓝 0) := by + simpa only [chosenWordMultiplicationBad, Equiv.Perm.coe_mul, Function.comp_apply, ne_eq, + normalizedHamming, + hammingDist, Fintype.card_fin] using chosenWordEvaluation_multiplicative_tendsto A s w hw g h + +private def chosenFiniteMultiplicationBad + {G ι : Type*} [Group G] + (A : SoficApproximation G) + (s : ι → G) (w : G → List ι) + (F : Finset G) (n : ℕ) : Finset (Fin (A.model n).size) := by + classical + exact (F.product F).biUnion fun q => + chosenWordMultiplicationBad A s w n q.1 q.2 + +private theorem chosenFiniteMultiplicationBad_density_tendsto_zero + {G ι : Type*} [Group G] + (A : SoficApproximation G) + (s : ι → G) (w : G → List ι) + (hw : ∀ g, ((w g).map s).prod = g) (F : Finset G) : + Tendsto + (fun n => + ((chosenFiniteMultiplicationBad A s w F n).card : ℝ) / + (A.model n).size) + atTop (𝓝 0) := by + classical + have h := finite_union_bad_density_tendsto_zero + (F.product F) + (fun n => (Finset.univ : Finset (Fin (A.model n).size))) + (fun n (q : G × G) => + chosenWordMultiplicationBad A s w n q.1 q.2) + (fun q _ => by + simpa only [Finset.univ_inter, Finset.card_univ, + Fintype.card_fin] using + chosenWordMultiplicationBad_density_tendsto_zero + A s w hw q.1 q.2) + simpa only [chosenFiniteMultiplicationBad, Finset.univ_inter, + Finset.card_univ, Fintype.card_fin] using h + +private theorem chosenFiniteMultiplicationBad_rooted + {G ι : Type*} [Group G] + (A : SoficApproximation G) + (s : ι → G) (w : G → List ι) + (F : Finset G) (n : ℕ) + {g h : G} (hg : g ∈ F) (hh : h ∈ F) + {x : Fin (A.model n).size} + (hx : x ∉ chosenFiniteMultiplicationBad A s w F n) : + chosenWordEvaluation A s w n (g * h) x = + (chosenWordEvaluation A s w n g * + chosenWordEvaluation A s w n h) x := by + classical + have hnot : x ∉ chosenWordMultiplicationBad A s w n g h := by + intro hbad + apply hx + exact Finset.mem_biUnion.mpr + ⟨(g, h), Finset.mem_product.mpr ⟨hg, hh⟩, hbad⟩ + simpa only [Equiv.Perm.coe_mul, Function.comp_apply, mem_chosenWordMultiplicationBad, ne_eq, + Decidable.not_not] using hnot + +private def chosenFiniteRootBad + {G ι : Type*} [Group G] + (A : SoficApproximation G) + (s : ι → G) (w : G → List ι) + (F : Finset G) (n : ℕ) : Finset (Fin (A.model n).size) := + finiteRootBad (A.model n) F ∪ + chosenFiniteMultiplicationBad A s w F n + +private theorem chosenFiniteRootBad_density_tendsto_zero + {G ι : Type*} [Group G] + (A : SoficApproximation G) + (s : ι → G) (w : G → List ι) + (hw : ∀ g, ((w g).map s).prod = g) (F : Finset G) : + Tendsto + (fun n => + ((chosenFiniteRootBad A s w F n).card : ℝ) / + (A.model n).size) + atTop (𝓝 0) := by + have hsum : + Tendsto + (fun n => + ((finiteRootBad (A.model n) F).card : ℝ) / + (A.model n).size + + ((chosenFiniteMultiplicationBad A s w F n).card : ℝ) / + (A.model n).size) + atTop (𝓝 0) := by + simpa only [add_zero] using + (finiteRootBad_density_tendsto_zero A F).add + (chosenFiniteMultiplicationBad_density_tendsto_zero A s w hw F) + refine squeeze_zero (fun n => by positivity) ?_ hsum + intro n + have hcard : + ((chosenFiniteRootBad A s w F n).card : ℝ) ≤ + (finiteRootBad (A.model n) F).card + + (chosenFiniteMultiplicationBad A s w F n).card := by + exact_mod_cast Finset.card_union_le + (finiteRootBad (A.model n) F) + (chosenFiniteMultiplicationBad A s w F n) + calc + ((chosenFiniteRootBad A s w F n).card : ℝ) / + (A.model n).size ≤ + (((finiteRootBad (A.model n) F).card : ℝ) + + (chosenFiniteMultiplicationBad A s w F n).card) / + (A.model n).size := + div_le_div_of_nonneg_right hcard (by positivity) + _ = ((finiteRootBad (A.model n) F).card : ℝ) / + (A.model n).size + + ((chosenFiniteMultiplicationBad A s w F n).card : ℝ) / + (A.model n).size := by + rw [add_div] + +private theorem chosenFiniteRootBad_injective_word_evaluation + {G ι : Type*} [Group G] + (A : SoficApproximation G) + (s : ι → G) (w : G → List ι) + (F : Finset G) (n : ℕ) + {x : Fin (A.model n).size} + (hx : x ∉ chosenFiniteRootBad A s w F n) : + Set.InjOn (fun g : G => (A.model n).action g x) + (↑F : Set G) := by + apply finiteRootBad_injective_word_evaluation + (A.model n) F + intro hbad + exact hx (Finset.mem_union_left _ hbad) + +private theorem exists_generator_word_of_symmetric_generates + {G : Type*} [Group G] + (S : Finset G) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) + (g : G) : + ∃ l : List ↥S, + ((l.map fun i : ↥S => (i : G)).prod) = g := by + classical + have hg : g ∈ Subgroup.closure (S : Set G) := by + rw [hgenerates] + simp only [Subgroup.mem_top] + induction hg using Subgroup.closure_induction with + | mem x hx => + exact ⟨[⟨x, hx⟩], by simp only [List.map_cons, List.map_nil, List.prod_cons, List.prod_nil, + mul_one]⟩ + | one => + exact ⟨[], by simp only [List.map_nil, List.prod_nil]⟩ + | mul x y _ _ ihx ihy => + obtain ⟨lx, hlx⟩ := ihx + obtain ⟨ly, hly⟩ := ihy + refine ⟨lx ++ ly, ?_⟩ + rw [List.map_append, List.prod_append, hlx, hly] + | inv x _ ih => + obtain ⟨l, hl⟩ := ih + let invLetter : ↥S → ↥S := + fun i => ⟨(i : G)⁻¹, hsymmetric (i : G) i.property⟩ + refine ⟨(l.map invLetter).reverse, ?_⟩ + rw [List.map_reverse, List.map_map] + change ((l.map fun i : ↥S => (i : G)⁻¹).reverse).prod = x⁻¹ + have hmap : + (l.map fun i : ↥S => (i : G)⁻¹) = + (l.map (fun i : ↥S => (i : G))).map + (fun x : G => x⁻¹) := by + rw [List.map_map] + rfl + rw [hmap, ← List.prod_inv_reverse, hl] + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def symmetricGeneratorWord + {G : Type*} [Group G] [DecidableEq G] + (S : Finset G) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) + (g : G) : List ↥S := by + classical + by_cases hone : g = 1 + · exact [] + · by_cases hg : g ∈ S + · exact [⟨g, hg⟩] + · exact (exists_generator_word_of_symmetric_generates + S hsymmetric hgenerates g).choose + +public +theorem symmetricGeneratorWord_prod + {G : Type*} [Group G] [DecidableEq G] + (S : Finset G) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) + (g : G) : + (((symmetricGeneratorWord S hsymmetric hgenerates g).map + fun i : ↥S => (i : G)).prod) = g := by + classical + unfold symmetricGeneratorWord + split <;> rename_i hone + · simp only [List.map_nil, List.prod_nil, hone] + · split <;> rename_i hg + · simp only [List.map_cons, List.map_nil, List.prod_cons, List.prod_nil, mul_one] + · exact (exists_generator_word_of_symmetric_generates + S hsymmetric hgenerates g).choose_spec + +@[simp] +public +theorem symmetricGeneratorWord_one + {G : Type*} [Group G] [DecidableEq G] + (S : Finset G) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) : + symmetricGeneratorWord S hsymmetric hgenerates (1 : G) = [] := by + simp only [symmetricGeneratorWord, ↓reduceDIte] + +public +theorem symmetricGeneratorWord_generator + {G : Type*} [Group G] [DecidableEq G] + (S : Finset G) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) + (i : ↥S) (hi : (i : G) ≠ 1) : + symmetricGeneratorWord S hsymmetric hgenerates (i : G) = [i] := by + classical + simp only [symmetricGeneratorWord, hi, ↓reduceDIte, i.property, Subtype.coe_eta] + +public +theorem chosen_symmetric_wordEvaluation_one + {G : Type*} [Group G] [DecidableEq G] + (A : SoficApproximation G) + (S : Finset G) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) + (n : ℕ) : + chosenWordEvaluation A (fun i : ↥S => (i : G)) + (symmetricGeneratorWord S hsymmetric hgenerates) n 1 = 1 := by + simp only [chosenWordEvaluation, symmetricGeneratorWord_one, List.map_nil, List.prod_nil] + +public +theorem chosen_symmetric_wordEvaluation_generator + {G : Type*} [Group G] [DecidableEq G] + (A : SoficApproximation G) + (S : Finset G) + (hsymmetric : ∀ g ∈ S, g⁻¹ ∈ S) + (hgenerates : Subgroup.closure (S : Set G) = ⊤) + (n : ℕ) (i : ↥S) : + chosenWordEvaluation A (fun j : ↥S => (j : G)) + (symmetricGeneratorWord S hsymmetric hgenerates) + n (i : G) = + (A.model n).action (i : G) := by + classical + by_cases hi : (i : G) = 1 + · simp only [chosenWordEvaluation, hi, symmetricGeneratorWord_one, List.map_nil, List.prod_nil, + PermutationModel.map_one] + · rw [chosenWordEvaluation, + symmetricGeneratorWord_generator S hsymmetric hgenerates i hi] + simp only [List.map_cons, List.map_nil, List.prod_cons, List.prod_nil, mul_one] + +private theorem generator_word_prod_mem_pow + {G : Type*} [Group G] [DecidableEq G] + (S : Finset G) (l : List ↥S) : + ((l.map fun i : ↥S => (i : G)).prod) ∈ S ^ l.length := by + induction l with + | nil => simp only [List.length_nil, pow_zero, List.map_nil, List.prod_nil, Finset.mem_one] + | cons a l ih => + simpa only [List.length_cons, pow_succ', List.map_cons, List.map_subtype, List.map_id_fun', + id_eq, + List.prod_cons] using (Finset.mul_mem_mul a.property ih) + +public +theorem mem_generator_pow_of_chosen_word_length + {G : Type*} [Group G] [DecidableEq G] + (S : Finset G) (hone : 1 ∈ S) + (w : G → List ↥S) + (hw : ∀ g, ((w g).map fun i : ↥S => (i : G)).prod = g) + {g : G} {r : ℕ} (hgr : (w g).length ≤ r) : + g ∈ S ^ r := by + have hword : g ∈ S ^ (w g).length := by + simpa only [hw g] using generator_word_prod_mem_pow S (w g) + exact Finset.pow_subset_pow_right hone hgr hword + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def chosenCayleyRadiusBad + {G : Type*} [Group G] [DecidableEq G] + (A : SoficApproximation G) + (S : Finset G) (w : G → List ↥S) (n r : ℕ) : + Finset (Fin (A.model n).size) := + chosenFiniteRootBad A (fun i : ↥S => (i : G)) w (S ^ r) n + +public +theorem chosenCayleyRadiusBad_density_tendsto_zero + {G : Type*} [Group G] [DecidableEq G] + (A : SoficApproximation G) + (S : Finset G) (w : G → List ↥S) + (hw : ∀ g, ((w g).map fun i : ↥S => (i : G)).prod = g) + (r : ℕ) : + Tendsto + (fun n => + ((chosenCayleyRadiusBad A S w n r).card : ℝ) / + (A.model n).size) + atTop (𝓝 0) := + chosenFiniteRootBad_density_tendsto_zero + A (fun i : ↥S => (i : G)) w hw (S ^ r) + +public +theorem chosenCayleyRadiusBad_rooted + {G : Type*} [Group G] [DecidableEq G] + (A : SoficApproximation G) + (S : Finset G) (hone : 1 ∈ S) + (w : G → List ↥S) + (hw : ∀ g, ((w g).map fun i : ↥S => (i : G)).prod = g) + (n r : ℕ) (a g : G) + (hword : (w a).length + (w g).length + + (w (a * g)).length ≤ r) + {x : Fin (A.model n).size} + (hx : x ∉ chosenCayleyRadiusBad A S w n r) : + chosenWordEvaluation A (fun i : ↥S => (i : G)) w n (a * g) x = + (chosenWordEvaluation A (fun i : ↥S => (i : G)) w n a * + chosenWordEvaluation A (fun i : ↥S => (i : G)) w n g) x := by + have ha : (w a).length ≤ r := by omega + have hg : (w g).length ≤ r := by omega + have ha' : a ∈ S ^ r := + mem_generator_pow_of_chosen_word_length S hone w hw ha + have hg' : g ∈ S ^ r := + mem_generator_pow_of_chosen_word_length S hone w hw hg + apply chosenFiniteMultiplicationBad_rooted + A (fun i : ↥S => (i : G)) w (S ^ r) n ha' hg' + intro hbad + exact hx (Finset.mem_union_right _ hbad) + +public +theorem chosenCayleyRadiusBad_injective_ball + {G : Type*} [Group G] [DecidableEq G] + (A : SoficApproximation G) + (S : Finset G) (w : G → List ↥S) (n r : ℕ) + {x : Fin (A.model n).size} + (hx : x ∉ chosenCayleyRadiusBad A S w n r) : + Set.InjOn (fun g : G => (A.model n).action g x) + (↑(S ^ r) : Set G) := by + exact chosenFiniteRootBad_injective_word_evaluation + A (fun i : ↥S => (i : G)) w (S ^ r) n hx + +end KunActualSoficRootRadius + +namespace KunDirectedIndicatorJensen + +open scoped BigOperators + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def realIndicator {V : Type*} [DecidableEq V] + (T : Finset V) (x : V) : ℝ := + if x ∈ T then 1 else 0 + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def realPermutationMarkov {V ι : Type*} [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) (x : V) : ℝ := + (∑ i : ι, f ((σ i).symm x)) / Fintype.card ι + +private theorem sq_realIndicator_displacement + {V : Type*} [DecidableEq V] + (p : Equiv.Perm V) (T : Finset V) (x : V) : + (realIndicator T (p x) - realIndicator T x) ^ 2 = + (if x ∈ T ∧ p x ∉ T then (1 : ℝ) else 0) + + (if x ∉ T ∧ p x ∈ T then (1 : ℝ) else 0) := by + classical + by_cases hx : x ∈ T <;> by_cases hp : p x ∈ T <;> + simp [realIndicator, hx, hp] + +private theorem sum_sq_realIndicator_displacement + {V : Type*} [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) (T : Finset V) : + (∑ x : V, + (realIndicator T (p x) - realIndicator T x) ^ 2) = + 2 * ((T.filter fun x => p x ∉ T).card : ℝ) := by + classical + simp_rw [sq_realIndicator_displacement] + rw [Finset.sum_add_distrib] + have hleave : + (∑ x : V, + if x ∈ T ∧ p x ∉ T then (1 : ℝ) else 0) = + ((T.filter fun x => p x ∉ T).card : ℝ) := by + rw [← Finset.sum_filter] + simp only [Finset.sum_const, nsmul_eq_mul, mul_one, Nat.cast_inj] + congr 1 + ext x + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + have henter : + (∑ x : V, + if x ∉ T ∧ p x ∈ T then (1 : ℝ) else 0) = + ((Finset.univ.filter fun x => x ∉ T ∧ p x ∈ T).card : ℝ) := by + rw [← Finset.sum_filter] + simp only [Finset.sum_const, nsmul_eq_mul, mul_one] + rw [hleave, henter, + KunThomFiberCoarea.card_entering_eq_card_exiting] + ring + +private theorem sum_sq_realIndicator_inverse_displacement + {V : Type*} [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) (T : Finset V) : + (∑ x : V, + (realIndicator T (p.symm x) - realIndicator T x) ^ 2) = + 2 * ((T.filter fun x => p x ∉ T).card : ℝ) := by + classical + calc + (∑ x : V, + (realIndicator T (p.symm x) - realIndicator T x) ^ 2) = + ∑ x : V, + (realIndicator T (p.symm (p x)) - + realIndicator T (p x)) ^ 2 := by + exact (Equiv.sum_comp p + (fun x : V => + (realIndicator T (p.symm x) - realIndicator T x) ^ 2)).symm + _ = ∑ x : V, + (realIndicator T (p x) - realIndicator T x) ^ 2 := by + apply Finset.sum_congr rfl + intro x _ + rw [p.symm_apply_apply] + ring + _ = 2 * ((T.filter fun x => p x ∉ T).card : ℝ) := + sum_sq_realIndicator_displacement p T + +private theorem sum_sum_sq_realIndicator_inverse_displacement + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (T : Finset V) : + (∑ i : ι, ∑ x : V, + (realIndicator T ((σ i).symm x) - realIndicator T x) ^ 2) = + 2 * (boundary σ T : ℝ) := by + classical + simp_rw [sum_sq_realIndicator_inverse_displacement] + unfold boundary + push_cast + rw [Finset.mul_sum] + +private theorem realPermutationMarkov_sub_sq_le_average_sq + {V ι : Type*} [Fintype ι] [Nonempty ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) (x : V) : + (realPermutationMarkov σ f x - f x) ^ 2 ≤ + (∑ i : ι, + (f ((σ i).symm x) - f x) ^ 2) / + (Fintype.card ι : ℝ) := by + classical + have hd : 0 < (Fintype.card ι : ℝ) := by + exact_mod_cast Fintype.card_pos_iff.mpr + (inferInstance : Nonempty ι) + have hmean : + realPermutationMarkov σ f x - f x = + (∑ i : ι, (f ((σ i).symm x) - f x)) / + (Fintype.card ι : ℝ) := by + unfold realPermutationMarkov + rw [Finset.sum_sub_distrib, Finset.sum_const, + Finset.card_univ, nsmul_eq_mul] + field_simp + have hcauchy : + (∑ i : ι, (f ((σ i).symm x) - f x)) ^ 2 ≤ + (Fintype.card ι : ℝ) * + ∑ i : ι, (f ((σ i).symm x) - f x) ^ 2 := by + simpa only [Finset.card_univ] using + (sq_sum_le_card_mul_sum_sq + (s := Finset.univ) + (f := fun i : ι => f ((σ i).symm x) - f x)) + rw [hmean, div_pow] + calc + (∑ i : ι, (f ((σ i).symm x) - f x)) ^ 2 / + (Fintype.card ι : ℝ) ^ 2 ≤ + ((Fintype.card ι : ℝ) * + ∑ i : ι, (f ((σ i).symm x) - f x) ^ 2) / + (Fintype.card ι : ℝ) ^ 2 := + (div_le_div_iff_of_pos_right (sq_pos_of_pos hd)).mpr hcauchy + _ = (∑ i : ι, + (f ((σ i).symm x) - f x) ^ 2) / + (Fintype.card ι : ℝ) := by + field_simp + +public +theorem realPermutationMarkov_indicator_defect_sq_le_boundary + {V ι : Type*} [Fintype V] [DecidableEq V] + [Fintype ι] [Nonempty ι] + (σ : ι → Equiv.Perm V) (T : Finset V) : + (∑ x : V, + (realPermutationMarkov σ (realIndicator T) x - + realIndicator T x) ^ 2) ≤ + 2 * (boundary σ T : ℝ) / + (Fintype.card ι : ℝ) := by + classical + calc + (∑ x : V, + (realPermutationMarkov σ (realIndicator T) x - + realIndicator T x) ^ 2) ≤ + ∑ x : V, + (∑ i : ι, + (realIndicator T ((σ i).symm x) - + realIndicator T x) ^ 2) / (Fintype.card ι : ℝ) := by + apply Finset.sum_le_sum + intro x _ + exact realPermutationMarkov_sub_sq_le_average_sq + σ (realIndicator T) x + _ = (∑ i : ι, ∑ x : V, + (realIndicator T ((σ i).symm x) - + realIndicator T x) ^ 2) / (Fintype.card ι : ℝ) := by + rw [← Finset.sum_div, Finset.sum_comm] + _ = 2 * (boundary σ T : ℝ) / + (Fintype.card ι : ℝ) := by + rw [sum_sum_sq_realIndicator_inverse_displacement] + +end KunDirectedIndicatorJensen + +namespace KunFinitePermutationMarkovMass + +open scoped BigOperators + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def realIndicator {V : Type*} [DecidableEq V] + (T : Finset V) (x : V) : ℝ := + if x ∈ T then 1 else 0 + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def realPermutationMarkov {V ι : Type*} [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) (x : V) : ℝ := + (Fintype.card ι : ℝ)⁻¹ * ∑ i : ι, f ((σ i).symm x) + +private theorem realPermutationMarkov_nonneg {V ι : Type*} + [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) + (hf : ∀ x, 0 ≤ f x) (x : V) : + 0 ≤ realPermutationMarkov σ f x := by + unfold realPermutationMarkov + exact mul_nonneg (inv_nonneg.mpr (Nat.cast_nonneg _)) + (Finset.sum_nonneg fun i _ => hf ((σ i).symm x)) + +private theorem realPermutationMarkov_le_one {V ι : Type*} + [Fintype ι] [Nonempty ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) + (hf : ∀ x, f x ≤ 1) (x : V) : + realPermutationMarkov σ f x ≤ 1 := by + have hcard : (Fintype.card ι : ℝ) ≠ 0 := by + exact_mod_cast Fintype.card_ne_zero + have hsum : + (∑ i : ι, f ((σ i).symm x)) ≤ ∑ _i : ι, (1 : ℝ) := by + exact Finset.sum_le_sum fun i _ => hf ((σ i).symm x) + calc + realPermutationMarkov σ f x = + (Fintype.card ι : ℝ)⁻¹ * ∑ i : ι, f ((σ i).symm x) := rfl + _ ≤ (Fintype.card ι : ℝ)⁻¹ * ∑ _i : ι, (1 : ℝ) := + mul_le_mul_of_nonneg_left hsum + (inv_nonneg.mpr (Nat.cast_nonneg _)) + _ = 1 := by + simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul, mul_one, ne_eq, hcard, + not_false_eq_true, + inv_mul_cancel₀] + +private theorem sum_realPermutationMarkov {V ι : Type*} + [Fintype V] [Fintype ι] [Nonempty ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) : + (∑ x : V, realPermutationMarkov σ f x) = ∑ x : V, f x := by + classical + have hcard : (Fintype.card ι : ℝ) ≠ 0 := by + exact_mod_cast Fintype.card_ne_zero + calc + (∑ x : V, realPermutationMarkov σ f x) = + (Fintype.card ι : ℝ)⁻¹ * + ∑ i : ι, ∑ x : V, f ((σ i).symm x) := by + simp only [realPermutationMarkov, ← Finset.mul_sum] + rw [Finset.sum_comm] + _ = (Fintype.card ι : ℝ)⁻¹ * + ∑ i : ι, ∑ x : V, f x := by + congr 1 + apply Finset.sum_congr rfl + intro i _ + exact Equiv.sum_comp (σ i).symm f + _ = ∑ x : V, f x := by + simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul, ne_eq, hcard, not_false_eq_true, + inv_mul_cancel_left₀] + +private theorem realPermutationMarkov_iterate_nonneg {V ι : Type*} + [Fintype ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) + (hf : ∀ x, 0 ≤ f x) (k : ℕ) : + ∀ x, 0 ≤ ((realPermutationMarkov σ)^[k]) f x := by + induction k with + | zero => simpa only [Function.iterate_zero, id_eq] using hf + | succ k ih => + intro x + rw [Function.iterate_succ_apply'] + exact realPermutationMarkov_nonneg σ _ ih x + +private theorem realPermutationMarkov_iterate_le_one {V ι : Type*} + [Fintype ι] [Nonempty ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) + (hf : ∀ x, f x ≤ 1) (k : ℕ) : + ∀ x, ((realPermutationMarkov σ)^[k]) f x ≤ 1 := by + induction k with + | zero => simpa only [Function.iterate_zero, id_eq] using hf + | succ k ih => + intro x + rw [Function.iterate_succ_apply'] + exact realPermutationMarkov_le_one σ _ ih x + +private theorem sum_realPermutationMarkov_iterate {V ι : Type*} + [Fintype V] [Fintype ι] [Nonempty ι] + (σ : ι → Equiv.Perm V) (f : V → ℝ) (k : ℕ) : + (∑ x : V, ((realPermutationMarkov σ)^[k]) f x) = + ∑ x : V, f x := by + induction k with + | zero => simp only [Function.iterate_zero, id_eq] + | succ k ih => + rw [Function.iterate_succ_apply'] + exact (sum_realPermutationMarkov σ + (((realPermutationMarkov σ)^[k]) f)).trans ih + +private theorem sum_realIndicator {V : Type*} + [Fintype V] [DecidableEq V] (T : Finset V) : + (∑ x : V, realIndicator T x) = (T.card : ℝ) := by + classical + simp only [realIndicator, Finset.sum_ite_mem, Finset.univ_inter, Finset.sum_const, nsmul_eq_mul, + mul_one] + +public +theorem sum_realPermutationMarkov_iterate_indicator {V ι : Type*} + [Fintype V] [DecidableEq V] [Fintype ι] [Nonempty ι] + (σ : ι → Equiv.Perm V) (T : Finset V) (k : ℕ) : + (∑ x : V, + ((realPermutationMarkov σ)^[k]) (realIndicator T) x) = + (T.card : ℝ) := by + rw [sum_realPermutationMarkov_iterate] + exact sum_realIndicator T + +public +theorem realPermutationMarkov_iterate_indicator_mem_unitInterval + {V ι : Type*} + [DecidableEq V] [Fintype ι] [Nonempty ι] + (σ : ι → Equiv.Perm V) (T : Finset V) (k : ℕ) (x : V) : + 0 ≤ ((realPermutationMarkov σ)^[k]) (realIndicator T) x ∧ + ((realPermutationMarkov σ)^[k]) (realIndicator T) x ≤ 1 := by + constructor + · apply realPermutationMarkov_iterate_nonneg + intro y + by_cases hy : y ∈ T + · simp only [realIndicator, hy, ↓reduceIte, zero_le_one] + · simp only [realIndicator, hy, ↓reduceIte, Std.le_refl] + · apply realPermutationMarkov_iterate_le_one + intro y + by_cases hy : y ∈ T + · simp only [realIndicator, hy, ↓reduceIte, Std.le_refl] + · simp only [realIndicator, hy, ↓reduceIte, zero_le_one] + +end KunFinitePermutationMarkovMass + +namespace KunResidualExpanderDecomposition + +open Filter Topology +open scoped BigOperators symmDiff + +private theorem boundary_eq_sum_indicator {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (A : Finset V) : + boundary σ A = + ∑ i : ι, ∑ x : V, + if x ∈ A ∧ σ i x ∉ A then 1 else 0 := by + classical + unfold boundary + apply Finset.sum_congr rfl + intro i _ + have hfilter : + (A.filter fun x => σ i x ∉ A) = + Finset.univ.filter fun x : V => x ∈ A ∧ σ i x ∉ A := by + ext x + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + rw [hfilter, Finset.card_eq_sum_ones, Finset.sum_filter] + +private theorem boundary_eq_sum_entering_indicator {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (A : Finset V) : + boundary σ A = + ∑ i : ι, ∑ x : V, + if x ∉ A ∧ σ i x ∈ A then 1 else 0 := by + classical + unfold boundary + apply Finset.sum_congr rfl + intro i _ + rw [← KunThomFiberCoarea.card_entering_eq_card_exiting + (σ i) A, Finset.card_eq_sum_ones, Finset.sum_filter] + +public +theorem boundary_complement {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (A : Finset V) : + boundary σ (Finset.univ \ A) = + boundary σ A := by + rw [boundary_eq_sum_indicator σ (Finset.univ \ A), + boundary_eq_sum_entering_indicator σ A] + apply Finset.sum_congr rfl + intro i _ + apply Finset.sum_congr rfl + intro x _ + simp only [Finset.mem_sdiff, Finset.mem_univ, true_and, Decidable.not_not] + +private theorem boundary_le_degree_mul_card {V ι : Type*} + [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (A : Finset V) : + boundary σ A ≤ Fintype.card ι * A.card := by + unfold boundary + calc + (∑ i : ι, (A.filter fun x => σ i x ∉ A).card) ≤ + ∑ _i : ι, A.card := by + apply Finset.sum_le_sum + intro i _ + exact Finset.card_filter_le _ _ + _ = Fintype.card ι * A.card := by + simp only [Finset.sum_const, Finset.card_univ, smul_eq_mul] + +private theorem boundary_inter_add_boundary_sdiff_le {V ι : Type*} + [Finite V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (R U : Finset V) : + boundary σ (R ∩ U) + + boundary σ (R \ U) ≤ + boundary σ R + 2 * boundary σ U := by + classical + let : Fintype V := Fintype.ofFinite V + have hpoint (i : ι) (x : V) : + (if x ∈ R ∩ U ∧ σ i x ∉ R ∩ U then 1 else 0) + + (if x ∈ R \ U ∧ σ i x ∉ R \ U then 1 else 0) ≤ + (if x ∈ R ∧ σ i x ∉ R then 1 else 0) + + (if x ∈ U ∧ σ i x ∉ U then 1 else 0) + + (if x ∉ U ∧ σ i x ∈ U then 1 else 0) := by + by_cases hxR : x ∈ R <;> + by_cases hxU : x ∈ U <;> + by_cases hyR : σ i x ∈ R <;> + by_cases hyU : σ i x ∈ U <;> + simp [hxR, hxU, hyR, hyU] + calc + boundary σ (R ∩ U) + + boundary σ (R \ U) = + ∑ i : ι, ∑ x : V, + ((if x ∈ R ∩ U ∧ σ i x ∉ R ∩ U then 1 else 0) + + (if x ∈ R \ U ∧ σ i x ∉ R \ U then 1 else 0)) := by + rw [boundary_eq_sum_indicator, boundary_eq_sum_indicator] + simp_rw [Finset.sum_add_distrib] + _ ≤ ∑ i : ι, ∑ x : V, + ((if x ∈ R ∧ σ i x ∉ R then 1 else 0) + + (if x ∈ U ∧ σ i x ∉ U then 1 else 0) + + (if x ∉ U ∧ σ i x ∈ U then 1 else 0)) := by + apply Finset.sum_le_sum + intro i _ + apply Finset.sum_le_sum + intro x _ + exact hpoint i x + _ = boundary σ R + + 2 * boundary σ U := by + rw [boundary_eq_sum_indicator σ R, + boundary_eq_sum_indicator σ U] + have henter := boundary_eq_sum_entering_indicator σ U + rw [boundary_eq_sum_indicator σ U] at henter + simp_rw [Finset.sum_add_distrib] + omega + +private theorem exists_minimum_sparse_residual_cut {V ι : Type*} + [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (R : Finset V) (γ : ℝ) + (hsparse : ∃ T : Finset V, T ⊆ R ∧ + (boundary σ T : ℝ) < γ * (T.card : ℝ)) : + ∃ T : Finset V, T ⊆ R ∧ + (boundary σ T : ℝ) < γ * (T.card : ℝ) ∧ + ∀ E : Finset V, E ⊆ R → + (boundary σ E : ℝ) < γ * (E.card : ℝ) → + T.card ≤ E.card := by + classical + let candidates : Finset (Finset V) := + R.powerset.filter fun T => + (boundary σ T : ℝ) < γ * (T.card : ℝ) + have hcandidates : candidates.Nonempty := by + obtain ⟨T, hTR, hT⟩ := hsparse + refine ⟨T, ?_⟩ + simp only [Finset.mem_filter, Finset.mem_powerset, hTR, hT, and_self, candidates] + obtain ⟨T, hT, hminimum⟩ := + Finset.exists_min_image candidates Finset.card hcandidates + have hT' := (Finset.mem_filter.mp hT) + refine ⟨T, Finset.mem_powerset.mp hT'.1, hT'.2, ?_⟩ + intro E hER hE + apply hminimum E + simp only [Finset.mem_filter, Finset.mem_powerset, hER, hE, and_self, candidates] + +private theorem close_residual_inter_properties {V : Type*} [DecidableEq V] + (R T U : Finset V) (hTR : T ⊆ R) + (hclose : 3 * (U ∆ T).card < T.card) : + (R ∩ U).Nonempty ∧ + U.card ≤ 2 * (R ∩ U).card ∧ + (R ∩ U).card < 2 * T.card := by + classical + have hmissing : + (T \ U).card ≤ (U ∆ T).card := + Finset.card_le_card + (Finset.symmDiff_subset_sdiff' (s := U) (t := T)) + have hexcess : + (U \ T).card ≤ (U ∆ T).card := + Finset.card_le_card + (Finset.symmDiff_subset_sdiff (s := U) (t := T)) + have hTinter : + (T ∩ U).card ≤ (R ∩ U).card := by + apply Finset.card_le_card + intro x hx + exact Finset.mem_inter.mpr + ⟨hTR (Finset.mem_inter.mp hx).1, (Finset.mem_inter.mp hx).2⟩ + have hUinter : + (U ∩ T).card ≤ (R ∩ U).card := by + apply Finset.card_le_card + intro x hx + exact Finset.mem_inter.mpr + ⟨hTR (Finset.mem_inter.mp hx).2, (Finset.mem_inter.mp hx).1⟩ + have hTsplit := Finset.card_sdiff_add_card_inter T U + have hUsplit := Finset.card_sdiff_add_card_inter U T + have hintercomm : (T ∩ U).card = (U ∩ T).card := by + rw [Finset.inter_comm] + have hPsub : (R ∩ U).card ≤ U.card := + Finset.card_le_card Finset.inter_subset_right + have hPpos : 0 < (R ∩ U).card := by omega + exact ⟨Finset.card_pos.mp hPpos, by omega, by omega⟩ + +private theorem minimum_sparse_cut_expands_close_residual_part + {V ι : Type*} [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (R T U : Finset V) (γ : ℝ) + (hTR : T ⊆ R) + (hminimum : ∀ E : Finset V, E ⊆ R → + (boundary σ E : ℝ) < γ * (E.card : ℝ) → + T.card ≤ E.card) + (hclose : 3 * (U ∆ T).card < T.card) : + ∀ E : Finset V, E ⊆ R ∩ U → + 2 * E.card ≤ (R ∩ U).card → + γ * (E.card : ℝ) ≤ (boundary σ E : ℝ) := by + intro E hE hhalf + by_contra h + have hbad : + (boundary σ E : ℝ) < γ * (E.card : ℝ) := + lt_of_not_ge h + have hER : E ⊆ R := hE.trans Finset.inter_subset_left + have hmin := hminimum E hER hbad + have hsize := (close_residual_inter_properties R T U hTR hclose).2.2 + omega + +private theorem exists_expanding_residual_finpartition + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (B : Finset V) (γ α : ℝ) + (hα : 0 ≤ α) + (himprove : ∀ T : Finset V, T ⊆ Finset.univ \ B → + (boundary σ T : ℝ) < γ * (T.card : ℝ) → + ∃ U : Finset V, 3 * (U ∆ T).card < T.card ∧ + (boundary σ U : ℝ) ≤ α * (U.card : ℝ)) + (R : Finset V) (hRB : R ⊆ Finset.univ \ B) : + ∃ P : Finpartition R, + (∀ C ∈ P.parts, ∀ E : Finset V, E ⊆ C → + 2 * E.card ≤ C.card → + γ * (E.card : ℝ) ≤ (boundary σ E : ℝ)) ∧ + (∑ C ∈ P.parts, (boundary σ C : ℝ)) ≤ + (boundary σ R : ℝ) + + 4 * α * (R.card : ℝ) := by + classical + have hmain : ∀ R : Finset V, R ⊆ Finset.univ \ B → + ∃ P : Finpartition R, + (∀ C ∈ P.parts, ∀ E : Finset V, E ⊆ C → + 2 * E.card ≤ C.card → + γ * (E.card : ℝ) ≤ + (boundary σ E : ℝ)) ∧ + (∑ C ∈ P.parts, (boundary σ C : ℝ)) ≤ + (boundary σ R : ℝ) + + 4 * α * (R.card : ℝ) := by + intro R + refine Finset.strongInductionOn R ?_ + intro R ih hRgood + by_cases hR : R.Nonempty + · by_cases hsparse : ∃ T : Finset V, T ⊆ R ∧ + (boundary σ T : ℝ) < γ * (T.card : ℝ) + · obtain ⟨T, hTR, hTsparse, hTminimum⟩ := + exists_minimum_sparse_residual_cut σ R γ hsparse + obtain ⟨U, hclose, hUboundary⟩ := + himprove T (hTR.trans hRgood) hTsparse + have hpiece := + close_residual_inter_properties R T U hTR hclose + let C : Finset V := R ∩ U + have hCnonempty : C.Nonempty := by + simpa only [C] using hpiece.1 + have hCR : C ⊆ R := Finset.inter_subset_left + have hstrict : R \ C ⊂ R := + Finset.sdiff_ssubset hCR hCnonempty + have hresgood : R \ C ⊆ Finset.univ \ B := + Finset.Subset.trans Finset.sdiff_subset hRgood + obtain ⟨Q, hQexpand, hQbudget⟩ := + ih (R \ C) hstrict hresgood + have hdisjoint : Disjoint (R \ C) C := + Finset.sdiff_disjoint + have hunion : (R \ C) ⊔ C = R := by + change (R \ C) ∪ C = R + exact Finset.sdiff_union_of_subset hCR + let P : Finpartition R := + Q.extend hCnonempty.ne_empty hdisjoint hunion + have hCnot : C ∉ Q.parts := by + intro hCQ + have hsub := Q.subset hCQ + obtain ⟨x, hx⟩ := hCnonempty + exact (Finset.mem_sdiff.mp (hsub hx)).2 hx + refine ⟨P, ?_, ?_⟩ + · intro D hD E hED hhalf + have hparts : D = C ∨ D ∈ Q.parts := by + simpa [P, Finpartition.extend] using hD + rcases hparts with rfl | hDQ + · exact minimum_sparse_cut_expands_close_residual_part + σ R T U γ hTR hTminimum hclose E + (by simpa only [C] using hED) + (by simpa only [C] using hhalf) + · exact hQexpand D hDQ E hED hhalf + · have hUcard : (U.card : ℝ) ≤ + 2 * (C.card : ℝ) := by + exact_mod_cast hpiece.2.1 + have hUcost : + 2 * (boundary σ U : ℝ) ≤ + 4 * α * (C.card : ℝ) := by + have hscale := mul_le_mul_of_nonneg_left hUcard hα + linarith only [hscale, hUboundary] + have hsplit : + (boundary σ C : ℝ) + + (boundary σ (R \ C) : ℝ) ≤ + (boundary σ R : ℝ) + + 2 * (boundary σ U : ℝ) := by + have h := boundary_inter_add_boundary_sdiff_le σ R U + have hres : R \ C = R \ U := by + ext x + simp only [Finset.sdiff_inter_self_left, Finset.mem_sdiff, C] + simpa only [C, hres, Nat.cast_add, Nat.cast_mul, + Nat.cast_ofNat] using + (show + ((boundary σ (R ∩ U) + + boundary σ (R \ U) : ℕ) : ℝ) ≤ + ((boundary σ R + + 2 * boundary σ U : ℕ) : ℝ) + from by exact_mod_cast h) + have hcard : + ((R \ C).card : ℝ) + (C.card : ℝ) = + (R.card : ℝ) := by + exact_mod_cast Finset.card_sdiff_add_card_eq_card hCR + calc + (∑ D ∈ P.parts, (boundary σ D : ℝ)) = + (boundary σ C : ℝ) + + ∑ D ∈ Q.parts, + (boundary σ D : ℝ) := by + simp only [Finpartition.extend, hCnot, not_false_eq_true, Finset.sum_insert, P] + _ ≤ (boundary σ C : ℝ) + + ((boundary σ (R \ C) : ℝ) + + 4 * α * ((R \ C).card : ℝ)) := + add_le_add (le_refl _) hQbudget + _ ≤ (boundary σ R : ℝ) + + 2 * (boundary σ U : ℝ) + + 4 * α * ((R \ C).card : ℝ) := by + linarith + _ ≤ (boundary σ R : ℝ) + + 4 * α * (C.card : ℝ) + + 4 * α * ((R \ C).card : ℝ) := by + linarith + _ = (boundary σ R : ℝ) + + 4 * α * (R.card : ℝ) := by + linear_combination (4 * α) * hcard + · refine ⟨Finpartition.indiscrete hR.ne_empty, ?_, ?_⟩ + · intro C hC E hEC _ + have hCR : C = R := by + simpa only [Finpartition.indiscrete, Finset.mem_singleton] using hC + subst C + by_contra h + apply hsparse + exact ⟨E, hEC, lt_of_not_ge h⟩ + · simp only [Finpartition.indiscrete, Finset.sum_singleton] + have hnonneg : 0 ≤ 4 * α * (R.card : ℝ) := by + positivity + linarith + · have hzero : R = ∅ := + Finset.not_nonempty_iff_eq_empty.mp hR + subst R + refine ⟨Finpartition.empty (Finset V), ?_, ?_⟩ + · simp only [Finpartition.empty_parts, Finset.notMem_empty, IsEmpty.forall_iff, implies_true] + · simp only [Finpartition.empty_parts, boundary, Nat.cast_sum, Finset.sum_empty, + Finset.notMem_empty, + not_false_eq_true, Finset.filter_empty, Finset.card_empty, Finset.sum_const_zero, + CharP.cast_eq_zero, mul_zero, + add_zero, Std.le_refl] + exact hmain R hRB + +private theorem exists_expanding_clean_finpartition + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (B : Finset V) (γ α : ℝ) + (hα : 0 ≤ α) + (himprove : ∀ T : Finset V, T ⊆ Finset.univ \ B → + (boundary σ T : ℝ) < γ * (T.card : ℝ) → + ∃ U : Finset V, 3 * (U ∆ T).card < T.card ∧ + (boundary σ U : ℝ) ≤ α * (U.card : ℝ)) : + ∃ P : Finpartition (Finset.univ \ B), + (∀ C ∈ P.parts, ∀ E : Finset V, E ⊆ C → + 2 * E.card ≤ C.card → + γ * (E.card : ℝ) ≤ (boundary σ E : ℝ)) ∧ + (∑ C ∈ P.parts, (boundary σ C : ℝ)) ≤ + (Fintype.card ι : ℝ) * (B.card : ℝ) + + 4 * α * ((Finset.univ \ B).card : ℝ) := by + obtain ⟨P, hP, hbudget⟩ := + exists_expanding_residual_finpartition σ B γ α hα himprove + (Finset.univ \ B) (Finset.Subset.refl _) + refine ⟨P, hP, ?_⟩ + calc + (∑ C ∈ P.parts, (boundary σ C : ℝ)) ≤ + (boundary σ (Finset.univ \ B) : ℝ) + + 4 * α * ((Finset.univ \ B).card : ℝ) := hbudget + _ = (boundary σ B : ℝ) + + 4 * α * ((Finset.univ \ B).card : ℝ) := by + rw [boundary_complement] + _ ≤ (Fintype.card ι : ℝ) * (B.card : ℝ) + + 4 * α * ((Finset.univ \ B).card : ℝ) := by + have hdegree := boundary_le_degree_mul_card σ B + have hdegreeReal : + (boundary σ B : ℝ) ≤ + (Fintype.card ι : ℝ) * (B.card : ℝ) := by + exact_mod_cast hdegree + linarith + +private noncomputable def completeCleanFinpartition + {V : Type*} [Fintype V] [DecidableEq V] + (B : Finset V) (P : Finpartition (Finset.univ \ B)) : + Finpartition (Finset.univ : Finset V) := by + classical + let parts : Finset (Finset V) := + P.parts ∪ (⊥ : Finpartition B).parts + refine Finpartition.ofExistsUnique parts ?_ ?_ ?_ + · intro C _ + exact Finset.subset_univ C + · intro x _ + by_cases hx : x ∈ B + · refine ⟨{x}, ⟨?_, by simp only [Finset.mem_singleton]⟩, ?_⟩ + · exact Finset.mem_union_right _ + (Finpartition.mem_bot_iff.mpr ⟨x, hx, rfl⟩) + · intro C hC + obtain ⟨hpart, hxC⟩ := hC + rcases Finset.mem_union.mp hpart with hclean | hbad + · have hxc := P.subset hclean hxC + exact ((Finset.mem_sdiff.mp hxc).2 hx).elim + · obtain ⟨y, _, hy⟩ := Finpartition.mem_bot_iff.mp hbad + subst C + simp only [Finset.mem_singleton] at hxC + subst y + rfl + · have hxclean : x ∈ (Finset.univ \ B : Finset V) := by + simp only [Finset.mem_sdiff, Finset.mem_univ, hx, not_false_eq_true, and_self] + obtain ⟨C, ⟨hCP, hxC⟩, hunique⟩ := + P.existsUnique_mem hxclean + refine ⟨C, ⟨Finset.mem_union_left _ hCP, hxC⟩, ?_⟩ + intro D hD + obtain ⟨hpart, hxD⟩ := hD + rcases Finset.mem_union.mp hpart with hclean | hbad + · exact hunique D ⟨hclean, hxD⟩ + · obtain ⟨y, hyB, hy⟩ := Finpartition.mem_bot_iff.mp hbad + subst D + simp only [Finset.mem_singleton] at hxD + exact (hx (hxD.symm ▸ hyB)).elim + · intro hempty + rcases Finset.mem_union.mp hempty with hclean | hbad + · exact P.empty_notMem_parts hclean + · obtain ⟨x, _, hx⟩ := Finpartition.mem_bot_iff.mp hbad + simp only [Finset.singleton_ne_empty] at hx + +@[simp] +private theorem completeCleanFinpartition_parts + {V : Type*} [Fintype V] [DecidableEq V] + (B : Finset V) (P : Finpartition (Finset.univ \ B)) : + (completeCleanFinpartition B P).parts = + P.parts ∪ (⊥ : Finpartition B).parts := by + rfl + +private theorem disjoint_clean_parts_singleton_bad_parts + {V : Type*} [Fintype V] [DecidableEq V] + (B : Finset V) (P : Finpartition (Finset.univ \ B)) : + Disjoint P.parts (⊥ : Finpartition B).parts := by + apply Finset.disjoint_left.mpr + intro C hCP hCB + obtain ⟨x, hxB, hxC⟩ := Finpartition.mem_bot_iff.mp hCB + subst C + have hxclean := P.subset hCP (Finset.mem_singleton_self x) + exact (Finset.mem_sdiff.mp hxclean).2 hxB + +private theorem sum_singleton_bad_boundary_le + {V ι : Type*} [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (B : Finset V) : + (∑ C ∈ (⊥ : Finpartition B).parts, + (boundary σ C : ℝ)) ≤ + (Fintype.card ι : ℝ) * (B.card : ℝ) := by + classical + calc + (∑ C ∈ (⊥ : Finpartition B).parts, + (boundary σ C : ℝ)) = + ∑ x ∈ B, (boundary σ {x} : ℝ) := by + simp only [Finpartition.parts_bot, Finset.sum_map, Function.Embedding.coeFn_mk] + _ ≤ ∑ _x ∈ B, (Fintype.card ι : ℝ) := by + apply Finset.sum_le_sum + intro x _ + have h := boundary_le_degree_mul_card σ ({x} : Finset V) + have h' : + boundary σ ({x} : Finset V) ≤ + Fintype.card ι := by + simpa only [Finset.card_singleton, mul_one] using h + exact_mod_cast h' + _ = (Fintype.card ι : ℝ) * (B.card : ℝ) := by + simp only [Finset.sum_const, nsmul_eq_mul, mul_comm] + +private theorem completeCleanFinpartition_half_expansion + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (B : Finset V) + (P : Finpartition (Finset.univ \ B)) (γ : ℝ) + (hexpand : ∀ C ∈ P.parts, ∀ E : Finset V, E ⊆ C → + 2 * E.card ≤ C.card → + γ * (E.card : ℝ) ≤ (boundary σ E : ℝ)) : + ∀ C ∈ (completeCleanFinpartition B P).parts, + ∀ E : Finset V, E ⊆ C → + 2 * E.card ≤ C.card → + γ * (E.card : ℝ) ≤ (boundary σ E : ℝ) := by + classical + intro C hC E hEC hhalf + rw [completeCleanFinpartition_parts] at hC + rcases Finset.mem_union.mp hC with hclean | hbad + · exact hexpand C hclean E hEC hhalf + · obtain ⟨x, _, hx⟩ := Finpartition.mem_bot_iff.mp hbad + subst C + have hE : E = ∅ := by + apply Finset.card_eq_zero.mp + simp only [Finset.card_singleton] at hhalf + omega + subst E + simp only [Finset.card_empty, CharP.cast_eq_zero, mul_zero, boundary, Finset.notMem_empty, + not_false_eq_true, + Finset.filter_empty, Finset.sum_const_zero, Std.le_refl] + +private theorem exists_expanding_full_finpartition + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (B : Finset V) (γ α : ℝ) + (hα : 0 ≤ α) + (himprove : ∀ T : Finset V, T ⊆ Finset.univ \ B → + (boundary σ T : ℝ) < γ * (T.card : ℝ) → + ∃ U : Finset V, 3 * (U ∆ T).card < T.card ∧ + (boundary σ U : ℝ) ≤ α * (U.card : ℝ)) : + ∃ P : Finpartition (Finset.univ : Finset V), + (∀ C ∈ P.parts, ∀ E : Finset V, E ⊆ C → + 2 * E.card ≤ C.card → + γ * (E.card : ℝ) ≤ (boundary σ E : ℝ)) ∧ + (∑ C ∈ P.parts, (boundary σ C : ℝ)) ≤ + 2 * (Fintype.card ι : ℝ) * (B.card : ℝ) + + 4 * α * (Fintype.card V : ℝ) := by + classical + obtain ⟨Q, hQexpand, hQbudget⟩ := + exists_expanding_clean_finpartition σ B γ α hα himprove + let P : Finpartition (Finset.univ : Finset V) := + completeCleanFinpartition B Q + refine ⟨P, ?_, ?_⟩ + · exact completeCleanFinpartition_half_expansion + σ B Q γ hQexpand + · have hbad := sum_singleton_bad_boundary_le σ B + have hdisjoint := + disjoint_clean_parts_singleton_bad_parts B Q + have hclean : + ((Finset.univ \ B).card : ℝ) ≤ + (Fintype.card V : ℝ) := by + exact_mod_cast + (Finset.card_le_card + (Finset.sdiff_subset : + Finset.univ \ B ⊆ (Finset.univ : Finset V))) + have hscaled := mul_le_mul_of_nonneg_left hclean + (mul_nonneg (by norm_num : (0 : ℝ) ≤ 4) hα) + calc + (∑ C ∈ P.parts, (boundary σ C : ℝ)) = + (∑ C ∈ Q.parts, (boundary σ C : ℝ)) + + (∑ C ∈ (⊥ : Finpartition B).parts, + (boundary σ C : ℝ)) := by + change + (∑ C ∈ (completeCleanFinpartition B Q).parts, + (boundary σ C : ℝ)) = _ + rw [completeCleanFinpartition_parts, + Finset.sum_union hdisjoint] + _ ≤ ((Fintype.card ι : ℝ) * (B.card : ℝ) + + 4 * α * ((Finset.univ \ B).card : ℝ)) + + (Fintype.card ι : ℝ) * (B.card : ℝ) := + add_le_add hQbudget hbad + _ ≤ 2 * (Fintype.card ι : ℝ) * (B.card : ℝ) + + 4 * α * (Fintype.card V : ℝ) := by + nlinarith + +public +theorem exists_expanding_full_finpartition_sequence + (ι : Type*) [Fintype ι] + (V : ℕ → Type*) + [∀ n, Fintype (V n)] + [∀ n, Nonempty (V n)] + [∀ n, DecidableEq (V n)] + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (B : (n : ℕ) → Finset (V n)) + (γ : ℝ) (hγ : 0 < γ) + (α : ℕ → ℝ) + (hα : ∀ n, 0 ≤ α n) + (hαzero : Tendsto α atTop (nhds 0)) + (hbad : Tendsto + (fun n => ((B n).card : ℝ) / Fintype.card (V n)) + atTop (nhds 0)) + (himprove : ∀ n (T : Finset (V n)), + T ⊆ Finset.univ \ B n → + (boundary (σ n) T : ℝ) < + γ * (T.card : ℝ) → + ∃ U : Finset (V n), 3 * (U ∆ T).card < T.card ∧ + (boundary (σ n) U : ℝ) ≤ + α n * (U.card : ℝ)) : + ∃ P : (n : ℕ) → Finpartition (Finset.univ : Finset (V n)), + 0 < γ ∧ + (∀ n, ∀ C ∈ (P n).parts, ∀ E : Finset (V n), E ⊆ C → + 2 * E.card ≤ C.card → + γ * (E.card : ℝ) ≤ + (boundary (σ n) E : ℝ)) ∧ + Tendsto + (fun n => + (∑ C ∈ (P n).parts, + (boundary (σ n) C : ℝ)) / + Fintype.card (V n)) + atTop (nhds 0) := by + classical + have hchoose (n : ℕ) := + exists_expanding_full_finpartition + (σ n) (B n) γ (α n) (hα n) (himprove n) + let P : (n : ℕ) → Finpartition (Finset.univ : Finset (V n)) := + fun n => (hchoose n).choose + have hexpand (n : ℕ) : + ∀ C ∈ (P n).parts, ∀ E : Finset (V n), E ⊆ C → + 2 * E.card ≤ C.card → + γ * (E.card : ℝ) ≤ + (boundary (σ n) E : ℝ) := + (hchoose n).choose_spec.1 + have hbudget (n : ℕ) : + (∑ C ∈ (P n).parts, + (boundary (σ n) C : ℝ)) ≤ + 2 * (Fintype.card ι : ℝ) * ((B n).card : ℝ) + + 4 * α n * (Fintype.card (V n) : ℝ) := + (hchoose n).choose_spec.2 + have hpositive (n : ℕ) : + (0 : ℝ) < Fintype.card (V n) := by + exact_mod_cast Fintype.card_pos_iff.mpr inferInstance + have hupper (n : ℕ) : + (∑ C ∈ (P n).parts, + (boundary (σ n) C : ℝ)) / + Fintype.card (V n) ≤ + (2 * (Fintype.card ι : ℝ)) * + (((B n).card : ℝ) / Fintype.card (V n)) + + 4 * α n := by + calc + (∑ C ∈ (P n).parts, + (boundary (σ n) C : ℝ)) / + Fintype.card (V n) ≤ + (2 * (Fintype.card ι : ℝ) * ((B n).card : ℝ) + + 4 * α n * (Fintype.card (V n) : ℝ)) / + Fintype.card (V n) := + div_le_div_of_nonneg_right (hbudget n) + (hpositive n).le + _ = (2 * (Fintype.card ι : ℝ)) * + (((B n).card : ℝ) / Fintype.card (V n)) + + 4 * α n := by + field_simp [(hpositive n).ne'] + have hlimit : Tendsto + (fun n => + (2 * (Fintype.card ι : ℝ)) * + (((B n).card : ℝ) / Fintype.card (V n)) + + 4 * α n) + atTop (nhds 0) := by + simpa only [mul_zero, add_zero] using (hbad.const_mul (2 * (Fintype.card ι : ℝ))).add + (hαzero.const_mul 4) + refine ⟨P, hγ, hexpand, ?_⟩ + exact squeeze_zero + (fun n => div_nonneg + (Finset.sum_nonneg fun C _ => Nat.cast_nonneg _) + (hpositive n).le) + hupper hlimit + +public +theorem original_boundary_le_completed_add_component_boundary + {V ι : Type*} [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (C : Finset V) + (τ : ι → Equiv.Perm {x : V // x ∈ C}) + (hτ : ∀ i (x : V) (hx : x ∈ C) (_hy : σ i x ∈ C), + ((τ i ⟨x, hx⟩ : {x : V // x ∈ C}) : V) = σ i x) + (A : Finset {x : V // x ∈ C}) : + boundary σ + (A.map (Function.Embedding.subtype (fun x : V => x ∈ C))) ≤ + boundary τ A + + boundary σ C := by + classical + let E : Finset V := + A.map (Function.Embedding.subtype (fun x : V => x ∈ C)) + change + (∑ i : ι, (E.filter fun x => σ i x ∉ E).card) ≤ + (∑ i : ι, (A.filter fun x => τ i x ∉ A).card) + + ∑ i : ι, (C.filter fun x => σ i x ∉ C).card + calc + (∑ i : ι, (E.filter fun x => σ i x ∉ E).card) ≤ + ∑ i : ι, + ((A.filter fun x => τ i x ∉ A).card + + (C.filter fun x => σ i x ∉ C).card) := by + apply Finset.sum_le_sum + intro i _ + let F : Finset V := + (A.filter fun x => τ i x ∉ A).map + (Function.Embedding.subtype (fun x : V => x ∈ C)) + let D : Finset V := C.filter fun x => σ i x ∉ C + have hsub : + (E.filter fun x => σ i x ∉ E) ⊆ F ∪ D := by + intro x hx + obtain ⟨hxE, hxout⟩ := Finset.mem_filter.mp hx + obtain ⟨z, hzA, rfl⟩ := Finset.mem_map.mp hxE + by_cases hzinternal : σ i (z : V) ∈ C + · have hnot : τ i z ∉ A := by + intro hmem + apply hxout + apply Finset.mem_map.mpr + refine ⟨τ i z, hmem, ?_⟩ + exact hτ i (z : V) z.property hzinternal + apply Finset.mem_union_left + exact Finset.mem_map.mpr + ⟨z, Finset.mem_filter.mpr ⟨hzA, hnot⟩, rfl⟩ + · apply Finset.mem_union_right + exact Finset.mem_filter.mpr ⟨z.property, hzinternal⟩ + calc + (E.filter fun x => σ i x ∉ E).card ≤ + (F ∪ D).card := + Finset.card_le_card hsub + _ ≤ F.card + D.card := + Finset.card_union_le F D + _ = (A.filter fun x => τ i x ∉ A).card + + (C.filter fun x => σ i x ∉ C).card := by + simp only [Finset.card_map, F, D] + _ = (∑ i : ι, (A.filter fun x => τ i x ∉ A).card) + + ∑ i : ι, (C.filter fun x => σ i x ∉ C).card := by + rw [Finset.sum_add_distrib] + +public +theorem completed_component_additive_expansion + {V ι : Type*} [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (C : Finset V) + (τ : ι → Equiv.Perm {x : V // x ∈ C}) + (hτ : ∀ i (x : V) (hx : x ∈ C) (_hy : σ i x ∈ C), + ((τ i ⟨x, hx⟩ : {x : V // x ∈ C}) : V) = σ i x) + (γ : ℝ) + (hexpand : ∀ E : Finset V, E ⊆ C → + 2 * E.card ≤ C.card → + γ * (E.card : ℝ) ≤ (boundary σ E : ℝ)) : + ∀ A : Finset {x : V // x ∈ C}, + γ * min (A.card : ℝ) ((C.card : ℝ) - A.card) - + (boundary σ C : ℝ) ≤ + (boundary τ A : ℝ) := by + classical + have hhalf (A : Finset {x : V // x ∈ C}) + (hA : 2 * A.card ≤ C.card) : + γ * (A.card : ℝ) - + (boundary σ C : ℝ) ≤ + (boundary τ A : ℝ) := by + let E : Finset V := + A.map (Function.Embedding.subtype (fun x : V => x ∈ C)) + have hEC : E ⊆ C := by + intro x hx + exact Finset.property_of_mem_map_subtype A hx + have hEcard : E.card = A.card := by + dsimp [E] + exact Finset.card_map _ + have hEhalf : 2 * E.card ≤ C.card := by + simpa only [hEcard] using hA + have hsource := hexpand E hEC hEhalf + have hboundary : + (boundary σ E : ℝ) ≤ + (boundary τ A : ℝ) + + (boundary σ C : ℝ) := by + have h := + original_boundary_le_completed_add_component_boundary + σ C τ hτ A + change + ((boundary σ E : ℕ) : ℝ) ≤ _ + exact_mod_cast h + rw [hEcard] at hsource + linarith + intro A + by_cases hA : 2 * A.card ≤ C.card + · have hreal : + (2 : ℝ) * (A.card : ℝ) ≤ (C.card : ℝ) := by + exact_mod_cast hA + rw [min_eq_left (by linarith)] + exact hhalf A hA + · let D : Finset {x : V // x ∈ C} := Finset.univ \ A + have hcard : + D.card + A.card = C.card := by + dsimp [D] + have h := + Finset.card_sdiff_add_card_eq_card + (Finset.subset_univ A) + simpa only [Finset.univ_eq_attach, Finset.card_attach] using h + have hDhalf : 2 * D.card ≤ C.card := by + omega + have hD := hhalf D hDhalf + have hDreal : + (D.card : ℝ) = (C.card : ℝ) - (A.card : ℝ) := by + have hreal : + (D.card : ℝ) + (A.card : ℝ) = (C.card : ℝ) := by + exact_mod_cast hcard + linarith + have hreal : + (C.card : ℝ) < 2 * (A.card : ℝ) := by + exact_mod_cast Nat.lt_of_not_ge hA + rw [min_eq_right (by linarith)] + rw [hDreal] at hD + have hcomplement : + boundary τ D = + boundary τ A := by + simpa only [D] using boundary_complement τ A + rw [hcomplement] at hD + exact hD + +end KunResidualExpanderDecomposition + +namespace KunDiagonalGoodRootGraphLoss + +open scoped BigOperators symmDiff + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def goodPermutationGraph {V : Type*} [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) (B : Finset V) : Finset (V × V) := + (permutationGraph p).filter + (fun z => z.1 ∉ B ∧ z.2 ∉ B) + +public +theorem goodPermutationGraph_subset {V : Type*} + [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) (B : Finset V) : + goodPermutationGraph p B ⊆ permutationGraph p := + Finset.filter_subset _ _ + +private theorem card_filter_permutationGraph_proj_mem {V : Type*} + [Fintype V] [DecidableEq V] + (π : V × V → V) (p : Equiv.Perm V) (w : V → V × V) + (hmem : ∀ x, w x ∈ permutationGraph p) + (hproj : ∀ x, π (w x) = x) + (hpoint : ∀ z ∈ permutationGraph p, w (π z) = z) + (B : Finset V) : + ((permutationGraph p).filter + fun z => π z ∈ B).card = B.card := by + classical + apply Finset.card_bij (fun z _ => π z) + · intro z hz + exact (Finset.mem_filter.mp hz).2 + · intro z hz w' hw' hproj' + rw [← hpoint z (Finset.mem_filter.mp hz).1, + ← hpoint w' (Finset.mem_filter.mp hw').1, hproj'] + · intro x hx + exact ⟨w x, Finset.mem_filter.mpr + ⟨hmem x, by rw [hproj x]; exact hx⟩, hproj x⟩ + +private theorem card_filter_permutationGraph_fst_mem {V : Type*} + [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) (B : Finset V) : + ((permutationGraph p).filter + fun z => z.1 ∈ B).card = B.card := + card_filter_permutationGraph_proj_mem Prod.fst p (fun y => (y, p y)) + (fun y => (mem_permutationGraph p y (p y)).mpr rfl) + (fun _ => rfl) + (fun z hz => Prod.ext rfl + ((mem_permutationGraph p z.1 z.2).mp hz).symm) + B + +private theorem card_filter_permutationGraph_snd_mem {V : Type*} + [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) (B : Finset V) : + ((permutationGraph p).filter + fun z => z.2 ∈ B).card = B.card := + card_filter_permutationGraph_proj_mem Prod.snd p (fun y => (p.symm y, y)) + (fun y => (mem_permutationGraph p (p.symm y) y).mpr + (p.apply_symm_apply y).symm) + (fun _ => rfl) + (fun z hz => Prod.ext + (by rw [(mem_permutationGraph p z.1 z.2).mp hz, + p.symm_apply_apply]) + rfl) + B + +private theorem permutationGraph_sdiff_goodPermutationGraph_subset {V : Type*} + [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) (B : Finset V) : + permutationGraph p \ goodPermutationGraph p B ⊆ + ((permutationGraph p).filter fun z => z.1 ∈ B) ∪ + ((permutationGraph p).filter fun z => z.2 ∈ B) := by + intro z hz + obtain ⟨hzgraph, hzgood⟩ := Finset.mem_sdiff.mp hz + by_cases hfirst : z.1 ∈ B + · exact Finset.mem_union_left _ + (Finset.mem_filter.mpr ⟨hzgraph, hfirst⟩) + · have hsecond : z.2 ∈ B := by + by_contra h + apply hzgood + exact Finset.mem_filter.mpr ⟨hzgraph, hfirst, h⟩ + exact Finset.mem_union_right _ + (Finset.mem_filter.mpr ⟨hzgraph, hsecond⟩) + +public +theorem card_permutationGraph_sdiff_goodPermutationGraph_le {V : Type*} + [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) (B : Finset V) : + (permutationGraph p \ goodPermutationGraph p B).card ≤ + 2 * B.card := by + calc + (permutationGraph p \ goodPermutationGraph p B).card ≤ + (((permutationGraph p).filter fun z => z.1 ∈ B) ∪ + ((permutationGraph p).filter + fun z => z.2 ∈ B)).card := + Finset.card_le_card + (permutationGraph_sdiff_goodPermutationGraph_subset p B) + _ ≤ ((permutationGraph p).filter + fun z => z.1 ∈ B).card + + ((permutationGraph p).filter + fun z => z.2 ∈ B).card := Finset.card_union_le _ _ + _ = 2 * B.card := by + rw [card_filter_permutationGraph_fst_mem, + card_filter_permutationGraph_snd_mem] + omega + +private theorem card_goodPermutationGraph_add_graph_loss {V : Type*} + [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) (B : Finset V) : + (permutationGraph p \ goodPermutationGraph p B).card + + (goodPermutationGraph p B).card = Fintype.card V := by + calc + (permutationGraph p \ goodPermutationGraph p B).card + + (goodPermutationGraph p B).card = + (permutationGraph p).card := + Finset.card_sdiff_add_card_eq_card + (goodPermutationGraph_subset p B) + _ = Fintype.card V := + KunThomFiberCoarea.permutationGraph_card p + +public +theorem card_goodPermutationGraph_ge_card_sub_twice_bad {V : Type*} + [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) (B : Finset V) : + (Fintype.card V : ℝ) - 2 * (B.card : ℝ) ≤ + ((goodPermutationGraph p B).card : ℝ) := by + have hloss : + (((permutationGraph p \ + goodPermutationGraph p B).card : ℕ) : ℝ) ≤ + 2 * (B.card : ℝ) := by + exact_mod_cast card_permutationGraph_sdiff_goodPermutationGraph_le p B + have htotal : + (((permutationGraph p \ + goodPermutationGraph p B).card : ℕ) : ℝ) + + ((goodPermutationGraph p B).card : ℝ) = + (Fintype.card V : ℝ) := by + exact_mod_cast card_goodPermutationGraph_add_graph_loss p B + linarith + +public +theorem boundary_goodPermutationGraph_le_commutationDefect_add {V ι : Type*} + [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (p : Equiv.Perm V) (B : Finset V) : + boundary + (fun i => (σ i).prodCongr (σ i)) (goodPermutationGraph p B) ≤ + permutationCommutationDefect σ p + + 2 * Fintype.card ι * B.card := by + have hboundary := + KunThomFiberCoarea.boundary_le_boundary_add_sdiff + (fun i => (σ i).prodCongr (σ i)) + (goodPermutationGraph p B) (permutationGraph p) + rw [boundary_permutationGraph_eq_commutationDefect, + Finset.sdiff_eq_empty_iff_subset.mpr + (goodPermutationGraph_subset p B), + Finset.card_empty, zero_add] at hboundary + calc + boundary + (fun i => (σ i).prodCongr (σ i)) (goodPermutationGraph p B) ≤ + permutationCommutationDefect σ p + + Fintype.card ι * + (permutationGraph p \ + goodPermutationGraph p B).card := hboundary + _ ≤ permutationCommutationDefect σ p + + Fintype.card ι * (2 * B.card) := by + gcongr + exact card_permutationGraph_sdiff_goodPermutationGraph_le p B + _ = permutationCommutationDefect σ p + + 2 * Fintype.card ι * B.card := by + ring + +end KunDiagonalGoodRootGraphLoss + +namespace KunCompletedPrunedComponent + +open scoped BigOperators + +public +theorem hasAlmostCentralizerImprovement_zero + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) : + HasAlmostCentralizerImprovement σ 0 := by + refine ⟨fun p hp => ⟨p, ?_, ?_⟩⟩ + · simpa only [nonpos_iff_eq_zero, mul_zero] using hp + · simp only [permutationDistance_self, mul_zero, zero_le] + + +private theorem boundary_expansion_of_half + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (h : ℝ) + (hhalf : ∀ A : Finset V, + 2 * A.card ≤ Fintype.card V → + h * (A.card : ℝ) ≤ (boundary σ A : ℝ)) : + ∀ A : Finset V, + h * min (A.card : ℝ) + ((Fintype.card V : ℝ) - A.card) ≤ + (boundary σ A : ℝ) := by + classical + intro A + by_cases hA : 2 * A.card ≤ Fintype.card V + · have hAreal : + (2 : ℝ) * A.card ≤ (Fintype.card V : ℝ) := by + exact_mod_cast hA + rw [min_eq_left (by linarith)] + exact hhalf A hA + · let C : Finset V := Finset.univ \ A + have hcard : C.card + A.card = Fintype.card V := by + dsimp [C] + simpa only [Finset.card_univ] using (Finset.card_sdiff_add_card_eq_card (Finset.subset_univ + A)) + have hChalf : 2 * C.card ≤ Fintype.card V := by + omega + have hC := hhalf C hChalf + have hAreal : + (Fintype.card V : ℝ) < (2 : ℝ) * A.card := by + exact_mod_cast Nat.lt_of_not_ge hA + have hCreal : + (C.card : ℝ) = (Fintype.card V : ℝ) - A.card := by + have hcardReal : + (C.card : ℝ) + A.card = (Fintype.card V : ℝ) := by + exact_mod_cast hcard + linarith + rw [min_eq_right (by linarith)] + rw [hCreal] at hC + simpa [C, KunResidualExpanderDecomposition.boundary_complement] using hC + +private theorem inducedBoundary_le_completed_boundary + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (B Z : Finset V) + (hZ : Z = Finset.univ \ B) + (τ : ι → Equiv.Perm {x : V // x ∈ Z}) + (hτ : ∀ i (x : V) (hx : x ∈ Z) (_hy : σ i x ∈ Z), + ((τ i ⟨x, hx⟩ : {x : V // x ∈ Z}) : V) = σ i x) + (A : Finset {x : V // x ∈ Z}) : + inducedBoundary σ B + (A.map (Function.Embedding.subtype (fun x : V => x ∈ Z))) ≤ + boundary τ A := by + classical + let E : Finset V := + A.map (Function.Embedding.subtype (fun x : V => x ∈ Z)) + have hmemZ (x : V) : x ∈ Z ↔ x ∉ B := by + rw [hZ] + simp only [Finset.mem_sdiff, Finset.mem_univ, true_and] + change + (∑ i : ι, + (E.filter fun x => σ i x ∉ B ∧ σ i x ∉ E).card) ≤ + ∑ i : ι, (A.filter fun x => τ i x ∉ A).card + apply Finset.sum_le_sum + intro i _ + have hsub : + (E.filter fun x => σ i x ∉ B ∧ σ i x ∉ E) ⊆ + (A.filter fun x => τ i x ∉ A).map + (Function.Embedding.subtype (fun x : V => x ∈ Z)) := by + intro x hx + obtain ⟨hxE, hxB, hxout⟩ := Finset.mem_filter.mp hx + obtain ⟨z, hzA, rfl⟩ := Finset.mem_map.mp hxE + have himage : σ i (z : V) ∈ Z := + (hmemZ (σ i (z : V))).2 hxB + have hnot : τ i z ∉ A := by + intro hmem + apply hxout + exact Finset.mem_map.mpr + ⟨τ i z, hmem, hτ i (z : V) z.property himage⟩ + exact Finset.mem_map.mpr + ⟨z, Finset.mem_filter.mpr ⟨hzA, hnot⟩, rfl⟩ + calc + (E.filter fun x => σ i x ∉ B ∧ σ i x ∉ E).card ≤ + ((A.filter fun x => τ i x ∉ A).map + (Function.Embedding.subtype (fun x : V => x ∈ Z))).card := + Finset.card_le_card hsub + _ = (A.filter fun x => τ i x ∉ A).card := + Finset.card_map _ + +public +theorem exists_completed_pruned_expander + {V ι : Type*} [Fintype V] [Fintype ι] [DecidableEq V] + (σ : ι → Equiv.Perm V) (γ ell a : ℝ) + (hgap : ell < γ) + (hadd : ∀ A : Finset V, + γ * min (A.card : ℝ) + ((Fintype.card V : ℝ) - (A.card : ℝ)) - + a * (Fintype.card V : ℝ) ≤ + (boundary σ A : ℝ)) + (hsmall : + 2 * a * (2 * (γ - ell) + (Fintype.card ι : ℝ)) ≤ + (γ - ell) ^ 2) : + ∃ (B : Finset V) + (τ : ι → Equiv.Perm + {x : V // x ∈ (Finset.univ \ B)}), + 2 * B.card ≤ Fintype.card V ∧ + (B.card : ℝ) ≤ + a * (Fintype.card V : ℝ) / (γ - ell) ∧ + (∀ i (x : V) (hx : x ∈ Finset.univ \ B) + (_hy : σ i x ∈ Finset.univ \ B), + ((τ i ⟨x, hx⟩ : + {x : V // x ∈ Finset.univ \ B}) : V) = σ i x) ∧ + ∀ A : Finset {x : V // x ∈ Finset.univ \ B}, + ell * min (A.card : ℝ) + ((Fintype.card {x : V // x ∈ Finset.univ \ B} : ℝ) - + A.card) ≤ (boundary τ A : ℝ) := by + classical + obtain ⟨B, hBhalf, hBsize, hprune⟩ := + exists_pruned_expander σ γ ell a hgap hadd hsmall + let Z : Finset V := Finset.univ \ B + have hZ : Z = Finset.univ \ B := rfl + choose τ hτ using + (fun i : ι => + exists_completion_of_internal_permutation + (σ i) Z) + have hcardZ : + Fintype.card {x : V // x ∈ Z} = + Fintype.card V - B.card := by + rw [Fintype.card_coe] + dsimp [Z] + exact Finset.card_sdiff_of_subset (Finset.subset_univ B) + have hexp : + ∀ A : Finset {x : V // x ∈ Z}, + ell * min (A.card : ℝ) + ((Fintype.card {x : V // x ∈ Z} : ℝ) - A.card) ≤ + (boundary τ A : ℝ) := by + apply boundary_expansion_of_half τ ell + intro A hA + let E : Finset V := + A.map (Function.Embedding.subtype (fun x : V => x ∈ Z)) + have hEcard : E.card = A.card := by + dsimp [E] + exact Finset.card_map _ + have hdisj : Disjoint B E := by + apply Finset.disjoint_left.mpr + intro x hxB hxE + have hxZ : x ∈ Z := + Finset.property_of_mem_map_subtype A hxE + rw [hZ] at hxZ + exact (Finset.mem_sdiff.mp hxZ).2 hxB + have hhalf : 2 * E.card ≤ Fintype.card V - B.card := by + rw [hEcard, ← hcardZ] + exact hA + have hcut := hprune E hdisj hhalf + have hbound : + (inducedBoundary σ B E : ℝ) ≤ + (boundary τ A : ℝ) := by + exact_mod_cast + inducedBoundary_le_completed_boundary σ B Z hZ τ hτ A + rw [hEcard] at hcut + exact hcut.trans hbound + refine ⟨B, τ, hBhalf, hBsize, ?_, ?_⟩ + · simpa only [Z] using hτ + · intro A + have hA := hexp A + simpa only [Fintype.card_coe] using hA + +end KunCompletedPrunedComponent + +namespace MatchedComponentCompletion + +open scoped BigOperators + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def completedRestriction {V : Type*} [Fintype V] + (p : Equiv.Perm V) (Z : Finset V) : + Equiv.Perm (↥Z) := + Classical.choose (exists_completion_of_internal_permutation p Z) + +public +theorem completedRestriction_apply_of_mem + {V : Type*} [Fintype V] + (p : Equiv.Perm V) (Z : Finset V) + (x : V) (hx : x ∈ Z) (hp : p x ∈ Z) : + ((completedRestriction p Z ⟨x, hx⟩ : {x : V // x ∈ Z}) : V) = p x := + (Classical.choose_spec + (exists_completion_of_internal_permutation p Z)) x hx hp + +@[simp] public theorem completedRestriction_one + {V : Type*} [Fintype V] (Z : Finset V) : + completedRestriction (1 : Equiv.Perm V) Z = 1 := by + ext x + simpa only [Equiv.Perm.coe_one, id_eq, SetLike.coe_eq_coe, Subtype.coe_eta] using + completedRestriction_apply_of_mem (1 : Equiv.Perm V) Z x x.property x.property + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def subtypeBad {V : Type*} [DecidableEq V] + (Z E : Finset V) : Finset (↥Z) := + Finset.univ.filter (fun x => (x : V) ∈ E) + +@[simp] private theorem mem_subtypeBad + {V : Type*} [DecidableEq V] + (Z E : Finset V) (x : {x : V // x ∈ Z}) : + x ∈ subtypeBad Z E ↔ (x : V) ∈ E := by + simp only [subtypeBad, Finset.univ_eq_attach, Finset.mem_filter, Finset.mem_attach, true_and] + +public +theorem card_subtypeBad + {V : Type*} [DecidableEq V] + (Z E : Finset V) : + (subtypeBad Z E).card = (Z ∩ E).card := by + classical + have hmap : + (subtypeBad Z E).map + (Function.Embedding.subtype (fun x : V => x ∈ Z)) = Z ∩ E := by + ext x + simp only [subtypeBad, Finset.univ_eq_attach, Finset.mem_map, Finset.mem_filter, + Finset.mem_attach, true_and, + Function.Embedding.subtype_apply, and_comm, Subtype.exists, exists_and_left, exists_prop, + exists_eq_left, + Finset.mem_inter] + simpa only [Finset.card_map] using congrArg Finset.card hmap + +public +theorem permutationDistance_le_subtypeBad + {V : Type*} [DecidableEq V] + (Z E : Finset V) + (p q : Equiv.Perm {x : V // x ∈ Z}) + (hagrees : ∀ x : {x : V // x ∈ Z}, + (x : V) ∉ E → p x = q x) : + permutationDistance p q ≤ (subtypeBad Z E).card := by + unfold permutationDistance hammingDist + apply Finset.card_le_card + intro x hx + have hneq : p x ≠ q x := (Finset.mem_filter.mp hx).2 + apply (mem_subtypeBad Z E x).2 + by_contra hnot + exact hneq (hagrees x hnot) + +private theorem card_lt_five_mul_permutationDistance_of_subtypeBad + {V : Type*} [DecidableEq V] + (Z E : Finset V) (hZ : Z.Nonempty) + (p q : Equiv.Perm {x : V // x ∈ Z}) + (hbad : 5 * (subtypeBad Z E).card ≤ Fintype.card {x : V // x ∈ Z}) + (hseparated : ∀ x : {x : V // x ∈ Z}, + (x : V) ∉ E → p x ≠ q x) : + Fintype.card {x : V // x ∈ Z} < + 5 * permutationDistance p q := by + have hagree : + (agreementSet p q).card ≤ (subtypeBad Z E).card := by + apply Finset.card_le_card + intro x hx + have heq : p x = q x := (Finset.mem_filter.mp hx).2 + apply (mem_subtypeBad Z E x).2 + by_contra hnot + exact hseparated x hnot heq + have hpartition := agreementSet_card_add_hammingDist p q + change + (agreementSet p q).card + + permutationDistance p q = + Fintype.card {x : V // x ∈ Z} at hpartition + have hpositive : 0 < Fintype.card {x : V // x ∈ Z} := by + simpa only [Fintype.card_coe] using hZ.card_pos + omega + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def sourceCompletionBad + {V ι J : Type*} [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) (p : J → Equiv.Perm V) + (F : Finset J) (Z : Finset V) : Finset V := by + classical + let T := CompressionCriterion.productTrackedTable F + exact + (Finset.univ.biUnion fun i : ι => + Z.filter fun z => σ i z ∉ Z) ∪ + (T.biUnion fun j => + Z.filter fun z => p j z ∉ Z) ∪ + (Finset.univ.biUnion fun i : ι => + T.biUnion fun j => + Z.filter fun z => p j (σ i z) ≠ σ i (p j z)) ∪ + (Finset.univ.biUnion fun i : ι => + T.biUnion fun j => + Z.filter fun z => p j (σ i z) ∉ Z) ∪ + (F.biUnion fun j => + F.biUnion fun k => + Z.filter fun z => p (j * k) z ≠ p j (p k z)) ∪ + (F.biUnion fun j => + F.biUnion fun k => + Z.filter fun z => j ≠ k ∧ p j z = p k z) + +public +theorem sourceCompletionBad_subset + {V ι J : Type*} [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) (p : J → Equiv.Perm V) + (F : Finset J) (Z : Finset V) : + sourceCompletionBad σ p F Z ⊆ Z := by + classical + intro x hx + simp only [sourceCompletionBad, ne_eq, Finset.union_assoc, Finset.mem_union, Finset.mem_biUnion, + Finset.mem_univ, Finset.mem_filter, true_and, exists_and_left] at hx + aesop + +public +theorem card_subtype_sourceCompletionBad + {V ι J : Type*} [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) (p : J → Equiv.Perm V) + (F : Finset J) (Z : Finset V) : + (subtypeBad Z (sourceCompletionBad σ p F Z)).card = + (sourceCompletionBad σ p F Z).card := by + rw [card_subtypeBad, Finset.inter_eq_right.mpr] + exact sourceCompletionBad_subset σ p F Z + +private theorem sourceCompletionBad_good + {V ι J : Type*} [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) (p : J → Equiv.Perm V) + (F : Finset J) (Z : Finset V) + (x : V) (hx : x ∈ Z) + (hgood : x ∉ sourceCompletionBad σ p F Z) : + (∀ i, σ i x ∈ Z) ∧ + (∀ j ∈ CompressionCriterion.productTrackedTable F, + p j x ∈ Z) ∧ + (∀ i, ∀ j ∈ CompressionCriterion.productTrackedTable F, + p j (σ i x) = σ i (p j x)) ∧ + (∀ i, ∀ j ∈ CompressionCriterion.productTrackedTable F, + p j (σ i x) ∈ Z) ∧ + (∀ j ∈ F, ∀ k ∈ F, + p (j * k) x = p j (p k x)) ∧ + (∀ j ∈ F, ∀ k ∈ F, j ≠ k → p j x ≠ p k x) := by + classical + simp only [sourceCompletionBad, ne_eq, Finset.union_assoc, Finset.mem_union, + Finset.mem_biUnion, Finset.mem_univ, Finset.mem_filter, hx, true_and, + not_or, not_exists, Decidable.not_not, not_and] at hgood + exact hgood + +public +theorem completedRestriction_mul_of_not_mem_sourceCompletionBad + {V ι J : Type*} [Fintype V] [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) (p : J → Equiv.Perm V) + (F : Finset J) (Z : Finset V) + {j k : J} (hj : j ∈ F) (hk : k ∈ F) + (z : {x : V // x ∈ Z}) + (hz : (z : V) ∉ sourceCompletionBad σ p F Z) : + completedRestriction (p (j * k)) Z z = + (completedRestriction (p j) Z * completedRestriction (p k) Z) z := by + have hg := sourceCompletionBad_good σ p F Z z z.property hz + have hjT := + CompressionCriterion.mem_productTrackedTable hj + have hkT := + CompressionCriterion.mem_productTrackedTable hk + have hjkT := + CompressionCriterion.mul_mem_productTrackedTable hj hk + have hkZ : p k (z : V) ∈ Z := hg.2.1 k hkT + have hjkZ : p (j * k) (z : V) ∈ Z := hg.2.1 (j * k) hjkT + have hmul : p (j * k) (z : V) = p j (p k (z : V)) := + hg.2.2.2.2.1 j hj k hk + have hinner : p j (p k (z : V)) ∈ Z := by + rw [← hmul] + exact hjkZ + have hkvalue : + ((completedRestriction (p k) Z z : {x : V // x ∈ Z}) : V) = + p k (z : V) := + completedRestriction_apply_of_mem (p k) Z z z.property hkZ + apply Subtype.ext + change + ((completedRestriction (p (j * k)) Z z : {x : V // x ∈ Z}) : V) = + ((completedRestriction (p j) Z + (completedRestriction (p k) Z z) : {x : V // x ∈ Z}) : V) + calc + ((completedRestriction (p (j * k)) Z z : {x : V // x ∈ Z}) : V) = + p (j * k) (z : V) := + completedRestriction_apply_of_mem (p (j * k)) Z z z.property hjkZ + _ = p j (p k (z : V)) := hmul + _ = p j + ((completedRestriction (p k) Z z : {x : V // x ∈ Z}) : V) := by + rw [hkvalue] + _ = ((completedRestriction (p j) Z + (completedRestriction (p k) Z z) : {x : V // x ∈ Z}) : V) := by + symm + apply completedRestriction_apply_of_mem + change + p j ((completedRestriction (p k) Z z : + {x : V // x ∈ Z}) : V) ∈ Z + rw [hkvalue] + exact hinner + +public +theorem completedRestriction_ne_of_not_mem_sourceCompletionBad + {V ι J : Type*} [Fintype V] [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) (p : J → Equiv.Perm V) + (F : Finset J) (Z : Finset V) + {j k : J} (hj : j ∈ F) (hk : k ∈ F) (hne : j ≠ k) + (z : {x : V // x ∈ Z}) + (hz : (z : V) ∉ sourceCompletionBad σ p F Z) : + completedRestriction (p j) Z z ≠ completedRestriction (p k) Z z := by + have hg := sourceCompletionBad_good σ p F Z z z.property hz + have hjT := + CompressionCriterion.mem_productTrackedTable hj + have hkT := + CompressionCriterion.mem_productTrackedTable hk + have hjZ : p j (z : V) ∈ Z := hg.2.1 j hjT + have hkZ : p k (z : V) ∈ Z := hg.2.1 k hkT + intro heq + apply hg.2.2.2.2.2 j hj k hk hne + have hval := congrArg + (fun x : {x : V // x ∈ Z} => (x : V)) heq + rwa [completedRestriction_apply_of_mem (p j) Z z z.property hjZ, + completedRestriction_apply_of_mem (p k) Z z z.property hkZ] at hval + +public +theorem completedRestriction_commute_of_not_mem_sourceCompletionBad + {V ι J : Type*} [Fintype V] [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) (p : J → Equiv.Perm V) + (F : Finset J) (Z : Finset V) + (σZ : ι → Equiv.Perm {x : V // x ∈ Z}) + (hσZ : ∀ i (x : V) (hx : x ∈ Z) (_hi : σ i x ∈ Z), + ((σZ i ⟨x, hx⟩ : {x : V // x ∈ Z}) : V) = σ i x) + {j : J} + (hj : j ∈ CompressionCriterion.productTrackedTable F) + (i : ι) (z : {x : V // x ∈ Z}) + (hz : (z : V) ∉ sourceCompletionBad σ p F Z) : + completedRestriction (p j) Z (σZ i z) = + σZ i (completedRestriction (p j) Z z) := by + have hg := sourceCompletionBad_good σ p F Z z z.property hz + have hσmem : σ i (z : V) ∈ Z := hg.1 i + have hjmem : p j (z : V) ∈ Z := hg.2.1 j hj + have hcomm : p j (σ i (z : V)) = σ i (p j (z : V)) := + hg.2.2.1 i j hj + have hcomposite : p j (σ i (z : V)) ∈ Z := + hg.2.2.2.1 i j hj + have hσvalue : + ((σZ i z : {x : V // x ∈ Z}) : V) = σ i (z : V) := + hσZ i z z.property hσmem + have hjvalue : + ((completedRestriction (p j) Z z : {x : V // x ∈ Z}) : V) = + p j (z : V) := + completedRestriction_apply_of_mem (p j) Z z z.property hjmem + have hleftmem : p j ((σZ i z : {x : V // x ∈ Z}) : V) ∈ Z := by + rw [hσvalue] + exact hcomposite + have hrightmem : + σ i + ((completedRestriction (p j) Z z : {x : V // x ∈ Z}) : V) ∈ Z := by + rw [hjvalue, ← hcomm] + exact hcomposite + apply Subtype.ext + calc + ((completedRestriction (p j) Z (σZ i z) : + {x : V // x ∈ Z}) : V) = + p j ((σZ i z : {x : V // x ∈ Z}) : V) := + completedRestriction_apply_of_mem + (p j) Z (σZ i z) (σZ i z).property hleftmem + _ = p j (σ i (z : V)) := congrArg (p j) hσvalue + _ = σ i (p j (z : V)) := hcomm + _ = σ i + ((completedRestriction (p j) Z z : {x : V // x ∈ Z}) : V) := + congrArg (σ i) hjvalue.symm + _ = ((σZ i (completedRestriction (p j) Z z) : + {x : V // x ∈ Z}) : V) := + (hσZ i (completedRestriction (p j) Z z) + (completedRestriction (p j) Z z).property hrightmem).symm + +public +theorem completedRestriction_mul_distance_le_sourceCompletionBad + {V ι J : Type*} [Fintype V] [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) (p : J → Equiv.Perm V) + (F : Finset J) (Z : Finset V) + {j k : J} (hj : j ∈ F) (hk : k ∈ F) : + permutationDistance + (completedRestriction (p (j * k)) Z) + (completedRestriction (p j) Z * completedRestriction (p k) Z) ≤ + (sourceCompletionBad σ p F Z).card := by + calc + permutationDistance + (completedRestriction (p (j * k)) Z) + (completedRestriction (p j) Z * completedRestriction (p k) Z) ≤ + (subtypeBad Z (sourceCompletionBad σ p F Z)).card := by + apply permutationDistance_le_subtypeBad + intro z hz + exact completedRestriction_mul_of_not_mem_sourceCompletionBad + σ p F Z hj hk z hz + _ = (sourceCompletionBad σ p F Z).card := + card_subtype_sourceCompletionBad σ p F Z + +public +theorem completedRestriction_separated_of_sourceCompletionBad + {V ι J : Type*} [Fintype V] [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) (p : J → Equiv.Perm V) + (F : Finset J) (Z : Finset V) (hZ : Z.Nonempty) + (hbad : 5 * (sourceCompletionBad σ p F Z).card ≤ Z.card) + {j k : J} (hj : j ∈ F) (hk : k ∈ F) (hne : j ≠ k) : + Fintype.card {x : V // x ∈ Z} < + 5 * permutationDistance + (completedRestriction (p j) Z) (completedRestriction (p k) Z) := by + apply card_lt_five_mul_permutationDistance_of_subtypeBad + Z (sourceCompletionBad σ p F Z) hZ + · simpa only [card_subtype_sourceCompletionBad, Fintype.card_coe] + using hbad + · intro z hz + exact completedRestriction_ne_of_not_mem_sourceCompletionBad + σ p F Z hj hk hne z hz + +public +theorem completedRestriction_commutationDefect_le_sourceCompletionBad + {V ι J : Type*} [Fintype V] [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) (p : J → Equiv.Perm V) + (F : Finset J) (Z : Finset V) + (σZ : ι → Equiv.Perm {x : V // x ∈ Z}) + (hσZ : ∀ i (x : V) (hx : x ∈ Z) (_hi : σ i x ∈ Z), + ((σZ i ⟨x, hx⟩ : {x : V // x ∈ Z}) : V) = σ i x) + {j : J} + (hj : j ∈ CompressionCriterion.productTrackedTable F) : + permutationCommutationDefect + σZ (completedRestriction (p j) Z) ≤ + Fintype.card ι * (sourceCompletionBad σ p F Z).card := by + classical + unfold permutationCommutationDefect + calc + (∑ i : ι, + (Finset.univ.filter fun x : {x : V // x ∈ Z} => + completedRestriction (p j) Z (σZ i x) ≠ + σZ i (completedRestriction (p j) Z x)).card) ≤ + ∑ _i : ι, (subtypeBad Z (sourceCompletionBad σ p F Z)).card := by + apply Finset.sum_le_sum + intro i _ + apply Finset.card_le_card + intro x hx + apply (mem_subtypeBad Z (sourceCompletionBad σ p F Z) x).2 + by_contra hnot + exact (Finset.mem_filter.mp hx).2 + (completedRestriction_commute_of_not_mem_sourceCompletionBad + σ p F Z σZ hσZ hj i x hnot) + _ = Fintype.card ι * (sourceCompletionBad σ p F Z).card := by + simp only [card_subtype_sourceCompletionBad, Finset.sum_const, Finset.card_univ, smul_eq_mul] + +end MatchedComponentCompletion + +namespace MatchedComponentExitBudget + +open Filter Topology +open scoped BigOperators + +public +theorem card_permutation_exit_le_deleted + {V : Type*} [Fintype V] [DecidableEq V] + (p : Equiv.Perm V) (Z : Finset V) : + (Z.filter fun x => p x ∉ Z).card ≤ + (Finset.univ \ Z).card := by + apply Finset.card_le_card_of_injOn p + · intro x hx + exact Finset.mem_sdiff.mpr + ⟨Finset.mem_univ _, (Finset.mem_filter.mp hx).2⟩ + · exact p.injective.injOn + +private theorem card_composite_exit_le_deleted + {V : Type*} [Fintype V] [DecidableEq V] + (p q : Equiv.Perm V) (Z : Finset V) : + (Z.filter fun x => p (q x) ∉ Z).card ≤ + (Finset.univ \ Z).card := by + apply Finset.card_le_card_of_injOn (p * q) + · intro x hx + apply Finset.mem_sdiff.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + simpa only [Equiv.Perm.mul_apply] using (Finset.mem_filter.mp hx).2 + · exact (p * q).injective.injOn + +private theorem card_biUnion_permutation_exit_le + {V ι : Type*} [Fintype V] [DecidableEq V] + (I : Finset ι) (p : ι → Equiv.Perm V) (Z : Finset V) : + (I.biUnion fun i => Z.filter fun x => p i x ∉ Z).card ≤ + I.card * (Finset.univ \ Z).card := by + classical + calc + (I.biUnion fun i => Z.filter fun x => p i x ∉ Z).card ≤ + ∑ i ∈ I, (Z.filter fun x => p i x ∉ Z).card := + Finset.card_biUnion_le + _ ≤ ∑ _i ∈ I, (Finset.univ \ Z).card := by + apply Finset.sum_le_sum + intro i _ + exact card_permutation_exit_le_deleted (p i) Z + _ = I.card * (Finset.univ \ Z).card := by simp only [Finset.sum_const, smul_eq_mul] + +private theorem card_biUnion_composite_exit_le + {V ι κ : Type*} [Fintype V] [DecidableEq V] + (I : Finset ι) (K : Finset κ) + (p : ι → Equiv.Perm V) (q : κ → Equiv.Perm V) + (Z : Finset V) : + (I.biUnion fun i => + K.biUnion fun k => Z.filter fun x => q k (p i x) ∉ Z).card ≤ + I.card * K.card * (Finset.univ \ Z).card := by + classical + calc + (I.biUnion fun i => + K.biUnion fun k => Z.filter fun x => q k (p i x) ∉ Z).card ≤ + ∑ i ∈ I, + (K.biUnion fun k => Z.filter fun x => q k (p i x) ∉ Z).card := + Finset.card_biUnion_le + _ ≤ ∑ _i ∈ I, K.card * (Finset.univ \ Z).card := by + apply Finset.sum_le_sum + intro i _ + calc + (K.biUnion fun k => + Z.filter fun x => q k (p i x) ∉ Z).card ≤ + ∑ k ∈ K, (Z.filter fun x => q k (p i x) ∉ Z).card := + Finset.card_biUnion_le + _ ≤ ∑ _k ∈ K, (Finset.univ \ Z).card := by + apply Finset.sum_le_sum + intro k _ + exact card_composite_exit_le_deleted (q k) (p i) Z + _ = K.card * (Finset.univ \ Z).card := by simp only [Finset.sum_const, smul_eq_mul] + _ = I.card * K.card * (Finset.univ \ Z).card := by + simp only [Finset.sum_const, smul_eq_mul, Nat.mul_assoc] + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +noncomputable def sourceWordTestBad + {V ι J : Type*} [Fintype V] [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) (p : J → Equiv.Perm V) + (F : Finset J) : Finset V := by + classical + let T := CompressionCriterion.productTrackedTable F + exact + (Finset.univ.biUnion fun i : ι => + T.biUnion fun j => + Finset.univ.filter fun z => p j (σ i z) ≠ σ i (p j z)) ∪ + (F.biUnion fun j => + F.biUnion fun k => + Finset.univ.filter fun z => p (j * k) z ≠ p j (p k z)) ∪ + (F.biUnion fun j => + F.biUnion fun k => + Finset.univ.filter fun z => j ≠ k ∧ p j z = p k z) + +public +theorem sourceCompletionBad_subset_exit_union_wordBad + {V ι J : Type*} [Fintype V] [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) (p : J → Equiv.Perm V) + (F : Finset J) (Z : Finset V) : + MatchedComponentCompletion.sourceCompletionBad σ p F Z ⊆ + (Finset.univ.biUnion fun i : ι => + Z.filter fun z => σ i z ∉ Z) ∪ + ((CompressionCriterion.productTrackedTable F).biUnion + fun j => Z.filter fun z => p j z ∉ Z) ∪ + (Finset.univ.biUnion fun i : ι => + (CompressionCriterion.productTrackedTable F).biUnion + fun j => Z.filter fun z => p j (σ i z) ∉ Z) ∪ + sourceWordTestBad σ p F := by + classical + intro x hx + simp only [MatchedComponentCompletion.sourceCompletionBad, ne_eq, Finset.union_assoc, + Finset.mem_union, + Finset.mem_biUnion, Finset.mem_univ, Finset.mem_filter, true_and, exists_and_left, + sourceWordTestBad] at hx ⊢ + rcases hx with hgen | hfactor | hcomm | hcomposite | hmul | hsep + · obtain ⟨hxZ, i, hi⟩ := hgen + exact Or.inl ⟨hxZ, i, hi⟩ + · obtain ⟨j, hj, hxZ, hexit⟩ := hfactor + exact Or.inr (Or.inl ⟨j, hj, hxZ, hexit⟩) + · obtain ⟨i, j, hj, _, hfailure⟩ := hcomm + exact Or.inr (Or.inr (Or.inr (Or.inl ⟨i, j, hj, hfailure⟩))) + · obtain ⟨i, j, hj, hxZ, hfailure⟩ := hcomposite + exact Or.inr (Or.inr (Or.inl ⟨i, j, hj, hxZ, hfailure⟩)) + · obtain ⟨j, hj, k, hk, _, hfailure⟩ := hmul + exact Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨j, hj, k, hk, hfailure⟩)))) + · obtain ⟨j, hj, k, hk, _, hne, hfailure⟩ := hsep + exact Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr ⟨j, hj, k, hk, hne, hfailure⟩)))) + +private theorem card_sourceCompletionBad_le_deleted_add_wordBad + {V ι J : Type*} [Fintype V] [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) (p : J → Equiv.Perm V) + (F : Finset J) (Z : Finset V) : + (MatchedComponentCompletion.sourceCompletionBad + σ p F Z).card ≤ + (Fintype.card ι + + (CompressionCriterion.productTrackedTable F).card + + Fintype.card ι * + (CompressionCriterion.productTrackedTable F).card) * + (Finset.univ \ Z).card + + (sourceWordTestBad σ p F).card := by + classical + let I : Finset ι := Finset.univ + let T : Finset J := + CompressionCriterion.productTrackedTable F + let A : Finset V := + I.biUnion fun i => Z.filter fun z => σ i z ∉ Z + let D : Finset V := + T.biUnion fun j => Z.filter fun z => p j z ∉ Z + let C : Finset V := + I.biUnion fun i => + T.biUnion fun j => Z.filter fun z => p j (σ i z) ∉ Z + let W : Finset V := sourceWordTestBad σ p F + let deleted : Finset V := Finset.univ \ Z + have hA : A.card ≤ Fintype.card ι * deleted.card := by + simpa only [Finset.card_univ] using card_biUnion_permutation_exit_le (Finset.univ : Finset ι) σ + Z + have hD : D.card ≤ T.card * deleted.card := by + simpa only using card_biUnion_permutation_exit_le T p Z + have hC : C.card ≤ Fintype.card ι * T.card * deleted.card := by + simpa only [Finset.card_univ] using card_biUnion_composite_exit_le (Finset.univ : Finset ι) T σ + p Z + have hsubset : + MatchedComponentCompletion.sourceCompletionBad + σ p F Z ⊆ A ∪ D ∪ C ∪ W := by + simpa only [Finset.union_assoc] using sourceCompletionBad_subset_exit_union_wordBad σ p F Z + have hunion : + (A ∪ D ∪ C ∪ W).card ≤ A.card + D.card + C.card + W.card := by + have hAD := Finset.card_union_le A D + have hADC := Finset.card_union_le (A ∪ D) C + have hADCW := Finset.card_union_le (A ∪ D ∪ C) W + omega + calc + (MatchedComponentCompletion.sourceCompletionBad + σ p F Z).card ≤ (A ∪ D ∪ C ∪ W).card := + Finset.card_le_card hsubset + _ ≤ A.card + D.card + C.card + W.card := hunion + _ ≤ Fintype.card ι * deleted.card + + T.card * deleted.card + + Fintype.card ι * T.card * deleted.card + W.card := by + omega + _ = (Fintype.card ι + + (CompressionCriterion.productTrackedTable F).card + + Fintype.card ι * + (CompressionCriterion.productTrackedTable F).card) * + (Finset.univ \ Z).card + + (sourceWordTestBad σ p F).card := by + dsimp [T, deleted, W] + ring + +private theorem sourceCompletionBad_subset_survivors + {V ι J : Type*} [DecidableEq V] + [Fintype ι] [Group J] + (σ : ι → Equiv.Perm V) (p : J → Equiv.Perm V) + (F : Finset J) (Z : Finset V) : + MatchedComponentCompletion.sourceCompletionBad + σ p F Z ⊆ Z := by + classical + intro x hx + simp only [MatchedComponentCompletion.sourceCompletionBad, ne_eq, Finset.union_assoc, + Finset.mem_union, + Finset.mem_biUnion, Finset.mem_univ, Finset.mem_filter, true_and, exists_and_left] at hx + aesop + +private theorem sourceCompletionBad_original_density_tendsto_zero + (V : ℕ → Type*) [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + {ι J : Type*} [Fintype ι] [Group J] + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (p : (n : ℕ) → J → Equiv.Perm (V n)) + (F : Finset J) + (B : (n : ℕ) → Finset (V n)) + (hdeleted : Tendsto + (fun n => ((B n).card : ℝ) / Fintype.card (V n)) + atTop (nhds 0)) + (hword : Tendsto + (fun n => + ((sourceWordTestBad (σ n) (p n) F).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0)) : + Tendsto + (fun n => + ((MatchedComponentCompletion.sourceCompletionBad + (σ n) (p n) F (Finset.univ \ B n)).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0) := by + let c : ℝ := + (Fintype.card ι + + (CompressionCriterion.productTrackedTable F).card + + Fintype.card ι * + (CompressionCriterion.productTrackedTable F).card : ℕ) + have hupper (n : ℕ) : + ((MatchedComponentCompletion.sourceCompletionBad + (σ n) (p n) F (Finset.univ \ B n)).card : ℝ) / + Fintype.card (V n) ≤ + c * (((B n).card : ℝ) / Fintype.card (V n)) + + ((sourceWordTestBad (σ n) (p n) F).card : ℝ) / + Fintype.card (V n) := by + have hfinite := card_sourceCompletionBad_le_deleted_add_wordBad + (σ n) (p n) F (Finset.univ \ B n) + have hdeleted_eq : + (Finset.univ \ (Finset.univ \ B n) : Finset (V n)) = B n := by + ext x + simp only [sdiff_sdiff_right_self, Finset.subset_univ, inf_of_le_right] + rw [hdeleted_eq] at hfinite + have hreal : + ((MatchedComponentCompletion.sourceCompletionBad + (σ n) (p n) F (Finset.univ \ B n)).card : ℝ) ≤ + c * ((B n).card : ℝ) + + (sourceWordTestBad (σ n) (p n) F).card := by + dsimp [c] + exact_mod_cast hfinite + calc + ((MatchedComponentCompletion.sourceCompletionBad + (σ n) (p n) F (Finset.univ \ B n)).card : ℝ) / + Fintype.card (V n) ≤ + (c * ((B n).card : ℝ) + + (sourceWordTestBad (σ n) (p n) F).card) / + Fintype.card (V n) := + div_le_div_of_nonneg_right hreal (by positivity) + _ = c * (((B n).card : ℝ) / Fintype.card (V n)) + + ((sourceWordTestBad (σ n) (p n) F).card : ℝ) / + Fintype.card (V n) := by + ring + have hlimit : Tendsto + (fun n => + c * (((B n).card : ℝ) / Fintype.card (V n)) + + ((sourceWordTestBad (σ n) (p n) F).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0) := by + simpa only [mul_zero, add_zero] using (hdeleted.const_mul c).add hword + exact squeeze_zero' + (Filter.Eventually.of_forall fun n => by positivity) + (Filter.Eventually.of_forall hupper) + hlimit + +public +theorem sourceCompletionBad_surviving_density_tendsto_zero + (V : ℕ → Type*) [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + {ι J : Type*} [Fintype ι] [Group J] + (σ : (n : ℕ) → ι → Equiv.Perm (V n)) + (p : (n : ℕ) → J → Equiv.Perm (V n)) + (F : Finset J) + (B : (n : ℕ) → Finset (V n)) + (hZ : ∀ n, (Finset.univ \ B n : Finset (V n)).Nonempty) + (hdeleted : Tendsto + (fun n => ((B n).card : ℝ) / Fintype.card (V n)) + atTop (nhds 0)) + (hword : Tendsto + (fun n => + ((sourceWordTestBad (σ n) (p n) F).card : ℝ) / + Fintype.card (V n)) + atTop (nhds 0)) : + Tendsto + (fun n => + ((MatchedComponentCompletion.sourceCompletionBad + (σ n) (p n) F (Finset.univ \ B n)).card : ℝ) / + (Finset.univ \ B n : Finset (V n)).card) + atTop (nhds 0) := by + let U : (n : ℕ) → Finset (V n) := fun _ => Finset.univ + let Z : (n : ℕ) → Finset (V n) := fun n => Finset.univ \ B n + let E : (n : ℕ) → Finset (V n) := fun n => + MatchedComponentCompletion.sourceCompletionBad + (σ n) (p n) F (Z n) + have hU (n : ℕ) : (U n).Nonempty := by + obtain ⟨x, _⟩ := hZ n + exact ⟨x, Finset.mem_univ _⟩ + have hcover : Tendsto + (fun n => ((Z n).card : ℝ) / (U n).card) + atTop (nhds 1) := by + have hbase : Tendsto + (fun n => (1 : ℝ) - + ((B n).card : ℝ) / Fintype.card (V n)) + atTop (nhds 1) := by + simpa only [sub_zero] using tendsto_const_nhds.sub hdeleted + convert hbase using 1 + funext n + have hcard : Fintype.card (V n) ≠ 0 := by + exact Finset.card_ne_zero.mpr (hU n) + dsimp [U, Z] + rw [Finset.card_sdiff_of_subset (Finset.subset_univ (B n)), + Finset.card_univ, Nat.cast_sub (Finset.card_le_univ (B n))] + field_simp + have hglobal : Tendsto + (fun n => (((U n ∩ E n).card : ℝ) / (U n).card)) + atTop (nhds 0) := by + simpa [U, Z, E] using + sourceCompletionBad_original_density_tendsto_zero + V σ p F B hdeleted hword + have hretained := retained_bad_density_tendsto_zero + U Z E hU hZ + (fun n => Finset.subset_univ (Z n)) hcover hglobal + convert hretained using 1 + funext n + dsimp [Z, E] + rw [Finset.inter_eq_right.mpr + (sourceCompletionBad_subset_survivors + (σ n) (p n) F (Finset.univ \ B n))] + +public +theorem pruned_component_card_tendsto_atTop + (V : ℕ → Type*) [∀ n, Fintype (V n)] + [∀ n, DecidableEq (V n)] + (B : (n : ℕ) → Finset (V n)) + (hsize : Tendsto (fun n => Fintype.card (V n)) atTop atTop) + (hdeleted : Tendsto + (fun n => ((B n).card : ℝ) / Fintype.card (V n)) + atTop (nhds 0)) : + Tendsto (fun n => (Finset.univ \ B n : Finset (V n)).card) + atTop atTop := by + have hhalf : ∀ᶠ n in atTop, + ((B n).card : ℝ) / Fintype.card (V n) < (1 / 2 : ℝ) := + hdeleted.eventually + (gt_mem_nhds (by norm_num : (0 : ℝ) < 1 / 2)) + have hpositive : ∀ᶠ n in atTop, 0 < Fintype.card (V n) := by + have hevent := (Filter.tendsto_atTop.1 hsize) 1 + filter_upwards [hevent] with n hn + omega + have hhalfsize : + Tendsto (fun n => Fintype.card (V n) / 2) atTop atTop := + (Nat.tendsto_div_const_atTop (by norm_num : (2 : ℕ) ≠ 0)).comp hsize + refine tendsto_atTop_mono' atTop ?_ hhalfsize + filter_upwards [hhalf, hpositive] with n hn hnpositive + have hrealpos : (0 : ℝ) < Fintype.card (V n) := by + exact_mod_cast hnpositive + have hratio := (div_lt_iff₀ hrealpos).1 hn + have hbadlt : 2 * (B n).card < Fintype.card (V n) := by + exact_mod_cast (show + (2 : ℝ) * (B n).card < Fintype.card (V n) by linarith) + rw [Finset.card_sdiff_of_subset (Finset.subset_univ (B n)), + Finset.card_univ] + omega + +end MatchedComponentExitBudget + +namespace KunRealComplexMarkovBridge + +open scoped BigOperators ComplexOrder InnerProductSpace Topology + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def realMarkov {ι V : Type*} [Fintype ι] + (p : ι → Equiv.Perm V) (f : V → ℝ) (x : V) : ℝ := + (∑ i, f ((p i).symm x)) / (Fintype.card ι : ℝ) + +private def permutationUnitary {V : Type*} [Fintype V] (p : Equiv.Perm V) : + EuclideanSpace ℂ V ≃ₗᵢ[ℂ] EuclideanSpace ℂ V := + LinearIsometryEquiv.piLpCongrLeft 2 ℂ ℂ p + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def indicatorVector {V : Type*} + (f : V → ℝ) : EuclideanSpace ℂ V := + WithLp.toLp 2 fun x => (f x : ℂ) + +@[simp] +private theorem indicatorVector_apply {V : Type*} + (f : V → ℝ) (x : V) : + indicatorVector f x = (f x : ℂ) := rfl + +/-- Internal interface connecting the split non-sofic proof modules. -/ +public +def permutationMarkov {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (ξ : EuclideanSpace ℂ V) : + EuclideanSpace ℂ V := + (Fintype.card ι : ℂ)⁻¹ • ∑ i, permutationUnitary (p i) ξ + +@[simp] +private theorem permutationMarkov_apply {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (ξ : EuclideanSpace ℂ V) (x : V) : + permutationMarkov p ξ x = + (∑ i, ξ ((p i).symm x)) / (Fintype.card ι : ℂ) := by + simp only [permutationMarkov, permutationUnitary, PiLp.smul_apply, WithLp.ofLp_sum, + LinearIsometryEquiv.piLpCongrLeft_apply, Finset.sum_apply, Equiv.piCongrLeft'_apply, + smul_eq_mul, div_eq_mul_inv, + mul_comm] + +private theorem indicatorVector_realMarkov + {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) : + indicatorVector (realMarkov p f) = + permutationMarkov p (indicatorVector f) := by + ext x + rw [indicatorVector_apply, permutationMarkov_apply] + simp only [indicatorVector_apply] + change (((∑ i, f ((p i).symm x)) / + (Fintype.card ι : ℝ) : ℝ) : ℂ) = + (∑ i, (f ((p i).symm x) : ℂ)) / (Fintype.card ι : ℂ) + norm_cast + +private theorem indicatorVector_iterate_realMarkov + {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) (k : ℕ) : + indicatorVector (((realMarkov p)^[k]) f) = + ((permutationMarkov p)^[k]) (indicatorVector f) := by + induction k with + | zero => simp only [Function.iterate_zero, id_eq] + | succ k ih => + rw [Function.iterate_succ_apply', Function.iterate_succ_apply', + indicatorVector_realMarkov, ih] + +private theorem norm_indicatorVector_sub_sq + {V : Type*} [Fintype V] (f g : V → ℝ) : + ‖indicatorVector f - indicatorVector g‖ ^ 2 = + ∑ x, (f x - g x) ^ 2 := by + rw [EuclideanSpace.norm_sq_eq] + apply Finset.sum_congr rfl + intro x _ + change ‖(f x : ℂ) - (g x : ℂ)‖ ^ 2 = (f x - g x) ^ 2 + rw [← Complex.ofReal_sub, Complex.norm_real, Real.norm_eq_abs, sq_abs] + +public +theorem norm_permutationMarkov_indicator_sub_sq + {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) : + ‖permutationMarkov p (indicatorVector f) - indicatorVector f‖ ^ 2 = + ∑ x, (realMarkov p f x - f x) ^ 2 := by + rw [← indicatorVector_realMarkov, norm_indicatorVector_sub_sq] + +public +theorem norm_iterate_permutationMarkov_indicator_sub_sq + {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) (k : ℕ) : + ‖((permutationMarkov p)^[k]) (indicatorVector f) - + indicatorVector f‖ ^ 2 = + ∑ x, ((((realMarkov p)^[k]) f) x - f x) ^ 2 := by + rw [← indicatorVector_iterate_realMarkov, + norm_indicatorVector_sub_sq] + +public +theorem norm_iterate_permutationMarkov_indicator_sub_iterate_sq + {ι V : Type*} [Fintype ι] [Fintype V] + (p : ι → Equiv.Perm V) (f : V → ℝ) (k : ℕ) : + ‖((permutationMarkov p)^[k + 1]) (indicatorVector f) - + ((permutationMarkov p)^[k]) (indicatorVector f)‖ ^ 2 = + ∑ x, ((((realMarkov p)^[k + 1]) f) x - + (((realMarkov p)^[k]) f) x) ^ 2 := by + rw [← indicatorVector_iterate_realMarkov, + ← indicatorVector_iterate_realMarkov, + norm_indicatorVector_sub_sq] + +end KunRealComplexMarkovBridge + + +end SoficGroups + +end diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index 563c654dd..3e59e9292 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -311,6 +311,45 @@ projects: msc: - "05D10" - "05C55" + - slug: non-sofic-group + title: Existence of a finitely presented non-sofic group + summary: >- + Constructs a finitely presented group that is not sofic, resolving the + question whether every group admits arbitrarily accurate finite + permutation approximations. The development combines an explicit + elementary group with property T, a finite-table construction of a + finitely presented group, finite-model expansion, and a local obstruction + to sofic approximation. + branch: geometric and combinatorial group theory + entry_module: LeanPool.NonSoficGroup + authors: + - OpenAI + - Dean Cureton + source: + title: Ten Advances in Mathematics and Theoretical Computer Science + authors: + - OpenAI + url: https://github.com/openai/ten-proofs + github_repo: openai/ten-proofs + commit: 94bc0feb6a9ff12c7d31d6de640a725c9d43d2b6 + license: Apache-2.0 + status: verified + provenance: mix + main_declarations: + - SoficGroups.exists_finitelyPresented_nonsofic_group + main_results: + - declaration: SoficGroups.exists_finitelyPresented_nonsofic_group + informal: >- + There exists a group admitting a finite presentation but no sofic + approximation. + tags: + - group-theory + - sofic-groups + - property-t + - finite-approximations + msc: + - "20F65" + - "20E22" - slug: connes-rigidity title: Conditional formalization of Zhou's Connes-rigidity counterexample summary: >-