From d79c3a4c670f5c8483986505870242df65a78c71 Mon Sep 17 00:00:00 2001 From: Cobord Date: Thu, 2 Jul 2026 19:43:06 -0400 Subject: [PATCH 01/12] for updated mathlib version --- Coxeter/LinearAlgebra/BilinearForm.lean | 2 +- Coxeter/LinearAlgebra/TwoDim.lean | 4 ++-- Coxeter/PermutationRepresentation.lean | 1 + lakefile.toml | 1 + 4 files changed, 5 insertions(+), 3 deletions(-) diff --git a/Coxeter/LinearAlgebra/BilinearForm.lean b/Coxeter/LinearAlgebra/BilinearForm.lean index 5749800..15ca7ed 100644 --- a/Coxeter/LinearAlgebra/BilinearForm.lean +++ b/Coxeter/LinearAlgebra/BilinearForm.lean @@ -144,7 +144,7 @@ theorem sup_orthogonal_eq_top (B : LinearMap.BilinForm ℝ V) rw [sub_eq_zero] symm unfold u - simp only [AddSubmonoidClass.coe_finset_sum, SetLike.val_smul, map_sum, map_smul, + simp only [AddSubmonoidClass.coe_finsetSum, SetLike.val_smul, map_sum, map_smul, LinearMap.coe_sum, Finset.sum_apply, LinearMap.smul_apply, smul_eq_mul] change ∑ j, B x (v j) * B (v j) (v i) = B x (v i) have : ∀ (i j : Fin (Module.finrank ℝ W)), (B x (v j)) * B (v j) (v i) diff --git a/Coxeter/LinearAlgebra/TwoDim.lean b/Coxeter/LinearAlgebra/TwoDim.lean index 7c10838..c3b13bf 100644 --- a/Coxeter/LinearAlgebra/TwoDim.lean +++ b/Coxeter/LinearAlgebra/TwoDim.lean @@ -57,7 +57,7 @@ theorem reflect_reflect {x y : E} (hx : ‖x‖ = 1) (hy : ‖y‖ = 1) : | 0 => simp only [Fin.isValue, Orientation.coe_basisRightAngleRotation, Nat.succ_eq_add_one, Nat.reduceAdd, Matrix.cons_val_zero, LinearEquiv.coe_coe, LinearEquiv.trans_apply, - SemilinearEquivClass.semilinearEquiv_apply, b] + b] calc reflect hy (reflect hx x) = reflect hy (-x) := by simp [reflect] _ = -x - (2 * ⟪y, -x⟫) • y := by rw [reflect_apply] @@ -81,7 +81,7 @@ theorem reflect_reflect {x y : E} (hx : ‖x‖ = 1) (hy : ‖y‖ = 1) : | 1 => simp only [Fin.isValue, Orientation.coe_basisRightAngleRotation, Nat.succ_eq_add_one, Nat.reduceAdd, Matrix.cons_val_one, Matrix.cons_val_fin_one, LinearEquiv.coe_coe, - LinearEquiv.trans_apply, SemilinearEquivClass.semilinearEquiv_apply, b] + LinearEquiv.trans_apply, b] calc reflect hy (reflect hx (J x)) = reflect hy (J x) := ?_ _ = J x - (2 * ⟪y, J x⟫) • y := by rw [reflect_apply] diff --git a/Coxeter/PermutationRepresentation.lean b/Coxeter/PermutationRepresentation.lean index 8dd0e25..44365bc 100644 --- a/Coxeter/PermutationRepresentation.lean +++ b/Coxeter/PermutationRepresentation.lean @@ -1,5 +1,6 @@ module + public import Coxeter.Basic /-! diff --git a/lakefile.toml b/lakefile.toml index 070d51c..d987b56 100644 --- a/lakefile.toml +++ b/lakefile.toml @@ -7,6 +7,7 @@ defaultTargets = ["Coxeter"] pp.unicode.fun = true # pretty-prints `fun a ↦ b` relaxedAutoImplicit = false weak.linter.mathlibStandardSet = true +weak.linter.style.header = false maxSynthPendingDepth = 3 [[require]] From f8a72aa418265d9879fcb75cf72409df1751c473 Mon Sep 17 00:00:00 2001 From: Cobord Date: Fri, 3 Jul 2026 15:12:00 -0400 Subject: [PATCH 02/12] encapsulate the Matsumoto theorem so consumers of this module can prove ad hoc for their specific W vs/until doing the general proof here --- Coxeter/Basic.lean | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/Coxeter/Basic.lean b/Coxeter/Basic.lean index 1b0b8ca..de8f5e6 100644 --- a/Coxeter/Basic.lean +++ b/Coxeter/Basic.lean @@ -152,6 +152,37 @@ end ReducedWord end +section BraidMoves + +/-! ### Braid moves and Matsumoto's theorem -/ + +/-- An **elementary braid move** +replacing a contiguous occurrence of the braid word +`braidWord M i i'` (i.e. `s_i s_{i'} s_i ⋯`, `M i i'` letters) +in a list by `braidWord M i' i` +(`s_{i'} s_i s_{i'} ⋯`) leaving the rest of the list unchanged. +Two lists related by `BraidMove` represent the same group element -/ +def BraidMove (ω ω' : List (B W)) : Prop := + ∃ (i i' : B W) (α β : List (B W)), + ω = α ++ braidWord M i i' ++ β ∧ ω' = α ++ braidWord M i' i ++ β + +theorem BraidMove.wordProd_eq {ω ω' : List (B W)} (h : BraidMove ω ω') : + cs.wordProd ω = cs.wordProd ω' := by + obtain ⟨i, i', α, β, hω, hω'⟩ := h + rw [hω, hω'] + simp only [wordProd_append, wordProd_braidWord_eq] + +class Matsumoto (W1 : Type*) [CoxeterGroup W1] : Prop where + /-- **Matsumoto's theorem** + (Tits' solution to the word problem for Coxeter groups) + Any two reduced words for the same element `w` + are connected by a finite chain of elementary braid moves. -/ + reduced_words_convert : ∀ w : W1, + ∀ ω ω': ReducedWord w, + Relation.EqvGen (BraidMove (W:=W1)) ω.val ω'.val + +end BraidMoves + section opposite /-! ### Opposite group -/ From 4ac119a76df619d94fc3be9958838f94e7932eec Mon Sep 17 00:00:00 2001 From: Cobord Date: Fri, 3 Jul 2026 15:13:03 -0400 Subject: [PATCH 03/12] more helpful lemmas --- Coxeter/Bruhat.lean | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/Coxeter/Bruhat.lean b/Coxeter/Bruhat.lean index 81d9a75..16d33e6 100644 --- a/Coxeter/Bruhat.lean +++ b/Coxeter/Bruhat.lean @@ -314,6 +314,14 @@ theorem finite_Icc (u w : W) : Finite (Set.Icc u w) := by noncomputable instance : LocallyFiniteOrder W := LocallyFiniteOrder.ofFiniteIcc finite_Icc +/-- Bruhat intervals are finite. -/ +lemma bruhat_interval_finite (u w : W) : {v : W | u ≤ v ∧ v ≤ w}.Finite := by + exact Set.Finite.ofFinset (Finset.Icc u w) (by simp) + +/-- Principal lower Bruhat intervals are finite. -/ +lemma bruhat_le_setOf_finite (w : W) : {u : W | u ≤ w}.Finite := by + exact Set.Finite.ofFinset (Finset.Icc (⊥ : W) w) (by simp) + /-- Bjorner--Brenti Corollary 2.2.4 -/ theorem card_Icc_le (u w : W) : (Finset.Icc u w).card ≤ 2 ^ cs.length w := by classical @@ -370,6 +378,33 @@ theorem covBy_iff {u w : W} : u ⋖ w ↔ u ≤ w ∧ cs.length u + 1 = cs.lengt show grade ℕ = cs.length by rfl] grind +theorem le_mul_of_isReflection_of_length_lt {u t : W} (ht : cs.IsReflection t) + (hlt : cs.length u < cs.length (u * t)) : u ≤ u * t := + le.step u u (u * t) (le.rfl _) (by simpa [mul_assoc] using ht.conj u) hlt + +theorem covBy_iff_exists_reflection {u w : W} : + u ⋖ w ↔ ∃ t : W, cs.IsReflection t ∧ w = u * t ∧ cs.length u + 1 = cs.length w := by + constructor + · intro h + have hlen := length_cover h + have hle := h.1.1 + induction hle with + | rfl => + exact (h.ne rfl).elim + | step v w huv href hlt ih => + have huv_eq : u = v := by + apply eq_of_le_of_length_eq huv + have huv_len := length_le_of_le huv + have : cs.length v < cs.length u + 1 := by + rwa [←hlen] at hlt + omega + subst v + refine ⟨u⁻¹ * w, ?_, by simp, hlen⟩ + simpa [mul_assoc] using href.conj u⁻¹ + · rintro ⟨t, ht, rfl, hlen⟩ + rw [covBy_iff] + exact ⟨le_mul_of_isReflection_of_length_lt ht (by omega), hlen⟩ + theorem simple_mul_covBy_self_iff (i : B W) (w : W) : cs.simple i * w ⋖ w ↔ cs.IsLeftDescent w i := by rw [covBy_iff, ←cs.isLeftDescent_iff, ←simple_mul_lt_self_iff, and_iff_right_iff_imp] From 5f487beaf4965b213504d19b3924f2f84cc8ef28 Mon Sep 17 00:00:00 2001 From: Cobord Date: Fri, 3 Jul 2026 15:21:22 -0400 Subject: [PATCH 04/12] Artin braid --- Coxeter/BraidGroup.lean | 130 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 130 insertions(+) create mode 100644 Coxeter/BraidGroup.lean diff --git a/Coxeter/BraidGroup.lean b/Coxeter/BraidGroup.lean new file mode 100644 index 0000000..a0d4b83 --- /dev/null +++ b/Coxeter/BraidGroup.lean @@ -0,0 +1,130 @@ +module + +public import Coxeter.Basic +public import Mathlib.GroupTheory.PresentedGroup + +/-! +# The Artin (braid) group of a Coxeter system + +The Artin (braid) group is the group +generated by the simple reflections of a Coxeter system +quotiented by the braid relations, but *not* the quadratic relations `s_i^2 = 1`. + +The natural quotient map is `quot : BraidGroup W →* W`. + +Assuming `Matsumoto W` there is a well-defined lift +`existsUnique_braidLift` of `w : W` back into `BraidGroup W`, +via any reduced word for `w`. + +## Main definitions + +* `Coxeter.BraidGroup`, `Coxeter.quot` +* `Coxeter.existsUnique_braidLift` +-/ + +@[expose] public section + +namespace Coxeter + +open List CoxeterSystem CoxeterGroup + +variable {W : Type*} [CoxeterGroup W] + +section ArtinBraid + +/-! ### The Artin (braid) group, and the lift `W → BraidGroup W` -/ + +/-- The defining relations of the Artin (braid) group attached to a Coxeter system: +for each pair of simple reflections `i i'`, the two braid words +`s_i s_{i'} s_i ⋯` and `s_{i'} s_i s_{i'} ⋯` (`M i i'` letters each) become equal. -/ +def braidGroupRels (W : Type*) [CoxeterGroup W] : Set (FreeGroup (B W)) := + {r | ∃ i i' : B W, + r = ((braidWord M i i').map FreeGroup.of).prod + * (((braidWord M i' i).map FreeGroup.of).prod)⁻¹} + +/-- The **Artin (braid) group** of a Coxeter system +generators `B W`, modulo only the braid relations. -/ +abbrev BraidGroup (W : Type*) [CoxeterGroup W] : Type _ := PresentedGroup (braidGroupRels W) + +/-- The group homomorphism collapsing `BraidGroup W` back onto `W` +sending each generator to the corresponding simple reflection. -/ +def quot {W : Type*} [CoxeterGroup W] : BraidGroup W →* W := + PresentedGroup.toGroup (f := fun i => cs.simple i) (by + rintro r ⟨i, i', rfl⟩ + simp only [map_mul, map_inv, mul_inv_eq_one] + rw [map_list_prod, map_list_prod, List.map_map, List.map_map] + have : ((braidWord M i i').map (FreeGroup.lift (fun i => cs.simple i) ∘ FreeGroup.of)).prod + = cs.wordProd (braidWord M i i') := by + congr 1 + apply List.map_congr_left + intro j _ + exact FreeGroup.lift_apply_of + rw [this] + have : ((braidWord M i' i).map (FreeGroup.lift (fun i => cs.simple i) ∘ FreeGroup.of)).prod + = cs.wordProd (braidWord M i' i) := by + congr 1 + apply List.map_congr_left + intro j _ + exact FreeGroup.lift_apply_of + rw [this] + exact cs.wordProd_braidWord_eq i i') + +end ArtinBraid + +section LiftQuot + +/-- The naive lift of a word to `BraidGroup W`, sending each letter to its generator. -/ +def braidLift {W : Type*} [CoxeterGroup W] (ω : List (B W)) : BraidGroup W := + (ω.map (PresentedGroup.of (rels := braidGroupRels W))).prod + +private theorem braidLift_eq_mk {W : Type*} [CoxeterGroup W] (l : List (B W)) : + braidLift l = PresentedGroup.mk (braidGroupRels W) ((l.map FreeGroup.of).prod) := by + simp only [braidLift, map_list_prod, List.map_map] + rfl + +private theorem braidLift_append {W : Type*} [CoxeterGroup W] (l1 l2 : List (B W)) : + braidLift (W := W) (l1 ++ l2) = braidLift l1 * braidLift l2 := by + simp [braidLift, List.map_append, List.prod_append] + +private theorem quot_braidLift {W : Type*} [CoxeterGroup W] (ω : List (B W)) : + quot (braidLift ω) = cs.wordProd ω := by + unfold braidLift quot wordProd + rw [map_list_prod, List.map_map] + congr 1 + apply List.map_congr_left + intro i _ + exact PresentedGroup.toGroup.of _ + +private theorem braidLift_of_braidMove {ω ω' : List (B W)} (h : BraidMove ω ω') : + braidLift ω = braidLift ω' := by + obtain ⟨i, i', α, β, hω, hω'⟩ := h + have hrel : ((braidWord M i i').map FreeGroup.of).prod + * (((braidWord M i' i).map FreeGroup.of).prod)⁻¹ ∈ braidGroupRels W := ⟨i, i', rfl⟩ + have hmid : braidLift (braidWord M i i') = braidLift (braidWord M i' i) := by + rw [braidLift_eq_mk, braidLift_eq_mk] + exact PresentedGroup.mk_eq_mk_of_mul_inv_mem hrel + rw [hω, hω', braidLift_append, braidLift_append, braidLift_append, braidLift_append, hmid] + +private theorem braidLift_of_eqvGen {ω ω' : List (B W)} (h : Relation.EqvGen BraidMove ω ω') : + braidLift ω = braidLift ω' := by + induction h with + | rel a b hab => exact braidLift_of_braidMove hab + | refl => rfl + | symm _ _ _ ih => exact ih.symm + | trans _ _ _ _ _ ih1 ih2 => exact ih1.trans ih2 + +/-- **The set of candidate values is a singleton** +The image of a reduced word for `w` under +`braidLift` doesn't depend on which reduced word was chosen. -/ +theorem existsUnique_braidLift [Matsumoto W] (w : W) : + ∃! x : BraidGroup W, + ∃ ω : ReducedWord w, x = braidLift ω.val ∧ quot x = w + := by + obtain ⟨ω⟩ : Nonempty (ReducedWord w) := inferInstance + refine ⟨braidLift ω.val, ⟨ω, rfl, by rw [quot_braidLift, ω.wordProd_eq]⟩, ?_⟩ + rintro x ⟨ω', rfl, -⟩ + exact braidLift_of_eqvGen (Matsumoto.reduced_words_convert w ω' ω) + +end LiftQuot + +end Coxeter From 2ccbee5ecc2603d10d459dcf0301453528a3cf43 Mon Sep 17 00:00:00 2001 From: Cobord Date: Fri, 3 Jul 2026 15:22:48 -0400 Subject: [PATCH 05/12] associated graded of filtered, for filtered structures on hecke algebras --- Coxeter/LinearAlgebra/AssociatedGraded.lean | 365 ++++++++++++++++++++ 1 file changed, 365 insertions(+) create mode 100644 Coxeter/LinearAlgebra/AssociatedGraded.lean diff --git a/Coxeter/LinearAlgebra/AssociatedGraded.lean b/Coxeter/LinearAlgebra/AssociatedGraded.lean new file mode 100644 index 0000000..091372a --- /dev/null +++ b/Coxeter/LinearAlgebra/AssociatedGraded.lean @@ -0,0 +1,365 @@ +module + +public import Mathlib.Algebra.DirectSum.Ring +public import Mathlib.Algebra.DirectSum.Module +public import Mathlib.LinearAlgebra.Quotient.Bilinear + +/-! +# Associated graded ring of a filtered algebra + +Given a `CommRing R`, a `Ring A` that is an `R`-algebra, +and an increasing, unital, submultiplicative `ℕ`-indexed filtration +`F : ℕ → Submodule R A` (bundled as `Coxeter.Filtration`), +this file constructs the graded pieces +`F.piece n := F.carrier n ⧸ F.carrier (n - 1)` (with `F.carrier (-1) := ⊥`) +and the bilinear multiplication `F.mulPiece` they inherit from `A`. + +`F.AssociatedGraded := ⨁ n, F.piece n` is a full associative, unital `Ring` and `R`-algebra, +all proved: the graded-monoid unitality/associativity laws +(`piece_one_mul`/`piece_mul_one`/`piece_mul_assoc`) +are established by transporting `A`'s own unitality/associativity +across `Nat.zero_add`/`Nat.add_zero`/`Nat.add_assoc` +(`mkPiece_heq`, `coe_carrier_cast`); +the `R`-algebra structure needs no such reindexing, +since scalar multiplication doesn't change degree +(`smul_mul_left`, `mul_smul_right`). + +## Main definitions + +* `Coxeter.Filtration` +* `Coxeter.Filtration.piece`, `Coxeter.Filtration.mulPiece` +* `Coxeter.Filtration.AssociatedGraded` +-/ + +@[expose] public section + +open DirectSum + +namespace Coxeter + +variable {R A : Type*} [CommRing R] [Ring A] [Algebra R A] + +/-- An increasing, unital, submultiplicative `ℕ`-indexed filtration of an `R`-algebra `A`: +`1 ∈ F.carrier 0`, +`F.carrier` is monotone, +and `F.carrier m * F.carrier n ⊆ F.carrier (m + n)`. -/ +structure Filtration (R A : Type*) [CommRing R] [Ring A] [Algebra R A] where + /-- The `n`-th filtration piece `F n`. -/ + carrier : ℕ → Submodule R A + mono : Monotone carrier + one_mem : (1 : A) ∈ carrier 0 + mul_mem : ∀ {m n : ℕ} {x y : A}, x ∈ carrier m → y ∈ carrier n → x * y ∈ carrier (m + n) + +namespace Filtration + +variable (F : Filtration R A) + +/-- `F.below n = F.carrier (n - 1)` (and `F.below 0 = ⊥`): +the filtration piece one degree below `n`, +against which the degree-`n` graded piece `F.piece n` is taken. -/ +def below : ℕ → Submodule R A + | 0 => ⊥ + | n + 1 => F.carrier n + +private theorem below_le (n : ℕ) : F.below n ≤ F.carrier n := by + cases n with + | zero => exact bot_le + | succ n => exact F.mono n.le_succ + +private theorem mul_mem_below_left {m n : ℕ} {x y : A} (hx : x ∈ F.below m) (hy : y ∈ F.carrier n) : + x * y ∈ F.below (m + n) := by + cases m with + | zero => + have : x = 0 := hx + simp [this] + | succ m => + rw [Nat.succ_add] + exact F.mul_mem hx hy + +private theorem mul_mem_below_right {m n : ℕ} {x y : A} + (hx : x ∈ F.carrier m) (hy : y ∈ F.below n) : + x * y ∈ F.below (m + n) := by + cases n with + | zero => + have : y = 0 := hy + simp [this] + | succ n => exact F.mul_mem hx hy + +/-- The `n`-th associated graded piece `F.carrier n ⧸ F.below n`. -/ +def piece (n : ℕ) : Type _ := + F.carrier n ⧸ (F.below n).comap (F.carrier n).subtype + +instance piece.addCommGroup (n : ℕ) : AddCommGroup (F.piece n) := + inferInstanceAs (AddCommGroup (F.carrier n ⧸ (F.below n).comap (F.carrier n).subtype)) + +instance piece.module (n : ℕ) : Module R (F.piece n) := + inferInstanceAs (Module R (F.carrier n ⧸ (F.below n).comap (F.carrier n).subtype)) + +/-- The quotient map `F.carrier n → F.piece n`. -/ +def mkPiece (n : ℕ) : F.carrier n →ₗ[R] F.piece n := + Submodule.mkQ _ + +/-- The raw multiplication `F.carrier m × F.carrier n → F.piece (m + n)`, +before descending to the quotients `F.piece m`, `F.piece n`. -/ +def mulRaw (m n : ℕ) : F.carrier m →ₗ[R] F.carrier n →ₗ[R] F.piece (m + n) := + LinearMap.mk₂ R + (fun x y => F.mkPiece (m + n) ⟨(x : A) * (y : A), F.mul_mem x.2 y.2⟩) + (fun x₁ x₂ y => by + simp only [← map_add] + congr 1 + exact Subtype.ext (add_mul ..)) + (fun c x y => by + simp only [← map_smul] + congr 1 + exact Subtype.ext (smul_mul_assoc c (x : A) (y : A))) + (fun x y₁ y₂ => by + simp only [← map_add] + congr 1 + exact Subtype.ext (mul_add ..)) + (fun c x y => by + simp only [← map_smul] + congr 1 + exact Subtype.ext (mul_smul_comm c (x : A) (y : A))) + +theorem mulRaw_ker_left (m n : ℕ) : + (F.below m).comap (F.carrier m).subtype ≤ (F.mulRaw m n).ker := by + intro x hx + ext y + exact (Submodule.Quotient.mk_eq_zero _).mpr (F.mul_mem_below_left hx y.2) + +theorem mulRaw_ker_right (m n : ℕ) : + (F.below n).comap (F.carrier n).subtype ≤ (F.mulRaw m n).flip.ker := by + intro y hy + ext x + exact (Submodule.Quotient.mk_eq_zero _).mpr (F.mul_mem_below_right x.2 hy) + +/-- The induced multiplication `F.piece m × F.piece n → F.piece (m + n)`. -/ +def mulPiece (m n : ℕ) : F.piece m →ₗ[R] F.piece n →ₗ[R] F.piece (m + n) := + (F.mulRaw m n).liftQ₂ _ _ (F.mulRaw_ker_left m n) (F.mulRaw_ker_right m n) + +@[simp] +private theorem mulPiece_mk (m n : ℕ) (x : F.carrier m) (y : F.carrier n) : + F.mulPiece m n (F.mkPiece m x) (F.mkPiece n y) + = F.mkPiece (m + n) ⟨(x : A) * (y : A), F.mul_mem x.2 y.2⟩ := + rfl + +/-- The distinguished element `1 ∈ F.piece 0`. -/ +def onePiece : F.piece 0 := F.mkPiece 0 ⟨1, F.one_mem⟩ + +instance : GradedMonoid.GMul F.piece where + mul {i j} a b := F.mulPiece i j a b + +instance : GradedMonoid.GOne F.piece where + one := F.onePiece + +instance : DirectSum.GNonUnitalNonAssocSemiring F.piece where + mul_zero a := map_zero (F.mulPiece _ _ a) + zero_mul b := LinearMap.map_zero₂ (F.mulPiece _ _) b + mul_add a b c := map_add (F.mulPiece _ _ a) b c + add_mul a b c := LinearMap.map_add₂ (F.mulPiece _ _) a b c + +/-- The associated graded `R`-module `⨁ n, F.piece n`. +An `abbrev`, not a bare `def` (unlike `Coxeter.NilHeckeAlgebra`): +its ring structure genuinely *is* the direct sum's own, +so `DirectSum`'s lemmas (`of_mul_of`, `of_smul`, ...) apply to it directly. -/ +abbrev AssociatedGraded : Type _ := ⨁ n, F.piece n + +noncomputable instance : AddCommGroup F.AssociatedGraded := + inferInstanceAs (AddCommGroup (⨁ n, F.piece n)) + +noncomputable instance : Module R F.AssociatedGraded := + inferInstanceAs (Module R (⨁ n, F.piece n)) + +/-- The multiplication on `F.AssociatedGraded` induced degreewise by `mulPiece`: +distributive (`NonUnitalNonAssocSemiring`). -/ +noncomputable instance : NonUnitalNonAssocSemiring F.AssociatedGraded := + inferInstanceAs (NonUnitalNonAssocSemiring (⨁ n, F.piece n)) + +instance : One F.AssociatedGraded where + one := DirectSum.of _ _ (F.onePiece) + +theorem natCast_mem (n : ℕ) : (n : A) ∈ F.carrier 0 := by + induction n with + | zero => simp [(F.carrier 0).zero_mem] + | succ n ih => simpa [Nat.cast_succ] using (F.carrier 0).add_mem ih F.one_mem + +theorem intCast_mem (z : ℤ) : (z : A) ∈ F.carrier 0 := by + cases z with + | ofNat n => simpa using F.natCast_mem n + | negSucc n => simpa using (F.carrier 0).neg_mem (F.natCast_mem (n + 1)) + +private theorem mkPiece_surjective (n : ℕ) : Function.Surjective (F.mkPiece n) := + Submodule.mkQ_surjective _ + +/-- Transporting `F.mkPiece m x` across a proof `m = n` +(reinterpreting `x : F.carrier m` as an element of `F.carrier n`) +lands `HEq`-equal to `F.mkPiece n` of the transported element: +the basic tool for comparing graded pieces +at propositionally-but-not-definitionally-equal indices. -/ +private theorem mkPiece_heq {m n : ℕ} (h : m = n) (x : F.carrier m) : + HEq (F.mkPiece m x) (F.mkPiece n (h ▸ x)) := by + subst h + rfl + +/-- Transporting a carrier element along a proof of index equality +doesn't change its underlying value in `A`. -/ +private theorem coe_carrier_cast {m n : ℕ} (h : m = n) (x : F.carrier m) : + ((h ▸ x : F.carrier n) : A) = (x : A) := by + subst h + rfl + +/-- The obligation that `1 * a = a` in the graded monoid `F.piece`, +i.e. `A`'s own left unitality +transported across the reindexing `Nat.zero_add`. -/ +theorem piece_one_mul (a : GradedMonoid F.piece) : + (1 : GradedMonoid F.piece) * a = a := by + obtain ⟨i, a⟩ := a + obtain ⟨a, rfl⟩ := F.mkPiece_surjective i a + refine Sigma.ext (zero_add i) ?_ + refine HEq.trans (heq_of_eq (F.mulPiece_mk 0 i ⟨1, F.one_mem⟩ a)) ?_ + refine HEq.trans (F.mkPiece_heq (zero_add i) ⟨(1 : A) * (a : A), F.mul_mem F.one_mem a.2⟩) ?_ + apply heq_of_eq + congr 1 + exact Subtype.ext (by rw [F.coe_carrier_cast]; exact one_mul (a : A)) + +/-- The obligation that `a * 1 = a` in the graded monoid `F.piece`, +i.e. `A`'s own right unitality +transported across the reindexing `Nat.add_zero`. -/ +theorem piece_mul_one (a : GradedMonoid F.piece) : + a * (1 : GradedMonoid F.piece) = a := by + obtain ⟨i, a⟩ := a + change GradedMonoid.mk (i + 0) (F.mulPiece i 0 a F.onePiece) = GradedMonoid.mk i a + congr 1 + obtain ⟨a, rfl⟩ := F.mkPiece_surjective i a + rw [onePiece, mulPiece_mk] + congr 1 + exact Subtype.ext (mul_one (a : A)) + +/-- The obligation that multiplication in the graded monoid `F.piece` is associative, +i.e. `A`'s own associativity +transported across the reindexing `Nat.add_assoc`. -/ +theorem piece_mul_assoc (a b c : GradedMonoid F.piece) : + a * b * c = a * (b * c) := by + obtain ⟨i, a⟩ := a + obtain ⟨j, b⟩ := b + obtain ⟨k, c⟩ := c + obtain ⟨a, rfl⟩ := F.mkPiece_surjective i a + obtain ⟨b, rfl⟩ := F.mkPiece_surjective j b + obtain ⟨c, rfl⟩ := F.mkPiece_surjective k c + refine Sigma.ext (add_assoc i j k) ?_ + refine HEq.trans (heq_of_eq (?_ : F.mulPiece (i + j) k + (F.mulPiece i j (F.mkPiece i a) (F.mkPiece j b)) (F.mkPiece k c) + = F.mkPiece (i + j + k) ⟨((a : A) * (b : A)) * (c : A), + F.mul_mem (F.mul_mem a.2 b.2) c.2⟩)) ?_ + · rw [mulPiece_mk, mulPiece_mk] + refine HEq.trans (F.mkPiece_heq (add_assoc i j k) + ⟨((a : A) * (b : A)) * (c : A), F.mul_mem (F.mul_mem a.2 b.2) c.2⟩) ?_ + refine heq_of_eq (?_ : F.mkPiece (i + (j + k)) _ + = F.mulPiece i (j + k) (F.mkPiece i a) (F.mulPiece j k (F.mkPiece j b) (F.mkPiece k c))) + rw [mulPiece_mk, mulPiece_mk] + congr 1 + exact Subtype.ext (by rw [F.coe_carrier_cast]; exact mul_assoc (a : A) (b : A) (c : A)) + +instance : GradedMonoid.GMonoid F.piece where + one_mul := F.piece_one_mul + mul_one := F.piece_mul_one + mul_assoc := F.piece_mul_assoc + +/-- Everything a `DirectSum.GSemiring` needs beyond `GNonUnitalNonAssocSemiring`/`GMonoid` +(the natural-number cast into `F.piece 0`) is genuinely provable: +`F.carrier 0` is a submodule containing `1`, +hence closed under the `ℕ`-fold sums that define `Nat.cast`. -/ +instance : DirectSum.GSemiring F.piece := + { (inferInstance : DirectSum.GNonUnitalNonAssocSemiring F.piece), + (inferInstance : GradedMonoid.GMonoid F.piece) with + natCast := fun n => F.mkPiece 0 ⟨(n : A), F.natCast_mem n⟩ + natCast_zero := by + change F.mkPiece 0 ⟨((0 : ℕ) : A), F.natCast_mem 0⟩ = 0 + rw [← map_zero (F.mkPiece 0)] + congr 1 + exact Subtype.ext (by norm_num) + natCast_succ := fun n => by + change F.mkPiece 0 ⟨((n + 1 : ℕ) : A), F.natCast_mem (n + 1)⟩ + = F.mkPiece 0 ⟨((n : ℕ) : A), F.natCast_mem n⟩ + F.onePiece + rw [onePiece, ← map_add] + congr 1 + exact Subtype.ext (by push_cast; ring_nf) } + +/-- Likewise, the integer cast into `F.piece 0` is genuinely provable: +`F.carrier 0` is a submodule, +hence also closed under negation. -/ +instance : DirectSum.GRing F.piece := + { (inferInstance : DirectSum.GSemiring F.piece) with + intCast := fun z => F.mkPiece 0 ⟨(z : A), F.intCast_mem z⟩ + intCast_ofNat := fun n => by + change F.mkPiece 0 ⟨((n : ℤ) : A), F.intCast_mem n⟩ + = F.mkPiece 0 ⟨((n : ℕ) : A), F.natCast_mem n⟩ + congr 1 + exact Subtype.ext (by push_cast; ring_nf) + intCast_negSucc_ofNat := fun n => by + change F.mkPiece 0 ⟨((Int.negSucc n : ℤ) : A), F.intCast_mem (Int.negSucc n)⟩ + = -F.mkPiece 0 ⟨(((n + 1 : ℕ)) : A), F.natCast_mem (n + 1)⟩ + rw [← map_neg] + congr 1 + exact Subtype.ext (by push_cast [Int.negSucc_eq]; ring_nf) } + +/-- `F.AssociatedGraded` as an associative, unital `Ring`, +assembled from the `DirectSum.GRing` instance above. -/ +noncomputable instance : Ring F.AssociatedGraded := + inferInstanceAs (Ring (⨁ n, F.piece n)) + +/-- `GMul.mul` on `F.piece` unfolds to `F.mulPiece`, +so `mulPiece`'s linearity can be invoked by name below. -/ +private theorem gmul_eq_mulPiece {i j : ℕ} (a : F.piece i) (b : F.piece j) : + GradedMonoid.GMul.mul a b = F.mulPiece i j a b := + rfl + +/-- Left `R`-linearity of the graded multiplication, restated for `GMul.mul`. -/ +private theorem piece_smul_mul_left (r : R) {i j : ℕ} (a : F.piece i) (b : F.piece j) : + r • GradedMonoid.GMul.mul a b = GradedMonoid.GMul.mul (r • a) b := by + rw [gmul_eq_mulPiece, gmul_eq_mulPiece, LinearMap.map_smul₂] + +/-- Right `R`-linearity of the graded multiplication, restated for `GMul.mul`. -/ +private theorem piece_smul_mul_right (r : R) {i j : ℕ} (a : F.piece i) (b : F.piece j) : + r • GradedMonoid.GMul.mul a b = GradedMonoid.GMul.mul a (r • b) := by + rw [gmul_eq_mulPiece, gmul_eq_mulPiece, map_smul] + +/-- `(r • x) * y = r • (x * y)` on `F.AssociatedGraded`, +via `DirectSum.induction_on` reducing to `piece_smul_mul_left` on pure tensors. -/ +theorem smul_mul_left (r : R) (x y : F.AssociatedGraded) : r • x * y = r • (x * y) := by + induction x using DirectSum.induction_on with + | zero => simp only [zero_mul, smul_zero] + | of i a => + induction y using DirectSum.induction_on with + | zero => simp only [mul_zero, smul_zero] + | of j b => + rw [DirectSum.of_mul_of, ← DirectSum.of_smul, ← DirectSum.of_smul, + DirectSum.of_mul_of] + exact congrArg (DirectSum.of F.piece (i + j)) (F.piece_smul_mul_left r a b).symm + | add y y' hy hy' => simp [mul_add, smul_add, hy, hy'] + | add x x' hx hx' => simp [add_mul, smul_add, hx, hx'] + +/-- `x * (r • y) = r • (x * y)` on `F.AssociatedGraded`, +via `DirectSum.induction_on` reducing to `piece_smul_mul_right` on pure tensors. -/ +theorem mul_smul_right (r : R) (x y : F.AssociatedGraded) : x * r • y = r • (x * y) := by + induction x using DirectSum.induction_on with + | zero => simp only [zero_mul, smul_zero] + | of i a => + induction y using DirectSum.induction_on with + | zero => simp only [mul_zero, smul_zero] + | of j b => + rw [DirectSum.of_mul_of, ← DirectSum.of_smul, ← DirectSum.of_smul, + DirectSum.of_mul_of] + exact congrArg (DirectSum.of F.piece (i + j)) (F.piece_smul_mul_right r a b).symm + | add y y' hy hy' => simp [mul_add, smul_add, hy, hy'] + | add x x' hx hx' => simp [add_mul, smul_add, hx, hx'] + +/-- `F.AssociatedGraded` as an `R`-algebra, via `Algebra.ofModule`: +no `Nat`-reindexing is involved here, unlike `Ring`, +since scalar multiplication doesn't change degree. -/ +noncomputable instance : Algebra R F.AssociatedGraded := + Algebra.ofModule F.smul_mul_left F.mul_smul_right + +end Filtration + +end Coxeter From 3c5762a89c8b8a135f1aa67bbd4a6acb6ee533b2 Mon Sep 17 00:00:00 2001 From: Cobord Date: Fri, 3 Jul 2026 15:24:35 -0400 Subject: [PATCH 06/12] WIP hecke algebra --- .gitignore | 3 +- Coxeter.lean | 3 + Coxeter/Hecke.lean | 905 +++++++++++++++++++++++++++++++++++ docbuild/docs/references.bib | 8 + 4 files changed, 918 insertions(+), 1 deletion(-) create mode 100644 Coxeter/Hecke.lean diff --git a/.gitignore b/.gitignore index 0b8e037..28126f5 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ /.lake -/docbuild/.lake \ No newline at end of file +/docbuild/.lake +NilHecke.lean \ No newline at end of file diff --git a/Coxeter.lean b/Coxeter.lean index 653b7ee..5a1f2a0 100644 --- a/Coxeter.lean +++ b/Coxeter.lean @@ -1,11 +1,14 @@ module public import Coxeter.Basic +public import Coxeter.BraidGroup public import Coxeter.Bruhat public import Coxeter.Data.List.Lemmas public import Coxeter.GeometricRepresentation +public import Coxeter.LinearAlgebra.AssociatedGraded public import Coxeter.LinearAlgebra.BilinearForm public import Coxeter.LinearAlgebra.TwoDim public import Coxeter.Order.Directed public import Coxeter.PermutationRepresentation public import Coxeter.StrongExchange +public import Coxeter.Hecke diff --git a/Coxeter/Hecke.lean b/Coxeter/Hecke.lean new file mode 100644 index 0000000..ec57d01 --- /dev/null +++ b/Coxeter/Hecke.lean @@ -0,0 +1,905 @@ +module + +public import Coxeter.Basic +public import Mathlib.Algebra.MonoidAlgebra.Basic +public import Mathlib.Algebra.Polynomial.Laurent +public import Mathlib.Algebra.FreeAlgebra +public import Mathlib.Algebra.RingQuot +public import Mathlib.RingTheory.TensorProduct.Basic +public import Mathlib.RingTheory.TensorProduct.Maps +public import Coxeter.LinearAlgebra.AssociatedGraded +public import Coxeter.StrongExchange + +/-! +# The Iwahori–Hecke algebra + +The Iwahori–Hecke algebra of a Coxeter group, +which is the deformation of the group algebra of `W`. + +This is the **multiparameter** (unequal parameter) Hecke algebra. +we work over the Laurent polynomial ring +`ℤ[v_i^{±1} : i ∈ B W]` +with one indeterminate `v_i` per simple reflection, and +Hecke parameter `q_i := v_i ^ 2` at `i`. +The `v_i` are forced equal (`heckeV_eq_of_odd`) whenever +`i`, `i'` are connected by a chain of *odd* Coxeter-matrix entries. + +`HeckeAlgebra` is defined as the free `HeckeRing`-algebra +on the simple reflections `B W`, modulo the relations + +* `T_i ^ 2 = (q_i - 1) • T_i + q_i • 1` for each simple reflection `T_i` (`T_simple_sq`), and +* `T_i T_{i'} T_i ⋯ = T_{i'} T_i T_{i'} ⋯` (`M i i'` factors on each side) for each pair of + simple reflections `T_i`, `T_{i'}` (`T_simple_braid`). + +The **bar involution** is the ring automorphism of `HeckeAlgebra` +sending `T_w ↦ (T_{w⁻¹})⁻¹`, +and is semilinear over the scalar automorphism +`Coxeter.barScalar : HeckeRing W ≃+* HeckeRing W` +sending `v_i ↦ v_i⁻¹` for each `i`. + +## Main definitions + +* `Coxeter.ParamIndex`, `Coxeter.HeckeRing`, `Coxeter.heckeV`, `Coxeter.heckeQ` +* `Coxeter.HeckeRingOne`, `Coxeter.heckeRingOneHom` +* `Coxeter.HeckeRel`, `Coxeter.HeckeAlgebra` +* `Coxeter.T_simple`, `Coxeter.T` +* `Coxeter.bar` + +## Main statements + +* `Coxeter.heckeV_eq_of_odd` +* `Coxeter.heckeRingOneHom_heckeV` +* `Coxeter.T_simple_sq`, `Coxeter.T_simple_braid` +* `Coxeter.T_one` +* `Coxeter.bar_T_involutive` + +## TODO + +`HeckeAlgebra` is presented by generators and relations, +but is not manifestly *free* of +rank `|W|` (i.e. that `{T_w : w ∈ W}` is a basis). + +## References + +* [humphreys1990] J. Humphreys, *Reflection Groups and Coxeter Groups* +* [bjorner2005] A. Björner and F. Brenti, *Combinatorics of Coxeter Groups* +-/ + +@[expose] public section + +namespace Coxeter + +open CoxeterGroup CoxeterSystem + +noncomputable section BaseRings + +/-- The equivalence relation on simple reflections +generated by "`M i i'` is odd": the standard +compatibility condition for multiparameter Hecke algebras, +since `s_i`, `s_{i'}` are conjugate in `W` +whenever they are connected by a chain of +odd Coxeter-matrix entries. -/ +def paramSetoid (W : Type*) [CoxeterGroup W] : Setoid (B W) := + Relation.EqvGen.setoid (fun i i' => Odd (M i i')) + +/-- The index set for Hecke parameters +simple reflections modulo `paramSetoid` +i.e. modulo the compatibility condition forcing `v_i = v_{i'}` +when `i`, `i'` are connected by a chain of odd Coxeter-matrix entries. -/ +def ParamIndex (W : Type*) [CoxeterGroup W] : Type _ := Quotient (paramSetoid W) + +/-- The multiparameter Laurent polynomial ring +`ℤ[v_i^{±1} : i ∈ ParamIndex W]`, with one +indeterminate per parameter class. +The Iwahori–Hecke algebra of a Coxeter system is defined over this ring. -/ +abbrev HeckeRing (W : Type*) [CoxeterGroup W] : Type _ := AddMonoidAlgebra ℤ (ParamIndex W →₀ ℤ) + +/-- `HeckeRing W` carries the ring involution `v_i ↦ v_i⁻¹` (negating exponents in the +multiparameter Laurent monomial) as its `star` operation. -/ +instance {W : Type*} [CoxeterGroup W] : StarRing (HeckeRing W) where + star := AddMonoidAlgebra.domCongr ℤ ℤ (AddEquiv.neg (ParamIndex W →₀ ℤ)) + star_involutive x := by + ext m + simp [AddMonoidAlgebra.domCongr_apply] + star_mul x y := by + change AddMonoidAlgebra.domCongr ℤ ℤ (AddEquiv.neg (ParamIndex W →₀ ℤ)) (x * y) + = AddMonoidAlgebra.domCongr ℤ ℤ (AddEquiv.neg (ParamIndex W →₀ ℤ)) y + * AddMonoidAlgebra.domCongr ℤ ℤ (AddEquiv.neg (ParamIndex W →₀ ℤ)) x + rw [map_mul, mul_comm] + star_add x y := map_add (AddMonoidAlgebra.domCongr ℤ ℤ (AddEquiv.neg (ParamIndex W →₀ ℤ))) x y + +/-- The distinguished indeterminate `v_i` +at the simple reflection `i`. -/ +def heckeV {W : Type*} [CoxeterGroup W] (i : B W) : HeckeRing W := + Finsupp.single (Finsupp.single (Quotient.mk (paramSetoid W) i) 1) 1 + +/-- The Hecke algebra parameter `q_i := v_i ^ 2` +at the simple reflection `i`. -/ +def heckeQ {W : Type*} [CoxeterGroup W] (i : B W) : HeckeRing W := heckeV i * heckeV i + +/-- The defining compatibility condition: `v_i` and `v_{i'}` +coincide whenever `M i i'` is odd +(in particular, whenever `s_i` and `s_{i'}` are conjugate +via a single odd braid relation). -/ +theorem heckeV_eq_of_odd {W : Type*} [CoxeterGroup W] {i i' : B W} (h : Odd (M i i')) : + heckeV i = heckeV i' := by + unfold heckeV + rw [Quotient.sound (Relation.EqvGen.rel i i' h)] + +def paramAugment (W : Type*) [CoxeterGroup W] : (ParamIndex W →₀ ℤ) →+ ℤ := + (Finsupp.linearCombination ℤ (fun _ : ParamIndex W => (1 : ℤ))).toAddMonoidHom + +/-- The classical single-parameter Hecke ring `ℤ[v, v⁻¹]` -/ +abbrev HeckeRingOne := LaurentPolynomial ℤ + +/-- `HeckeRingOne = ℤ[v, v⁻¹]` carries the ring involution `v ↦ v⁻¹` as its `star` operation. -/ +instance : StarRing HeckeRingOne where + star := LaurentPolynomial.invert + star_involutive := LaurentPolynomial.involutive_invert + star_mul x y := by + change LaurentPolynomial.invert (x * y) + = LaurentPolynomial.invert y * LaurentPolynomial.invert x + rw [map_mul, mul_comm] + star_add x y := map_add LaurentPolynomial.invert x y + +/-- The **equal-parameter specialization** +The `ℤ`-algebra homomorphism sending every `v_i` to +the same `v` (`heckeRingOneHom_heckeV`) +collapsing the multiparameter Hecke ring `HeckeRing W` +to the classical single-parameter one `HeckeRingOne`. +Tensoring with `HeckeRingOne` over `HeckeRing W` gives the +classical single-parameter Iwahori–Hecke algebra. +It is compatible with `star` on both sides (`v_i ↦ v_i⁻¹` and `v ↦ v⁻¹`), i.e. a star algebra +homomorphism. -/ +def heckeRingOneHom {W : Type*} [CoxeterGroup W] : HeckeRing W →⋆ₐ[ℤ] HeckeRingOne := + { AddMonoidAlgebra.mapDomainAlgHom ℤ ℤ (paramAugment W) with + map_star' := fun x => by + have h : (AddMonoidAlgebra.mapDomainAlgHom ℤ ℤ (paramAugment W)).comp + (AddMonoidAlgebra.domCongr ℤ ℤ (AddEquiv.neg (ParamIndex W →₀ ℤ)) + : HeckeRing W →ₐ[ℤ] HeckeRing W) + = (LaurentPolynomial.invert (R := ℤ)).toAlgHom.comp + (AddMonoidAlgebra.mapDomainAlgHom ℤ ℤ (paramAugment W)) := by + apply AddMonoidAlgebra.algHom_ext + intro g + simp [AddMonoidAlgebra.domCongr_single, map_neg] + exact congrFun (congrArg DFunLike.coe h) x } + +theorem heckeRingOneHom_heckeV {W : Type*} [CoxeterGroup W] (i : B W) : + heckeRingOneHom (heckeV i) = LaurentPolynomial.T 1 := by + unfold heckeV heckeRingOneHom + rw [StarAlgHom.coe_mk', AddMonoidAlgebra.mapDomainAlgHom_apply, AddMonoidAlgebra.mapDomain_single] + change Finsupp.single (paramAugment W (Finsupp.single (Quotient.mk (paramSetoid W) i) 1)) 1 + = Finsupp.single (1 : ℤ) 1 + congr 1 + simp [paramAugment, Finsupp.linearCombination_single] + +/-- `paramAugment W` hits every integer already at a single simple reflection's class, so it is +surjective as soon as there is at least one simple reflection. -/ +theorem paramAugment_surjective {W : Type*} [CoxeterGroup W] [Nonempty (B W)] : + Function.Surjective (paramAugment W) := by + obtain ⟨i⟩ := ‹Nonempty (B W)› + intro n + exact ⟨Finsupp.single (Quotient.mk (paramSetoid W) i) n, by + simp [paramAugment, Finsupp.linearCombination_single]⟩ + +/-- The equal-parameter specialization `heckeRingOneHom` is surjective: every `v_i ↦ v`, so the +image already contains `v` and hence (being a ring homomorphism) every `v^n`, spanning all of +`HeckeRingOne = ℤ[v, v⁻¹]`. Needs at least one simple reflection (`Nonempty (B W)`) — with none, +`v` itself is never hit. -/ +theorem heckeRingOneHom_surjective {W : Type*} [CoxeterGroup W] [Nonempty (B W)] : + Function.Surjective (heckeRingOneHom (W := W)) := by + intro s + obtain ⟨x, hx⟩ := Finsupp.mapDomain_surjective (M := ℤ) (paramAugment_surjective (W := W)) s + refine ⟨x, ?_⟩ + unfold heckeRingOneHom + rw [StarAlgHom.coe_mk', AddMonoidAlgebra.mapDomainAlgHom_apply] + exact hx + +end BaseRings + +section MultiparamDef + +/-- The defining relations of the Iwahori–Hecke algebra +imposed on the free algebra on the simple reflections +- The quadratic relation for each generator +- The braid relation for each pair of generators. +-/ +inductive HeckeRel (W : Type*) [CoxeterGroup W] : + FreeAlgebra (HeckeRing W) (B W) → FreeAlgebra (HeckeRing W) (B W) → Prop + | quad (i : B W) : + HeckeRel W (FreeAlgebra.ι (HeckeRing W) i * FreeAlgebra.ι (HeckeRing W) i) + ((heckeQ i - 1) • FreeAlgebra.ι (HeckeRing W) i + heckeQ i • 1) + | braid (i i' : B W) : + HeckeRel W ((braidWord M i i').map (FreeAlgebra.ι (HeckeRing W))).prod + ((braidWord M i' i).map (FreeAlgebra.ι (HeckeRing W))).prod + +/-- The **Iwahori–Hecke algebra** +The free `HeckeRing`-algebra on the simple reflections, +modulo the quadratic and braid relations (`HeckeRel`). +Its `Ring`/`Algebra` structure comes for free from `RingQuot`. -/ +abbrev HeckeAlgebra (W : Type*) [CoxeterGroup W] : Type _ := RingQuot (HeckeRel W) + +variable {W : Type*} [CoxeterGroup W] [mat : Matsumoto (W1 := W)] + +/-- The generator `T_i` of the Hecke algebra. -/ +noncomputable def T_simple (i : B W) : HeckeAlgebra W := + RingQuot.mkAlgHom (HeckeRing W) (HeckeRel W) (FreeAlgebra.ι (HeckeRing W) i) + +omit mat in +theorem T_simple_sq (i : B W) : + T_simple i * T_simple i = (heckeQ i - 1) • T_simple i + heckeQ i • (1 : HeckeAlgebra W) := by + have h := RingQuot.mkAlgHom_rel (HeckeRing W) (HeckeRel.quad (W := W) i) + simpa [T_simple, map_mul, map_add, map_smul, map_one] using h + +omit mat in +theorem T_simple_braid (i i' : B W) : + ((braidWord M i i').map T_simple).prod = ((braidWord M i' i).map T_simple).prod := by + have h := RingQuot.mkAlgHom_rel (HeckeRing W) (HeckeRel.braid (W := W) i i') + simpa [T_simple, map_list_prod] using h + +/-- The standard basis element `T_w` +The product of the generators `T_simple` along an +(arbitrarily chosen) reduced word for `w`. +Independence from that choice is deferred -/ +noncomputable def T (w : W) : HeckeAlgebra W := + ((Classical.arbitrary (ReducedWord w)).val.map T_simple).prod + +omit mat in +theorem T_one : T (1 : W) = 1 := by + simp only [T] + set ω := Classical.arbitrary (ReducedWord (1 : W)) with hω + have hlen : ω.val.length = 0 := by rw [ω.length_eq, cs.length_one] + have hnil : ω.val = [] := List.eq_nil_of_length_eq_zero hlen + simp [hnil] + +omit mat in +/-- A single elementary braid move (`Coxeter.BraidMove`) between two words doesn't change the +`T_simple`-product, since it's exactly the braid relation `T_simple_braid`. -/ +theorem BraidMove.T_simple_prod_eq {ω ω' : List (B W)} (h : BraidMove ω ω') : + (ω.map T_simple).prod = (ω'.map T_simple).prod := by + obtain ⟨i, i', α, β, hω, hω'⟩ := h + rw [hω, hω'] + simp only [List.map_append, List.prod_append, T_simple_braid] + +/-- `T w` doesn't depend on the choice of reduced word: it equals the `T_simple`-product along +*any* reduced word for `w`, not just the one used in the definition. This is where Matsumoto's +theorem (`Coxeter.eqvGen_braidMove_of_reduced`) is actually used: any two reduced words for `w` +are connected by a chain of braid moves, each of which preserves the `T_simple`-product +(`BraidMove.T_simple_prod_eq`). -/ +theorem T_eq_of_reducedWord {w : W} (ω : ReducedWord w) : + T w = (ω.val.map T_simple).prod := by + simp only [T] + set ω₀ := Classical.arbitrary (ReducedWord w) with hω₀ + clear_value ω₀ + clear hω₀ + have h : Relation.EqvGen BraidMove ω₀.val ω.val := mat.reduced_words_convert w ω₀ ω + generalize ω₀.val = l₀ at h ⊢ + generalize ω.val = l at h ⊢ + clear ω₀ ω + induction h with + | rel a b hab => exact hab.T_simple_prod_eq + | refl a => rfl + | symm a b _ ih => exact ih.symm + | trans a b c _ _ ih1 ih2 => exact ih1.trans ih2 + +theorem T_mul_T_of_length_add {u w : W} + (h : cs.length (u * w) = + cs.length u + cs.length w) : + T u * T w = T (u * w) := by + set ω := Classical.arbitrary (ReducedWord (w : W)) with hω + set υ := Classical.arbitrary (ReducedWord (u : W)) with hυ + have hred : cs.IsReduced (υ.val ++ ω.val) := by + unfold CoxeterSystem.IsReduced + rw [wordProd_append, υ.wordProd_eq, ω.wordProd_eq, h, List.length_append, υ.length_eq, + ω.length_eq] + have hwordProd : u * w = cs.wordProd (υ.val ++ ω.val) := by + rw [wordProd_append, υ.wordProd_eq, ω.wordProd_eq] + set ωυ : ReducedWord (u * w) := ⟨υ.val ++ ω.val, hred, hwordProd⟩ + calc T u * T w = (υ.val.map T_simple).prod * (ω.val.map T_simple).prod := by + rw [T_eq_of_reducedWord υ, T_eq_of_reducedWord ω] + _ = ((υ.val ++ ω.val).map T_simple).prod := by + rw [List.map_append, List.prod_append] + _ = T (u * w) := (T_eq_of_reducedWord ωυ).symm + +@[simp] +theorem T_simple_eq_T (i : B W) : T (cs.simple i) = T_simple i := by + let ω : ReducedWord (cs.simple i) := ⟨[i], isReduced_singleton i, by rw [wordProd_singleton]⟩ + rw [T_eq_of_reducedWord ω] + rw [List.map_cons, List.map_nil, List.prod_cons, List.prod_nil, mul_one] + +theorem T_mul_T_simple_of_not_rightDescent {w : W} {i : B W} + (h : ¬ cs.IsRightDescent w i) : + T w * T_simple i = T (w * cs.simple i) := by + rw [← T_simple_eq_T i] + exact T_mul_T_of_length_add (by rw [cs.not_isRightDescent_iff.mp h, cs.length_simple]) + +theorem T_mul_T_simple_of_rightDescent {w : W} {i : B W} + (h : cs.IsRightDescent w i) : + T w * T_simple i = + (heckeQ i - 1) • T w + heckeQ i • T (w * cs.simple i) := by + have hnot : ¬ cs.IsRightDescent (w * cs.simple i) i := + (cs.isRightDescent_iff_not_isRightDescent_mul.mp h) + have hmul := T_mul_T_simple_of_not_rightDescent (w := w * cs.simple i) (i := i) hnot + have hcancel : (w * cs.simple i) * cs.simple i = w := cs.simple_mul_simple_cancel_right i + calc + T w * T_simple i = (T (w * cs.simple i) * T_simple i) * T_simple i := by + rw [hmul, hcancel] + _ = T (w * cs.simple i) * (T_simple i * T_simple i) := by + rw [mul_assoc] + _ = T (w * cs.simple i) * + ((heckeQ i - 1) • T_simple i + heckeQ i • (1 : HeckeAlgebra W)) := by + rw [T_simple_sq] + _ = (heckeQ i - 1) • T w + heckeQ i • T (w * cs.simple i) := by + rw [mul_add, mul_smul_comm, mul_smul_comm, mul_one, hmul, hcancel] + +theorem T_mul_T_simple_mem_span {i : B W} {x : HeckeAlgebra W} + (hx : x ∈ Submodule.span (HeckeRing W) (Set.range (T (W := W)))) : + x * T_simple i ∈ Submodule.span (HeckeRing W) (Set.range (T (W := W))) := by + induction hx using Submodule.span_induction with + | mem x hx => + obtain ⟨w, rfl⟩ := hx + by_cases h : cs.IsRightDescent w i + · rw [T_mul_T_simple_of_rightDescent h] + exact Submodule.add_mem _ (Submodule.smul_mem _ _ (Submodule.subset_span ⟨w, rfl⟩)) + (Submodule.smul_mem _ _ (Submodule.subset_span ⟨w * cs.simple i, rfl⟩)) + · rw [T_mul_T_simple_of_not_rightDescent h] + exact Submodule.subset_span ⟨w * cs.simple i, rfl⟩ + | zero => + rw [zero_mul] + exact Submodule.zero_mem _ + | add x y _ _ hx hy => + rw [add_mul] + exact Submodule.add_mem _ hx hy + | smul c x _ hx => + rw [smul_mul_assoc] + exact Submodule.smul_mem _ c hx + +end MultiparamDef + +section LengthFiltration + +variable {W : Type*} [CoxeterGroup W] [mat : Matsumoto (W1 := W)] + +/-- Monomials of length at most `n` in the simple Hecke generators. -/ +noncomputable def heckeLengthFiltrationMonomials (n : ℕ) : Set (HeckeAlgebra W) := + {x | ∃ l : List (B W), l.length ≤ n ∧ (l.map T_simple).prod = x} + +/-- The length filtration on `HeckeAlgebra W`. +`F_n` is the `HeckeRing W`-span of products of +at most `n` simple generators. -/ +noncomputable def heckeLengthFiltration (n : ℕ) : Submodule (HeckeRing W) (HeckeAlgebra W) := + Submodule.span (HeckeRing W) (heckeLengthFiltrationMonomials (W := W) n) + +omit mat in +theorem one_mem_heckeLengthFiltration (n : ℕ) : + (1 : HeckeAlgebra W) ∈ heckeLengthFiltration (W := W) n := by + refine Submodule.subset_span ?_ + exact ⟨[], by simp, by simp⟩ + +omit mat in +theorem algebraMap_mem_heckeLengthFiltration_zero (c : HeckeRing W) : + algebraMap (HeckeRing W) (HeckeAlgebra W) c ∈ heckeLengthFiltration (W := W) 0 := by + simpa [Algebra.smul_def] using + Submodule.smul_mem (heckeLengthFiltration (W := W) 0) c + (one_mem_heckeLengthFiltration (W := W) 0) + +omit mat in +theorem T_simple_mem_heckeLengthFiltration_one (i : B W) : + T_simple i ∈ heckeLengthFiltration (W := W) 1 := by + refine Submodule.subset_span ?_ + exact ⟨[i], by simp, by simp⟩ + +omit mat in +theorem T_prod_mem_heckeLengthFiltration {l : List (B W)} {n : ℕ} (h : l.length ≤ n) : + (l.map T_simple).prod ∈ heckeLengthFiltration (W := W) n := by + exact Submodule.subset_span ⟨l, h, rfl⟩ + +theorem T_mem_heckeLengthFiltration (w : W) : + T w ∈ heckeLengthFiltration (W := W) (cs.length w) := by + let ω : ReducedWord w := Classical.arbitrary (ReducedWord w) + rw [T_eq_of_reducedWord ω] + exact T_prod_mem_heckeLengthFiltration (W := W) (by rw [ω.length_eq]) + +omit mat in +theorem heckeLengthFiltrationMonomials_mono {m n : ℕ} (h : m ≤ n) : + heckeLengthFiltrationMonomials (W := W) m ⊆ heckeLengthFiltrationMonomials (W := W) n := by + rintro x ⟨l, hl, rfl⟩ + exact ⟨l, hl.trans h, rfl⟩ + +omit mat in +/-- The length filtration is monotone: +a monomial of length at most `m` is also of length at most `n` +for `m ≤ n`. -/ +theorem heckeLengthFiltration_mono : Monotone (heckeLengthFiltration (W := W)) := by + intro m n h + exact Submodule.span_mono (heckeLengthFiltrationMonomials_mono h) + +omit mat in +/-- The length filtration is submultiplicative: +`heckeLengthFiltration m * heckeLengthFiltration n ⊆ heckeLengthFiltration (m + n)`, +since concatenating a monomial of length `≤ m` with one of length `≤ n` +gives a monomial of length `≤ m + n`. -/ +theorem heckeLengthFiltration_mul_mem {m n : ℕ} {x y : HeckeAlgebra W} + (hx : x ∈ heckeLengthFiltration (W := W) m) (hy : y ∈ heckeLengthFiltration (W := W) n) : + x * y ∈ heckeLengthFiltration (W := W) (m + n) := by + induction hx, hy using Submodule.span_induction₂ with + | mem_mem x y hx hy => + obtain ⟨l1, hl1, rfl⟩ := hx + obtain ⟨l2, hl2, rfl⟩ := hy + rw [← List.prod_append, ← List.map_append] + exact T_prod_mem_heckeLengthFiltration (by rw [List.length_append]; omega) + | zero_left y hy => simp + | zero_right x hx => simp + | add_left x y z hx hy hz ihx ihy => rw [add_mul]; exact Submodule.add_mem _ ihx ihy + | add_right x y z hx hy hz ihy ihz => rw [mul_add]; exact Submodule.add_mem _ ihy ihz + | smul_left r x y hx hy ih => rw [smul_mul_assoc]; exact Submodule.smul_mem _ r ih + | smul_right r x y hx hy ih => rw [mul_smul_comm]; exact Submodule.smul_mem _ r ih + +/-- The length filtration on `HeckeAlgebra W`, bundled as a `Coxeter.Filtration`: +this unlocks the general associated graded machinery +(`Coxeter.Filtration.AssociatedGraded`, its `Ring`/`Algebra (HeckeRing W)` structure) +for free. -/ +noncomputable def heckeLengthCoxeterFiltration : Filtration (HeckeRing W) (HeckeAlgebra W) where + carrier := heckeLengthFiltration + mono := heckeLengthFiltration_mono + one_mem := one_mem_heckeLengthFiltration 0 + mul_mem hx hy := heckeLengthFiltration_mul_mem hx hy + +end LengthFiltration + +section OneParameterSpecialization + +variable {W : Type*} [CoxeterGroup W] + +open TensorProduct + +/-- `HeckeRingOne` as a `HeckeRing W`-algebra, by restricting scalars along the ring homomorphism +`heckeRingOneHom : HeckeRing W →+* HeckeRingOne`. -/ +noncomputable instance : Algebra (HeckeRing W) HeckeRingOne := + (heckeRingOneHom.toAlgHom.toRingHom : HeckeRing W →+* HeckeRingOne).toAlgebra + +/-- The classical single-parameter Iwahori–Hecke algebra: the base change of the multiparameter +`HeckeAlgebra W` along `heckeRingOneHom : HeckeRing W → HeckeRingOne`. As a `HeckeRingOne`-algebra +(not just a `HeckeRing W`-module), via `Algebra.TensorProduct.rightAlgebra`. -/ +abbrev HeckeAlgebraOne (W : Type*) [CoxeterGroup W] : Type _ := + HeckeAlgebra W ⊗[HeckeRing W] HeckeRingOne + +noncomputable instance : Algebra HeckeRingOne (HeckeAlgebraOne W) := + Algebra.TensorProduct.rightAlgebra + + +/-- The base-change map `HeckeAlgebra W → HeckeAlgebraOne W`, `a ↦ a ⊗ₜ 1`, is surjective: since +`heckeRingOneHom_surjective` says `HeckeRing W → HeckeRingOne` is already surjective, every pure +tensor `a ⊗ₜ s` is hit (writing `s = heckeRingOneHom r` gives `a ⊗ₜ s = (r • a) ⊗ₜ 1`), and a +general element of the tensor product is a finite sum of pure tensors. -/ +theorem heckeAlgebraOne_includeLeft_surjective [Nonempty (B W)] : + Function.Surjective (Algebra.TensorProduct.includeLeft : + HeckeAlgebra W →ₐ[HeckeRing W] HeckeAlgebraOne W) := + Algebra.TensorProduct.includeLeft_surjective _ _ heckeRingOneHom_surjective + +section QOneSpecialization + +/-- The **`q = 1` specialization**: evaluating the classical single-parameter Hecke ring +`HeckeRingOne = ℤ[v, v⁻¹]` at `v = 1` (so `q_i = v_i^2 = 1` too, once composed with +`heckeRingOneHom`). -/ +noncomputable def qOneHom : HeckeRingOne →+* ℤ := + LaurentPolynomial.eval₂ (RingHom.id ℤ) (1 : ℤˣ) + +theorem qOneHom_surjective : Function.Surjective qOneHom := + fun n => ⟨LaurentPolynomial.C n, LaurentPolynomial.eval₂_C ..⟩ + +theorem qOneHom_T (n : ℤ) : qOneHom (LaurentPolynomial.T n) = 1 := by + simp [qOneHom, LaurentPolynomial.eval₂_T] + +/-- The composite `HeckeRing W → HeckeRingOne → ℤ → ℤ[W]`, `v_i ↦ 1` for every `i`: the ring +homomorphism making `MonoidAlgebra ℤ W` a `HeckeRing W`-algebra for the `q = 1` specialization. -/ +noncomputable def qOneRingHom : HeckeRing W →+* MonoidAlgebra ℤ W := + (algebraMap ℤ (MonoidAlgebra ℤ W)).comp (qOneHom.comp heckeRingOneHom.toAlgHom.toRingHom) + +theorem qOneRingHom_heckeQ (i : B W) : qOneRingHom (heckeQ i) = 1 := by + simp [qOneRingHom, heckeQ, map_mul, heckeRingOneHom_heckeV, qOneHom_T, + MonoidAlgebra.one_def] + +/-- The scalar augmentation on the multiparameter Hecke ring, evaluating every `v_i` at `1`. -/ +noncomputable def qOneScalarHom : HeckeRing W →+* ℤ := + qOneHom.comp heckeRingOneHom.toAlgHom.toRingHom + +@[simp] +theorem qOneScalarHom_heckeQ (i : B W) : qOneScalarHom (heckeQ i) = 1 := by + simp [qOneScalarHom, heckeQ, map_mul, heckeRingOneHom_heckeV, qOneHom_T] + +/-- The image of `qOneRingHom` is central (it factors through `ℤ`), so it defines a genuine +`HeckeRing W`-algebra structure on `MonoidAlgebra ℤ W`, even though the latter is generally +noncommutative. -/ +noncomputable instance : Algebra (HeckeRing W) (MonoidAlgebra ℤ W) := + qOneRingHom.toAlgebra' fun c x => Algebra.commutes (qOneHom (heckeRingOneHom c)) x + +@[simp] +theorem algebraMap_qOneScalarHom (c : HeckeRing W) : + algebraMap (HeckeRing W) (MonoidAlgebra ℤ W) c = + (qOneScalarHom c : MonoidAlgebra ℤ W) := rfl + +theorem algebraMap_heckeQ (i : B W) : + algebraMap (HeckeRing W) (MonoidAlgebra ℤ W) (heckeQ i) = 1 := + qOneRingHom_heckeQ i + +/-- The `HeckeRing W`-algebra homomorphism from the free algebra on the simple reflections to +`ℤ[W]`, sending each generator `T_i` to the group element `s_i`. -/ +noncomputable def qOneFreeAlgHom : + FreeAlgebra (HeckeRing W) (B W) →ₐ[HeckeRing W] MonoidAlgebra ℤ W := + FreeAlgebra.lift (HeckeRing W) (fun i => MonoidAlgebra.single (cs.simple i) (1 : ℤ)) + +@[simp] theorem qOneFreeAlgHom_ι (i : B W) : + qOneFreeAlgHom (FreeAlgebra.ι (HeckeRing W) i) = MonoidAlgebra.single (cs.simple i) (1 : ℤ) := + FreeAlgebra.lift_ι_apply _ _ + +theorem qOneFreeAlgHom_wordProd (l : List (B W)) : + qOneFreeAlgHom ((l.map (FreeAlgebra.ι (HeckeRing W))).prod) + = MonoidAlgebra.single (cs.wordProd l) (1 : ℤ) := by + induction l with + | nil => simp [MonoidAlgebra.one_def] + | cons j l ih => + rw [List.map_cons, List.prod_cons, map_mul, qOneFreeAlgHom_ι, ih, + MonoidAlgebra.single_mul_single, one_mul, wordProd_cons] + +theorem qOneFreeAlgHom_respects_rel : ∀ ⦃x y⦄, HeckeRel W x y → + qOneFreeAlgHom x = qOneFreeAlgHom y := by + intro x y h + cases h with + | quad i => + rw [map_mul, qOneFreeAlgHom_ι, MonoidAlgebra.single_mul_single, mul_one, + cs.simple_mul_simple_self, ← MonoidAlgebra.one_def, map_add, map_smul, map_smul, + qOneFreeAlgHom_ι, map_one] + simp [Algebra.smul_def, MonoidAlgebra.one_def] + | braid i i' => + rw [qOneFreeAlgHom_wordProd, qOneFreeAlgHom_wordProd, wordProd_braidWord_eq] + +/-- The `HeckeRing W`-algebra homomorphism `HeckeAlgebra W → ℤ[W]` induced by `qOneFreeAlgHom` +via the universal property of `RingQuot`, sending `T_i ↦ s_i`. -/ +noncomputable def qOneAlgHom0 : HeckeAlgebra W →ₐ[HeckeRing W] MonoidAlgebra ℤ W := + RingQuot.liftAlgHom (HeckeRing W) ⟨qOneFreeAlgHom, qOneFreeAlgHom_respects_rel⟩ + +theorem qOneFreeAlgHom_surjective : Function.Surjective (qOneFreeAlgHom (W := W)) := by + intro s + induction s using Finsupp.induction with + | zero => exact ⟨0, map_zero _⟩ + | single_add w n f _hw _hn ih => + obtain ⟨x, hx⟩ := ih + obtain ⟨l, hl⟩ := cs.wordProd_surjective w + refine ⟨n • ((l.map (FreeAlgebra.ι (HeckeRing W))).prod) + x, ?_⟩ + rw [map_add, map_zsmul, qOneFreeAlgHom_wordProd, hl, hx] + congr 1 + rw [zsmul_eq_mul (MonoidAlgebra.single w 1) n] + change (n : MonoidAlgebra ℤ W) * MonoidAlgebra.single w 1 = MonoidAlgebra.single w n + rw [show (n : MonoidAlgebra ℤ W) = MonoidAlgebra.single (1 : W) n by rfl] + rw [MonoidAlgebra.single_mul_single] + simp + +theorem qOneAlgHom0_surjective : Function.Surjective (qOneAlgHom0 (W := W)) := by + have heq : qOneAlgHom0.comp (RingQuot.mkAlgHom (HeckeRing W) (HeckeRel W)) + = qOneFreeAlgHom := by + apply FreeAlgebra.hom_ext + funext x + exact RingQuot.liftAlgHom_mkAlgHom_apply (HeckeRing W) qOneFreeAlgHom + qOneFreeAlgHom_respects_rel (FreeAlgebra.ι (HeckeRing W) x) + exact Function.Surjective.of_comp (f := qOneAlgHom0) + (g := RingQuot.mkAlgHom (HeckeRing W) (HeckeRel W)) (show Function.Surjective + (qOneAlgHom0.comp (RingQuot.mkAlgHom (HeckeRing W) (HeckeRel W))) from by + rw [heq] + exact qOneFreeAlgHom_surjective) + +/-- `HeckeRingOne` maps into `ℤ[W]` as a `HeckeRing W`-algebra homomorphism, via `qOneHom`. -/ +noncomputable def qOneRingHomOne : HeckeRingOne →ₐ[HeckeRing W] MonoidAlgebra ℤ W where + toRingHom := (algebraMap ℤ (MonoidAlgebra ℤ W)).comp qOneHom + commutes' _ := rfl + +theorem qOneAlgHom0_commute (x : HeckeAlgebra W) (y : HeckeRingOne) : + Commute (qOneAlgHom0 x) (qOneRingHomOne y) := + (Algebra.commutes (qOneHom y) (qOneAlgHom0 x)).symm + +/-- At `q = 1`, the quadratic relation `T_i ^ 2 = (q_i - 1) • T_i + q_i • 1` degenerates to +`T_i ^ 2 = 1`, exactly the defining relation `s_i ^ 2 = 1` of the group `W`; the braid relations +carry over unchanged (`qOneFreeAlgHom_respects_rel`). So the single-parameter Hecke algebra +`HeckeAlgebraOne W`, further specialized along `qOneHom` (`v ↦ 1`), collapses onto the integral +group algebra `MonoidAlgebra ℤ W`, via the ℤ-algebra homomorphism sending `T_w ⊗ₜ 1 ↦ +Finsupp.single w 1`. -/ +noncomputable def qOneAlgHom : HeckeAlgebraOne W →ₐ[ℤ] MonoidAlgebra ℤ W where + toRingHom := (Algebra.TensorProduct.lift (S := HeckeRing W) qOneAlgHom0 qOneRingHomOne + qOneAlgHom0_commute).toRingHom + commutes' n := by simp + +theorem qOneAlgHom_surjective : Function.Surjective (qOneAlgHom (W := W)) := by + intro c + obtain ⟨a, ha⟩ := qOneAlgHom0_surjective c + exact ⟨a ⊗ₜ[HeckeRing W] 1, by + change Algebra.TensorProduct.lift qOneAlgHom0 qOneRingHomOne qOneAlgHom0_commute + (a ⊗ₜ[HeckeRing W] 1) = c + rw [Algebra.TensorProduct.lift_tmul, map_one, mul_one, ha]⟩ + +/-- At `q = 1`, the simple Hecke generator maps to the corresponding group-algebra basis +element. -/ +theorem qOneAlgHom0_T_simple (i : B W) : + qOneAlgHom0 (T_simple i) = MonoidAlgebra.single (cs.simple i) (1 : ℤ) := by + simp [qOneAlgHom0, T_simple, + RingQuot.liftAlgHom_mkAlgHom_apply (HeckeRing W) qOneFreeAlgHom + qOneFreeAlgHom_respects_rel (FreeAlgebra.ι (HeckeRing W) i)] + +/-- At `q = 1`, the Hecke word product along any word maps to the corresponding group-algebra +basis element. -/ +theorem qOneAlgHom0_T_prod (l : List (B W)) : + qOneAlgHom0 ((l.map T_simple).prod) = MonoidAlgebra.single (cs.wordProd l) (1 : ℤ) := by + induction l with + | nil => simp [MonoidAlgebra.one_def] + | cons i l ih => + rw [List.map_cons, List.prod_cons, map_mul, qOneAlgHom0_T_simple, ih, + MonoidAlgebra.single_mul_single, one_mul, wordProd_cons] + +/-- At `q = 1`, `T_w` specializes to the standard group-algebra basis vector indexed by `w`. -/ +theorem qOneAlgHom0_T (w : W) [Matsumoto (W1 := W)] : + qOneAlgHom0 (T w) = MonoidAlgebra.single w (1 : ℤ) := by + let ω : ReducedWord w := Classical.arbitrary (ReducedWord w) + rw [T_eq_of_reducedWord ω, qOneAlgHom0_T_prod, ω.wordProd_eq] + +/-- The specialized elements `qOneAlgHom0 (T_w)` are linearly independent over `ℤ`, because +they are exactly the standard basis of the group algebra. -/ +theorem qOneAlgHom0_T_linearIndependent [Matsumoto (W1 := W)] : + LinearIndependent ℤ (fun w : W => qOneAlgHom0 (T w)) := by + simpa [qOneAlgHom0_T, MonoidAlgebra.basis_apply] using + (MonoidAlgebra.basis W ℤ).linearIndependent + +end QOneSpecialization + +end OneParameterSpecialization + +section Dihedral + +variable {W : Type*} [CoxeterGroup W] + +/-- The rank-2 parabolic subgroup generated by two simple reflections. -/ +def rankTwoSubgroup (i i' : B W) : Subgroup W := Subgroup.closure {cs.simple i, cs.simple i'} + +/-- Every element of `rankTwoSubgroup i i'` +can be written as `cs.wordProd μ` for some +(not necessarily reduced) word `μ` +using only the letters `i`, `i'`. -/ +private theorem exists_confined_word + {i i' : B W} {v : W} + (hv : v ∈ rankTwoSubgroup i i') : + ∃ μ : List (B W), + v = cs.wordProd μ ∧ ∀ k ∈ μ, k = i ∨ k = i' := by + induction hv using Subgroup.closure_induction with + | mem x hx => + rcases hx with h | h + · exact ⟨[i], by rw [wordProd_singleton, h], by simp⟩ + · exact ⟨[i'], by rw [wordProd_singleton, h], by simp⟩ + | one => exact ⟨[], by rw [wordProd_nil], by simp⟩ + | mul x y _ _ ihx ihy => + obtain ⟨μx, hμx1, hμx2⟩ := ihx + obtain ⟨μy, hμy1, hμy2⟩ := ihy + refine ⟨μx ++ μy, ?_, ?_⟩ + · rw [wordProd_append, ← hμx1, ← hμy1] + · intro k hk + rcases List.mem_append.mp hk with hk | hk + · exact hμx2 k hk + · exact hμy2 k hk + | inv x _ ihx => + obtain ⟨μ, hμ1, hμ2⟩ := ihx + refine ⟨μ.reverse, ?_, ?_⟩ + · rw [hμ1, wordProd_reverse] + · intro k hk + exact hμ2 k (List.mem_reverse.mp hk) + +/-- Every element of `rankTwoSubgroup i i'` +has a **reduced** word using only the letters +`i`, `i'`. -/ +theorem exists_confined_reduced_word + {i i' : B W} {v : W} + (hv : v ∈ rankTwoSubgroup i i') : + ∃ μ : List (B W), + cs.IsReduced μ ∧ v = cs.wordProd μ ∧ ∀ k ∈ μ, k = i ∨ k = i' := by + obtain ⟨μ₀, hμ₀1, hμ₀2⟩ := exists_confined_word hv + obtain ⟨μ, hsub, hred, heq⟩ := exists_reduced_subword μ₀ + exact ⟨μ, hred, hμ₀1.trans heq, fun k hk => hμ₀2 k (hsub.subset hk)⟩ + +end Dihedral + +section ActOnGroupAlgebra + +variable {W : Type*} [CoxeterGroup W] + +abbrev module_actedOn (W : Type*) [CoxeterGroup W] : Type _ := MonoidAlgebra (HeckeRing W) W + +open Classical in +/-- The action of `T_i` on `module_actedOn W`, specified on the standard basis `single w 1` by +the same case-split formula as `T_mul_T_simple_of_rightDescent`/ +`T_mul_T_simple_of_not_rightDescent` (right multiplication by `T_simple i` on the `HeckeAlgebra` +basis `T_w`), then extended `HeckeRing W`-linearly. -/ +noncomputable def T_simple_action (i : B W) : Module.End (HeckeRing W) (module_actedOn W) := + Finsupp.lift (module_actedOn W) (HeckeRing W) W (fun w => + if cs.IsRightDescent w i then + (heckeQ i - 1) • MonoidAlgebra.single w (1 : HeckeRing W) + + heckeQ i • MonoidAlgebra.single (w * cs.simple i) (1 : HeckeRing W) + else + MonoidAlgebra.single (w * cs.simple i) (1 : HeckeRing W)) + +open Classical in +theorem T_simple_action_apply (i : B W) (w : W) : + T_simple_action i (MonoidAlgebra.single w (1 : HeckeRing W)) = + if cs.IsRightDescent w i then + (heckeQ i - 1) • MonoidAlgebra.single w (1 : HeckeRing W) + + heckeQ i • MonoidAlgebra.single (w * cs.simple i) (1 : HeckeRing W) + else + MonoidAlgebra.single (w * cs.simple i) (1 : HeckeRing W) := by + change Finsupp.lift _ _ _ _ (Finsupp.single w (1 : HeckeRing W)) = _ + rw [Finsupp.lift_apply, Finsupp.sum_single_index (by simp), one_smul] + +/-- The action `T_simple_action` satisfies the Hecke quadratic relation, by the same case-split +calculation as `T_mul_T_simple_of_rightDescent` (mirrored here directly on `module_actedOn W`, +since `{T_w}` isn't known to be a basis yet). -/ +theorem T_simple_action_sq (i : B W) : + T_simple_action i * T_simple_action i + = (heckeQ i - 1) • T_simple_action i + + heckeQ i • (1 : Module.End (HeckeRing W) (module_actedOn W)) := by + apply MonoidAlgebra.lhom_ext' + intro w + apply LinearMap.ext_ring + simp only [LinearMap.comp_apply, MonoidAlgebra.lsingle_apply, Module.End.mul_apply, + LinearMap.add_apply, LinearMap.smul_apply, Module.End.one_apply] + rw [T_simple_action_apply] + by_cases h : cs.IsRightDescent w i + · have hnot : ¬ cs.IsRightDescent (w * cs.simple i) i := + cs.isRightDescent_iff_not_isRightDescent_mul.mp h + simp only [h, if_true] + rw [map_add, map_smul, map_smul, T_simple_action_apply, T_simple_action_apply] + simp only [h, hnot, if_true, if_false, cs.simple_mul_simple_cancel_right] + · have hw : cs.IsRightDescent (w * cs.simple i) i := by + by_contra hcon + exact h (cs.isRightDescent_iff_not_isRightDescent_mul.mpr hcon) + simp only [h, if_false] + rw [T_simple_action_apply] + simp only [hw, if_true, cs.simple_mul_simple_cancel_right] + +/-- The action `T_simple_action` satisfies the Hecke braid relation: deferred, comparable in +difficulty to Matsumoto's theorem (see the module `TODO`). -/ +theorem T_simple_action_braid (i i' : B W) : + ((braidWord M i i').map T_simple_action).prod + = ((braidWord M i' i).map T_simple_action).prod := + sorry + +/-- The `HeckeRing W`-algebra homomorphism from the free algebra on the simple reflections to +`Module.End (HeckeRing W) (module_actedOn W)`, sending each generator `T_i` to its action +`T_simple_action i`. -/ +noncomputable def heckeActionFreeAlgHom : + FreeAlgebra (HeckeRing W) (B W) →ₐ[HeckeRing W] Module.End (HeckeRing W) (module_actedOn W) := + FreeAlgebra.lift (HeckeRing W) T_simple_action + +theorem heckeActionFreeAlgHom_wordProd (l : List (B W)) : + heckeActionFreeAlgHom ((l.map (FreeAlgebra.ι (HeckeRing W))).prod) + = (l.map T_simple_action).prod := by + induction l with + | nil => simp [heckeActionFreeAlgHom] + | cons j l ih => + rw [List.map_cons, List.prod_cons, map_mul, List.map_cons, List.prod_cons, ih] + congr 1 + simp [heckeActionFreeAlgHom] + +theorem heckeActionFreeAlgHom_respects_rel : ∀ ⦃x y⦄, HeckeRel W x y → + heckeActionFreeAlgHom x = heckeActionFreeAlgHom y := by + intro x y h + cases h with + | quad i => + simp only [heckeActionFreeAlgHom, map_mul, map_add, map_smul, map_one, + FreeAlgebra.lift_ι_apply] + exact T_simple_action_sq i + | braid i i' => + rw [heckeActionFreeAlgHom_wordProd, heckeActionFreeAlgHom_wordProd] + exact T_simple_action_braid i i' + +/-- The algebra map from `HeckeAlgebra`, presented by generators and relations, to +`Module.End (HeckeRing W) (module_actedOn W)`: the action of the Hecke algebra on the free +`HeckeRing W`-module on `W`, specified (via the universal property of `RingQuot`) purely by +declaring the action of each generator `T_i` (`T_simple_action`) and checking it respects the +defining relations (`heckeActionFreeAlgHom_respects_rel`). -/ +noncomputable def heckeActionAlgHom : + HeckeAlgebra W →ₐ[HeckeRing W] Module.End (HeckeRing W) (module_actedOn W) := + RingQuot.liftAlgHom (HeckeRing W) ⟨heckeActionFreeAlgHom, heckeActionFreeAlgHom_respects_rel⟩ + +theorem heckeActionAlgHom_T_simple (i : B W) : + heckeActionAlgHom (T_simple i) = T_simple_action i := by + simp [heckeActionAlgHom, T_simple, heckeActionFreeAlgHom, FreeAlgebra.lift_ι_apply] + +end ActOnGroupAlgebra + +section FreeBasis + +variable {W : Type*} [CoxeterGroup W] + +/-- The family `{T_w}` is linearly independent over the constant subring `ℤ`. +This follows by applying the `q = 1` specialization: constants embed injectively into +`MonoidAlgebra ℤ W`, and `T_w` maps to the standard group-algebra basis vector. -/ +theorem T_intLinearIndependent [Matsumoto (W1 := W)] : + LinearIndependent ℤ (T (W := W)) := by + let f : HeckeAlgebra W →ₗ[ℤ] MonoidAlgebra ℤ W := + { toFun := qOneAlgHom0 (W := W) + map_add' := map_add (qOneAlgHom0 (W := W)) + map_smul' := fun n x => by + simpa only [RingHom.id_apply] using + (qOneAlgHom0 (W := W) : HeckeAlgebra W →+* MonoidAlgebra ℤ W).map_zsmul n x } + exact LinearIndependent.of_comp f (by + simpa [f, Function.comp_def] using qOneAlgHom0_T_linearIndependent (W := W)) + +/-- The obligation that `{T_w : w ∈ W}` +is linearly independent over `HeckeRing W` +one of the two facts needed to build `basis` via `Module.Basis.mk`. -/ +theorem T_linearIndependent [Matsumoto (W1 := W)] : + LinearIndependent (HeckeRing W) (T (W := W)) := + sorry + +/-- The obligation that `{T_w : w ∈ W}` +spans `HeckeAlgebra W` over `HeckeRing W` +the other fact needed to build `basis` via `Module.Basis.mk`. -/ +theorem T_span : ⊤ ≤ Submodule.span (HeckeRing W) (Set.range (T (W := W))) := + sorry + +/-- `HeckeAlgebra` is free as a `HeckeRing`-module with basis `{T_w : w ∈ W}`. -/ +noncomputable def basis [Matsumoto (W1 := W)] : + Module.Basis W (HeckeRing W) (HeckeAlgebra W) := + Module.Basis.mk T_linearIndependent T_span + +theorem basis_apply (w : W) [Matsumoto (W1 := W)] : + basis w = T w := + Module.Basis.mk_apply T_linearIndependent T_span w + +end FreeBasis + +section BarInvolution + +variable {W : Type*} [CoxeterGroup W] + +/-- The **bar involution** on `HeckeAlgebra` +The additive ring automorphism +sending `T_w ↦ (T_{w⁻¹})⁻¹` +semilinear over `barScalar` -/ +noncomputable def bar : + HeckeAlgebra W ≃+* HeckeAlgebra W := sorry + +private theorem bar_smul (c : HeckeRing W) (x : HeckeAlgebra W) : + bar (c • x) = star c • bar x := by + sorry + +private theorem bar_T (w : W) : + bar (T w) * T w⁻¹ = 1 := by + sorry + +private theorem bar_T_involutive (w : W) : bar (bar (T w)) = T w := by + have h1 := bar_T w + have h2 := bar_T w⁻¹ + rw [inv_inv] at h2 + have h4 : bar (bar (T w)) * bar (T w⁻¹) = 1 := by + rw [← map_mul, h1, map_one] + calc bar (bar (T w)) + = bar (bar (T w)) * 1 := (mul_one _).symm + _ = bar (bar (T w)) * (bar (T w⁻¹) * T w) := by rw [h2] + _ = bar (bar (T w)) * bar (T w⁻¹) * T w := + (mul_assoc _ _ _).symm + _ = 1 * T w := by rw [h4] + _ = T w := one_mul _ + +/-- Involutivity of `bar` on all of `HeckeAlgebra` +Induct on the standard basis `{T_w}` -/ +theorem bar_involutive [Matsumoto (W1 := W)] : + Function.Involutive (bar (W := W)) := by + intro x + rw [← basis.linearCombination_repr x] + generalize basis.repr x = f + induction f using Finsupp.induction with + | zero => simp + | single_add w c f _hw hc ih => + have hsingle : Finsupp.linearCombination (HeckeRing W) basis (Finsupp.single w c + f) + = c • T w + Finsupp.linearCombination (HeckeRing W) basis f := by + rw [map_add, Finsupp.linearCombination_single, basis_apply] + rw [hsingle, map_add, map_add, bar_smul, bar_smul, star_involutive, bar_T_involutive, ih] + +end BarInvolution + +end Coxeter diff --git a/docbuild/docs/references.bib b/docbuild/docs/references.bib index 10d2b4a..dbdd173 100644 --- a/docbuild/docs/references.bib +++ b/docbuild/docs/references.bib @@ -6,6 +6,14 @@ @book{bjorner2005 doi={10.1007/3-540-27596-7} } +@book{humphreys1990, + title={Reflection Groups and Coxeter Groups}, + author={Humphreys, James E.}, + year={1990}, + publisher={Cambridge University Press}, + doi={10.1017/CBO9780511623646} +} + @book{bourbaki2007, title={Groupes et algèbres de Lie}, author={N. Bourbaki}, From 5d68bd3861aa54b94a170f3567172b9d4a967cb2 Mon Sep 17 00:00:00 2001 From: Cobord Date: Fri, 3 Jul 2026 15:42:10 -0400 Subject: [PATCH 07/12] format comments --- Coxeter/Hecke.lean | 107 +++++++++++++++++++++++++-------------------- 1 file changed, 59 insertions(+), 48 deletions(-) diff --git a/Coxeter/Hecke.lean b/Coxeter/Hecke.lean index ec57d01..75984eb 100644 --- a/Coxeter/Hecke.lean +++ b/Coxeter/Hecke.lean @@ -253,18 +253,21 @@ theorem T_one : T (1 : W) = 1 := by simp [hnil] omit mat in -/-- A single elementary braid move (`Coxeter.BraidMove`) between two words doesn't change the -`T_simple`-product, since it's exactly the braid relation `T_simple_braid`. -/ +/-- A single elementary braid move (`Coxeter.BraidMove`) +between two words doesn't change the `T_simple`-product, +since it's exactly the braid relation `T_simple_braid`. -/ theorem BraidMove.T_simple_prod_eq {ω ω' : List (B W)} (h : BraidMove ω ω') : (ω.map T_simple).prod = (ω'.map T_simple).prod := by obtain ⟨i, i', α, β, hω, hω'⟩ := h rw [hω, hω'] simp only [List.map_append, List.prod_append, T_simple_braid] -/-- `T w` doesn't depend on the choice of reduced word: it equals the `T_simple`-product along -*any* reduced word for `w`, not just the one used in the definition. This is where Matsumoto's -theorem (`Coxeter.eqvGen_braidMove_of_reduced`) is actually used: any two reduced words for `w` -are connected by a chain of braid moves, each of which preserves the `T_simple`-product +/-- `T w` doesn't depend on the choice of reduced word: +it equals the `T_simple`-product along +*any* reduced word for `w`, not just the one used in the definition. +This is where Matsumoto's theorem (`Coxeter.eqvGen_braidMove_of_reduced`) is actually used +any two reduced words for `w` are connected by a chain of braid moves +each of which preserves the `T_simple`-product (`BraidMove.T_simple_prod_eq`). -/ theorem T_eq_of_reducedWord {w : W} (ω : ReducedWord w) : T w = (ω.val.map T_simple).prod := by @@ -435,10 +438,10 @@ theorem heckeLengthFiltration_mul_mem {m n : ℕ} {x y : HeckeAlgebra W} | smul_left r x y hx hy ih => rw [smul_mul_assoc]; exact Submodule.smul_mem _ r ih | smul_right r x y hx hy ih => rw [mul_smul_comm]; exact Submodule.smul_mem _ r ih -/-- The length filtration on `HeckeAlgebra W`, bundled as a `Coxeter.Filtration`: +/-- The length filtration on `HeckeAlgebra W`, +bundled as a `Coxeter.Filtration`: this unlocks the general associated graded machinery -(`Coxeter.Filtration.AssociatedGraded`, its `Ring`/`Algebra (HeckeRing W)` structure) -for free. -/ +(`Coxeter.Filtration.AssociatedGraded`, its `Ring`/`Algebra (HeckeRing W)` structure) for free. -/ noncomputable def heckeLengthCoxeterFiltration : Filtration (HeckeRing W) (HeckeAlgebra W) where carrier := heckeLengthFiltration mono := heckeLengthFiltration_mono @@ -453,14 +456,17 @@ variable {W : Type*} [CoxeterGroup W] open TensorProduct -/-- `HeckeRingOne` as a `HeckeRing W`-algebra, by restricting scalars along the ring homomorphism +/-- `HeckeRingOne` as a `HeckeRing W`-algebra, +by restricting scalars along the ring homomorphism `heckeRingOneHom : HeckeRing W →+* HeckeRingOne`. -/ noncomputable instance : Algebra (HeckeRing W) HeckeRingOne := (heckeRingOneHom.toAlgHom.toRingHom : HeckeRing W →+* HeckeRingOne).toAlgebra -/-- The classical single-parameter Iwahori–Hecke algebra: the base change of the multiparameter -`HeckeAlgebra W` along `heckeRingOneHom : HeckeRing W → HeckeRingOne`. As a `HeckeRingOne`-algebra -(not just a `HeckeRing W`-module), via `Algebra.TensorProduct.rightAlgebra`. -/ +/-- The classical single-parameter Iwahori–Hecke algebra: +the base change of the multiparameter +`HeckeAlgebra W` along `heckeRingOneHom : HeckeRing W → HeckeRingOne`. +As a `HeckeRingOne`-algebra (not just a `HeckeRing W`-module), +via `Algebra.TensorProduct.rightAlgebra`. -/ abbrev HeckeAlgebraOne (W : Type*) [CoxeterGroup W] : Type _ := HeckeAlgebra W ⊗[HeckeRing W] HeckeRingOne @@ -468,10 +474,8 @@ noncomputable instance : Algebra HeckeRingOne (HeckeAlgebraOne W) := Algebra.TensorProduct.rightAlgebra -/-- The base-change map `HeckeAlgebra W → HeckeAlgebraOne W`, `a ↦ a ⊗ₜ 1`, is surjective: since -`heckeRingOneHom_surjective` says `HeckeRing W → HeckeRingOne` is already surjective, every pure -tensor `a ⊗ₜ s` is hit (writing `s = heckeRingOneHom r` gives `a ⊗ₜ s = (r • a) ⊗ₜ 1`), and a -general element of the tensor product is a finite sum of pure tensors. -/ +/-- The base-change map `HeckeAlgebra W → HeckeAlgebraOne W`, +`a ↦ a ⊗ₜ 1`, is surjective -/ theorem heckeAlgebraOne_includeLeft_surjective [Nonempty (B W)] : Function.Surjective (Algebra.TensorProduct.includeLeft : HeckeAlgebra W →ₐ[HeckeRing W] HeckeAlgebraOne W) := @@ -479,9 +483,10 @@ theorem heckeAlgebraOne_includeLeft_surjective [Nonempty (B W)] : section QOneSpecialization -/-- The **`q = 1` specialization**: evaluating the classical single-parameter Hecke ring -`HeckeRingOne = ℤ[v, v⁻¹]` at `v = 1` (so `q_i = v_i^2 = 1` too, once composed with -`heckeRingOneHom`). -/ +/-- The **`q = 1` specialization** +evaluating the classical single-parameter Hecke ring +`HeckeRingOne = ℤ[v, v⁻¹]` at `v = 1` +(so `q_i = v_i^2 = 1` too, once composed with `heckeRingOneHom`). -/ noncomputable def qOneHom : HeckeRingOne →+* ℤ := LaurentPolynomial.eval₂ (RingHom.id ℤ) (1 : ℤˣ) @@ -491,7 +496,8 @@ theorem qOneHom_surjective : Function.Surjective qOneHom := theorem qOneHom_T (n : ℤ) : qOneHom (LaurentPolynomial.T n) = 1 := by simp [qOneHom, LaurentPolynomial.eval₂_T] -/-- The composite `HeckeRing W → HeckeRingOne → ℤ → ℤ[W]`, `v_i ↦ 1` for every `i`: the ring +/-- The composite `HeckeRing W → HeckeRingOne → ℤ → ℤ[W]` +`v_i ↦ 1` for every `i`: the ring homomorphism making `MonoidAlgebra ℤ W` a `HeckeRing W`-algebra for the `q = 1` specialization. -/ noncomputable def qOneRingHom : HeckeRing W →+* MonoidAlgebra ℤ W := (algebraMap ℤ (MonoidAlgebra ℤ W)).comp (qOneHom.comp heckeRingOneHom.toAlgHom.toRingHom) @@ -500,7 +506,8 @@ theorem qOneRingHom_heckeQ (i : B W) : qOneRingHom (heckeQ i) = 1 := by simp [qOneRingHom, heckeQ, map_mul, heckeRingOneHom_heckeV, qOneHom_T, MonoidAlgebra.one_def] -/-- The scalar augmentation on the multiparameter Hecke ring, evaluating every `v_i` at `1`. -/ +/-- The scalar augmentation on the multiparameter Hecke ring +evaluating every `v_i` at `1`. -/ noncomputable def qOneScalarHom : HeckeRing W →+* ℤ := qOneHom.comp heckeRingOneHom.toAlgHom.toRingHom @@ -508,9 +515,8 @@ noncomputable def qOneScalarHom : HeckeRing W →+* ℤ := theorem qOneScalarHom_heckeQ (i : B W) : qOneScalarHom (heckeQ i) = 1 := by simp [qOneScalarHom, heckeQ, map_mul, heckeRingOneHom_heckeV, qOneHom_T] -/-- The image of `qOneRingHom` is central (it factors through `ℤ`), so it defines a genuine -`HeckeRing W`-algebra structure on `MonoidAlgebra ℤ W`, even though the latter is generally -noncommutative. -/ +/-- The image of `qOneRingHom` is central +because it factors through `ℤ` -/ noncomputable instance : Algebra (HeckeRing W) (MonoidAlgebra ℤ W) := qOneRingHom.toAlgebra' fun c x => Algebra.commutes (qOneHom (heckeRingOneHom c)) x @@ -523,8 +529,9 @@ theorem algebraMap_heckeQ (i : B W) : algebraMap (HeckeRing W) (MonoidAlgebra ℤ W) (heckeQ i) = 1 := qOneRingHom_heckeQ i -/-- The `HeckeRing W`-algebra homomorphism from the free algebra on the simple reflections to -`ℤ[W]`, sending each generator `T_i` to the group element `s_i`. -/ +/-- The `HeckeRing W`-algebra homomorphism +from the free algebra on the simple reflections to `ℤ[W]` +sending each generator `T_i` to the group element `s_i`. -/ noncomputable def qOneFreeAlgHom : FreeAlgebra (HeckeRing W) (B W) →ₐ[HeckeRing W] MonoidAlgebra ℤ W := FreeAlgebra.lift (HeckeRing W) (fun i => MonoidAlgebra.single (cs.simple i) (1 : ℤ)) @@ -554,7 +561,8 @@ theorem qOneFreeAlgHom_respects_rel : ∀ ⦃x y⦄, HeckeRel W x y → | braid i i' => rw [qOneFreeAlgHom_wordProd, qOneFreeAlgHom_wordProd, wordProd_braidWord_eq] -/-- The `HeckeRing W`-algebra homomorphism `HeckeAlgebra W → ℤ[W]` induced by `qOneFreeAlgHom` +/-- The `HeckeRing W`-algebra homomorphism `HeckeAlgebra W → ℤ[W]` +induced by `qOneFreeAlgHom` via the universal property of `RingQuot`, sending `T_i ↦ s_i`. -/ noncomputable def qOneAlgHom0 : HeckeAlgebra W →ₐ[HeckeRing W] MonoidAlgebra ℤ W := RingQuot.liftAlgHom (HeckeRing W) ⟨qOneFreeAlgHom, qOneFreeAlgHom_respects_rel⟩ @@ -588,7 +596,8 @@ theorem qOneAlgHom0_surjective : Function.Surjective (qOneAlgHom0 (W := W)) := b rw [heq] exact qOneFreeAlgHom_surjective) -/-- `HeckeRingOne` maps into `ℤ[W]` as a `HeckeRing W`-algebra homomorphism, via `qOneHom`. -/ +/-- `HeckeRingOne` maps into `ℤ[W]` +as a `HeckeRing W`-algebra homomorphism, via `qOneHom`. -/ noncomputable def qOneRingHomOne : HeckeRingOne →ₐ[HeckeRing W] MonoidAlgebra ℤ W where toRingHom := (algebraMap ℤ (MonoidAlgebra ℤ W)).comp qOneHom commutes' _ := rfl @@ -598,8 +607,9 @@ theorem qOneAlgHom0_commute (x : HeckeAlgebra W) (y : HeckeRingOne) : (Algebra.commutes (qOneHom y) (qOneAlgHom0 x)).symm /-- At `q = 1`, the quadratic relation `T_i ^ 2 = (q_i - 1) • T_i + q_i • 1` degenerates to -`T_i ^ 2 = 1`, exactly the defining relation `s_i ^ 2 = 1` of the group `W`; the braid relations -carry over unchanged (`qOneFreeAlgHom_respects_rel`). So the single-parameter Hecke algebra +`T_i ^ 2 = 1`, exactly the defining relation `s_i ^ 2 = 1` of the group `W` +the braid relations carry over unchanged (`qOneFreeAlgHom_respects_rel`). +So the single-parameter Hecke algebra `HeckeAlgebraOne W`, further specialized along `qOneHom` (`v ↦ 1`), collapses onto the integral group algebra `MonoidAlgebra ℤ W`, via the ℤ-algebra homomorphism sending `T_w ⊗ₜ 1 ↦ Finsupp.single w 1`. -/ @@ -616,16 +626,16 @@ theorem qOneAlgHom_surjective : Function.Surjective (qOneAlgHom (W := W)) := by (a ⊗ₜ[HeckeRing W] 1) = c rw [Algebra.TensorProduct.lift_tmul, map_one, mul_one, ha]⟩ -/-- At `q = 1`, the simple Hecke generator maps to the corresponding group-algebra basis -element. -/ +/-- At `q = 1`, the simple Hecke generator maps to +the corresponding group-algebra basis element. -/ theorem qOneAlgHom0_T_simple (i : B W) : qOneAlgHom0 (T_simple i) = MonoidAlgebra.single (cs.simple i) (1 : ℤ) := by simp [qOneAlgHom0, T_simple, RingQuot.liftAlgHom_mkAlgHom_apply (HeckeRing W) qOneFreeAlgHom qOneFreeAlgHom_respects_rel (FreeAlgebra.ι (HeckeRing W) i)] -/-- At `q = 1`, the Hecke word product along any word maps to the corresponding group-algebra -basis element. -/ +/-- At `q = 1`, the Hecke word product along any word maps to +the corresponding group-algebra basis element. -/ theorem qOneAlgHom0_T_prod (l : List (B W)) : qOneAlgHom0 ((l.map T_simple).prod) = MonoidAlgebra.single (cs.wordProd l) (1 : ℤ) := by induction l with @@ -733,9 +743,9 @@ theorem T_simple_action_apply (i : B W) (w : W) : change Finsupp.lift _ _ _ _ (Finsupp.single w (1 : HeckeRing W)) = _ rw [Finsupp.lift_apply, Finsupp.sum_single_index (by simp), one_smul] -/-- The action `T_simple_action` satisfies the Hecke quadratic relation, by the same case-split -calculation as `T_mul_T_simple_of_rightDescent` (mirrored here directly on `module_actedOn W`, -since `{T_w}` isn't known to be a basis yet). -/ +/-- The action `T_simple_action` satisfies the Hecke quadratic relation, +by the same case-split calculation as `T_mul_T_simple_of_rightDescent` +(mirrored here directly on `module_actedOn W`, since `{T_w}` isn't known to be a basis yet). -/ theorem T_simple_action_sq (i : B W) : T_simple_action i * T_simple_action i = (heckeQ i - 1) • T_simple_action i @@ -759,16 +769,17 @@ theorem T_simple_action_sq (i : B W) : rw [T_simple_action_apply] simp only [hw, if_true, cs.simple_mul_simple_cancel_right] -/-- The action `T_simple_action` satisfies the Hecke braid relation: deferred, comparable in -difficulty to Matsumoto's theorem (see the module `TODO`). -/ +/-- The action `T_simple_action` satisfies the Hecke braid relation: +deferred, comparable in difficulty to Matsumoto's theorem (see the module `TODO`). -/ theorem T_simple_action_braid (i i' : B W) : ((braidWord M i i').map T_simple_action).prod = ((braidWord M i' i).map T_simple_action).prod := sorry -/-- The `HeckeRing W`-algebra homomorphism from the free algebra on the simple reflections to -`Module.End (HeckeRing W) (module_actedOn W)`, sending each generator `T_i` to its action -`T_simple_action i`. -/ +/-- The `HeckeRing W`-algebra homomorphism from +the free algebra on the simple reflections +to `Module.End (HeckeRing W) (module_actedOn W)`, +sending each generator `T_i` to its action `T_simple_action i`. -/ noncomputable def heckeActionFreeAlgHom : FreeAlgebra (HeckeRing W) (B W) →ₐ[HeckeRing W] Module.End (HeckeRing W) (module_actedOn W) := FreeAlgebra.lift (HeckeRing W) T_simple_action @@ -795,11 +806,11 @@ theorem heckeActionFreeAlgHom_respects_rel : ∀ ⦃x y⦄, HeckeRel W x y → rw [heckeActionFreeAlgHom_wordProd, heckeActionFreeAlgHom_wordProd] exact T_simple_action_braid i i' -/-- The algebra map from `HeckeAlgebra`, presented by generators and relations, to -`Module.End (HeckeRing W) (module_actedOn W)`: the action of the Hecke algebra on the free -`HeckeRing W`-module on `W`, specified (via the universal property of `RingQuot`) purely by -declaring the action of each generator `T_i` (`T_simple_action`) and checking it respects the -defining relations (`heckeActionFreeAlgHom_respects_rel`). -/ +/-- The algebra map from `HeckeAlgebra`, presented by generators and relations, to `Module.End (HeckeRing W) (module_actedOn W)` +the action of the Hecke algebra on the free +`HeckeRing W`-module on `W`, specified purely by +declaring the action of each generator `T_i` (`T_simple_action`) +and checking it respects the defining relations (`heckeActionFreeAlgHom_respects_rel`). -/ noncomputable def heckeActionAlgHom : HeckeAlgebra W →ₐ[HeckeRing W] Module.End (HeckeRing W) (module_actedOn W) := RingQuot.liftAlgHom (HeckeRing W) ⟨heckeActionFreeAlgHom, heckeActionFreeAlgHom_respects_rel⟩ From bea119b8bf646b47de3a5bc0fa932181f6cfb76b Mon Sep 17 00:00:00 2001 From: Cobord Date: Tue, 7 Jul 2026 01:11:46 -0400 Subject: [PATCH 08/12] finish hecke --- Coxeter/Basic.lean | 16 + Coxeter/Bruhat.lean | 19 + Coxeter/Dihedral.lean | 182 ++++ Coxeter/GeometricRepresentation.lean | 116 ++- Coxeter/Hecke.lean | 1271 ++++++++++++++++++++++++-- Coxeter/SpecialFeatures.lean | 131 +++ Coxeter/StrongExchange.lean | 32 + 7 files changed, 1620 insertions(+), 147 deletions(-) create mode 100644 Coxeter/Dihedral.lean create mode 100644 Coxeter/SpecialFeatures.lean diff --git a/Coxeter/Basic.lean b/Coxeter/Basic.lean index de8f5e6..23aa85d 100644 --- a/Coxeter/Basic.lean +++ b/Coxeter/Basic.lean @@ -93,6 +93,22 @@ theorem alternatingWord_even_add (i i' : B W) (k m : ℕ) : rw [←concat_eq_append, ←alternatingWord_succ, alternatingWord_succ'] simp +theorem reverse_alternatingWord_of_odd (i i' : B W) (m : ℕ) (hm : Odd m) : + (alternatingWord i i' m).reverse = alternatingWord i i' m := by + apply List.ext_getElem (by simp [length_alternatingWord]) + intro k h1 h2 + have hkm : k < m := by simpa [length_alternatingWord] using h2 + have hkm' : m - 1 - k < m := by omega + simp only [List.getElem_reverse, length_alternatingWord] + rw [getElem_alternatingWord i i' m k hkm, getElem_alternatingWord i i' m (m - 1 - k) hkm'] + obtain ⟨j, hj⟩ := hm + have hpar : Even (m + (m - 1 - k)) ↔ Even (m + k) := by + rw [Nat.even_iff, Nat.even_iff] + omega + by_cases hE : Even (m + k) + · rw [if_pos hE, if_pos (hpar.mpr hE)] + · rw [if_neg hE, if_neg (fun hc => hE (hpar.mp hc))] + theorem reverse_alternatingWord (i i' : B W) (k : ℕ) : (alternatingWord i i' (2 * k)).reverse = alternatingWord i' i (2 * k) := by induction k with diff --git a/Coxeter/Bruhat.lean b/Coxeter/Bruhat.lean index 16d33e6..2a1edeb 100644 --- a/Coxeter/Bruhat.lean +++ b/Coxeter/Bruhat.lean @@ -533,6 +533,25 @@ instance : IsDirectedOrder W where rw [simple_mul_simple_cancel_left] at h4 exact ⟨h4, hx2.trans h3⟩ +lemma simple_upper (i : B W) (w : W) : + w <= cs.simple i ↔ (w = 1 ∨ w = cs.simple i) := by + constructor + · intro h + by_cases hw : w = 1 + · exact Or.inl hw + · right + apply eq_of_le_of_length_eq h + have hle := length_le_of_le h + rw [cs.length_simple] at hle ⊢ + have ⟨j, hj⟩ := cs.exists_leftDescent_of_ne_one hw + have hlt : cs.length (cs.simple j * w) < cs.length w := + strictMono_length ((simple_mul_lt_self_iff j w).mpr hj) + have hpos : 0 < cs.length w := by omega + omega + · rintro (rfl | rfl) + · exact bot_le + · exact le_rfl + section finite /-! ### Bruhat order on finite Coxeter groups -/ diff --git a/Coxeter/Dihedral.lean b/Coxeter/Dihedral.lean new file mode 100644 index 0000000..9b16603 --- /dev/null +++ b/Coxeter/Dihedral.lean @@ -0,0 +1,182 @@ +module + +public import Coxeter.StrongExchange + +/-! +# Dihedral parabolic subgroups + +This file studies the rank-two (dihedral) parabolic subgroup generated by two simple reflections, +and minimal-length right coset representatives for it. + +## Main definitions + +* `Coxeter.rankTwoSubgroup` + +## Main statements + +* `Coxeter.exists_confined_reduced_word` +* `Coxeter.exists_minimal_rightCosetRep` +* `Coxeter.mem_alternatingWord` +-/ + +@[expose] public section + +namespace Coxeter + +open List CoxeterSystem CoxeterGroup + +variable {W : Type*} [CoxeterGroup W] + +/-- The rank-2 parabolic subgroup generated by two simple reflections. -/ +def rankTwoSubgroup (i i' : B W) : Subgroup W := Subgroup.closure {cs.simple i, cs.simple i'} + +/-- Every element of `rankTwoSubgroup i i'` +can be written as `cs.wordProd μ` for some +(not necessarily reduced) word `μ` +using only the letters `i`, `i'`. -/ +private theorem exists_confined_word + {i i' : B W} {v : W} + (hv : v ∈ rankTwoSubgroup i i') : + ∃ μ : List (B W), + v = cs.wordProd μ ∧ ∀ k ∈ μ, k = i ∨ k = i' := by + induction hv using Subgroup.closure_induction with + | mem x hx => + rcases hx with h | h + · exact ⟨[i], by rw [wordProd_singleton, h], by simp⟩ + · exact ⟨[i'], by rw [wordProd_singleton, h], by simp⟩ + | one => exact ⟨[], by rw [wordProd_nil], by simp⟩ + | mul x y _ _ ihx ihy => + obtain ⟨μx, hμx1, hμx2⟩ := ihx + obtain ⟨μy, hμy1, hμy2⟩ := ihy + refine ⟨μx ++ μy, ?_, ?_⟩ + · rw [wordProd_append, ← hμx1, ← hμy1] + · intro k hk + rcases List.mem_append.mp hk with hk | hk + · exact hμx2 k hk + · exact hμy2 k hk + | inv x _ ihx => + obtain ⟨μ, hμ1, hμ2⟩ := ihx + refine ⟨μ.reverse, ?_, ?_⟩ + · rw [hμ1, wordProd_reverse] + · intro k hk + exact hμ2 k (List.mem_reverse.mp hk) + +/-- Every element of `rankTwoSubgroup i i'` +has a **reduced** word using only the letters +`i`, `i'`. -/ +theorem exists_confined_reduced_word + {i i' : B W} {v : W} + (hv : v ∈ rankTwoSubgroup i i') : + ∃ μ : List (B W), + cs.IsReduced μ ∧ v = cs.wordProd μ ∧ ∀ k ∈ μ, k = i ∨ k = i' := by + obtain ⟨μ₀, hμ₀1, hμ₀2⟩ := exists_confined_word hv + obtain ⟨μ, hsub, hred, heq⟩ := exists_reduced_subword μ₀ + exact ⟨μ, hred, hμ₀1.trans heq, fun k hk => hμ₀2 k (hsub.subset hk)⟩ + +/-- Every `w : W` factors as `w = w₀ * v` with `v ∈ rankTwoSubgroup i i'` and `w₀` having no right +descent among `i`, `i'` (i.e. `w₀` is of minimal length in the coset `w₀ * rankTwoSubgroup i i'`). +Obtained by repeatedly cancelling a right descent among `i`, `i'` off the right of `w`, which +strictly decreases length and so terminates. -/ +theorem exists_minimal_rightCosetRep (i i' : B W) (w : W) : + ∃ w₀ v, v ∈ rankTwoSubgroup i i' ∧ w = w₀ * v ∧ + ¬ cs.IsRightDescent w₀ i ∧ ¬ cs.IsRightDescent w₀ i' := by + induction hn : cs.length w using Nat.strong_induction_on generalizing w with + | _ n ih => + subst hn + by_cases hi : cs.IsRightDescent w i + · obtain ⟨w₀, v, hv, hw, hi0, hi'0⟩ := + ih (cs.length (w * cs.simple i)) hi (w * cs.simple i) rfl + refine ⟨w₀, v * cs.simple i, Subgroup.mul_mem _ hv (Subgroup.subset_closure (Or.inl rfl)), + ?_, hi0, hi'0⟩ + rw [← mul_assoc, ← hw, cs.simple_mul_simple_cancel_right] + · by_cases hi' : cs.IsRightDescent w i' + · obtain ⟨w₀, v, hv, hw, hi0, hi'0⟩ := + ih (cs.length (w * cs.simple i')) hi' (w * cs.simple i') rfl + refine ⟨w₀, v * cs.simple i', Subgroup.mul_mem _ hv (Subgroup.subset_closure (Or.inr rfl)), + ?_, hi0, hi'0⟩ + rw [← mul_assoc, ← hw, cs.simple_mul_simple_cancel_right] + · exact ⟨w, 1, Subgroup.one_mem _, (mul_one w).symm, hi, hi'⟩ + +/-- The easy half of the "gate property" (see `DihedralSubProperties` in `Coxeter/Hecke.lean`): if +`v` has a right descent at `j` and `w * v` has no length cancellation (`hlen`), then `w * v` has a +right descent at `j` too. General (no `rankTwoSubgroup` hypothesis needed), following directly from +`isRightInversion_of_isRightInversion_mul_right`. The converse ("hard half": `w * v` having a +descent at `j` forces `v` to) is what's still deferred, since it needs `hlen` itself established +from `w`/`v`'s descents rather than assumed outright. -/ +theorem isRightDescent_mul_right_of_isRightDescent {w v : W} + (hlen : cs.length (w * v) = cs.length w + cs.length v) {j : B W} + (hj : cs.IsRightDescent v j) : cs.IsRightDescent (w * v) j := by + rw [← isRightInversion_simple_iff_isRightDescent] at hj ⊢ + exact isRightInversion_of_isRightInversion_mul_right hj hlen + +/-- Every letter of `alternatingWord i i' p` is `i` or `i'`. -/ +theorem mem_alternatingWord {i i' k : B W} {p : ℕ} (hk : k ∈ alternatingWord i i' p) : + k = i ∨ k = i' := by + obtain ⟨n, hn, rfl⟩ := List.mem_iff_getElem.mp hk + rw [length_alternatingWord] at hn + rw [getElem_alternatingWord i i' p n hn] + split <;> simp + +/-- A reduced word can never repeat a letter in two consecutive positions: `s_k * s_k = 1` would +let the pair cancel, giving a strictly shorter word for the same element. -/ +private theorem not_isReduced_append_simple_simple (a : List (B W)) (k : B W) : + ¬ cs.IsReduced (a ++ [k, k]) := by + intro hred + have h1 : cs.wordProd (a ++ [k, k]) = cs.wordProd a := by + simp only [wordProd_append, wordProd_cons, wordProd_nil, mul_one] + rw [← mul_assoc, cs.simple_mul_simple_cancel_right] + have h2 : cs.length (cs.wordProd a) ≤ a.length := cs.length_wordProd_le a + unfold CoxeterSystem.IsReduced at hred + rw [h1] at hred + simp only [List.length_append, List.length_cons, List.length_nil] at hred + omega + +/-- A reduced word confined to two letters `i`, `i'` must be an alternating word, in one order or +the other: since a reduced word never repeats a letter in two consecutive positions +(`not_isReduced_append_simple_simple`), and a sequence over a two-letter alphabet with no +immediate repeats is determined entirely by its first letter and length. -/ +theorem eq_alternatingWord_of_isReduced_of_confined {i i' : B W} {μ : List (B W)} + (hred : cs.IsReduced μ) (hconf : ∀ k ∈ μ, k = i ∨ k = i') : + μ = alternatingWord i i' μ.length ∨ μ = alternatingWord i' i μ.length := by + induction μ using List.reverseRecOn with + | nil => exact Or.inl rfl + | append_singleton rest k ih => + have hred_rest : cs.IsReduced rest := isReduced_of_append_left hred + have hconf_rest : ∀ m ∈ rest, m = i ∨ m = i' := fun m hm => hconf m (by simp [hm]) + have hk : i = k ∨ i' = k := (hconf k (by simp)).imp Eq.symm Eq.symm + rcases Nat.eq_zero_or_pos rest.length with hL0 | hLpos + · have hnil : rest = [] := List.length_eq_zero_iff.mp hL0 + subst hnil + rcases hk with rfl | rfl + · exact Or.inr rfl + · exact Or.inl rfl + · obtain ⟨L, hL⟩ : ∃ L, rest.length = L + 1 := ⟨rest.length - 1, by omega⟩ + rcases ih hred_rest hconf_rest with hrest | hrest + · rw [hL] at hrest + rcases hk with rfl | rfl + · right + have heq : rest ++ [i] = alternatingWord i' i (L + 2) := by + rw [alternatingWord_succ i' i (L + 1), List.concat_eq_append, hrest] + rw [heq] + congr 1 + simp + · exfalso + rw [alternatingWord_succ i i' L, List.concat_eq_append] at hrest + refine not_isReduced_append_simple_simple (alternatingWord i' i L) i' ?_ + rw [hrest, List.append_assoc] at hred + exact hred + · rw [hL] at hrest + rcases hk with rfl | rfl + · exfalso + rw [alternatingWord_succ i' i L, List.concat_eq_append] at hrest + refine not_isReduced_append_simple_simple (alternatingWord i i' L) i ?_ + rw [hrest, List.append_assoc] at hred + exact hred + · left + have heq : rest ++ [i'] = alternatingWord i i' (L + 2) := by + rw [alternatingWord_succ i i' (L + 1), List.concat_eq_append, hrest] + rw [heq] + congr 1 + simp + +end Coxeter diff --git a/Coxeter/GeometricRepresentation.lean b/Coxeter/GeometricRepresentation.lean index 76fc7a5..b47544c 100644 --- a/Coxeter/GeometricRepresentation.lean +++ b/Coxeter/GeometricRepresentation.lean @@ -16,7 +16,10 @@ This file defines the geometric representation of a Coxeter group. ## Main statements * `Coxeter.orderOf_simple_mul_simple` : $s_i s_{i'}$ has the expected order -* `Coxeter.simple_inj` +* `Coxeter.simple_inj` : the simple reflections are pairwise distinct +* `Coxeter.finite_generating_set` : `B W` is finite if `W` is finite +* `Coxeter.single_letter_reduced` : the only reduced word for a simple reflection is the + corresponding singleton letter ## TODO @@ -41,25 +44,27 @@ variable {W : Type*} [CoxeterGroup W] def stdBasis : Module.Basis (B W) ℝ (V W) := Finsupp.basisSingleOne +-- `M i i' = 0` codes for `∞` (no braid relation); `π / (0:ℝ) = 0` by convention, giving +-- `-cos (π / M i i') = -1`, matching the `m → ∞` limit of `-cos (π / m)`. def bil : LinearMap.BilinForm ℝ (V W) := Matrix.toBilin stdBasis (fun i i' => -cos (π / M i i')) -theorem bil_isSymm : (@bil W _).IsSymm := by +private theorem bil_isSymm : (@bil W _).IsSymm := by rw [LinearMap.BilinForm.isSymm_iff_basis stdBasis] intro i i' unfold bil rw [Matrix.toBilin_single, Matrix.toBilin_single, M.symmetric i i'] @[simp] -theorem bil_eq (i i' : B W) : bil (stdBasis i) (stdBasis i') = -cos (π / M i i') := by +private theorem bil_eq (i i' : B W) : bil (stdBasis i) (stdBasis i') = -cos (π / M i i') := by unfold bil rw [Matrix.toBilin_single] @[simp] -theorem bil_diag (i : B W) : bil (stdBasis i) (stdBasis i) = 1 := by +private theorem bil_diag (i : B W) : bil (stdBasis i) (stdBasis i) = 1 := by rw [bil_eq] simp -theorem bil_off_diag_le (i i' : B W) (h : i ≠ i') : bil (stdBasis i) (stdBasis i') ≤ 0 := by +private theorem bil_off_diag_le (i i' : B W) (h : i ≠ i') : bil (stdBasis i) (stdBasis i') ≤ 0 := by rw [bil_eq, neg_nonpos] apply cos_nonneg_of_neg_pi_div_two_le_of_le · trans 0 @@ -98,7 +103,7 @@ theorem geomRepAux_apply (i : B W) (x : V W) : theorem geomRepAux_involutive (i : B W) : Involutive (geomRepAux i) := (geomRepAux i).left_inv -theorem orderOf_geomRepAux_mul_geomRepAux₁ (i i' : B W) (h : M i i' = 1) : +private theorem orderOf_geomRepAux_mul_geomRepAux₁ (i i' : B W) (h : M i i' = 1) : orderOf (geomRepAux i * geomRepAux i') = 1 := by rw [(M.off_diagonal i i').mtr h, orderOf_eq_one_iff] apply LinearEquiv.ext @@ -112,23 +117,23 @@ theorem geomRepAux_stdBasis (i : B W) : geomRepAux i (stdBasis i) = -stdBasis i match_scalars norm_num -def E (i i' : B W) : Submodule ℝ (V W) := supported ℝ _ {i, i'} +private def E (i i' : B W) : Submodule ℝ (V W) := supported ℝ _ {i, i'} -theorem E_eq_span (i i' : B W) : E i i' = Submodule.span ℝ {stdBasis i, stdBasis i'} := by +private theorem E_eq_span (i i' : B W) : E i i' = Submodule.span ℝ {stdBasis i, stdBasis i'} := by unfold E stdBasis rw [supported_eq_span_single, Set.image_pair] rfl -theorem mem_E_iff (i i' : B W) (v : V W) : +private theorem mem_E_iff (i i' : B W) (v : V W) : v ∈ E i i' ↔ ∃ (x y : ℝ), v = x • stdBasis i + y • stdBasis i' := by rw [E_eq_span, Submodule.mem_span_pair] tauto -theorem E_symm (i i' : B W) : E i i' = E i' i := by +private theorem E_symm (i i' : B W) : E i i' = E i' i := by unfold E rw [Set.pair_comm] -theorem bil_restrict_E_diag (i i' : B W) (x y : ℝ) : +private theorem bil_restrict_E_diag (i i' : B W) (x y : ℝ) : bil (x • stdBasis i + y • stdBasis i') (x • stdBasis i + y • stdBasis i') = (x - y * cos (π / M i i')) ^ 2 + (y * sin (π / M i i')) ^ 2 := by calc @@ -141,10 +146,10 @@ theorem bil_restrict_E_diag (i i' : B W) (x y : ℝ) : rw [←one_mul (y ^ 2), ←sin_sq_add_cos_sq (π / M i i')] ring -theorem bil_restrict_E_isSymm (i i' : B W) : (bil.restrict (E i i')).IsSymm := by +private theorem bil_restrict_E_isSymm (i i' : B W) : (bil.restrict (E i i')).IsSymm := by apply bil_isSymm.restrict -theorem bil_restrict_E_nonneg (i i' : B W) : (bil.restrict (E i i')).IsNonneg := by +private theorem bil_restrict_E_nonneg (i i' : B W) : (bil.restrict (E i i')).IsNonneg := by rw [LinearMap.BilinForm.isNonneg_def] intro ⟨z, hz⟩ rw [mem_E_iff] at hz @@ -154,12 +159,13 @@ theorem bil_restrict_E_nonneg (i i' : B W) : (bil.restrict (E i i')).IsNonneg := positivity /-- Bourbaki Ch V, §4, Proposition 1 -/ -theorem bil_restrict_E_isPosSemidef (i i' : B W) : (bil.restrict (E i i')).IsPosSemidef := by +private theorem bil_restrict_E_isPosSemidef (i i' : B W) : + (bil.restrict (E i i')).IsPosSemidef := by rw [LinearMap.BilinForm.isPosSemidef_def] exact ⟨bil_restrict_E_isSymm i i', bil_restrict_E_nonneg i i'⟩ /-- Bourbaki Ch V, §4, Proposition 1 (continued) -/ -theorem bil_restrict_E_nondegenerate_iff (i i' : B W) (h : i ≠ i') : +private theorem bil_restrict_E_nondegenerate_iff (i i' : B W) (h : i ≠ i') : (bil.restrict (E i i')).Nondegenerate ↔ M i i' ≠ 0 := by unfold LinearMap.BilinForm.Nondegenerate rw [LinearMap.BilinForm.nondegenerate_iff'] @@ -214,7 +220,7 @@ theorem bil_restrict_E_nondegenerate_iff (i i' : B W) (h : i ≠ i') : · rw [←LinearMap.BilinForm.isSymm_iff] exact bil_restrict_E_isSymm i i' -theorem geomRepAux_E_perp_left (i i' : B W) : +private theorem geomRepAux_E_perp_left (i i' : B W) : ∀ z ∈ (E i i').orthogonalBilin bil, geomRepAux i z = z := by intro z hz rw [geomRepAux_apply, sub_eq_self, hz (stdBasis i), mul_zero, zero_smul] @@ -222,28 +228,28 @@ theorem geomRepAux_E_perp_left (i i' : B W) : apply Submodule.mem_span_of_mem simp -theorem geomRepAux_E_perp_right (i i' : B W) : +private theorem geomRepAux_E_perp_right (i i' : B W) : ∀ z ∈ (E i i').orthogonalBilin bil, geomRepAux i' z = z := by rw [E_symm] apply geomRepAux_E_perp_left -theorem geomRepAux_E_left (i i' : B W) : Set.MapsTo (geomRepAux i) (E i i') (E i i') := by +private theorem geomRepAux_E_left (i i' : B W) : Set.MapsTo (geomRepAux i) (E i i') (E i i') := by rw [Set.mapsTo_iff_image_subset] change Submodule.map (geomRepAux i).toLinearMap (E i i') ≤ E i i' rw [E_eq_span, LinearMap.map_span_le] simp only [LinearEquiv.coe_coe, geomRepAux_apply] aesop -theorem geomRepAux_E_right (i i' : B W) : Set.MapsTo (geomRepAux i') (E i i') (E i i') := by +private theorem geomRepAux_E_right (i i' : B W) : Set.MapsTo (geomRepAux i') (E i i') (E i i') := by rw [E_symm] apply geomRepAux_E_left -theorem geomRepAux_E_2 (i i' : B W) +private theorem geomRepAux_E_2 (i i' : B W) : Set.MapsTo (geomRepAux i * geomRepAux i') (E i i') (E i i') := by change Set.MapsTo (geomRepAux i ∘ geomRepAux i') (E i i') (E i i') exact (geomRepAux_E_left i i').comp (geomRepAux_E_right i i') -theorem restrict_geomRepAux_mul (i i' : B W) : +private theorem restrict_geomRepAux_mul (i i' : B W) : (geomRepAux i * geomRepAux i').restrict (geomRepAux_E_2 i i') = (geomRepAux i).restrict (geomRepAux_E_left i i') ∘ₗ (geomRepAux i').restrict (geomRepAux_E_right i i') := by rfl @@ -252,7 +258,7 @@ section infinite_order variable (i i' : B W) -theorem geomRepAux_mul_geomRepAux_pow₀ (h : M i i' = 0) (n : ℕ) : +private theorem geomRepAux_mul_geomRepAux_pow₀ (h : M i i' = 0) (n : ℕ) : ((geomRepAux i * geomRepAux i') ^ n) (stdBasis i) = (2 * n) • (stdBasis i + stdBasis i') + stdBasis i := by generalize hu : stdBasis i + stdBasis i' = u @@ -282,7 +288,7 @@ theorem geomRepAux_mul_geomRepAux_pow₀ (h : M i i' = 0) (n : ℕ) : match_scalars <;> ring · rw [pow_succ, LinearEquiv.mul_apply, h3, ih.2] -theorem orderOf_geomRepAux_mul_geomRepAux₀ (h : M i i' = 0) : +private theorem orderOf_geomRepAux_mul_geomRepAux₀ (h : M i i' = 0) : orderOf (geomRepAux i * geomRepAux i') = 0 := by rw [orderOf_eq_zero_iff'] intro n hn h2 @@ -307,14 +313,14 @@ section finite_order variable (i i' : B W) [Fact (M i i' ≥ 2)] -theorem index_ne : i ≠ i' := by +private theorem index_ne : i ≠ i' := by have h := (inferInstance : Fact (M i i' ≥ 2)).out intro heq subst heq simp at h open Classical in -def e : ({i, i'} : Set (B W)) ≃ Fin 2 where +private def e : ({i, i'} : Set (B W)) ≃ Fin 2 where toFun := fun x => if x.val = i then 0 else 1 invFun | 0 => ⟨i, by tauto⟩ @@ -328,11 +334,11 @@ def e : ({i, i'} : Set (B W)) ≃ Fin 2 where symm apply index_ne -def stdBasisE : Module.Basis (Fin 2) ℝ (E i i') := +private def stdBasisE : Module.Basis (Fin 2) ℝ (E i i') := (Finsupp.basisSingleOne.map (supportedEquivFinsupp {i, i'}).symm).reindex (e i i') @[simp] -theorem stdBasisE_0 : stdBasisE i i' 0 = stdBasis i := +private theorem stdBasisE_0 : stdBasisE i i' 0 = stdBasis i := calc (((Finsupp.basisSingleOne.map (supportedEquivFinsupp {i, i'}).symm).reindex (e i i')) 0).val = ((Finsupp.basisSingleOne.map (supportedEquivFinsupp {i, i'}).symm) ((e i i').symm 0)).val @@ -340,29 +346,29 @@ theorem stdBasisE_0 : stdBasisE i i' 0 = stdBasis i := _ = stdBasis i := by rw [Module.Basis.map_apply]; simp [stdBasis, e] @[simp] -theorem stdBasisE_1 : stdBasisE i i' 1 = stdBasis i' := +private theorem stdBasisE_1 : stdBasisE i i' 1 = stdBasis i' := calc (((Finsupp.basisSingleOne.map (supportedEquivFinsupp {i, i'}).symm).reindex (e i i')) 1).val = ((Finsupp.basisSingleOne.map (supportedEquivFinsupp {i, i'}).symm) ((e i i').symm 1)).val := by rw [Module.Basis.reindex_apply] _ = stdBasis i' := by rw [Module.Basis.map_apply]; simp [stdBasis, e] -instance : FiniteDimensional ℝ (E i i') := (stdBasisE i i').finiteDimensional_of_finite +private instance : FiniteDimensional ℝ (E i i') := (stdBasisE i i').finiteDimensional_of_finite -theorem finrank_E_eq_two : Module.finrank ℝ (E i i') = 2 := by +private theorem finrank_E_eq_two : Module.finrank ℝ (E i i') = 2 := by rw [Module.finrank_eq_card_basis (stdBasisE i i')] apply Fintype.card_fin -instance : Fact (Module.finrank ℝ (E i i') = 2) where +private instance : Fact (Module.finrank ℝ (E i i') = 2) where out := finrank_E_eq_two i i' -theorem E_sup_orthogonal : E i i' ⊔ (E i i').orthogonalBilin bil = ⊤ := by +private theorem E_sup_orthogonal : E i i' ⊔ (E i i').orthogonalBilin bil = ⊤ := by apply sup_orthogonal_eq_top _ bil_isSymm (bil_restrict_E_nonneg i i') rw [bil_restrict_E_nondegenerate_iff i i' (index_ne i i')] have := (inferInstance : Fact (M i i' ≥ 2)).out lia -theorem orderOf_geomRepAux_mul_geomRepAux_eq_orderOf_restrict (m : ℕ) : +private theorem orderOf_geomRepAux_mul_geomRepAux_eq_orderOf_restrict (m : ℕ) : (geomRepAux i * geomRepAux i') ^ m = 1 ↔ (geomRepAux i * geomRepAux i').restrict (geomRepAux_E_2 i i') ^ m = 1 := by rw [Module.End.pow_restrict] @@ -397,7 +403,7 @@ theorem orderOf_geomRepAux_mul_geomRepAux_eq_orderOf_restrict (m : ℕ) : change ((geomRepAux i * geomRepAux i') ^ m) (geomRepAux i (geomRepAux i' v)) = v rw [geomRepAux_E_perp_right i i' v hv, geomRepAux_E_perp_left i i' v hv, ih] -instance : PreInnerProductSpace.Core ℝ (E i i') where +private instance : PreInnerProductSpace.Core ℝ (E i i') where inner x y := bil.restrict (E i i') x y conj_inner_symm x y := by simp only [conj_trivial] @@ -408,7 +414,7 @@ instance : PreInnerProductSpace.Core ℝ (E i i') where add_left := by simp smul_left := by simp -instance : InnerProductSpace.Core ℝ (E i i') where +private instance : InnerProductSpace.Core ℝ (E i i') where definite x h := by have h2 := (inferInstance : Fact (M i i' ≥ 2)).out change bil.restrict (E i i') x x = 0 at h @@ -424,32 +430,32 @@ instance : InnerProductSpace.Core ℝ (E i i') where · rw [←LinearMap.BilinForm.isSymm_iff] exact bil_restrict_E_isSymm i i' -instance : NormedAddCommGroup (E i i') := +private instance : NormedAddCommGroup (E i i') := @InnerProductSpace.Core.toNormedAddCommGroup ℝ (E i i') _ _ _ inferInstance -instance : InnerProductSpace ℝ (E i i') := InnerProductSpace.ofCore inferInstance +private instance : InnerProductSpace ℝ (E i i') := InnerProductSpace.ofCore inferInstance open scoped RealInnerProductSpace @[simp] -theorem norm_stdBasisE_0 : ‖stdBasisE i i' 0‖ = 1 := by +private theorem norm_stdBasisE_0 : ‖stdBasisE i i' 0‖ = 1 := by rw [@norm_eq_sqrt_re_inner ℝ (E i i')] change √((bil.restrict (E i i') (stdBasisE i i' 0) (stdBasisE i i' 0))) = 1 rw [LinearMap.BilinForm.restrict_apply] simp @[simp] -theorem norm_stdBasisE_1 : ‖stdBasisE i i' 1‖ = 1 := by +private theorem norm_stdBasisE_1 : ‖stdBasisE i i' 1‖ = 1 := by rw [@norm_eq_sqrt_re_inner ℝ (E i i')] change √((bil.restrict (E i i') (stdBasisE i i' 1) (stdBasisE i i' 1))) = 1 rw [LinearMap.BilinForm.restrict_apply] simp @[simp] -theorem inner_stdBasisE_0_1 : ⟪stdBasisE i i' 0, stdBasisE i i' 1⟫ = -cos (π / M i i') := by +private theorem inner_stdBasisE_0_1 : ⟪stdBasisE i i' 0, stdBasisE i i' 1⟫ = -cos (π / M i i') := by simp [inner] -theorem oangle_stdBasisE : ∃ (o : Orientation ℝ (E i i') (Fin 2)), +private theorem oangle_stdBasisE : ∃ (o : Orientation ℝ (E i i') (Fin 2)), o.oangle (stdBasisE i i' 0) (stdBasisE i i' 1) = Angle.coe (π - π / M i i') := by let o := (stdBasisE i i').orientation have h2 := o.inner_eq_norm_mul_norm_mul_cos_oangle (stdBasisE i i' 0) (stdBasisE i i' 1) @@ -464,7 +470,7 @@ theorem oangle_stdBasisE : ∃ (o : Orientation ℝ (E i i') (Fin 2)), exists -o rw [Orientation.oangle_neg_orientation_eq_neg, h2, neg_neg] -theorem restrict_geomRepAux_left_eq_reflect : +private theorem restrict_geomRepAux_left_eq_reflect : (geomRepAux i).restrict (geomRepAux_E_left i i') = reflect (norm_stdBasisE_0 i i') := by ext x : 1 rw [LinearMap.restrict_apply] @@ -477,7 +483,7 @@ theorem restrict_geomRepAux_left_eq_reflect : rw [LinearMap.BilinForm.restrict_apply, stdBasisE_0] rfl -theorem restrict_geomRepAux_right_eq_reflect : +private theorem restrict_geomRepAux_right_eq_reflect : (geomRepAux i').restrict (geomRepAux_E_right i i') = reflect (norm_stdBasisE_1 i i') := by ext x : 1 rw [LinearMap.restrict_apply] @@ -490,9 +496,10 @@ theorem restrict_geomRepAux_right_eq_reflect : rw [LinearMap.BilinForm.restrict_apply, stdBasisE_1] rfl -theorem restrict_geomRepAux_mul_geomRep_aux_eq_rotate : ∃ (o : Orientation ℝ (E i i') (Fin 2)), - (geomRepAux i * geomRepAux i').restrict (geomRepAux_E_2 i i') - = (o.rotation (2 * π / M i i' : ℝ)).toLinearMap := by +private theorem restrict_geomRepAux_mul_geomRep_aux_eq_rotate : + ∃ (o : Orientation ℝ (E i i') (Fin 2)), + (geomRepAux i * geomRepAux i').restrict (geomRepAux_E_2 i i') + = (o.rotation (2 * π / M i i' : ℝ)).toLinearMap := by have h := (inferInstance : Fact (M i i' ≥ 2)).out have ⟨o, ho⟩ := oangle_stdBasisE i i' exists o @@ -505,7 +512,8 @@ theorem restrict_geomRepAux_mul_geomRep_aux_eq_rotate : ∃ (o : Orientation ℝ simp rfl -theorem orderOf_geomRepAux_mul_geomRepAux₂ : orderOf (geomRepAux i * geomRepAux i') = M i i' := by +private theorem orderOf_geomRepAux_mul_geomRepAux₂ : + orderOf (geomRepAux i * geomRepAux i') = M i i' := by have h := (inferInstance : Fact (M i i' ≥ 2)).out have ⟨o, ho⟩ := restrict_geomRepAux_mul_geomRep_aux_eq_rotate i i' have h2 := order_rotation_two_pi_div o (M i i') (by lia) @@ -586,6 +594,20 @@ theorem simple_inj : Injective ((@cs W).simple) := by theorem finite_generating_set [Finite W] : Finite (B W) := Finite.of_injective _ simple_inj +/-- The only reduced word for a simple reflection `cs.simple i` is the singleton `[i]`. -/ +lemma single_letter_reduced (i : B W) : + (Classical.arbitrary (ReducedWord (cs.simple i))) = + List.singleton i := by + have inj := simple_inj (W:=W) + set ω := Classical.arbitrary (ReducedWord (cs.simple i)) + obtain ⟨j, hj⟩ := List.length_eq_one_iff.mp (ω.length_eq.trans (cs.length_simple i)) + have heq : cs.simple j = cs.simple i := by + rw [←cs.wordProd_singleton, ←hj] + exact ω.wordProd_eq + rw [inj.eq_iff] at heq + rw [hj, heq] + rfl + end end Coxeter diff --git a/Coxeter/Hecke.lean b/Coxeter/Hecke.lean index 75984eb..973b60b 100644 --- a/Coxeter/Hecke.lean +++ b/Coxeter/Hecke.lean @@ -7,8 +7,16 @@ public import Mathlib.Algebra.FreeAlgebra public import Mathlib.Algebra.RingQuot public import Mathlib.RingTheory.TensorProduct.Basic public import Mathlib.RingTheory.TensorProduct.Maps +public import Mathlib.Tactic.Module +public import Mathlib.Tactic.LinearCombination +public import Mathlib.LinearAlgebra.Finsupp.VectorSpace public import Coxeter.LinearAlgebra.AssociatedGraded public import Coxeter.StrongExchange +public import Coxeter.GeometricRepresentation +public import Coxeter.Bruhat +public import Coxeter.Dihedral +public import Coxeter.GeometricRepresentation +public import Mathlib.Data.Finsupp.Order /-! # The Iwahori–Hecke algebra @@ -108,6 +116,97 @@ instance {W : Type*} [CoxeterGroup W] : StarRing (HeckeRing W) where rw [map_mul, mul_comm] star_add x y := map_add (AddMonoidAlgebra.domCongr ℤ ℤ (AddEquiv.neg (ParamIndex W →₀ ℤ))) x y +/-- The fixed subring of the coefficient involution `v_i ↦ v_i⁻¹` on `HeckeRing W`: the +"bar-invariant" Laurent polynomials, e.g. the symmetric ones in `v_i, v_i⁻¹`. -/ +def heckeRingBarFixed (W : Type*) [CoxeterGroup W] : Subring (HeckeRing W) where + carrier := {c | star c = c} + one_mem' := star_one _ + mul_mem' {a b} ha hb := by + change star (a * b) = a * b + rw [star_mul', ha, hb] + zero_mem' := star_zero _ + add_mem' {a b} ha hb := by + change star (a + b) = a + b + rw [star_add, ha, hb] + neg_mem' {a} ha := by + change star (-a) = -a + rw [star_neg, ha] + +theorem mem_heckeRingBarFixed_iff {W : Type*} [CoxeterGroup W] {c : HeckeRing W} : + c ∈ heckeRingBarFixed W ↔ star c = c := Iff.rfl + +/-- On the bar-fixed subring itself, `star` (inherited from `HeckeRing W`) is *trivial*: every +element is already fixed by definition, so `star = id` here. Since `heckeRingBarFixed W` is +commutative (`HeckeRing W` is), the ordinary and anti-multiplicative laws coincide, so this +trivial `star` is a genuine `StarRing` structure (unlike the situation on `heckeAlgebraBarFixed` +in `section BarInvariant` below, which is generally noncommutative). -/ +noncomputable instance {W : Type*} [CoxeterGroup W] : StarRing (heckeRingBarFixed W) where + star := id + star_involutive _ := rfl + star_mul a b := mul_comm a b + star_add _ _ := rfl + +instance {W : Type*} [CoxeterGroup W] : TrivialStar (heckeRingBarFixed W) := ⟨fun _ => rfl⟩ + +/-- The subring of `HeckeRing W` consisting of **ordinary (non-Laurent) polynomials**: those whose +every monomial has every exponent nonnegative, i.e. `ℤ[v_i : i]` sitting inside the Laurent ring +`ℤ[v_i^{±1} : i]`. This is the "positive part" the Kazhdan–Lusztig degree/triangularity condition +is stated against (`IsKLBasisElement` in `section BarInvariant`). -/ +noncomputable def heckeRingPoly (W : Type*) [CoxeterGroup W] : Subring (HeckeRing W) where + carrier := {c | ∀ m ∈ c.support, 0 ≤ m} + one_mem' m hm := by + classical + rw [Finsupp.mem_support_iff, AddMonoidAlgebra.one_def, Finsupp.single_apply] at hm + by_cases h : m = 0 + · rw [h] + · simp only [ne_eq, ite_eq_right_iff, one_ne_zero, imp_false, Decidable.not_not] at hm + have h2 : ¬0=m := by + by_contra + rw [hm] at h + exact absurd rfl h + exact absurd hm h2 + zero_mem' m hm := by + rw [Finsupp.mem_support_iff] at hm + exact absurd rfl hm + add_mem' {a b} ha hb m hm := by + rw [Finsupp.mem_support_iff] at hm + by_contra hc + have ha0 : a m = 0 := by_contra fun h => hc (ha m (Finsupp.mem_support_iff.mpr h)) + have hb0 : b m = 0 := by_contra fun h => hc (hb m (Finsupp.mem_support_iff.mpr h)) + exact hm (show a m + b m = 0 by rw [ha0, hb0, add_zero]) + neg_mem' {a} ha m hm := by + have h : a m ≠ 0 := by + have hm' := Finsupp.mem_support_iff.mp hm + exact fun h0 => hm' (by rw [AddMonoidAlgebra.neg_apply, h0, neg_zero]) + exact ha m (Finsupp.mem_support_iff.mpr h) + mul_mem' {a b} ha hb m hm := by + classical + obtain ⟨m1, hm1, m2, hm2, rfl⟩ := Finset.mem_add.mp (AddMonoidAlgebra.support_mul a b hm) + exact add_nonneg (ha m1 hm1) (hb m2 hm2) + +theorem mem_heckeRingPoly_iff {W : Type*} [CoxeterGroup W] {c : HeckeRing W} : + c ∈ heckeRingPoly W ↔ ∀ m ∈ c.support, 0 ≤ m := Iff.rfl + +/-- The total degree of a multiparameter Laurent monomial `∏ᵢ vᵢ^{eᵢ}`: the sum of its exponents +across all parameter classes. Each `vᵢ` is given weight `1` (matching its contribution to the +length filtration), so this is the multiparameter analogue of the usual single-variable `v`-degree +used in the classical Kazhdan–Lusztig grading. -/ +def monomialDegree {W : Type*} [CoxeterGroup W] (m : ParamIndex W →₀ ℤ) : ℤ := + m.sum (fun _ e => e) + +/-- An element of `HeckeRing W` is a **genuine polynomial in the `qᵢ := vᵢ²`** (not merely in the +`vᵢ`) of `v`-degree at most `n`: every monomial in its support has every exponent nonnegative +(`heckeRingPoly`) *and even* (so it is really built from the `qᵢ`, not just the `vᵢ` — the name +records this, unlike a plain "degree `≤ n`" bound on `heckeRingPoly` alone, which would still +allow odd exponents), and total degree (`monomialDegree`) at most `n`. This is the shape of bound +the Kazhdan–Lusztig triangularity condition imposes on each (untwisted) `T_v`-coefficient of +`C'_w`, with `n` taken to be `length w - length v - 1` (see `IsKLBasisElement` in `section +BarInvariant`): the classical `P_{y,w}` are polynomials *in `q`*, so e.g. a bare `v_i` term +(degree `1`, odd) can never legitimately appear, even when the bound `n` would otherwise permit +degree `1`. -/ +def heckeRingEvenPolyDegreeLE {W : Type*} [CoxeterGroup W] (n : ℤ) (c : HeckeRing W) : Prop := + c ∈ heckeRingPoly W ∧ ∀ m ∈ c.support, (∀ p, Even (m p)) ∧ monomialDegree m ≤ n + /-- The distinguished indeterminate `v_i` at the simple reflection `i`. -/ def heckeV {W : Type*} [CoxeterGroup W] (i : B W) : HeckeRing W := @@ -117,6 +216,44 @@ def heckeV {W : Type*} [CoxeterGroup W] (i : B W) : HeckeRing W := at the simple reflection `i`. -/ def heckeQ {W : Type*} [CoxeterGroup W] (i : B W) : HeckeRing W := heckeV i * heckeV i +/-- `heckeV i` is a unit in `HeckeRing W`, with inverse `star (heckeV i)` (negating the exponent +of the Laurent monomial `v_i` gives `v_i⁻¹`). -/ +theorem heckeV_mul_star {W : Type*} [CoxeterGroup W] (i : B W) : + heckeV i * star (heckeV i) = 1 := by + change heckeV i * AddMonoidAlgebra.domCongr ℤ ℤ (AddEquiv.neg (ParamIndex W →₀ ℤ)) (heckeV i) = 1 + unfold heckeV + rw [AddMonoidAlgebra.domCongr_single, AddMonoidAlgebra.single_mul_single, mul_one, + AddMonoidAlgebra.one_def] + congr 1 + simp + +theorem star_heckeV_mul {W : Type*} [CoxeterGroup W] (i : B W) : + star (heckeV i) * heckeV i = 1 := by + change AddMonoidAlgebra.domCongr ℤ ℤ (AddEquiv.neg (ParamIndex W →₀ ℤ)) (heckeV i) * heckeV i = 1 + unfold heckeV + rw [AddMonoidAlgebra.domCongr_single, AddMonoidAlgebra.single_mul_single, mul_one, + AddMonoidAlgebra.one_def] + congr 1 + simp + +/-- `star (heckeQ i)`, i.e. `q_i` conjugated by the involution `v_i ↦ v_i⁻¹`: the parameter that +`bar` (via its semilinearity) sends `heckeQ i` to. Since `heckeQ i = heckeV i * heckeV i` is a +product of units, so is it, with this inverse. -/ +noncomputable def heckeQinv {W : Type*} [CoxeterGroup W] (i : B W) : HeckeRing W := + star (heckeQ i) + +theorem heckeQ_mul_heckeQinv {W : Type*} [CoxeterGroup W] (i : B W) : + heckeQ i * heckeQinv i = 1 := by + simp only [heckeQ, heckeQinv] + rw [star_mul'] + calc heckeV i * heckeV i * (star (heckeV i) * star (heckeV i)) + = (heckeV i * star (heckeV i)) * (heckeV i * star (heckeV i)) := by ring + _ = 1 := by rw [heckeV_mul_star]; ring + +theorem heckeQinv_mul_heckeQ {W : Type*} [CoxeterGroup W] (i : B W) : + heckeQinv i * heckeQ i = 1 := by + rw [mul_comm]; exact heckeQ_mul_heckeQinv i + /-- The defining compatibility condition: `v_i` and `v_{i'}` coincide whenever `M i i'` is odd (in particular, whenever `s_i` and `s_{i'}` are conjugate @@ -237,6 +374,106 @@ theorem T_simple_braid (i i' : B W) : have h := RingQuot.mkAlgHom_rel (HeckeRing W) (HeckeRel.braid (W := W) i i') simpa [T_simple, map_list_prod] using h +omit mat in +/-- The formula for the (two-sided) inverse of `T_simple i`, obtained by solving the quadratic +relation `T_simple_sq` for `T_i⁻¹`: since `T_i² = (q_i - 1) T_i + q_i`, we get +`T_i⁻¹ = q_i⁻¹ T_i + (q_i⁻¹ - 1)` (`T_simple_mul_inv`, `T_simple_inv_mul`). This is exactly the +value `bar` assigns to `T_simple i`, since `s_i⁻¹ = s_i` forces `bar (T_i) = T_i⁻¹`. -/ +noncomputable def T_simple_inv (i : B W) : HeckeAlgebra W := + heckeQinv i • T_simple i + (heckeQinv i - 1) • 1 + +omit mat in +theorem T_simple_mul_inv (i : B W) : T_simple i * T_simple_inv i = 1 := by + have hq : heckeQinv i * heckeQ i = 1 := heckeQinv_mul_heckeQ i + unfold T_simple_inv + rw [mul_add, mul_smul_comm, mul_smul_comm, mul_one, T_simple_sq] + match_scalars + · linear_combination hq + · linear_combination hq + +omit mat in +theorem T_simple_inv_mul (i : B W) : T_simple_inv i * T_simple i = 1 := by + have hq : heckeQinv i * heckeQ i = 1 := heckeQinv_mul_heckeQ i + unfold T_simple_inv + rw [add_mul, smul_mul_assoc, smul_mul_assoc, one_mul, T_simple_sq] + match_scalars + · linear_combination hq + · linear_combination hq + +omit mat in +/-- `T_simple_inv i` satisfies the "co-quadratic" relation for the conjugate parameter +`heckeQinv i = star (heckeQ i)`: the same shape as `T_simple_sq`, but for the inverse generator +and the inverse parameter. This is what lets `bar`, sending `T_i ↦ T_simple_inv i` and semilinear +over `star`, respect the defining quadratic relation `HeckeRel.quad`. -/ +theorem T_simple_inv_sq (i : B W) : + T_simple_inv i * T_simple_inv i + = (heckeQinv i - 1) • T_simple_inv i + heckeQinv i • (1 : HeckeAlgebra W) := by + have hq : heckeQinv i * heckeQ i = 1 := heckeQinv_mul_heckeQ i + simp only [T_simple_inv, add_mul, mul_add, smul_mul_assoc, mul_smul_comm, mul_one, one_mul] + rw [T_simple_sq] + match_scalars + · linear_combination heckeQinv i * hq + · linear_combination heckeQinv i * hq + +omit mat in +theorem T_prod_mul_reverse_inv_prod (l : List (B W)) : + (l.map T_simple).prod * (l.reverse.map T_simple_inv).prod = 1 := by + induction l with + | nil => simp + | cons i l ih => + simp only [List.map_cons, List.prod_cons, List.reverse_cons, List.map_append, + List.prod_append, List.map_cons, List.map_nil, List.prod_cons, List.prod_nil, mul_one] + rw [mul_assoc, ← mul_assoc (l.map T_simple).prod, ih, one_mul, T_simple_mul_inv] + +omit mat in +theorem T_reverse_inv_prod_mul_prod (l : List (B W)) : + (l.reverse.map T_simple_inv).prod * (l.map T_simple).prod = 1 := by + induction l with + | nil => simp + | cons i l ih => + simp only [List.map_cons, List.prod_cons, List.reverse_cons, List.map_append, + List.prod_append, List.map_cons, List.map_nil, List.prod_cons, List.prod_nil, mul_one] + rw [mul_assoc, ← mul_assoc (T_simple_inv i), T_simple_inv_mul, one_mul, ih] + +omit mat in +/-- If two words in the simple generators have the same `T_simple`-product, their reversals have +the same `T_simple_inv`-product: the standard "two-sided inverses are unique" argument, using +`T_prod_mul_reverse_inv_prod`/`T_reverse_inv_prod_mul_prod` as the witnessing inverse relations. -/ +theorem T_reverse_inv_prod_eq_of_prod_eq {l l' : List (B W)} + (h : (l.map T_simple).prod = (l'.map T_simple).prod) : + (l.reverse.map T_simple_inv).prod = (l'.reverse.map T_simple_inv).prod := by + calc (l.reverse.map T_simple_inv).prod + = 1 * (l.reverse.map T_simple_inv).prod := (one_mul _).symm + _ = (l'.reverse.map T_simple_inv).prod * (l'.map T_simple).prod + * (l.reverse.map T_simple_inv).prod := by rw [T_reverse_inv_prod_mul_prod] + _ = (l'.reverse.map T_simple_inv).prod + * ((l'.map T_simple).prod * (l.reverse.map T_simple_inv).prod) := by rw [mul_assoc] + _ = (l'.reverse.map T_simple_inv).prod + * ((l.map T_simple).prod * (l.reverse.map T_simple_inv).prod) := by rw [← h] + _ = (l'.reverse.map T_simple_inv).prod * 1 := by rw [T_prod_mul_reverse_inv_prod] + _ = (l'.reverse.map T_simple_inv).prod := mul_one _ + +omit mat in +/-- `T_simple_inv` satisfies the same braid relation as `T_simple`: the generator-wise inverses, +substituted in the *same* (order-preserving) positions, still braid correctly. This is the +combinatorial fact (via `reverse_alternatingWord`/`reverse_alternatingWord_of_odd`, casing on the +parity of `M i i'`) that lets `bar`, sending `T_i ↦ T_simple_inv i`, respect `HeckeRel.braid`. -/ +theorem T_simple_inv_braid (i i' : B W) : + ((braidWord M i i').map T_simple_inv).prod = ((braidWord M i' i).map T_simple_inv).prod := by + have h := T_reverse_inv_prod_eq_of_prod_eq (T_simple_braid i i') + unfold braidWord at h ⊢ + rcases Nat.even_or_odd (M i i') with he | ho + · obtain ⟨k, hk⟩ := he + have hk2 : M i i' = 2 * k := by omega + have hk' : M i' i = 2 * k := by rw [← M.symmetric i i', hk2] + rw [hk2, hk'] at h ⊢ + rw [reverse_alternatingWord i i' k, reverse_alternatingWord i' i k] at h + exact h.symm + · have ho' : Odd (M i' i) := by rwa [← M.symmetric i i'] + rw [reverse_alternatingWord_of_odd i i' (M i i') ho, + reverse_alternatingWord_of_odd i' i (M i' i) ho'] at h + exact h + /-- The standard basis element `T_w` The product of the generators `T_simple` along an (arbitrarily chosen) reduced word for `w`. @@ -438,6 +675,39 @@ theorem heckeLengthFiltration_mul_mem {m n : ℕ} {x y : HeckeAlgebra W} | smul_left r x y hx hy ih => rw [smul_mul_assoc]; exact Submodule.smul_mem _ r ih | smul_right r x y hx hy ih => rw [mul_smul_comm]; exact Submodule.smul_mem _ r ih +omit mat in +/-- The length filtration is *exhaustive*: every element of `HeckeAlgebra W` lies in some finite +level. Unlike `T_span` (spanning by the *canonical* representatives `T_w`, one per group element, +which needs Matsumoto/an actual basis theorem), this is the much cheaper fact that `HeckeAlgebra` +is spanned by *arbitrary* monomials in the generators — immediate from `RingQuot.mkAlgHom`'s +surjectivity together with `FreeAlgebra.induction`, since each of the four generating cases +(scalar, generator, product, sum) already has a witness among +`algebraMap_mem_heckeLengthFiltration_zero`, `T_simple_mem_heckeLengthFiltration_one`, +`heckeLengthFiltration_mul_mem`, `heckeLengthFiltration_mono`. -/ +theorem exists_mem_heckeLengthFiltration (x : HeckeAlgebra W) : + ∃ n, x ∈ heckeLengthFiltration (W := W) n := by + obtain ⟨y, rfl⟩ := RingQuot.mkAlgHom_surjective (HeckeRing W) (HeckeRel W) x + induction y using FreeAlgebra.induction with + | grade0 r => + refine ⟨0, ?_⟩ + have : RingQuot.mkAlgHom (HeckeRing W) (HeckeRel W) + (algebraMap (HeckeRing W) (FreeAlgebra (HeckeRing W) (B W)) r) + = algebraMap (HeckeRing W) (HeckeAlgebra W) r := AlgHom.commutes _ r + rw [this] + exact algebraMap_mem_heckeLengthFiltration_zero r + | grade1 i => exact ⟨1, T_simple_mem_heckeLengthFiltration_one i⟩ + | mul a b ha hb => + obtain ⟨na, hna⟩ := ha + obtain ⟨nb, hnb⟩ := hb + exact ⟨na + nb, by rw [map_mul]; exact heckeLengthFiltration_mul_mem hna hnb⟩ + | add a b ha hb => + obtain ⟨na, hna⟩ := ha + obtain ⟨nb, hnb⟩ := hb + refine ⟨max na nb, ?_⟩ + rw [map_add] + exact Submodule.add_mem _ (heckeLengthFiltration_mono (le_max_left na nb) hna) + (heckeLengthFiltration_mono (le_max_right na nb) hnb) + /-- The length filtration on `HeckeAlgebra W`, bundled as a `Coxeter.Filtration`: this unlocks the general associated graded machinery @@ -661,58 +931,6 @@ end QOneSpecialization end OneParameterSpecialization -section Dihedral - -variable {W : Type*} [CoxeterGroup W] - -/-- The rank-2 parabolic subgroup generated by two simple reflections. -/ -def rankTwoSubgroup (i i' : B W) : Subgroup W := Subgroup.closure {cs.simple i, cs.simple i'} - -/-- Every element of `rankTwoSubgroup i i'` -can be written as `cs.wordProd μ` for some -(not necessarily reduced) word `μ` -using only the letters `i`, `i'`. -/ -private theorem exists_confined_word - {i i' : B W} {v : W} - (hv : v ∈ rankTwoSubgroup i i') : - ∃ μ : List (B W), - v = cs.wordProd μ ∧ ∀ k ∈ μ, k = i ∨ k = i' := by - induction hv using Subgroup.closure_induction with - | mem x hx => - rcases hx with h | h - · exact ⟨[i], by rw [wordProd_singleton, h], by simp⟩ - · exact ⟨[i'], by rw [wordProd_singleton, h], by simp⟩ - | one => exact ⟨[], by rw [wordProd_nil], by simp⟩ - | mul x y _ _ ihx ihy => - obtain ⟨μx, hμx1, hμx2⟩ := ihx - obtain ⟨μy, hμy1, hμy2⟩ := ihy - refine ⟨μx ++ μy, ?_, ?_⟩ - · rw [wordProd_append, ← hμx1, ← hμy1] - · intro k hk - rcases List.mem_append.mp hk with hk | hk - · exact hμx2 k hk - · exact hμy2 k hk - | inv x _ ihx => - obtain ⟨μ, hμ1, hμ2⟩ := ihx - refine ⟨μ.reverse, ?_, ?_⟩ - · rw [hμ1, wordProd_reverse] - · intro k hk - exact hμ2 k (List.mem_reverse.mp hk) - -/-- Every element of `rankTwoSubgroup i i'` -has a **reduced** word using only the letters -`i`, `i'`. -/ -theorem exists_confined_reduced_word - {i i' : B W} {v : W} - (hv : v ∈ rankTwoSubgroup i i') : - ∃ μ : List (B W), - cs.IsReduced μ ∧ v = cs.wordProd μ ∧ ∀ k ∈ μ, k = i ∨ k = i' := by - obtain ⟨μ₀, hμ₀1, hμ₀2⟩ := exists_confined_word hv - obtain ⟨μ, hsub, hred, heq⟩ := exists_reduced_subword μ₀ - exact ⟨μ, hred, hμ₀1.trans heq, fun k hk => hμ₀2 k (hsub.subset hk)⟩ - -end Dihedral - section ActOnGroupAlgebra variable {W : Type*} [CoxeterGroup W] @@ -720,10 +938,23 @@ variable {W : Type*} [CoxeterGroup W] abbrev module_actedOn (W : Type*) [CoxeterGroup W] : Type _ := MonoidAlgebra (HeckeRing W) W open Classical in -/-- The action of `T_i` on `module_actedOn W`, specified on the standard basis `single w 1` by -the same case-split formula as `T_mul_T_simple_of_rightDescent`/ -`T_mul_T_simple_of_not_rightDescent` (right multiplication by `T_simple i` on the `HeckeAlgebra` -basis `T_w`), then extended `HeckeRing W`-linearly. -/ +/-- The action of `T_i` on `module_actedOn W`: a `Module.End`, specified directly on the standard +basis `single w 1` by the case-split formula below, then extended `HeckeRing W`-linearly. (Aside on +where the formula comes from: it's the same case-split as `T_mul_T_simple_of_rightDescent`/ +`T_mul_T_simple_of_not_rightDescent`, matching right multiplication by `T_simple i` on the +`HeckeAlgebra` basis `T_w` — `{T_w}` isn't known to be a basis yet at this point; this action is +in fact one of the tools later used to establish that, via `T_linearIndependent`.) + +(Aside on *right* vs. *left*: composing several `T_simple_action`s via `Module.End` multiplication, +as `heckeActionFreeAlgHom` does order-preservingly via `FreeAlgebra.lift`, would naively need +`T_simple_action` to be an *anti*-representation, since it's built from right multiplication. This +isn't a problem, because of an ambidexterity in `HeckeAlgebra`'s presentation: its defining +relations (`HeckeRel`) are invariant under reversing multiplication order — the quadratic relation +involves only one generator, and the braid relation's two alternating words are exchanged (`M i i'` +even) or each individually a palindrome (`M i i'` odd) under `List.reverse` +(`reverse_alternatingWord`/`reverse_alternatingWord_of_odd`). So `HeckeAlgebra ≅ HeckeAlgebraᵐᵒᵖ` +via the identity on generators, and an anti-representation of it is automatically a genuine +representation too.) -/ noncomputable def T_simple_action (i : B W) : Module.End (HeckeRing W) (module_actedOn W) := Finsupp.lift (module_actedOn W) (HeckeRing W) W (fun w => if cs.IsRightDescent w i then @@ -732,6 +963,43 @@ noncomputable def T_simple_action (i : B W) : Module.End (HeckeRing W) (module_a else MonoidAlgebra.single (w * cs.simple i) (1 : HeckeRing W)) +/-- Two deferred facts about rank-two (dihedral) parabolic subgroups, needed to finish +`T_simple_action_braid` (the `M i i' = 2` case is proved outright, needing neither): + +* **The gate property** (`isRightDescent_mul_iff_of_not_rightDescent`): if `w₀` has no right + descent among `i`, `i'`, then right-multiplying it by any `v` in the rank-two parabolic subgroup + `rankTwoSubgroup i i'` they generate does not disturb the descent set among `i`, `i'` — the right + descent of `w₀ * v` at `i` or `i'` matches that of `v` itself. Equivalently, `w₀` is the + minimal-length representative of its coset `w₀ * rankTwoSubgroup i i'` in the strong sense used + to show length is additive along it (see e.g. Björner–Brenti, *Combinatorics of Coxeter Groups*, + the "Gate Property", Prop 2.4.4). Proving this needs the deletion/exchange property + (`StrongExchange.lean`) to rule out cancellation reaching back into `w₀`'s own reduced word. +* **The `M i i' ≥ 3` braid fact** (`T_simple_action_braid_apply_of_ge_three`): for `v` in the + rank-two subgroup, applying `T_simple_action` along either alternating word builds up, step by + step, a `HeckeRing`-linear combination of *several* basis vectors (as soon as a right descent is + hit, `T_simple_action_apply` splits into a two-term sum, not a single tracked element — the same + phenomenon checked explicitly, term by term, in the `M i i' = 2` case). The claim is that the two + resulting linear combinations, one per alternating word, agree — matching `heckeQ`-coefficients + on each shared basis vector, both ultimately supported on the elements of `v`'s orbit under `i`, + `i'`, with the extremes tied together via the common longest element + `v * cs.wordProd (braidWord M i i') = v * cs.wordProd (braidWord M i' i)` + (`wordProd_braidWord_eq`); a concrete finite computation, but not yet formalized. + +This class defers both, exactly as `Matsumoto` defers Tits' solution to the word problem. -/ +class DihedralSubProperties (W1 : Type*) [CoxeterGroup W1] : Prop where + /-- The right descents of `w₀ * v` among `i`, `i'` are exactly those of `v`, provided `w₀` has + no right descent among `i`, `i'` and `v` lies in the rank-two subgroup they generate. -/ + isRightDescent_mul_iff_of_not_rightDescent : ∀ {i i' : B W1} {w₀ v : W1}, + ¬ cs.IsRightDescent w₀ i → ¬ cs.IsRightDescent w₀ i' → v ∈ rankTwoSubgroup i i' → + ∀ j, j = i ∨ j = i' → (cs.IsRightDescent (w₀ * v) j ↔ cs.IsRightDescent v j) + /-- The `M i i' ≥ 3` case of the Hecke braid relation, restricted to basis vectors indexed by + the rank-two subgroup `rankTwoSubgroup i i'` (see `T_simple_action_braid_apply_of_ge_three` for + the standalone wrapper and its documentation). -/ + T_simple_action_braid_apply_of_ge_three {i i' : B W1} (hM : 3 ≤ M i i') {v : W1} + (hv : v ∈ rankTwoSubgroup i i') : + ((braidWord M i i').map T_simple_action).prod (MonoidAlgebra.single v (1 : HeckeRing W1)) = + ((braidWord M i' i).map T_simple_action).prod (MonoidAlgebra.single v (1 : HeckeRing W1)) + open Classical in theorem T_simple_action_apply (i : B W) (w : W) : T_simple_action i (MonoidAlgebra.single w (1 : HeckeRing W)) = @@ -769,12 +1037,232 @@ theorem T_simple_action_sq (i : B W) : rw [T_simple_action_apply] simp only [hw, if_true, cs.simple_mul_simple_cancel_right] -/-- The action `T_simple_action` satisfies the Hecke braid relation: -deferred, comparable in difficulty to Matsumoto's theorem (see the module `TODO`). -/ -theorem T_simple_action_braid (i i' : B W) : +/-- The one-step "gate" fact for the Hecke action: acting by `T_simple_action j` (`j ∈ {i, i'}`) +on `single (w₀ * v) 1`, for `w₀` with no right descent among `i`, `i'` and `v` in the rank-2 +subgroup they generate, is the same as acting on `single v 1` and then translating the whole +result by `w₀` on the left (via the ring multiplication on `module_actedOn W`). -/ +theorem T_simple_action_apply_rightCosetRep + [DihedralSubProperties W] {i i' : B W} {w₀ v : W} (h0i : ¬ cs.IsRightDescent w₀ i) + (h0i' : ¬ cs.IsRightDescent w₀ i') (hv : v ∈ rankTwoSubgroup i i') {j : B W} + (hj : j = i ∨ j = i') : + T_simple_action j (MonoidAlgebra.single (w₀ * v) (1 : HeckeRing W)) = + MonoidAlgebra.single w₀ (1 : HeckeRing W) * + T_simple_action j (MonoidAlgebra.single v (1 : HeckeRing W)) := by + rw [T_simple_action_apply, T_simple_action_apply, + DihedralSubProperties.isRightDescent_mul_iff_of_not_rightDescent h0i h0i' hv j hj] + by_cases hd : cs.IsRightDescent v j + · simp only [if_pos hd, mul_add, mul_smul_comm, MonoidAlgebra.single_mul_single, mul_one, + mul_assoc] + · simp only [if_neg hd, MonoidAlgebra.single_mul_single, mul_one, mul_assoc] + +/-- The "gate" fact for the Hecke action along a whole word: acting by any list `l` of +`T_simple_action`s using only the letters `i`, `i'` on `single (w₀ * v) 1`, for `w₀` with no right +descent among `i`, `i'` and `v` in the rank-2 subgroup they generate, is the same as acting on +`single v 1` and translating the result by `w₀` on the left at the end. In particular this applies +to `l = braidWord M i i'` or `l = braidWord M i' i`. -/ +theorem T_simple_action_prod_apply_rightCosetRep + [DihedralSubProperties W] {i i' : B W} {w₀ : W} (h0i : ¬ cs.IsRightDescent w₀ i) + (h0i' : ¬ cs.IsRightDescent w₀ i') {l : List (B W)} (hl : ∀ j ∈ l, j = i ∨ j = i') : + ∀ v ∈ rankTwoSubgroup i i', + (l.map T_simple_action).prod (MonoidAlgebra.single (w₀ * v) (1 : HeckeRing W)) = + MonoidAlgebra.single w₀ (1 : HeckeRing W) * + (l.map T_simple_action).prod (MonoidAlgebra.single v (1 : HeckeRing W)) := by + induction l using List.reverseRecOn with + | nil => intro v _; simp [MonoidAlgebra.single_mul_single] + | append_singleton rest j ih => + intro v hv + have hj : j = i ∨ j = i' := hl j (List.mem_append_right _ (List.mem_singleton_self j)) + have hjrest : ∀ k ∈ rest, k = i ∨ k = i' := fun k hk => hl k (List.mem_append_left _ hk) + have hjmem : cs.simple j ∈ rankTwoSubgroup i i' := by + rcases hj with rfl | rfl + · exact Subgroup.subset_closure (by simp) + · exact Subgroup.subset_closure (by simp) + have hv' : v * cs.simple j ∈ rankTwoSubgroup i i' := Subgroup.mul_mem _ hv hjmem + rw [List.map_append, List.prod_append, List.map_singleton, List.prod_singleton, + Module.End.mul_apply, Module.End.mul_apply, + T_simple_action_apply_rightCosetRep h0i h0i' hv hj] + rw [T_simple_action_apply] + by_cases hd : cs.IsRightDescent v j + · simp only [if_pos hd, mul_add, mul_smul_comm, MonoidAlgebra.single_mul_single, mul_one, + map_add, map_smul, ih hjrest v hv, ih hjrest (v * cs.simple j) hv'] + · simp only [if_neg hd, MonoidAlgebra.single_mul_single, mul_one, + ih hjrest (v * cs.simple j) hv'] + +/-- The `M i i' = 2` case of `T_simple_action_braid_apply`: `cs.simple i` and `cs.simple i'` +commute (from `(s_i s_i')^(M i i') = 1` with exponent `2`), `braidWord M i i' = [i, i']` and +`braidWord M i' i = [i', i]`, and `rankTwoSubgroup i i'` has only the `4` elements `1`, `s_i`, +`s_i'`, `s_i * s_i'`, on each of which the two length-`2` actions can be checked directly. -/ +theorem T_simple_action_braid_apply_of_eq_two {i i' : B W} (hM : M i i' = 2) {v : W} + (hv : v ∈ rankTwoSubgroup i i') : + ((braidWord M i i').map T_simple_action).prod (MonoidAlgebra.single v (1 : HeckeRing W)) = + ((braidWord M i' i).map T_simple_action).prod (MonoidAlgebra.single v (1 : HeckeRing W)) := by + have hii' : i ≠ i' := by + rintro rfl + have := M.diagonal i + omega + have hne : cs.simple i ≠ cs.simple i' := fun h => hii' (simple_inj h) + have haa : cs.simple i * cs.simple i = 1 := by + nth_rewrite 2 [← cs.inv_simple i]; exact mul_inv_cancel (cs.simple i) + have hbb : cs.simple i' * cs.simple i' = 1 := by + nth_rewrite 2 [← cs.inv_simple i']; exact mul_inv_cancel (cs.simple i') + have habab : cs.simple i * cs.simple i' * (cs.simple i * cs.simple i') = 1 := by + rw [← sq, ← hM]; exact cs.simple_mul_simple_pow i i' + have hcomm : cs.simple i * cs.simple i' = cs.simple i' * cs.simple i := by + have hinv : (cs.simple i * cs.simple i')⁻¹ = cs.simple i * cs.simple i' := + inv_eq_of_mul_eq_one_right habab + rw [← hinv, mul_inv_rev, cs.inv_simple, cs.inv_simple] + have hlen_ab : cs.length (cs.simple i * cs.simple i') = 2 := by + rcases cs.length_mul_simple (cs.simple i) i' with h | h + · rw [cs.length_simple] at h; omega + · exfalso + rw [cs.length_simple] at h + have hz : cs.length (cs.simple i * cs.simple i') = 0 := by omega + rw [cs.length_eq_zero_iff, mul_eq_one_iff_eq_inv, cs.inv_simple] at hz + exact hne hz + have hab_a : cs.simple i * cs.simple i' * cs.simple i = cs.simple i' := by + rw [mul_assoc, ← hcomm, ← mul_assoc, haa, one_mul] + have hab_b : cs.simple i * cs.simple i' * cs.simple i' = cs.simple i := by + rw [mul_assoc, hbb, mul_one] + have hmem : v = 1 ∨ v = cs.simple i ∨ v = cs.simple i' ∨ v = cs.simple i * cs.simple i' := by + induction hv using Subgroup.closure_induction with + | mem x hx => + rcases hx with rfl | rfl + · exact Or.inr (Or.inl rfl) + · exact Or.inr (Or.inr (Or.inl rfl)) + | one => exact Or.inl rfl + | mul x y _ _ ihx ihy => + rcases ihx with rfl | rfl | rfl | rfl <;> rcases ihy with rfl | rfl | rfl | rfl <;> + ( + try simp only [one_mul, mul_one, ← mul_assoc, + haa, hbb, habab, hab_a, hab_b, hcomm.symm] ; + try simp only [or_true, true_or] + ) + | inv x _ ihx => + rcases ihx with rfl | rfl | rfl | rfl + · exact Or.inl (by simp) + · exact Or.inr (Or.inl (by rw [cs.inv_simple])) + · exact Or.inr (Or.inr (Or.inl (by rw [cs.inv_simple]))) + · exact Or.inr (Or.inr (Or.inr (by + rw [mul_inv_rev, cs.inv_simple, cs.inv_simple, ← hcomm]))) + have hnd1 := cs.not_isRightDescent_one (W := W) + have hda_i : cs.IsRightDescent (cs.simple i) i := by + unfold CoxeterSystem.IsRightDescent; rw [haa, cs.length_simple, cs.length_one]; omega + have hda_i' : ¬ cs.IsRightDescent (cs.simple i) i' := by + unfold CoxeterSystem.IsRightDescent; rw [cs.length_simple, hlen_ab]; omega + have hdb_i : ¬ cs.IsRightDescent (cs.simple i') i := by + unfold CoxeterSystem.IsRightDescent + rw [cs.length_simple, ← hcomm, hlen_ab]; omega + have hdb_i' : cs.IsRightDescent (cs.simple i') i' := by + unfold CoxeterSystem.IsRightDescent; rw [hbb, cs.length_simple, cs.length_one]; omega + have hdab_i : cs.IsRightDescent (cs.simple i * cs.simple i') i := by + unfold CoxeterSystem.IsRightDescent; rw [hab_a, cs.length_simple, hlen_ab]; omega + have hdab_i' : cs.IsRightDescent (cs.simple i * cs.simple i') i' := by + unfold CoxeterSystem.IsRightDescent; rw [hab_b, cs.length_simple, hlen_ab]; omega + have hbraid1 : braidWord M i i' = [i, i'] := by + rw [show (braidWord M i i' : List (B W)) = alternatingWord i i' (M i i') from rfl, hM] + rfl + have hbraid2 : braidWord M i' i = [i', i] := by + rw [show (braidWord M i' i : List (B W)) = alternatingWord i' i (M i' i) from rfl, + ← M.symmetric i i', hM] + rfl + rw [hbraid1, hbraid2] + simp only [List.map_cons, List.map_nil, List.prod_cons, List.prod_nil, mul_one, + Module.End.mul_apply] + rcases hmem with rfl | rfl | rfl | rfl + · rw [T_simple_action_apply (i := i'), if_neg (hnd1 i'), one_mul, + T_simple_action_apply (i := i), if_neg hdb_i, + T_simple_action_apply (i := i), if_neg (hnd1 i), one_mul, + T_simple_action_apply (i := i'), if_neg hda_i', hcomm] + · rw [T_simple_action_apply (i := i'), if_neg hda_i', + T_simple_action_apply (i := i), if_pos hdab_i, hab_a, + T_simple_action_apply (i := i), if_pos hda_i, haa, + map_add, map_smul, map_smul, + T_simple_action_apply (i := i'), if_neg hda_i', + T_simple_action_apply (i := i'), if_neg (hnd1 i'), one_mul] + · rw [T_simple_action_apply (i := i'), if_pos hdb_i', hbb, + map_add, map_smul, map_smul, + T_simple_action_apply (i := i), if_neg hdb_i, ← hcomm, + T_simple_action_apply (i := i), if_neg (hnd1 i), one_mul, + T_simple_action_apply (i := i'), if_pos hdab_i', hab_b] + · rw [T_simple_action_apply (i := i'), if_pos hdab_i', hab_b, map_add, map_smul, map_smul, + T_simple_action_apply (i := i), if_pos hdab_i, hab_a, + T_simple_action_apply (i := i), if_pos hda_i, haa, + map_add, map_smul, map_smul, + T_simple_action_apply (i := i'), if_pos hdab_i', hab_b, + T_simple_action_apply (i := i'), if_pos hdb_i', hbb] + module + +/-- The `M i i' ≥ 3` case of `T_simple_action_braid_apply`: for `v` in the rank-two subgroup, +applying `T_simple_action` along either alternating word builds up, step by step, a +`HeckeRing`-linear combination of *several* basis vectors (as soon as a right descent is hit, +`T_simple_action_apply` splits into a two-term sum, not a single tracked element — the same +phenomenon checked explicitly, term by term, in the `M i i' = 2` case). The claim is that the two +resulting linear combinations, one per alternating word, agree — matching `heckeQ`-coefficients on +each shared basis vector, both ultimately supported on the elements of `v`'s orbit under `i`, `i'`, +with the extremes tied together via the common longest element +`v * cs.wordProd (braidWord M i i') = v * cs.wordProd (braidWord M i' i)` +(`wordProd_braidWord_eq`). See `DihedralSubProperties` for why this is deferred as a class field. -/ +theorem T_simple_action_braid_apply_of_ge_three + [dsp : DihedralSubProperties W] + {i i' : B W} (hM : 3 ≤ M i i') {v : W} + (hv : v ∈ rankTwoSubgroup i i') : + ((braidWord M i i').map T_simple_action).prod (MonoidAlgebra.single v (1 : HeckeRing W)) = + ((braidWord M i' i).map T_simple_action).prod (MonoidAlgebra.single v (1 : HeckeRing W)) := by + exact dsp.T_simple_action_braid_apply_of_ge_three hM hv + +/-- The core dihedral-group content of the Hecke braid relation: for `v` in the rank-two subgroup +generated by `i`, `i'`, walking the two alternating words `braidWord M i i'`/`braidWord M i' i` +from `v` gives the same result. Trivial when `i = i'` (the two words coincide) or `M i i' = 0` (the +infinite dihedral case: both words are empty), and otherwise dispatches to +`T_simple_action_braid_apply_of_eq_two`/`_of_ge_three` according to `M i i'`. -/ +theorem T_simple_action_braid_apply [DihedralSubProperties W] + {i i' : B W} {v : W} (hv : v ∈ rankTwoSubgroup i i') : + ((braidWord M i i').map T_simple_action).prod (MonoidAlgebra.single v (1 : HeckeRing W)) = + ((braidWord M i' i).map T_simple_action).prod (MonoidAlgebra.single v (1 : HeckeRing W)) := by + by_cases hii' : i = i' + · rw [hii'] + · rcases Nat.lt_or_ge (M i i') 2 with hlt | hge + · have h01 : M i i' = 0 ∨ M i i' = 1 := by omega + rcases h01 with h0 | h1 + · have h0' : M i' i = 0 := by rw [← M.symmetric i i']; exact h0 + simp [braidWord, h0, h0', alternatingWord] + · exact absurd h1 (M.off_diagonal i i' hii') + · rcases eq_or_lt_of_le hge with hM2 | hM2 + · exact T_simple_action_braid_apply_of_eq_two hM2.symm hv + · exact T_simple_action_braid_apply_of_ge_three hM2 hv + +/-- The action `T_simple_action` satisfies the Hecke braid relation. + +By `MonoidAlgebra.lhom_ext'` it suffices to check both sides agree on every basis vector +`single w 1`. Writing `w = w₀ * v` via `exists_minimal_rightCosetRep` (`w₀` has no right descent +among `i`, `i'`, and `v ∈ rankTwoSubgroup i i'`), `T_simple_action_prod_apply_rightCosetRep` peels +off a common `single w₀ 1 *` factor from both sides, reducing the goal to +`((braidWord M i i').map T_simple_action).prod (single v 1) + = ((braidWord M i' i).map T_simple_action).prod (single v 1)`. +Since `v` ranges over the whole rank-two subgroup `rankTwoSubgroup i i'` (dihedral of order +`2 * M i i'`) and every letter of both alternating words lies in `{i, i'}`, this remaining goal no +longer refers to `w₀` or the ambient group `W` at all: it is exactly the same braid identity, but +for the Hecke action of the *dihedral* Coxeter system on `rankTwoSubgroup i i'` itself (with `v` as +the "identity-relative" basis point). `T_simple_action_braid_apply` supplies this dihedral-group +fact, a substantially *smaller* task than Matsumoto's theorem: `rankTwoSubgroup i i'`'s elements, +lengths and reduced words are completely explicit (`alternatingWord`), so it is a concrete finite +computation along the alternating words rather than an instance of the general word problem. -/ +theorem T_simple_action_braid [DihedralSubProperties W] (i i' : B W) : ((braidWord M i i').map T_simple_action).prod - = ((braidWord M i' i).map T_simple_action).prod := - sorry + = ((braidWord M i' i).map T_simple_action).prod := by + apply MonoidAlgebra.lhom_ext' + intro w + apply LinearMap.ext_ring + simp only [LinearMap.comp_apply, MonoidAlgebra.lsingle_apply] + obtain ⟨w₀, v, hv, hw, h0i, h0i'⟩ := exists_minimal_rightCosetRep i i' w + subst hw + have hl : ∀ j ∈ braidWord M i i', j = i ∨ j = i' := fun j hj => mem_alternatingWord hj + have hl' : ∀ j ∈ braidWord M i' i, j = i ∨ j = i' := + fun j hj => (mem_alternatingWord hj).symm + rw [T_simple_action_prod_apply_rightCosetRep h0i h0i' hl v hv, + T_simple_action_prod_apply_rightCosetRep h0i h0i' hl' v hv] + congr 1 + exact T_simple_action_braid_apply hv /-- The `HeckeRing W`-algebra homomorphism from the free algebra on the simple reflections @@ -794,7 +1282,7 @@ theorem heckeActionFreeAlgHom_wordProd (l : List (B W)) : congr 1 simp [heckeActionFreeAlgHom] -theorem heckeActionFreeAlgHom_respects_rel : ∀ ⦃x y⦄, HeckeRel W x y → +theorem heckeActionFreeAlgHom_respects_rel [DihedralSubProperties W] : ∀ ⦃x y⦄, HeckeRel W x y → heckeActionFreeAlgHom x = heckeActionFreeAlgHom y := by intro x y h cases h with @@ -806,19 +1294,56 @@ theorem heckeActionFreeAlgHom_respects_rel : ∀ ⦃x y⦄, HeckeRel W x y → rw [heckeActionFreeAlgHom_wordProd, heckeActionFreeAlgHom_wordProd] exact T_simple_action_braid i i' -/-- The algebra map from `HeckeAlgebra`, presented by generators and relations, to `Module.End (HeckeRing W) (module_actedOn W)` +/-- The algebra map from `HeckeAlgebra`, presented by generators and relations, to +`Module.End (HeckeRing W) (module_actedOn W)` the action of the Hecke algebra on the free `HeckeRing W`-module on `W`, specified purely by declaring the action of each generator `T_i` (`T_simple_action`) and checking it respects the defining relations (`heckeActionFreeAlgHom_respects_rel`). -/ -noncomputable def heckeActionAlgHom : +noncomputable def heckeActionAlgHom [DihedralSubProperties W] : HeckeAlgebra W →ₐ[HeckeRing W] Module.End (HeckeRing W) (module_actedOn W) := RingQuot.liftAlgHom (HeckeRing W) ⟨heckeActionFreeAlgHom, heckeActionFreeAlgHom_respects_rel⟩ -theorem heckeActionAlgHom_T_simple (i : B W) : +theorem heckeActionAlgHom_T_simple [DihedralSubProperties W] (i : B W) : heckeActionAlgHom (T_simple i) = T_simple_action i := by simp [heckeActionAlgHom, T_simple, heckeActionFreeAlgHom, FreeAlgebra.lift_ι_apply] +/-- Evaluating the (reversed) list of simple actions for `l` at the basis vector `single u 1` +builds up `single (u * wordProd l) 1`, *provided* right-multiplying `u` by `wordProd l` doesn't +cancel any length along the way (`hlen`). Since `Module.End` multiplication is composition with +the *second* factor applied first, `(l.map T_simple_action).prod` processes `l`'s letters in +reverse order as functions — hence the `l.reverse` on the left: it undoes that reversal, so the +letters of `l` end up applied in their original left-to-right order. -/ +theorem T_simple_action_prod_apply_single (l : List (B W)) (u : W) + (hlen : cs.length (u * cs.wordProd l) = cs.length u + l.length) : + (l.reverse.map T_simple_action).prod (MonoidAlgebra.single u (1 : HeckeRing W)) + = MonoidAlgebra.single (u * cs.wordProd l) (1 : HeckeRing W) := by + induction l generalizing u with + | nil => simp + | cons i rest ih => + rw [wordProd_cons, ← mul_assoc] at hlen + have hb1 : cs.length (u * cs.simple i) ≤ cs.length u + 1 := by + have := cs.length_mul_le u (cs.simple i) + rwa [cs.length_simple] at this + have hb2 : cs.length (u * cs.simple i * cs.wordProd rest) + ≤ cs.length (u * cs.simple i) + rest.length := by + have h1 := cs.length_mul_le (u * cs.simple i) (cs.wordProd rest) + have h2 := cs.length_wordProd_le rest + omega + have heq1 : cs.length (u * cs.simple i) = cs.length u + 1 := by + simp only [List.length_cons] at hlen + omega + have heq2 : cs.length (u * cs.simple i * cs.wordProd rest) + = cs.length (u * cs.simple i) + rest.length := by + simp only [List.length_cons] at hlen + omega + have hnd : ¬ cs.IsRightDescent u i := by + rw [not_isRightDescent_iff] + omega + rw [List.reverse_cons, List.map_append, List.prod_append, List.map_singleton, + List.prod_singleton, Module.End.mul_apply, T_simple_action_apply, if_neg hnd, + ih (u * cs.simple i) heq2, wordProd_cons, mul_assoc] + end ActOnGroupAlgebra section FreeBasis @@ -841,23 +1366,81 @@ theorem T_intLinearIndependent [Matsumoto (W1 := W)] : /-- The obligation that `{T_w : w ∈ W}` is linearly independent over `HeckeRing W` -one of the two facts needed to build `basis` via `Module.Basis.mk`. -/ -theorem T_linearIndependent [Matsumoto (W1 := W)] : - LinearIndependent (HeckeRing W) (T (W := W)) := - sorry +one of the two facts needed to build `basis` via `Module.Basis.mk`. +Proved via the action `heckeActionAlgHom` of `HeckeAlgebra` on the free module `module_actedOn W`: +evaluating at the basis vector `single 1 1` sends `T w⁻¹` to `single w 1` +(`T_simple_action_prod_apply_single`, applied to a reduced word for `w` and its reverse), and +`{single w 1}` is linearly independent, so `LinearIndependent.of_comp` pulls independence back to +`{T w⁻¹}`, hence (reindexing by the bijection `w ↦ w⁻¹`) to `{T w}` itself. -/ +theorem T_linearIndependent [Matsumoto (W1 := W)] [DihedralSubProperties W] : + LinearIndependent (HeckeRing W) (T (W := W)) := by + let L : HeckeAlgebra W →ₗ[HeckeRing W] module_actedOn W := + (LinearMap.applyₗ (MonoidAlgebra.single (1 : W) (1 : HeckeRing W))).comp + heckeActionAlgHom.toLinearMap + have hLT : ∀ w : W, L (T w⁻¹) = MonoidAlgebra.single w (1 : HeckeRing W) := by + intro w + set ω := Classical.arbitrary (ReducedWord w) + have hlen : cs.length ((1 : W) * cs.wordProd ω.val) = cs.length (1 : W) + ω.val.length := by + rw [ω.wordProd_eq, one_mul, ω.length_eq, cs.length_one, zero_add] + have key := T_simple_action_prod_apply_single ω.val 1 hlen + rw [one_mul, ω.wordProd_eq] at key + change heckeActionAlgHom (T w⁻¹) (MonoidAlgebra.single 1 1) = MonoidAlgebra.single w 1 + rw [T_eq_of_reducedWord ω.reverse] + change heckeActionAlgHom ((ω.val.reverse.map T_simple).prod) (MonoidAlgebra.single 1 1) + = MonoidAlgebra.single w 1 + rw [map_list_prod, List.map_map] + simp only [Function.comp_def, heckeActionAlgHom_T_simple] + exact key + have hindep : + LinearIndependent (HeckeRing W) (fun w : W => MonoidAlgebra.single w (1 : HeckeRing W)) := + Finsupp.linearIndependent_single_one (HeckeRing W) W + have hcomp : LinearIndependent (HeckeRing W) (fun w : W => T w⁻¹) := + LinearIndependent.of_comp L (by simpa [Function.comp_def, hLT] using hindep) + have hbij : Function.Injective (Inv.inv : W → W) := inv_injective + simpa [Function.comp_def] using hcomp.comp Inv.inv hbij + +/-- Every monomial `T_{i_1} ⋯ T_{i_k}` in the simple generators lies in the `HeckeRing`-span of +`{T_w : w ∈ W}`: induct from the right using `T_mul_T_simple_mem_span`, which absorbs one more +simple generator into the span at each step (via the quadratic relation when it's a right +descent). -/ +theorem monomial_mem_T_span [Matsumoto (W1 := W)] (l : List (B W)) : + (l.map T_simple).prod ∈ Submodule.span (HeckeRing W) (Set.range (T (W := W))) := by + induction l using List.reverseRecOn with + | nil => + rw [List.map_nil, List.prod_nil] + exact Submodule.subset_span ⟨(1 : W), T_one⟩ + | append_singleton l i ih => + rw [List.map_append, List.prod_append, List.map_singleton, List.prod_singleton] + exact T_mul_T_simple_mem_span ih + +/-- Every finite level of the length filtration lies in the `HeckeRing`-span of `{T_w : w ∈ W}`: +its generating monomials do, by `monomial_mem_T_span`. -/ +theorem heckeLengthFiltration_le_T_span [Matsumoto (W1 := W)] (n : ℕ) : + heckeLengthFiltration (W := W) n ≤ Submodule.span (HeckeRing W) (Set.range (T (W := W))) := by + rw [heckeLengthFiltration, Submodule.span_le] + rintro x ⟨l, -, rfl⟩ + exact monomial_mem_T_span l /-- The obligation that `{T_w : w ∈ W}` spans `HeckeAlgebra W` over `HeckeRing W` -the other fact needed to build `basis` via `Module.Basis.mk`. -/ -theorem T_span : ⊤ ≤ Submodule.span (HeckeRing W) (Set.range (T (W := W))) := - sorry +the other fact needed to build `basis` via `Module.Basis.mk`. +Unlike `T_linearIndependent`, this doesn't need a genuine freeness theorem: `HeckeAlgebra` is +built as a *quotient* of the free algebra on the simple generators, so it is automatically +spanned by arbitrary monomials (`exists_mem_heckeLengthFiltration`, no `Matsumoto` needed), and +each monomial reduces to a `HeckeRing`-combination of the canonical `T_w` one simple generator at +a time (`heckeLengthFiltration_le_T_span`). -/ +theorem T_span [Matsumoto (W1 := W)] : + ⊤ ≤ Submodule.span (HeckeRing W) (Set.range (T (W := W))) := by + intro x _ + obtain ⟨n, hn⟩ := exists_mem_heckeLengthFiltration x + exact heckeLengthFiltration_le_T_span n hn /-- `HeckeAlgebra` is free as a `HeckeRing`-module with basis `{T_w : w ∈ W}`. -/ -noncomputable def basis [Matsumoto (W1 := W)] : +noncomputable def basis [Matsumoto (W1 := W)] [DihedralSubProperties (W1 := W)] : Module.Basis W (HeckeRing W) (HeckeAlgebra W) := Module.Basis.mk T_linearIndependent T_span -theorem basis_apply (w : W) [Matsumoto (W1 := W)] : +theorem basis_apply (w : W) [Matsumoto (W1 := W)] [DihedralSubProperties (W1 := W)] : basis w = T w := Module.Basis.mk_apply T_linearIndependent T_span w @@ -867,39 +1450,126 @@ section BarInvolution variable {W : Type*} [CoxeterGroup W] -/-- The **bar involution** on `HeckeAlgebra` -The additive ring automorphism -sending `T_w ↦ (T_{w⁻¹})⁻¹` -semilinear over `barScalar` -/ -noncomputable def bar : - HeckeAlgebra W ≃+* HeckeAlgebra W := sorry - -private theorem bar_smul (c : HeckeRing W) (x : HeckeAlgebra W) : - bar (c • x) = star c • bar x := by - sorry - -private theorem bar_T (w : W) : - bar (T w) * T w⁻¹ = 1 := by - sorry - -private theorem bar_T_involutive (w : W) : bar (bar (T w)) = T w := by +/-- The underlying construction of `bar`, bundled with its two defining properties: it sends +`T_simple i ↦ T_simple_inv i` and is semilinear over `star` on `HeckeRing W`. Built by lifting the +generator assignment `i ↦ T_simple_inv i` through the free-algebra presentation of `HeckeAlgebra` +(`T_simple_inv_sq`/`T_simple_inv_braid` show it respects the defining relations `HeckeRel`), using +a *twisted* `HeckeRing W`-algebra structure on the codomain (scalars acting through `star`) so that +the lift is automatically semilinear rather than linear. Kept as a private bundle (rather than +exposing the twisted instance) so the rest of the file only ever sees the plain `RingHom` and its +two properties, proved once here and restated as `bar_T_simple`/`bar_smul` below. -/ +noncomputable def barCore : {f : HeckeAlgebra W →+* HeckeAlgebra W // + (∀ i, f (T_simple i) = T_simple_inv i) ∧ + ∀ (c : HeckeRing W) (x : HeckeAlgebra W), f (c • x) = star c • f x} := by + -- `φ` and its properties are extracted from a *nested* proof so that the twisted `star_alg` + -- instance used to build it (only needed to make `FreeAlgebra.lift` come out semilinear) does + -- not leak into the rest of this proof, where `RingQuot.mkAlgHom` etc. must keep using the + -- ordinary (untwisted) `Algebra (HeckeRing W) (HeckeAlgebra W)` instance. + have hex : + ∃ φ : FreeAlgebra (HeckeRing W) (B W) →+* HeckeAlgebra W, + (∀ ⦃x y⦄, HeckeRel W x y → φ x = φ y) ∧ + (∀ i, φ (FreeAlgebra.ι (HeckeRing W) i) = T_simple_inv i) ∧ + ∀ (c : HeckeRing W) (x : FreeAlgebra (HeckeRing W) (B W)), φ (c • x) = star c • φ x := by + letI star_alg : Algebra (HeckeRing W) (HeckeAlgebra W) := + Algebra.compHom (HeckeAlgebra W) (starRingEnd (HeckeRing W)) + refine ⟨(FreeAlgebra.lift (HeckeRing W) T_simple_inv).toRingHom, ?_, ?_, ?_⟩ + · intro x y hxy + change (FreeAlgebra.lift (HeckeRing W) T_simple_inv) x + = (FreeAlgebra.lift (HeckeRing W) T_simple_inv) y + cases hxy with + | quad i => + have e1 : (FreeAlgebra.lift (HeckeRing W) T_simple_inv) + (FreeAlgebra.ι (HeckeRing W) i * FreeAlgebra.ι (HeckeRing W) i) + = T_simple_inv i * T_simple_inv i := by + rw [map_mul, FreeAlgebra.lift_ι_apply] + have e2 : (FreeAlgebra.lift (HeckeRing W) T_simple_inv) + ((heckeQ i - 1) • FreeAlgebra.ι (HeckeRing W) i + + heckeQ i • (1 : FreeAlgebra (HeckeRing W) (B W))) + = (heckeQinv i - 1) • T_simple_inv i + heckeQinv i • (1 : HeckeAlgebra W) := by + rw [map_add, + LinearMapClass.map_smul (FreeAlgebra.lift (HeckeRing W) T_simple_inv) (heckeQ i - 1), + LinearMapClass.map_smul (FreeAlgebra.lift (HeckeRing W) T_simple_inv) (heckeQ i), + FreeAlgebra.lift_ι_apply, map_one, Algebra.compHom_smul_def, + Algebra.compHom_smul_def] + congr 2 + show starRingEnd (HeckeRing W) (heckeQ i - 1) = heckeQinv i - 1 + rw [map_sub, map_one] + rfl + rw [e1, e2, T_simple_inv_sq] + | braid i i' => + rw [map_list_prod, map_list_prod, List.map_map, List.map_map] + simp only [Function.comp_def, FreeAlgebra.lift_ι_apply] + exact T_simple_inv_braid i i' + · intro i + change (FreeAlgebra.lift (HeckeRing W) T_simple_inv) (FreeAlgebra.ι (HeckeRing W) i) + = T_simple_inv i + exact FreeAlgebra.lift_ι_apply _ _ + · intro c x + change (FreeAlgebra.lift (HeckeRing W) T_simple_inv) (c • x) + = star c • (FreeAlgebra.lift (HeckeRing W) T_simple_inv) x + rw [LinearMapClass.map_smul (FreeAlgebra.lift (HeckeRing W) T_simple_inv) c, + Algebra.compHom_smul_def] + rfl + set φ := hex.choose with hφdef + obtain ⟨hrel, hφι, hφsmul⟩ := hex.choose_spec + refine ⟨RingQuot.lift ⟨φ, hrel⟩, ?_, ?_⟩ + · intro i + have hmk : T_simple i = RingQuot.mkRingHom (HeckeRel W) (FreeAlgebra.ι (HeckeRing W) i) := + DFunLike.congr_fun (RingQuot.mkAlgHom_coe (HeckeRing W) (HeckeRel W)) + (FreeAlgebra.ι (HeckeRing W) i) + rw [hmk, RingQuot.lift_mkRingHom_apply] + exact hφι i + · intro c x + obtain ⟨y, rfl⟩ := RingQuot.mkAlgHom_surjective (HeckeRing W) (HeckeRel W) x + have hmk : ∀ z : FreeAlgebra (HeckeRing W) (B W), + RingQuot.mkAlgHom (HeckeRing W) (HeckeRel W) z = RingQuot.mkRingHom (HeckeRel W) z := + fun z => DFunLike.congr_fun (RingQuot.mkAlgHom_coe (HeckeRing W) (HeckeRel W)) z + rw [← LinearMapClass.map_smul (RingQuot.mkAlgHom (HeckeRing W) (HeckeRel W)) c, hmk, hmk, + RingQuot.lift_mkRingHom_apply, RingQuot.lift_mkRingHom_apply, hφsmul] + +/-- The additive, `star`-semilinear ring homomorphism underlying the bar involution: sends +`T_simple i ↦ T_simple_inv i` (`bar0_T_simple`) and `bar0 (c • x) = star c • bar0 x` +(`bar0_smul`). -/ +noncomputable def bar0 : HeckeAlgebra W →+* HeckeAlgebra W := barCore.val + +theorem bar0_T_simple (i : B W) : bar0 (T_simple i) = T_simple_inv i := barCore.property.1 i + +theorem bar0_smul (c : HeckeRing W) (x : HeckeAlgebra W) : + bar0 (c • x) = star c • bar0 x := barCore.property.2 c x + +/-- `bar0` sends `T_w ↦ (T_{w⁻¹})⁻¹`: along a reduced word `ω` for `w`, `bar0` (a ring hom) +replaces each `T_simple i` by `T_simple_inv i` (`bar0_T_simple`), giving `bar0 (T w)` as the +`T_simple_inv`-monomial along `ω`; `T w⁻¹` is the `T_simple`-monomial along the *reversed* word +`ω.reverse`. These are mutually inverse by `T_reverse_inv_prod_mul_prod`. -/ +theorem bar_T (w : W) [Matsumoto (W1 := W)] : bar0 (T w) * T w⁻¹ = 1 := by + set ω := Classical.arbitrary (ReducedWord w) + have h1 : bar0 (T w) = (ω.val.map T_simple_inv).prod := by + rw [T_eq_of_reducedWord ω, map_list_prod, List.map_map] + simp only [Function.comp_def, bar0_T_simple] + have h2 : T w⁻¹ = (ω.val.reverse.map T_simple).prod := T_eq_of_reducedWord ω.reverse + rw [h1, h2] + have h3 := T_reverse_inv_prod_mul_prod ω.val.reverse + rwa [List.reverse_reverse] at h3 + +theorem bar_T_involutive (w : W) [Matsumoto (W1 := W)] : bar0 (bar0 (T w)) = T w := by have h1 := bar_T w have h2 := bar_T w⁻¹ rw [inv_inv] at h2 - have h4 : bar (bar (T w)) * bar (T w⁻¹) = 1 := by + have h4 : bar0 (bar0 (T w)) * bar0 (T w⁻¹) = 1 := by rw [← map_mul, h1, map_one] - calc bar (bar (T w)) - = bar (bar (T w)) * 1 := (mul_one _).symm - _ = bar (bar (T w)) * (bar (T w⁻¹) * T w) := by rw [h2] - _ = bar (bar (T w)) * bar (T w⁻¹) * T w := + calc bar0 (bar0 (T w)) + = bar0 (bar0 (T w)) * 1 := (mul_one _).symm + _ = bar0 (bar0 (T w)) * (bar0 (T w⁻¹) * T w) := by rw [h2] + _ = bar0 (bar0 (T w)) * bar0 (T w⁻¹) * T w := (mul_assoc _ _ _).symm _ = 1 * T w := by rw [h4] _ = T w := one_mul _ -/-- Involutivity of `bar` on all of `HeckeAlgebra` -Induct on the standard basis `{T_w}` -/ -theorem bar_involutive [Matsumoto (W1 := W)] : - Function.Involutive (bar (W := W)) := by +/-- Involutivity of `bar0` on all of `HeckeAlgebra`: induct on the (now fully proven) standard +basis `{T_w}`, using semilinearity (`bar0_smul`) and involutivity on basis elements +(`bar_T_involutive`). -/ +theorem bar0_involutive [Matsumoto (W1 := W)] [DihedralSubProperties (W1 := W)] : + Function.Involutive (bar0 (W := W)) := by intro x rw [← basis.linearCombination_repr x] generalize basis.repr x = f @@ -909,8 +1579,409 @@ theorem bar_involutive [Matsumoto (W1 := W)] : have hsingle : Finsupp.linearCombination (HeckeRing W) basis (Finsupp.single w c + f) = c • T w + Finsupp.linearCombination (HeckeRing W) basis f := by rw [map_add, Finsupp.linearCombination_single, basis_apply] - rw [hsingle, map_add, map_add, bar_smul, bar_smul, star_involutive, bar_T_involutive, ih] + rw [hsingle, map_add, map_add, bar0_smul, bar0_smul, star_involutive, bar_T_involutive, ih] + +/-- The **bar involution** on `HeckeAlgebra`: the additive ring automorphism sending +`T_w ↦ (T_{w⁻¹})⁻¹` (`bar0_T_simple`, extended to `T w` by `bar_T`), semilinear over `star` on +`HeckeRing W` (`bar0_smul`), and involutive (`bar0_involutive`). -/ +noncomputable def bar [Matsumoto (W1 := W)] [DihedralSubProperties (W1 := W)] : + HeckeAlgebra W ≃+* HeckeAlgebra W where + toFun := bar0 + invFun := bar0 + left_inv := bar0_involutive + right_inv := bar0_involutive + map_mul' := bar0.map_mul + map_add' := bar0.map_add + +theorem bar_smul [Matsumoto (W1 := W)] [DihedralSubProperties (W1 := W)] + (c : HeckeRing W) (x : HeckeAlgebra W) : + bar (c • x) = star c • bar x := bar0_smul c x + +noncomputable instance {W : Type*} [CoxeterGroup W] + [Matsumoto (W1 := W)] [DihedralSubProperties (W1 := W)] : + Star (HeckeAlgebra W) := ⟨bar⟩ + +noncomputable instance {W : Type*} [CoxeterGroup W] + [Matsumoto (W1 := W)] [DihedralSubProperties (W1 := W)] : + StarAddMonoid (HeckeAlgebra W) where + star_involutive := bar0_involutive + star_add := bar.map_add + +/-- `bar`'s semilinearity (`bar_smul`) is exactly the `StarModule` axiom for the `star`s just +defined on `HeckeAlgebra W` and (already, via `barScalar`) on `HeckeRing W`. -/ +noncomputable instance {W : Type*} [CoxeterGroup W] + [Matsumoto (W1 := W)] [DihedralSubProperties (W1 := W)] : + StarModule (HeckeRing W) (HeckeAlgebra W) where + star_smul := bar_smul + +/-- `bar` is multiplicative — an honest ring automorphism, not just an additive map: +`star (a * b) = star a * star b`. Since `HeckeAlgebra` is generally noncommutative, this is the +*ordinary* multiplicativity law, not the anti-multiplicative `star_mul' : star (a * b) = +star b * star a` that `Mathlib`'s `StarMul`/`StarRing` classes axiomatize (that would describe an +adjoint-like anti-automorphism, which `bar` is not). So this is stated as a plain lemma rather +than a `StarMul`/`StarRing` instance. -/ +theorem star_mul_eq [Matsumoto (W1 := W)] [DihedralSubProperties (W1 := W)] + (a b : HeckeAlgebra W) : + star (a * b) = star a * star b := + bar.map_mul a b end BarInvolution +section BarInvariant + +variable {W : Type*} [CoxeterGroup W] + +/-- `HeckeAlgebra W` as an algebra over the bar-fixed scalars `heckeRingBarFixed W`, restricting +the ambient `HeckeRing W`-algebra structure along the inclusion `heckeRingBarFixed W →+* HeckeRing +W`. This lets `heckeAlgebraBarFixed` below be phrased as a genuine `Subalgebra`, not just a +`Subring`. -/ +noncomputable instance : Algebra (heckeRingBarFixed W) (HeckeAlgebra W) := + Algebra.compHom (HeckeAlgebra W) (heckeRingBarFixed W).subtype + +variable [Matsumoto (W1 := W)] [DihedralSubProperties (W1 := W)] + +/-- The `bar`-invariant elements of `HeckeAlgebra W`, as a `Subalgebra` over the bar-fixed scalars +`heckeRingBarFixed W`. Closure under `*` uses that `bar` is a genuine ring automorphism +(`star_mul_eq`), so no commutativity is needed between the two factors — unlike the usual +`star`-ring `selfAdjoint` construction, which is built around the *anti*-multiplicative law and +so only closes under products of *commuting* self-adjoint elements. Closure under the +`heckeRingBarFixed`-action follows from `bar`'s semilinearity (`bar_smul`): a fixed scalar acting +on a fixed vector is plain linear, landing back on a fixed vector. -/ +def heckeAlgebraBarFixed : Subalgebra (heckeRingBarFixed W) (HeckeAlgebra W) where + carrier := {x | star x = x} + mul_mem' {a b} ha hb := by + change star (a * b) = a * b + rw [star_mul_eq, ha, hb] + one_mem' := bar.map_one + add_mem' {a b} ha hb := by + change star (a + b) = a + b + rw [star_add, ha, hb] + zero_mem' := star_zero _ + algebraMap_mem' r := by + change bar (algebraMap (heckeRingBarFixed W) (HeckeAlgebra W) r) + = algebraMap (heckeRingBarFixed W) (HeckeAlgebra W) r + have hr : algebraMap (heckeRingBarFixed W) (HeckeAlgebra W) r + = (r : HeckeRing W) • (1 : HeckeAlgebra W) := + Algebra.algebraMap_eq_smul_one r + rw [hr, bar_smul, r.property, bar.map_one] + +theorem mem_heckeAlgebraBarFixed_iff {x : HeckeAlgebra W} : + x ∈ heckeAlgebraBarFixed (W := W) ↔ star x = x := Iff.rfl + +theorem T_one_mem_heckeAlgebraBarFixed : T (1 : W) ∈ heckeAlgebraBarFixed (W := W) := by + rw [T_one] + exact Subalgebra.one_mem _ + +/-- The length filtration on `HeckeAlgebra W`, restricted to the bar-invariant subalgebra +`heckeAlgebraBarFixed`: `F_n^{bar} := F_n ∩ heckeAlgebraBarFixed`, as a submodule over the +bar-fixed scalars `heckeRingBarFixed W`. This is the filtration a Kazhdan–Lusztig-style induction +on length would proceed along (the induction itself is not attempted here). -/ +def heckeAlgebraBarFixedFiltration (n : ℕ) : + Submodule (heckeRingBarFixed W) (heckeAlgebraBarFixed (W := W)) where + carrier := {x | (x : HeckeAlgebra W) ∈ heckeLengthFiltration (W := W) n} + zero_mem' := by + change (0 : HeckeAlgebra W) ∈ heckeLengthFiltration (W := W) n + exact zero_mem _ + add_mem' {a b} ha hb := by + change ((a : HeckeAlgebra W) + (b : HeckeAlgebra W)) ∈ heckeLengthFiltration (W := W) n + exact Submodule.add_mem _ ha hb + smul_mem' c x hx := by + change ((c : HeckeRing W) • (x : HeckeAlgebra W)) ∈ heckeLengthFiltration (W := W) n + exact Submodule.smul_mem _ _ hx + +theorem mem_heckeAlgebraBarFixedFiltration_iff {n : ℕ} {x : heckeAlgebraBarFixed (W := W)} : + x ∈ heckeAlgebraBarFixedFiltration (W := W) n ↔ + (x : HeckeAlgebra W) ∈ heckeLengthFiltration (W := W) n := Iff.rfl + +theorem heckeAlgebraBarFixedFiltration_mono : + Monotone (heckeAlgebraBarFixedFiltration (W := W)) := + fun _ _ h _ hx => heckeLengthFiltration_mono h hx + +/-- The **Kazhdan–Lusztig basis element for a simple reflection**, in the `v`-normalized +convention: `v_i⁻¹ (T_i + 1)`. This is the rank-one building block of the Kazhdan–Lusztig basis +(`C_w` for `w` of length `≤ 1`); the general `C_w` (all `w`), defined by an induction on length +using the bar-invariant lift against the length filtration, is not attempted here. -/ +noncomputable def KLSimple (i : B W) : HeckeAlgebra W := + star (heckeV i) • (T_simple i + 1) + +/-- `KLSimple i` really is bar-invariant: writing `v := heckeV i` (a unit, with inverse `star v`), +`bar (star v • (T_i + 1)) = v • (T_simple_inv i + 1)`, and this equals `star v • (T_i + 1)` because +`v • T_simple_inv i = star v • T_i + (star v - v) • 1` (expanding `T_simple_inv i` and using +`heckeV_mul_star`/`heckeQ`'s relation to `heckeV`), so the `1`-coefficients `(star v - v) + v` and +the `T_i`-coefficients `star v` on both sides match after simplifying with `star_involutive`. -/ +theorem KLSimple_mem_heckeAlgebraBarFixed (i : B W) : + KLSimple i ∈ heckeAlgebraBarFixed (W := W) := by + rw [mem_heckeAlgebraBarFixed_iff] + change bar (star (heckeV i) • (T_simple i + 1)) = star (heckeV i) • (T_simple i + 1) + have hbarT : bar (T_simple i) = T_simple_inv i := bar0_T_simple i + rw [bar_smul, map_add, hbarT, bar.map_one, star_involutive] + unfold T_simple_inv heckeQinv heckeQ + have hv : heckeV i * star (heckeV i) = 1 := heckeV_mul_star i + have hstar : star (heckeV i * heckeV i) = star (heckeV i) * star (heckeV i) := star_mul' _ _ + rw [hstar] + match_scalars + · linear_combination star (heckeV i) * hv + · linear_combination star (heckeV i) * hv + +/-- The `HeckeRing`-scalar collected from the leading (all-`T_simple`) term of a product of +`KLSimple`'s along the list `l`: `∏ᵢ star (heckeV i)`. A unit (product of units), but generally +not itself bar-fixed. -/ +noncomputable def KLLeadingCoeff (l : List (B W)) : HeckeRing W := + (l.map (fun i => star (heckeV i))).prod + +/-- The **naive Kazhdan–Lusztig-style element** for `w`: the product of the rank-one +`KLSimple`'s along an (arbitrarily chosen) reduced word for `w`, mirroring the definition of `T`. +It is bar-fixed (`KLNaive_mem_heckeAlgebraBarFixed`) and has "leading term `T_w`" in the sense of +`KLSimple_prod_eq_leading_add_lower` below — but, unlike the genuine Kazhdan–Lusztig basis +element `C_w`, its leading coefficient is only a *unit* (not exactly `1`), and no attempt is made +to cancel the lower-order terms into the canonical (triangularity/positivity) normal form. -/ +noncomputable def KLNaive (w : W) : HeckeAlgebra W := + ((Classical.arbitrary (ReducedWord w)).val.map KLSimple).prod + +theorem KLNaive_mem_heckeAlgebraBarFixed (w : W) : + KLNaive w ∈ heckeAlgebraBarFixed (W := W) := by + unfold KLNaive + refine Subalgebra.list_prod_mem _ (fun x hx => ?_) + obtain ⟨i, -, rfl⟩ := List.mem_map.mp hx + exact KLSimple_mem_heckeAlgebraBarFixed i + +omit [DihedralSubProperties (W1 := W)] in +/-- Auxiliary strengthened form of `KLSimple_prod_eq_leading_add_lower`, additionally tracking +that the remainder is *exactly* `0` when `l` is empty. This extra bookkeeping is needed only to +make the induction go through: at `l = i :: rest` with `rest = []`, the plain membership +`r' ∈ heckeLengthFiltration (rest.length - 1) = heckeLengthFiltration 0` isn't enough to place +`T_simple i * r'` back in `heckeLengthFiltration 0` (it would only give `heckeLengthFiltration 1`) +— but knowing `r' = 0` exactly sidesteps this. -/ +private theorem KLSimple_prod_eq_leading_add_lower_aux (l : List (B W)) (hl : cs.IsReduced l) : + ∃ r, r ∈ heckeLengthFiltration (W := W) (l.length - 1) ∧ + (l.map KLSimple).prod = KLLeadingCoeff l • T (cs.wordProd l) + r ∧ (l = [] → r = 0) := by + induction l with + | nil => + exact ⟨0, zero_mem _, by simp [KLLeadingCoeff, T_one], fun _ => rfl⟩ + | cons i rest ih => + have hrest : cs.IsReduced rest := isReduced_of_append_right (μ := [i]) hl + have hnd : ¬ cs.IsLeftDescent (cs.wordProd rest) i := (isReduced_cons hrest i).mp hl + have hlen : cs.length (cs.simple i * cs.wordProd rest) = cs.length (cs.simple i) + + cs.length (cs.wordProd rest) := by + rw [not_isLeftDescent_iff] at hnd + rw [hnd, cs.length_simple, add_comm] + have hTmul : T_simple i * T (cs.wordProd rest) = T (cs.wordProd (i :: rest)) := by + rw [wordProd_cons, ← T_simple_eq_T, T_mul_T_of_length_add hlen] + obtain ⟨r', hr'mem, hr'eq, hr'zero⟩ := ih hrest + refine ⟨star (heckeV i) • (T_simple i * r') + + KLLeadingCoeff (i :: rest) • T (cs.wordProd rest) + star (heckeV i) • r', + ?_, ?_, fun h => absurd h (List.cons_ne_nil i rest)⟩ + · have hrestlen : cs.length (cs.wordProd rest) = rest.length := hrest + have hlen2 : (i :: rest).length - 1 = rest.length := by simp + rw [hlen2] + rcases eq_or_ne rest [] with hre | hre + · subst hre + rw [hr'zero rfl] + have h0 : T (1 : W) ∈ heckeLengthFiltration (W := W) 0 := by + have h := T_mem_heckeLengthFiltration (1 : W) + rwa [cs.length_one] at h + simp only [List.length_nil, mul_zero, smul_zero, zero_add, add_zero] + rw [show cs.wordProd ([] : List (B W)) = (1 : W) from cs.wordProd_nil] + exact Submodule.smul_mem _ _ h0 + · have hpos : 0 < rest.length := List.length_pos_of_ne_nil hre + have heq1 : 1 + (rest.length - 1) = rest.length := by omega + have hT1 : T_simple i * r' ∈ heckeLengthFiltration (W := W) rest.length := by + rw [← heq1] + exact heckeLengthFiltration_mul_mem (T_simple_mem_heckeLengthFiltration_one i) hr'mem + have hTrest : T (cs.wordProd rest) ∈ heckeLengthFiltration (W := W) rest.length := by + rw [← hrestlen]; exact T_mem_heckeLengthFiltration (cs.wordProd rest) + exact Submodule.add_mem _ + (Submodule.add_mem _ (Submodule.smul_mem _ _ hT1) (Submodule.smul_mem _ _ hTrest)) + (Submodule.smul_mem _ _ (heckeLengthFiltration_mono (by omega) hr'mem)) + · rw [List.map_cons, List.prod_cons, hr'eq] + unfold KLSimple + have hstep : T_simple i * (KLLeadingCoeff rest • T (cs.wordProd rest)) + = KLLeadingCoeff rest • T (cs.wordProd (i :: rest)) := by + rw [mul_smul_comm, hTmul] + have hcoeff : KLLeadingCoeff (i :: rest) = star (heckeV i) * KLLeadingCoeff rest := by + unfold KLLeadingCoeff + rw [List.map_cons, List.prod_cons] + rw [hcoeff, smul_mul_assoc, add_mul, one_mul, mul_add, hstep] + module + +/-- The leading coefficient of `KLNaive w`: `KLLeadingCoeff` along the same (arbitrarily chosen) +reduced word for `w` used to define `KLNaive w`. -/ +noncomputable def KLNaiveLeadingCoeff (w : W) : HeckeRing W := + KLLeadingCoeff (Classical.arbitrary (ReducedWord w)).val + +omit [DihedralSubProperties (W1 := W)] in +/-- The "leading term" behavior of `KLNaive w`: it equals `KLNaiveLeadingCoeff w • T w` plus a +remainder that lies *strictly* deeper in the length filtration than `length w`. Proved via +`KLSimple_prod_eq_leading_add_lower_aux`, using the induction on the reduced word peeling the +*first* letter `i` off the front: `l = i :: rest` reduced means `rest` is reduced and `i` is not a +left descent of `wordProd rest` (`isReduced_cons`), so `T_simple i * T (wordProd rest) = +T (wordProd l)` (`T_mul_T_of_length_add`) gives exactly the new leading term; every other term in +the expansion of `KLSimple i * (leading + remainder)` drops into the filtration level below +`l.length`. -/ +theorem KLNaive_eq_leading_add_lower (w : W) : + ∃ r ∈ heckeLengthFiltration (W := W) (cs.length w - 1), + KLNaive w = KLNaiveLeadingCoeff w • T w + r := by + unfold KLNaive KLNaiveLeadingCoeff + set ω := Classical.arbitrary (ReducedWord w) + obtain ⟨r, hmem, heq, -⟩ := KLSimple_prod_eq_leading_add_lower_aux ω.val ω.prop.1 + rw [ω.wordProd_eq] at heq + exact ⟨r, by rwa [ω.length_eq] at hmem, heq⟩ + +/-- The Kazhdan–Lusztig element for `w`: `x` is bar-invariant, has leading coefficient exactly +`KLNaiveLeadingCoeff w` at `T_w`, its `T`-basis expansion (now available, via `basis`) is +supported only on the Bruhat interval below `w` (`Coxeter.le`, `Coxeter.Bruhat`) — the +*definitional* triangularity — and, the condition that actually forces *uniqueness* (without it, +`x` and `x + C'_v` for any `v ≤ w` would both qualify): "untwisting" each remaining coefficient +`basis.repr x v` (`v < w`) by `star (KLNaiveLeadingCoeff w)` (which is `KLNaiveLeadingCoeff w`'s +inverse — `star` is a ring involution on `HeckeRing W`, and `star (star c) * c = c * c⁻¹ = 1` for +the unit `c := KLNaiveLeadingCoeff w`) lands it in the `qᵢ`-polynomial subring +`heckeRingEvenPolyDegreeLE`, of `v`-degree at most `length w - length v - 1`. -/ +def IsKLBasisElement (w : W) (x : HeckeAlgebra W) : Prop := + x ∈ heckeAlgebraBarFixed (W := W) ∧ + basis.repr x w = KLNaiveLeadingCoeff w ∧ + (∀ v : W, ¬ v ≤ w → basis.repr x v = 0) ∧ + ∀ v : W, v < w → heckeRingEvenPolyDegreeLE (cs.length w - cs.length v - 1 : ℤ) + (star (KLNaiveLeadingCoeff w) • basis.repr x v) + +omit [Matsumoto (W1 := W)] [DihedralSubProperties (W1 := W)] in +theorem KLNaiveLeadingCoeff_one : KLNaiveLeadingCoeff (1 : W) = 1 := by + unfold KLNaiveLeadingCoeff KLLeadingCoeff + set ω := Classical.arbitrary (ReducedWord (1 : W)) + have hnil : ω.val = [] := + List.eq_nil_of_length_eq_zero (by rw [ω.length_eq, cs.length_one]) + rw [hnil] + simp + +/-- `C'_1 = 1`: the trivial base case of the Kazhdan–Lusztig basis. Since `1` is the bottom +element of the Bruhat order, the Bruhat-support and degree conditions are vacuous (nothing is +`< 1`, and `v ≤ 1 → v = 1`), leaving just `1 ∈ heckeAlgebraBarFixed` and the leading coefficient +computation `basis.repr 1 1 = 1 = KLNaiveLeadingCoeff 1`. -/ +theorem isKLBasisElement_one : IsKLBasisElement (1 : W) (1 : HeckeAlgebra W) := by + have hT1 : (1 : HeckeAlgebra W) = T (1 : W) := T_one.symm + have hrepr : basis.repr (1 : HeckeAlgebra W) = Finsupp.single (1 : W) (1 : HeckeRing W) := by + rw [hT1, ← basis_apply, Module.Basis.repr_self] + refine ⟨by rw [hT1]; exact T_one_mem_heckeAlgebraBarFixed, ?_, ?_, ?_⟩ + · rw [hrepr, Finsupp.single_eq_same, KLNaiveLeadingCoeff_one] + · intro v hv + classical + rw [hrepr, Finsupp.single_apply, if_neg] + exact fun h => hv (h ▸ le_refl (1 : W)) + · intro v hv + exact absurd (le_antisymm hv.le bot_le) hv.ne + +theorem isKLBasisElement_simple (i : B W) : IsKLBasisElement (cs.simple i : W) (KLSimple i) := by + set bi := KLSimple i + have leading : KLNaiveLeadingCoeff (cs.simple i) = star (heckeV i) := by + simp only [KLNaiveLeadingCoeff] + rw [single_letter_reduced] + simp only [KLLeadingCoeff] + erw [List.map_singleton] + rw [List.prod_singleton] + have ti := basis_apply (cs.simple i) + have ti_eq : T (cs.simple i) = T_simple i := by + simp + have t_one := basis_apply (1 : W) + have t_one_eq : T (1 : W) = (1 : HeckeAlgebra W) := by + exact (T_one (W:=W)) + have t_part_1 : (basis.repr (T_simple i)) 1 = 0 := by + rw [<-ti_eq, <-ti] + simp + have t_part_t : (basis.repr (T_simple i)) (cs.simple i) = 1 := by + rw [<-ti_eq, <-ti] + simp + have one_part_1 : (basis.repr (1 : HeckeAlgebra W)) 1 = 1 := by + rw [<-t_one_eq,<-t_one] + simp + have one_part_t : (basis.repr (1 : HeckeAlgebra W)) (cs.simple i) = 0 := by + rw [<-t_one_eq,<-t_one] + simp + have t_part_rest (w : W) (hw: ¬(w ≤ cs.simple i)) : (basis.repr (T_simple i)) w = 0 := by + rw [<-ti_eq, <-ti] + by_cases w_eqi: w = cs.simple i + · exact absurd w_eqi.le hw + · simp only [Module.Basis.repr_self] + rw [Finsupp.single_eq_of_ne w_eqi] + have one_part_rest (w : W) (hw: ¬(w ≤ cs.simple i)) : (basis.repr 1) w = 0 := by + rw [<-t_one_eq,<-t_one] + have temp := (simple_upper i (1 : W)).mpr (Or.inl rfl) + have one_le_w : 1 <= w := by + exact bot_le + by_cases w_eq1: w = 1 + · have w_le_simp : w ≤ cs.simple i := by + rw [w_eq1] + exact temp + exact absurd w_le_simp hw + · simp only [Module.Basis.repr_self] + rw [Finsupp.single_eq_of_ne w_eq1] + have bi_1 : basis.repr bi (1 : W) = star (heckeV i) := by + unfold bi + unfold KLSimple + simp only [smul_add, map_add, map_smul, Finsupp.coe_add, Finsupp.coe_smul, Pi.add_apply, + Pi.smul_apply, smul_eq_mul] + rw [t_part_1, one_part_1] + rw [mul_zero, zero_add, mul_one] + have bi_ts : basis.repr bi (cs.simple i) = star (heckeV i) := by + unfold bi + unfold KLSimple + simp only [smul_add, map_add, map_smul, Finsupp.coe_add, Finsupp.coe_smul, Pi.add_apply, + Pi.smul_apply, smul_eq_mul] + rw [t_part_t, one_part_t] + rw [mul_one, mul_zero, add_zero] + have bi_rest (w : W) (hw: ¬(w ≤ cs.simple i)) : + basis.repr bi w = 0 := by + unfold bi + unfold KLSimple + simp only [smul_add, map_add, map_smul, Finsupp.coe_add, Finsupp.coe_smul, Pi.add_apply, + Pi.smul_apply, smul_eq_mul] + rw [t_part_rest w hw, one_part_rest w hw] + rw [mul_zero, add_zero] + refine ⟨by exact KLSimple_mem_heckeAlgebraBarFixed i, ?_, ?_, ?_⟩ + · rw [bi_ts] + rw [leading] + · intro v hv + rw [bi_rest v hv] + · intro v hv + classical + have v_one : v = 1 := by + have su := (simple_upper i v).mp hv.le + have is_neq : v ≠ cs.simple i := by + exact hv.ne + refine Or.by_cases su ?_ ?_ + · exact id + · intro is_eq + exact absurd is_eq is_neq + rw [v_one] + erw [bi_1] + simp only [length_simple, Nat.cast_one, length_one, CharP.cast_eq_zero, + sub_zero, sub_self, smul_eq_mul] + rw [leading] + rw [star_star] + rw [heckeV_mul_star] + rw [heckeRingEvenPolyDegreeLE] + refine ⟨?_, ?_⟩ + · simp + · intro m hm + have m_eq : m = (0 : ParamIndex W →₀ ℤ) := by + have one_supp : (1 : HeckeRing W) = AddMonoidAlgebra.single 0 1 := by + rfl + rw [one_supp, AddMonoidAlgebra.single, Finsupp.single] at hm + simp only [one_ne_zero, ↓reduceIte, Finset.mem_singleton] at hm + exact hm + rw [m_eq] + simp + simp only [monomialDegree] + simp + +/-- On `heckeAlgebraBarFixed` itself, `star` (inherited from `HeckeAlgebra W`) is *trivial*, for +the same reason as on `heckeRingBarFixed`: every element is already fixed by definition. Unlike +the scalar case, we stop at `TrivialStar` here rather than `StarRing`: `heckeAlgebraBarFixed` is +*not* generally commutative (being fixed by `bar` doesn't force two elements to commute), so +`star = id` would make the anti-multiplicative `star_mul` axiom assert `a * b = b * a`, which can +fail. -/ +noncomputable instance : Star (heckeAlgebraBarFixed (W := W)) := ⟨id⟩ + +instance : TrivialStar (heckeAlgebraBarFixed (W := W)) := ⟨fun _ => rfl⟩ + +end BarInvariant + end Coxeter diff --git a/Coxeter/SpecialFeatures.lean b/Coxeter/SpecialFeatures.lean new file mode 100644 index 0000000..0131d7d --- /dev/null +++ b/Coxeter/SpecialFeatures.lean @@ -0,0 +1,131 @@ +module + +public import Coxeter.GeometricRepresentation +public import Mathlib.Combinatorics.SimpleGraph.Connectivity.Connected + +/-! +# Special features of Coxeter systems + +This file collects propositions singling out special classes of Coxeter systems. +`IsRightAngled`/`IsCrystallographic` are readable directly off the entries of a Coxeter matrix with +only minimal arithmetic (they don't need a group at all, only `CoxeterMatrix ι`); +`IsFiniteCoxeter`/`IsPolyFiniteWeyl`/`IsAffineCoxeter`/`IsPolyAffineWeyl` instead bundle the genuine +(semi)definiteness of the associated bilinear form `bil`, since that classification isn't +entrywise-arithmetic in nature. +None of these require the Coxeter diagram to be connected +(irreducible); +The `Poly` prefix on `IsPolyFiniteWeyl`/`IsPolyAffineWeyl` signals that they allow a +*product* of several irreducible finite/affine Weyl groups, not just a single irreducible one. + +## Main definitions + +* `Coxeter.IsRightAngled` +* `Coxeter.IsCrystallographic` +* `Coxeter.IsIrreducible` +* `Coxeter.IsFiniteCoxeter` +* `Coxeter.IsPolyFiniteWeyl` +* `Coxeter.IsIrreducibleFiniteWeyl` +* `Coxeter.IsAffineCoxeter` +* `Coxeter.IsPolyAffineWeyl` +* `Coxeter.IsIrreducibleAffineWeyl` +-/ + +@[expose] public section + +namespace Coxeter + +open Finsupp CoxeterGroup CoxeterSystem + +variable {W : Type*} {cg : CoxeterGroup W} + +/-- A Coxeter matrix is *right-angled* if every pair of distinct generators either commutes +(`M i i' = 2`) or generates an infinite dihedral subgroup (`M i i' = 0`) — i.e. no relation of +order `3` or more ever occurs between two distinct generators. -/ +def IsRightAngled : Prop := ∀ i i' : B W, i ≠ i' → M i i' = 2 ∨ M i i' = 0 + +def IsCrystallographicMatrix {B1 : Type*} (M1 : Matrix B1 B1 ℕ) : Prop := + ∀ i i' : B1, i ≠ i' → M1 i i' = 0 ∨ M1 i i' = 2 ∨ M1 i i' = 3 ∨ M1 i i' = 4 ∨ M1 i i' = 6 + +/-- A Coxeter matrix is *crystallographic* if every pair of distinct generators either generates an +infinite dihedral subgroup (`M i i' = 0`) or one of order `2 * M i i'` for `M i i' ∈ {2, 3, 4, 6}` +— the restriction on dihedral angles forced by requiring the reflections to preserve a lattice. -/ +def IsCrystallographic : Prop := + IsCrystallographicMatrix (B1 := B W) (M1 := cg.M) + +/-- The graph on generators with an edge between `i ≠ i'` whenever `M i i' ≠ 2` (the two simple +reflections don't commute) — the *Coxeter diagram*, as a `SimpleGraph`. -/ +def coxeterGraphMatrix {B1 : Type*} (M1 : CoxeterMatrix B1) : + SimpleGraph B1 := SimpleGraph.fromRel (M1 · · ≠ 2) + +/-- A Coxeter matrix is *irreducible* if its Coxeter diagram (`coxeterGraphMatrix`) is connected. -/ +def IsIrreducibleMatrix {B1 : Type*} (M1 : CoxeterMatrix B1) : Prop := + (coxeterGraphMatrix M1).Connected + +def IsIrreducible : Prop := + IsIrreducibleMatrix (M1 := cg.M) + +/-- The Coxeter matrix obtained from `M` by deleting one generator `i₀` — restricting the matrix to +the remaining generators is again a valid Coxeter matrix (symmetric, diagonal `1`, off-diagonal +`≠ 1`), inherited directly from `M`. -/ +def deleteGenerator (i₀ : B W) : + CoxeterMatrix {j : B W // j ≠ i₀} where + M a b := M a.1 b.1 + isSymm := Matrix.IsSymm.ext_iff.mpr (fun a b => M.symmetric b.1 a.1) + diagonal a := M.diagonal a.1 + off_diagonal a b hab := M.off_diagonal a.1 b.1 (fun h => hab (Subtype.ext h)) + +/-- `W` is of *finite type*: either finite, or `bil` is positive semidefinite and nondegenerate +(i.e. positive definite — `IsPosDef` isn't a separate notion in Mathlib for bilinear forms). Stated +as an *or*, not an *iff*: the classical equivalence `W` finite ↔ `bil` positive definite isn't +proved here, so satisfying either disjunct is the obligation, not both. -/ +def IsFiniteCoxeter : Prop := + Finite W ∨ ( + (@bil W _).IsPosSemidef ∧ (@bil W _).Nondegenerate + ) + +/-- `W` is a *product of finite Weyl groups*: +`IsFiniteCoxeter` together with `IsCrystallographic`. -/ +def IsPolyFiniteWeyl : Prop := + @IsFiniteCoxeter W cg ∧ + @IsCrystallographic W cg + +/-- `W` is an *irreducible finite Weyl group*: `IsPolyFiniteWeyl` together with `IsIrreducible` +(the Coxeter diagram is connected) — the genuine, single (not a product) case. -/ +def IsIrreducibleFiniteWeyl : Prop := + @IsPolyFiniteWeyl W cg ∧ @IsIrreducible W cg + +/-- A Coxeter system is of *affine type*: +`bil` is positive semidefinite but not nondegenerate — +This covers the properly-degenerate case. +That is the only restriction on how large the degenerate (radical) directions are. +It is at least 1, but can be more. +-/ +def IsAffineCoxeter : Prop := + (@bil W _).IsPosSemidef ∧ ¬ (@bil W _).Nondegenerate + +/-- A particular kind of affine Coxeter system +(`IsAffineCoxeter`), characterized the classical way. +Deleting a single node from the Coxeter diagram recovers a finite part. +Concretely: +- `bil` is positive semidefinite +- the whole matrix `IsCrystallographic` + (the entire diagram, including the null generator, preserves a lattice) +- there is some generator `i₀` and some `δ` supported away from `i₀` + (`δ i₀ = 0`) such that `bil`'s radical (kernel) is spanned by `stdBasis i₀ + δ` + as exactly the single "null"/imaginary-root direction + (the diagonal entry `bil (stdBasis i₀) (stdBasis i₀) = 1` rules out the kernel + being spanned by `stdBasis i₀` alone) +- Deleting `i₀` (`deleteGenerator i₀`) then recovers the + finite part. -/ +def IsPolyAffineWeyl : Prop := + (@bil W _).IsPosSemidef ∧ + @IsCrystallographic W cg ∧ + ∃ i₀ : B W, ∃ δ ∈ supported ℝ ℝ ({i₀}ᶜ : Set (B W)), + LinearMap.ker (@bil W _) = Submodule.span ℝ {stdBasis i₀ + δ} + +/-- `W` is an *irreducible affine Weyl group*: `IsPolyAffineWeyl` together with `IsIrreducible` +(the Coxeter diagram is connected) — the genuine, single (not a product) case. -/ +def IsIrreducibleAffineWeyl : Prop := + @IsPolyAffineWeyl W cg ∧ @IsIrreducible W cg + +end Coxeter diff --git a/Coxeter/StrongExchange.lean b/Coxeter/StrongExchange.lean index 5167809..b0dd295 100644 --- a/Coxeter/StrongExchange.lean +++ b/Coxeter/StrongExchange.lean @@ -179,6 +179,38 @@ theorem card_of_isRightInversion (w : W) : Nat.card {t : W // cs.IsRightInversion w t} = cs.length w := by rw [Nat.card_congr equiv_isRightInversion, card_of_isLeftInversion, length_op] +/-- If `s` is a right inversion of `v`, it stays a right inversion of `w * v` provided `w * v` has +no length cancellation (`hlen`): right-multiplying the length-additive `w` onto the left of `v` +can't undo the length drop `s` already causes on `v`. One half of the classical fact that +`RightInversion (w * v)` splits as `RightInversion v` together with `w`'s inversions conjugated by +`v⁻¹` (the other half is `isRightInversion_conj_of_isRightInversion_mul_left`); a step toward the +"gate property" (`DihedralSubProperties.isRightDescent_mul_iff_of_not_rightDescent` in +`Coxeter/Hecke.lean`), though the disjointness/exhaustiveness of the two halves (needed to turn +this into an iff) isn't proved here. -/ +theorem isRightInversion_of_isRightInversion_mul_right {w v s : W} + (hs : cs.IsRightInversion v s) (hlen : cs.length (w * v) = cs.length w + cs.length v) : + cs.IsRightInversion (w * v) s := by + obtain ⟨hrefl, hlt⟩ := hs + refine ⟨hrefl, ?_⟩ + rw [mul_assoc] + have h1 := cs.length_mul_le w (v * s) + omega + +/-- If `t` is a right inversion of `w`, then its conjugate `v⁻¹ * t * v` is a right inversion of +`w * v`, provided `w * v` has no length cancellation (`hlen`): appending the length-additive `v` +on the right can't undo the length drop `t` already causes on `w`. The other half of the classical +"inversions of a length-additive product split" fact (see +`isRightInversion_of_isRightInversion_mul_right`). -/ +theorem isRightInversion_conj_of_isRightInversion_mul_left {w v t : W} + (ht : cs.IsRightInversion w t) (hlen : cs.length (w * v) = cs.length w + cs.length v) : + cs.IsRightInversion (w * v) (v⁻¹ * t * v) := by + obtain ⟨hrefl, hlt⟩ := ht + refine ⟨by simpa using hrefl.conj v⁻¹, ?_⟩ + have h1 : w * v * (v⁻¹ * t * v) = w * t * v := by group + rw [h1] + have h2 := cs.length_mul_le (w * t) v + omega + end rightVariants end Coxeter From 634e9350e2c3308e694745294e695b16d7213830 Mon Sep 17 00:00:00 2001 From: Cobord Date: Tue, 7 Jul 2026 05:52:58 -0400 Subject: [PATCH 09/12] assembly of prop from on connected components --- Coxeter.lean | 5 +- Coxeter/Component.lean | 206 ++++++++++++++++++++++++ Coxeter/LinearAlgebra/BilinearForm.lean | 73 +++++++++ Coxeter/SpecialFeatures.lean | 178 ++++++++++++++++++-- 4 files changed, 446 insertions(+), 16 deletions(-) create mode 100644 Coxeter/Component.lean diff --git a/Coxeter.lean b/Coxeter.lean index 5a1f2a0..2da771d 100644 --- a/Coxeter.lean +++ b/Coxeter.lean @@ -3,12 +3,15 @@ module public import Coxeter.Basic public import Coxeter.BraidGroup public import Coxeter.Bruhat +public import Coxeter.Component +public import Coxeter.Dihedral public import Coxeter.Data.List.Lemmas public import Coxeter.GeometricRepresentation +public import Coxeter.Hecke public import Coxeter.LinearAlgebra.AssociatedGraded public import Coxeter.LinearAlgebra.BilinearForm public import Coxeter.LinearAlgebra.TwoDim public import Coxeter.Order.Directed public import Coxeter.PermutationRepresentation +public import Coxeter.SpecialFeatures public import Coxeter.StrongExchange -public import Coxeter.Hecke diff --git a/Coxeter/Component.lean b/Coxeter/Component.lean new file mode 100644 index 0000000..49d0732 --- /dev/null +++ b/Coxeter/Component.lean @@ -0,0 +1,206 @@ +module + +public import Coxeter.GeometricRepresentation +public import Mathlib.Combinatorics.SimpleGraph.Connectivity.Connected + +/-! +# Components of a Coxeter system + +`Coxeter.IsComponentOf cg1 cg` records that `cg1` is identified with one connected component of +`cg`'s Coxeter diagram: a bijection between `cg1`'s generators and the generators lying in that +component, together with a group homomorphism sending simple reflections to simple reflections +accordingly. + +This is *data*, not a theorem: none of the fields are derived from more primitive facts about +Coxeter groups (e.g. `toHom` is not asserted or proved to be injective). + +## Main definitions + +* `Coxeter.IsComponentOf` +-/ + +@[expose] public section + +namespace Coxeter + +/-- The graph on generators with an edge between `i ≠ i'` whenever `M i i' ≠ 2` (the two simple +reflections don't commute) — the *Coxeter diagram*, as a `SimpleGraph`. -/ +def coxeterGraphMatrix {B1 : Type*} (M1 : CoxeterMatrix B1) : + SimpleGraph B1 := SimpleGraph.fromRel (M1 · · ≠ 2) + +/-- `cg1 IsComponentOf cg`: data identifying `cg1` with one connected component of `cg`'s Coxeter +diagram — a bijection between `cg1`'s generators and the generators lying in that component, +together with a group homomorphism `W1 →* W` sending each simple reflection of `cg1` to the +simple reflection of `cg` at the corresponding generator. -/ +structure IsComponentOf {W1 : Type*} (cg1 : CoxeterGroup W1) {W : Type*} (cg : CoxeterGroup W) + where + /-- The connected component of `cg`'s Coxeter diagram that `cg1` is identified with. -/ + component : (coxeterGraphMatrix cg.M).ConnectedComponent + /-- The identification of `cg1`'s generators with the generators lying in `component`. -/ + reindex : cg1.B ≃ component.supp + /-- The group homomorphism realizing `W1` inside `W`. -/ + toHom : W1 →* W + /-- `toHom` sends each simple reflection of `cg1` to the simple reflection of `cg` at the + corresponding (via `reindex`) generator. -/ + map_simple : ∀ i : cg1.B, toHom (cg1.cs.simple i) = cg.cs.simple (reindex i : cg.B) + +/-- The Coxeter matrix on the generators of `cg` lying in a single connected component `c` of +`cg`'s Coxeter diagram, obtained by restricting `cg.M`. -/ +def componentMatrix {W : Type*} (cg : CoxeterGroup W) + (c : (coxeterGraphMatrix cg.M).ConnectedComponent) : CoxeterMatrix c.supp where + M a b := cg.M a.1 b.1 + isSymm := Matrix.IsSymm.ext_iff.mpr (fun a b => cg.M.symmetric b.1 a.1) + diagonal a := cg.M.diagonal a.1 + off_diagonal a b hab := cg.M.off_diagonal a.1 b.1 (fun h => hab (Subtype.ext h)) + +/-- The Coxeter group of `componentMatrix cg c`, presented as the quotient of the free group on +that component's generators by the relevant relations coming from `cg.M`. -/ +@[reducible] noncomputable def componentCoxeterGroup {W : Type*} (cg : CoxeterGroup W) + (c : (coxeterGraphMatrix cg.M).ConnectedComponent) : + CoxeterGroup (componentMatrix cg c).Group where + B := c.supp + M := componentMatrix cg c + cs := (componentMatrix cg c).toCoxeterSystem + +/-- `componentCoxeterGroup cg c` is a component of `cg`, in the sense of `IsComponentOf`: its +generators literally *are* `c.supp` (so `reindex` is the identity), and the group homomorphism is +the one induced by the universal property of the presented group, sending each generator to the +simple reflection of `cg` at the corresponding point of `c` — so `toHom` and `map_simple` are both +immediate from the construction, via `CoxeterSystem.lift_apply_simple`. -/ +noncomputable def ofComponent {W : Type*} (cg : CoxeterGroup W) + (c : (coxeterGraphMatrix cg.M).ConnectedComponent) : + IsComponentOf (componentCoxeterGroup cg c) cg where + component := c + reindex := Equiv.refl _ + toHom := (componentMatrix cg c).toCoxeterSystem.lift + ⟨fun a => cg.cs.simple a.1, fun a b => cg.cs.simple_mul_simple_pow a.1 b.1⟩ + map_simple a := (componentMatrix cg c).toCoxeterSystem.lift_apply_simple + (fun a b => cg.cs.simple_mul_simple_pow a.1 b.1) a + +/-- Every connected component of `cg`'s Coxeter diagram, each paired with the witness that its +associated Coxeter group is a component of `cg`. Assumes finitely many components. -/ +noncomputable def allComponents {W : Type*} (cg : CoxeterGroup W) + [Finite (coxeterGraphMatrix cg.M).ConnectedComponent] : + List (Σ c : (coxeterGraphMatrix cg.M).ConnectedComponent, + IsComponentOf (componentCoxeterGroup cg c) cg) := + haveI := Fintype.ofFinite (coxeterGraphMatrix cg.M).ConnectedComponent + Finset.univ.toList.map (fun c => ⟨c, ofComponent cg c⟩) + +/-- The generating set of `cg` is, as a type, the disjoint union of its connected components. -/ +def blockEquiv {W : Type*} (cg : CoxeterGroup W) : + (Σ c : (coxeterGraphMatrix cg.M).ConnectedComponent, c.supp) ≃ cg.B := + Equiv.sigmaFiberEquiv (coxeterGraphMatrix cg.M).connectedComponentMk + +/-- `cg.M` is *block diagonal* along the partition of generators into connected components: two +generators from different components always commute (`M i i' = 2`), since a diagram edge would put +them in the same component. -/ +theorem M_eq_two_of_connectedComponentMk_ne {W : Type*} (cg : CoxeterGroup W) {i i' : cg.B} + (h : (coxeterGraphMatrix cg.M).connectedComponentMk i ≠ + (coxeterGraphMatrix cg.M).connectedComponentMk i') : + cg.M i i' = 2 := by + have hii' : i ≠ i' := fun heq => + h (congrArg (coxeterGraphMatrix cg.M).connectedComponentMk heq) + have hadj : ¬ (coxeterGraphMatrix cg.M).Adj i i' := + fun hadj => h (SimpleGraph.ConnectedComponent.eq.mpr hadj.reachable) + have hadj' : ¬ (i ≠ i' ∧ (cg.M i i' ≠ 2 ∨ cg.M i' i ≠ 2)) := hadj + push Not at hadj' + exact (hadj' hii').1 + +/-- Generators within the same component agree with `componentMatrix`, definitionally: the "block" +of `cg.M` on component `c` is exactly `componentMatrix cg c`. -/ +theorem M_eq_componentMatrix {W : Type*} (cg : CoxeterGroup W) + (c : (coxeterGraphMatrix cg.M).ConnectedComponent) (i i' : c.supp) : + cg.M i.1 i'.1 = componentMatrix cg c i i' := rfl + +/-- `bil` is manifestly built entrywise from `cos (π / M i i')` (see `bil`'s definition via +`Matrix.toBilin`), so — for exactly the same reason as `M_eq_two_of_connectedComponentMk_ne` — it +vanishes on pairs of standard basis vectors from different connected components. This is the +"direct sum" structure of `bil` across components: cross-component terms never contribute. -/ +theorem bil_stdBasis_eq_zero_of_connectedComponentMk_ne {W : Type*} (cg : CoxeterGroup W) + {i i' : cg.B} + (h : (coxeterGraphMatrix cg.M).connectedComponentMk i ≠ + (coxeterGraphMatrix cg.M).connectedComponentMk i') : + (@bil W cg) (stdBasis i) (stdBasis i') = 0 := by + unfold bil + rw [Matrix.toBilin_single, M_eq_two_of_connectedComponentMk_ne cg h] + norm_num + +/-- The other half of the "direct sum" structure of `bil`, alongside +`bil_stdBasis_eq_zero_of_connectedComponentMk_ne`: on a single connected component, `bil` agrees +exactly with that component's own `bil` — again immediate from `bil`'s entrywise definition via +`M`, this time using `M_eq_componentMatrix` instead of `M_eq_two_of_connectedComponentMk_ne`. -/ +theorem bil_stdBasis_eq_of_mem_component {W : Type*} (cg : CoxeterGroup W) + (c : (coxeterGraphMatrix cg.M).ConnectedComponent) (i i' : c.supp) : + (@bil W cg) (stdBasis i.1) (stdBasis i'.1) = + (@bil _ (componentCoxeterGroup cg c)) + (@stdBasis _ (componentCoxeterGroup cg c) i) + (@stdBasis _ (componentCoxeterGroup cg c) i') := by + unfold bil + repeat rw [Matrix.toBilin_single] + rfl + +open Classical in +/-- `bil` is *block diagonal*, on the level of the underlying symmetric matrix: transported along +`blockEquiv` (reindexing `stdBasis` by the disjoint-union-of-components identification), the +matrix of `bil` at `⟨c, i⟩, ⟨c', i'⟩` is `0` when `c ≠ c'` +(`bil_stdBasis_eq_zero_of_connectedComponentMk_ne`), and is the matrix of component `c`'s own +`bil` when `c = c'` (`bil_stdBasis_eq_of_mem_component`). -/ +theorem bil_toMatrix_blockEquiv_apply {W : Type*} (cg : CoxeterGroup W) + (c c' : (coxeterGraphMatrix cg.M).ConnectedComponent) (i : c.supp) (i' : c'.supp) : + (LinearMap.BilinForm.toMatrix (stdBasis.reindex (blockEquiv cg).symm)) (@bil W cg) + ⟨c, i⟩ ⟨c', i'⟩ = + if h : c = c' then + (LinearMap.BilinForm.toMatrix (@stdBasis _ (componentCoxeterGroup cg c))) + (@bil _ (componentCoxeterGroup cg c)) i (h ▸ i') + else 0 := by + have key : (LinearMap.BilinForm.toMatrix (stdBasis.reindex (blockEquiv cg).symm)) (@bil W cg) + ⟨c, i⟩ ⟨c', i'⟩ = (@bil W cg) (stdBasis i.1) (stdBasis i'.1) := by + unfold LinearMap.BilinForm.toMatrix + simp only [Module.Basis.reindex_apply, blockEquiv] + simp only [Equiv.symm_symm, LinearEquiv.coe_mk, LinearMap.coe_mk, AddHom.coe_mk] + have keyL := Equiv.sigmaFiberEquiv_apply + (f:=(coxeterGraphMatrix cg.M).connectedComponentMk) + (x:=⟨c, i⟩) + have keyR := Equiv.sigmaFiberEquiv_apply + (f:=(coxeterGraphMatrix cg.M).connectedComponentMk) + (x:=⟨c', i'⟩) + erw [keyL, keyR] + rw [key] + by_cases h : c = c' + · subst h + rw [dif_pos rfl] + exact bil_stdBasis_eq_of_mem_component cg c i i' + · rw [dif_neg h] + exact bil_stdBasis_eq_zero_of_connectedComponentMk_ne cg (by rw [i.2, i'.2]; exact h) + +open Classical in +/-- `bil` **is** a direct sum: the matrix of `bil` (in the `blockEquiv`-reindexed basis) is +exactly `Matrix.blockDiagonal'` of the components' own `bil` matrices — mathlib's standard +"block diagonal matrix" construction, built entrywise from `bil_toMatrix_blockEquiv_apply`. -/ +theorem bil_toMatrix_blockEquiv_eq_blockDiagonal' {W : Type*} (cg : CoxeterGroup W) : + LinearMap.BilinForm.toMatrix (stdBasis.reindex (blockEquiv cg).symm) (@bil W cg) = + Matrix.blockDiagonal' (fun c : (coxeterGraphMatrix cg.M).ConnectedComponent => + LinearMap.BilinForm.toMatrix (@stdBasis _ (componentCoxeterGroup cg c)) + (@bil _ (componentCoxeterGroup cg c))) := by + funext ⟨c, i⟩ ⟨c', i'⟩ + rw [bil_toMatrix_blockEquiv_apply cg c c' i i', Matrix.blockDiagonal'_apply'] + by_cases h : c = c' + · subst h + rw [dif_pos rfl, dif_pos rfl] + congr! + · rw [dif_neg h, dif_neg h] + +/-- `P` *assembles* across connected components: whenever `cg` has finitely many components and +`P` holds of the Coxeter group of each individual component, `P` already holds of `cg` itself. + +`P` is required to apply to `CoxeterGroup.{v, v}`, i.e. Coxeter groups whose underlying group and +generating set live in the *same* universe `v` — this is forced by `componentCoxeterGroup`, whose +underlying group `(componentMatrix cg c).Group` always lives in the universe of `cg.B`, not of +`W`, so `cg` itself must already have `W` and `B` in that common universe for `P` to apply to both +`cg` and all of its components uniformly. -/ +def Assembles (P : ∀ {W : Type v}, CoxeterGroup.{v, v} W → Prop) : Prop := + ∀ {W : Type v} (cg : CoxeterGroup.{v, v} W) + [Finite (coxeterGraphMatrix cg.M).ConnectedComponent], + (∀ c : (coxeterGraphMatrix cg.M).ConnectedComponent, P (componentCoxeterGroup cg c)) → P cg + +end Coxeter diff --git a/Coxeter/LinearAlgebra/BilinearForm.lean b/Coxeter/LinearAlgebra/BilinearForm.lean index 15ca7ed..830832b 100644 --- a/Coxeter/LinearAlgebra/BilinearForm.lean +++ b/Coxeter/LinearAlgebra/BilinearForm.lean @@ -53,6 +53,46 @@ theorem Matrix.toBilin_single (B : Matrix ι ι R) (i j : ι) : toBilin b B (b i unfold toBilin LinearMap.BilinForm.toMatrix simp +section BlockDiagonal + +variable {κ : Type*} {ιk : κ → Type*} + +/-- If the matrix of a bilinear form `B` (w.r.t. a basis indexed by a disjoint union `Σ k, ιk k`) +is block diagonal, with each block itself the matrix of a bilinear form `Bk k` on the free module +`ιk k →₀ R` (w.r.t. its standard basis `Finsupp.basisSingleOne`), and some block `Bk k₀` is +degenerate (not left-separating), then `B` itself is degenerate. + +Proof idea (currently unproved — pick up here): +* Unfold `¬ (Bk k₀).SeparatingLeft` (`LinearMap.SeparatingLeft`, `not_forall`) to get `x ≠ 0` in + `ιk k₀ →₀ R` with `∀ y, Bk k₀ x y = 0`. +* The witness for `¬ B.SeparatingLeft` is `x' := x.sum (fun j r => r • b ⟨k₀, j⟩)` — `x` padded + with zeros outside block `k₀`. +* `x' ≠ 0`: `b` is a basis (so `b ⟨k₀, ·⟩` is injective / linearly independent) and `x ≠ 0`. +* `∀ z, B x' z = 0`: reduce to `z = b l` for `l : Σ k, ιk k` via `Module.Basis.ext` (a linear map + vanishing on a basis is the zero map). Then + `B x' (b l) = x.sum (fun j r => r * (toMatrix b B) ⟨k₀, j⟩ l)` + (unfold via `B.flip (b l) : M →ₗ[R] R`, `map_sum` after `unfold Finsupp.sum` — `map_finsupp_sum` + does not exist under that name in this mathlib version, use `map_sum f (fun a => g a (l a)) + l.support` instead — plus `map_smul`/`smul_eq_mul` and the definitional + `(toMatrix b B) i j = B (b i) (b j)`). + Rewrite the matrix entry via `hB` and `Matrix.blockDiagonal'_apply'`: + - if `k₀ ≠ l.1`: every term is `r * 0`, so the sum is `0` (`Finsupp.sum` of the zero function). + - if `k₀ = l.1` (with `m := cast _ l.2 : ιk k₀`): the sum becomes + `x.sum (fun j r => r * (toMatrix Finsupp.basisSingleOne (Bk k₀)) j m)`, which is exactly + `Bk k₀ x (Finsupp.basisSingleOne m)` run through the *same* unfolding (using + `x = x.sum (fun j r => r • Finsupp.basisSingleOne j)`, from `Finsupp.sum_single` + + `Finsupp.coe_basisSingleOne`) — so it equals `0` by `hx`. -/ +theorem LinearMap.BilinForm.not_separatingLeft_of_toMatrix_eq_blockDiagonal' [DecidableEq κ] + (b : Module.Basis (Σ k, ιk k) R M) (B : LinearMap.BilinForm R M) + (Bk : ∀ k, LinearMap.BilinForm R (ιk k →₀ R)) + (hB : LinearMap.BilinForm.toMatrix b B = + Matrix.blockDiagonal' (fun k => LinearMap.BilinForm.toMatrix Finsupp.basisSingleOne (Bk k))) + {k₀ : κ} (hdeg : ¬ (Bk k₀).SeparatingLeft) : + ¬ B.SeparatingLeft := by + sorry + +end BlockDiagonal + section real /-! ### Positive definite symmetric bilinear forms on real vector spaces -/ @@ -61,6 +101,39 @@ open Real variable {V : Type*} [AddCommGroup V] [Module ℝ V] +section BlockDiagonalPosSemidef + +variable {κ : Type*} {ιk : κ → Type*} + +/-- The positive-semidefinite analogue of +`LinearMap.BilinForm.not_separatingLeft_of_toMatrix_eq_blockDiagonal'`: if the matrix of `B` is +block diagonal with blocks the matrices of `Bk k` (w.r.t. `Finsupp.basisSingleOne`), and every +block `Bk k` is positive semidefinite, then `B` is positive semidefinite. + +Proof idea (currently unproved — pick up here): +* `IsSymm`: `B (b l) (b l') = (toMatrix b B) l l' = blockDiagonal' ... l l'`; this is symmetric in + `l, l'` termwise (`0` off the diagonal blocks, and `(Bk k).IsSymm` on the diagonal block), so + `B.IsSymm` follows from `LinearMap.BilinForm.isSymm_iff_basis b` (already used for `bil_isSymm` + in `Coxeter/GeometricRepresentation.lean`) plus a case split on whether `l, l'` share a block. +* `IsNonneg`, i.e. `∀ x, 0 ≤ B x x`: write `x = b.repr.symm (b.repr x)`; group `b.repr x : (Σ k, ιk + k) →₀ ℝ` by its first (block) coordinate to get, for each block `k` in the *finite* set + `(b.repr x).support.image Sigma.fst`, a vector `xk : ιk k →₀ ℝ` (the restriction of `b.repr x` to + block `k`, via `Finsupp.comapDomain`/`Finsupp.subtypeDomain` composed with `Equiv.sigmaFiberEquiv` + as in `Coxeter/Component.lean`'s `blockEquiv`). Off-diagonal-block terms of `B x x` vanish (same + `blockDiagonal'_apply'` case split as the degenerate-case lemma), so `B x x` reduces to a *finite* + sum `∑ k ∈ s, Bk k xk xk`, and each summand is `≥ 0` by `hpsd k`, hence so is the sum. -/ +theorem LinearMap.BilinForm.isPosSemidef_of_toMatrix_eq_blockDiagonal' [DecidableEq κ] + (b : Module.Basis (Σ k, ιk k) ℝ V) (B : LinearMap.BilinForm ℝ V) + (Bk : ∀ k, LinearMap.BilinForm ℝ (ιk k →₀ ℝ)) + (hB : LinearMap.BilinForm.toMatrix b B = + Matrix.blockDiagonal' (fun k => + LinearMap.BilinForm.toMatrix Finsupp.basisSingleOne (Bk k))) + (hpsd : ∀ k, (Bk k).IsPosSemidef) : + B.IsPosSemidef := by + sorry + +end BlockDiagonalPosSemidef + def Orthonormal {ι : Type*} (B : LinearMap.BilinForm ℝ V) (v : ι → V) := (∀ (i : ι), B (v i) (v i) = 1) ∧ LinearMap.IsOrthoᵢ B v diff --git a/Coxeter/SpecialFeatures.lean b/Coxeter/SpecialFeatures.lean index 0131d7d..1c6df4f 100644 --- a/Coxeter/SpecialFeatures.lean +++ b/Coxeter/SpecialFeatures.lean @@ -1,6 +1,7 @@ module public import Coxeter.GeometricRepresentation +public import Coxeter.Component public import Mathlib.Combinatorics.SimpleGraph.Connectivity.Connected /-! @@ -17,6 +18,14 @@ None of these require the Coxeter diagram to be connected The `Poly` prefix on `IsPolyFiniteWeyl`/`IsPolyAffineWeyl` signals that they allow a *product* of several irreducible finite/affine Weyl groups, not just a single irreducible one. +Each definition's docstring below also records how it interacts with the connected components of +the Coxeter diagram (writing `component_cg` for the sub-Coxeter-system obtained by restricting to +one component): whether *descent* holds (`cg.IsX → component_cg.IsX` for every component), and +whether *assembly* holds (`component_cg.IsX` for every component `⟹ cg.IsX`). This matters because +generators in different components automatically have `M i i' = 2`, hence +`bil (stdBasis i) (stdBasis i') = -cos (π / 2) = 0`: the diagram's components correspond to an +orthogonal direct sum decomposition of `bil`. + ## Main definitions * `Coxeter.IsRightAngled` @@ -40,27 +49,75 @@ variable {W : Type*} {cg : CoxeterGroup W} /-- A Coxeter matrix is *right-angled* if every pair of distinct generators either commutes (`M i i' = 2`) or generates an infinite dihedral subgroup (`M i i' = 0`) — i.e. no relation of -order `3` or more ever occurs between two distinct generators. -/ +order `3` or more ever occurs between two distinct generators. + +- Descent: holds. This is a `∀` over pairs of generators, so it restricts to any subset for free. +- Assembly: holds. `assembles_rightAngled` -/ def IsRightAngled : Prop := ∀ i i' : B W, i ≠ i' → M i i' = 2 ∨ M i i' = 0 -def IsCrystallographicMatrix {B1 : Type*} (M1 : Matrix B1 B1 ℕ) : Prop := - ∀ i i' : B1, i ≠ i' → M1 i i' = 0 ∨ M1 i i' = 2 ∨ M1 i i' = 3 ∨ M1 i i' = 4 ∨ M1 i i' = 6 +/- +Generators in different components already have `M i i' = 2`, which satisfies +the disjunction for free, so `cg.IsRightAngled` holds iff every component does. +-/ +lemma assembles_rightAngled : + Assembles + fun [W1 : Type*] (cg1 : CoxeterGroup W1) => @IsRightAngled W1 cg1 + := by + unfold Assembles + intro W1 cg1 finitely_many_comp on_components + unfold IsRightAngled + set cg1_graph := coxeterGraphMatrix cg1.M + intro i i' hii' + by_cases same_comp : cg1_graph.Reachable i i' + · set c := cg1_graph.connectedComponentMk i + have hi : i ∈ c.supp := rfl + have hi' : i' ∈ c.supp := (SimpleGraph.ConnectedComponent.sound same_comp).symm + have hne : (⟨i, hi⟩ : c.supp) ≠ ⟨i', hi'⟩ := fun h => hii' (congrArg Subtype.val h) + exact on_components c ⟨i, hi⟩ ⟨i', hi'⟩ hne + · exact Or.inl (M_eq_two_of_connectedComponentMk_ne cg1 + (fun heq => same_comp (SimpleGraph.ConnectedComponent.eq.mp heq))) /-- A Coxeter matrix is *crystallographic* if every pair of distinct generators either generates an infinite dihedral subgroup (`M i i' = 0`) or one of order `2 * M i i'` for `M i i' ∈ {2, 3, 4, 6}` -— the restriction on dihedral angles forced by requiring the reflections to preserve a lattice. -/ +— the restriction on dihedral angles forced by requiring the reflections to preserve a lattice. + +- Descent: holds, for the same reason as `IsRightAngled` — a `∀` over pairs restricts freely. +- Assembly: holds. `assembles_crystallographic` -/ def IsCrystallographic : Prop := - IsCrystallographicMatrix (B1 := B W) (M1 := cg.M) + ∀ i i' : cg.B, i ≠ i' → + cg.M i i' = 0 ∨ cg.M i i' = 2 ∨ + cg.M i i' = 3 ∨ cg.M i i' = 4 ∨ cg.M i i' = 6 -/-- The graph on generators with an edge between `i ≠ i'` whenever `M i i' ≠ 2` (the two simple -reflections don't commute) — the *Coxeter diagram*, as a `SimpleGraph`. -/ -def coxeterGraphMatrix {B1 : Type*} (M1 : CoxeterMatrix B1) : - SimpleGraph B1 := SimpleGraph.fromRel (M1 · · ≠ 2) +/- +Cross-component entries are `2 ∈ {0, 2, 3, 4, 6}` for free, so +`cg.IsCrystallographic` holds iff every component does. +-/ +lemma assembles_crystallographic : + Assembles + fun [W1 : Type*] (cg1 : CoxeterGroup W1) => @IsCrystallographic W1 cg1 + := by + unfold Assembles + intro W1 cg1 finitely_many_comp on_components + unfold IsCrystallographic + set cg1_graph := coxeterGraphMatrix cg1.M + intro i i' hii' + by_cases same_comp : cg1_graph.Reachable i i' + · set c := cg1_graph.connectedComponentMk i + have hi : i ∈ c.supp := rfl + have hi' : i' ∈ c.supp := (SimpleGraph.ConnectedComponent.sound same_comp).symm + have hne : (⟨i, hi⟩ : c.supp) ≠ ⟨i', hi'⟩ := fun h => hii' (congrArg Subtype.val h) + exact on_components c ⟨i, hi⟩ ⟨i', hi'⟩ hne + · exact Or.inr (Or.inl (M_eq_two_of_connectedComponentMk_ne cg1 + (fun heq => same_comp (SimpleGraph.ConnectedComponent.eq.mp heq)))) /-- A Coxeter matrix is *irreducible* if its Coxeter diagram (`coxeterGraphMatrix`) is connected. -/ def IsIrreducibleMatrix {B1 : Type*} (M1 : CoxeterMatrix B1) : Prop := (coxeterGraphMatrix M1).Connected +/-- - Descent: holds, but vacuously — a connected component is connected by definition, so + `component_cg.IsIrreducible` holds unconditionally, whether or not `cg.IsIrreducible` does. + - Assembly: fails. "Every component is connected" is always true and carries no information + about whether there is only *one* component, so it cannot imply `cg.IsIrreducible`. -/ def IsIrreducible : Prop := IsIrreducibleMatrix (M1 := cg.M) @@ -77,20 +134,34 @@ def deleteGenerator (i₀ : B W) : /-- `W` is of *finite type*: either finite, or `bil` is positive semidefinite and nondegenerate (i.e. positive definite — `IsPosDef` isn't a separate notion in Mathlib for bilinear forms). Stated as an *or*, not an *iff*: the classical equivalence `W` finite ↔ `bil` positive definite isn't -proved here, so satisfying either disjunct is the obligation, not both. -/ +proved here, so satisfying either disjunct is the obligation, not both. + +- Descent: holds, via either disjunct — a direct factor of a finite group is finite, and a block + of a positive-definite form is positive-definite. +- Assembly: holds, symmetrically — a finite product of finite groups is finite, and an orthogonal + sum of positive-definite blocks is positive-definite (assuming finitely many components; an + infinite product of nontrivial finite groups is infinite). -/ def IsFiniteCoxeter : Prop := Finite W ∨ ( (@bil W _).IsPosSemidef ∧ (@bil W _).Nondegenerate ) /-- `W` is a *product of finite Weyl groups*: -`IsFiniteCoxeter` together with `IsCrystallographic`. -/ +`IsFiniteCoxeter` together with `IsCrystallographic`. + +- Descent: holds — conjunction of two properties that each descend. +- Assembly: holds — conjunction of two properties that each assemble. -/ def IsPolyFiniteWeyl : Prop := @IsFiniteCoxeter W cg ∧ @IsCrystallographic W cg /-- `W` is an *irreducible finite Weyl group*: `IsPolyFiniteWeyl` together with `IsIrreducible` -(the Coxeter diagram is connected) — the genuine, single (not a product) case. -/ +(the Coxeter diagram is connected) — the genuine, single (not a product) case. + +- Descent: holds, but vacuously, via the `IsIrreducible` conjunct. +- Assembly: fails, via the `IsIrreducible` conjunct — if there are ≥2 components each individually + an irreducible finite Weyl group, their union is reducible, so it isn't `IsIrreducibleFiniteWeyl` + even though the `IsPolyFiniteWeyl` part would assemble fine. -/ def IsIrreducibleFiniteWeyl : Prop := @IsPolyFiniteWeyl W cg ∧ @IsIrreducible W cg @@ -99,10 +170,67 @@ def IsIrreducibleFiniteWeyl : Prop := This covers the properly-degenerate case. That is the only restriction on how large the degenerate (radical) directions are. It is at least 1, but can be more. --/ + +- Descent: fails. `bil` positive semidefinite does descend to each block, but degeneracy of the + whole form doesn't: `cg` can be degenerate because of just one "bad" component while a + finite-type sibling component stays nondegenerate on its own, failing `IsAffineCoxeter` there. +- Assembly: holds, given at least one component — see `assembles_affineCoxeter`. If every + component's block is positive semidefinite and degenerate, the orthogonal sum is positive + semidefinite (sum of psd) and degenerate (its kernel contains each block's nonzero kernel). -/ def IsAffineCoxeter : Prop := (@bil W _).IsPosSemidef ∧ ¬ (@bil W _).Nondegenerate +/-- `IsAffineCoxeter`, or `cg` has no generators at all. Plain `IsAffineCoxeter` isn't an instance +of `Assembles`: on the empty diagram (zero components), `V W` is the trivial module, on which `bil` +is vacuously `Nondegenerate`, so `IsAffineCoxeter` is false there while `∀ c, IsAffineCoxeter +(component c)` is vacuously true. Weakening to this "or empty" version fixes it: the extra disjunct +is only ever needed exactly when `cg` itself has no generators, and is never needed for an +individual component, since a connected component's own sub-diagram always has itself as an +inhabitant (`SimpleGraph.ConnectedComponent.nonempty_supp`) — so it's never vacuously empty. -/ +def IsAffineCoxeterOrEmpty : Prop := IsEmpty (B W) ∨ @IsAffineCoxeter W cg + +/- +TODO: the proof needs infrastructure that doesn't exist yet — that `bil` is an orthogonal direct +sum of the components' own `bil`s (`bil x x = ∑ c, bil xc xc` where `xc` is `x` restricted to +component `c`, via `Finsupp.filter`/`Finsupp.subtypeDomain`). This is the same missing "block +structure on connected components" noted on `IsPolyAffineWeyl` below. +-/ +lemma assembles_affineCoxeter : + Assembles + fun [W1 : Type*] (cg1 : CoxeterGroup W1) => @IsAffineCoxeterOrEmpty W1 cg1 + := by + unfold Assembles + intro W1 cg1 finitely_many_comp on_components + unfold IsAffineCoxeterOrEmpty + by_cases empty : IsEmpty (B W1) + · exact Or.inl empty + · refine Or.inr ?obligation + unfold IsAffineCoxeter + set bil_c := fun c : (coxeterGraphMatrix cg1.M).ConnectedComponent => + @bil _ (componentCoxeterGroup cg1 c) with bil_c_def + have on_components' : ∀ c : (coxeterGraphMatrix cg1.M).ConnectedComponent, + (bil_c c).IsPosSemidef ∧ ¬ (bil_c c).Nondegenerate := by + intro c + rcases on_components c with hempty | haffine + · obtain ⟨v, hv⟩ := c.nonempty_supp + exact hempty.elim ⟨v, hv⟩ + · exact haffine + have arbitrary_component : (coxeterGraphMatrix cg1.M).ConnectedComponent := by + have arbitrary_gen : B W1 := Classical.arbitrary (B W1) + (h:=not_isEmpty_iff.mp empty) + exact (coxeterGraphMatrix cg1.M).connectedComponentMk arbitrary_gen + have on_arbitrary := on_components' arbitrary_component + unfold IsAffineCoxeterOrEmpty at on_arbitrary + have on_arbitrary := on_arbitrary.right + unfold LinearMap.BilinForm.Nondegenerate at on_arbitrary + unfold LinearMap.Nondegenerate at on_arbitrary + rw [not_and] at on_arbitrary + have on_components'' : ∀ c : (coxeterGraphMatrix cg1.M).ConnectedComponent, + (bil_c c).IsPosSemidef := by + intro c + exact (on_components' c).left + sorry + /-- A particular kind of affine Coxeter system (`IsAffineCoxeter`), characterized the classical way. Deleting a single node from the Coxeter diagram recovers a finite part. @@ -116,7 +244,23 @@ Concretely: (the diagonal entry `bil (stdBasis i₀) (stdBasis i₀) = 1` rules out the kernel being spanned by `stdBasis i₀` alone) - Deleting `i₀` (`deleteGenerator i₀`) then recovers the - finite part. -/ + finite part. +We do not have the classification result available. So we cannot +go from `IsAffineCoxeter` to disjoint union of connected `IsAffineCoxeter` +and from there to disjoint union of several possibilities all of which have nullity at +most 1. We also do not have the block structure on connected components needed +to write `δ` in terms of `B_a^-1 B_{i0, a_j}` where `a` indexes the components upon +removing `i0` and `a_j` indexes the nodes within that component. + +- Descent: fails, worse than `IsAffineCoxeter`. The `∃ i₀, δ` clause pins the *total* nullity of + `bil` to exactly `1`; since the kernel of an orthogonal direct sum is the direct sum of the + kernels, `cg` satisfying this has exactly one component with nullity `1` and every other + component nondegenerate, so `IsPolyAffineWeyl` fails on those nondegenerate components. +- Assembly: fails, in the opposite direction. If *every* component individually had nullity `1`, + the total nullity would be the number of components, not `1`, unless there is only one + component. The real per-component statement is a *mixed* one — exactly one component is + `IsIrreducibleAffineWeyl` and the rest are `IsIrreducibleFiniteWeyl` — not "the same property on + every component". -/ def IsPolyAffineWeyl : Prop := (@bil W _).IsPosSemidef ∧ @IsCrystallographic W cg ∧ @@ -124,7 +268,11 @@ def IsPolyAffineWeyl : Prop := LinearMap.ker (@bil W _) = Submodule.span ℝ {stdBasis i₀ + δ} /-- `W` is an *irreducible affine Weyl group*: `IsPolyAffineWeyl` together with `IsIrreducible` -(the Coxeter diagram is connected) — the genuine, single (not a product) case. -/ +(the Coxeter diagram is connected) — the genuine, single (not a product) case. + +- Descent: holds, but vacuously, via the `IsIrreducible` conjunct. +- Assembly: fails, via the `IsIrreducible` conjunct, compounded by the nullity-counting failure of + `IsPolyAffineWeyl` (several irreducible affine components would sum to nullity `> 1`). -/ def IsIrreducibleAffineWeyl : Prop := @IsPolyAffineWeyl W cg ∧ @IsIrreducible W cg From 505b25c03de9e62eaa6660c2bef4dccc03dc53b8 Mon Sep 17 00:00:00 2001 From: Cobord Date: Tue, 7 Jul 2026 14:39:10 -0400 Subject: [PATCH 10/12] finish assembly of special features, example of usage of Is... with type A --- Coxeter.lean | 1 + Coxeter/Component.lean | 20 ++ Coxeter/FiniteOrAffine/TypeA.lean | 303 ++++++++++++++++++++++++ Coxeter/GeometricRepresentation.lean | 2 +- Coxeter/LinearAlgebra/BilinearForm.lean | 233 ++++++++++++++---- Coxeter/SpecialFeatures.lean | 49 +++- 6 files changed, 556 insertions(+), 52 deletions(-) create mode 100644 Coxeter/FiniteOrAffine/TypeA.lean diff --git a/Coxeter.lean b/Coxeter.lean index 2da771d..be039b3 100644 --- a/Coxeter.lean +++ b/Coxeter.lean @@ -6,6 +6,7 @@ public import Coxeter.Bruhat public import Coxeter.Component public import Coxeter.Dihedral public import Coxeter.Data.List.Lemmas +public import Coxeter.FiniteOrAffine.TypeA public import Coxeter.GeometricRepresentation public import Coxeter.Hecke public import Coxeter.LinearAlgebra.AssociatedGraded diff --git a/Coxeter/Component.lean b/Coxeter/Component.lean index 49d0732..e7e7f3d 100644 --- a/Coxeter/Component.lean +++ b/Coxeter/Component.lean @@ -203,4 +203,24 @@ def Assembles (P : ∀ {W : Type v}, CoxeterGroup.{v, v} W → Prop) : Prop := [Finite (coxeterGraphMatrix cg.M).ConnectedComponent], (∀ c : (coxeterGraphMatrix cg.M).ConnectedComponent, P (componentCoxeterGroup cg c)) → P cg +lemma assembles_combination + (P Q : ∀ {W : Type v}, CoxeterGroup.{v, v} W → Prop) : + Assembles P -> Assembles Q -> Assembles (fun x => P x ∧ Q x) := by + intro assembles_P assembles_Q W cg finiteness on_components_PQ + have on_componentsP' : ∀ c : (coxeterGraphMatrix cg.M).ConnectedComponent, + P (componentCoxeterGroup cg c) := by + intro c + have key := on_components_PQ c + simp at key + exact key.left + have on_componentsQ' : ∀ c : (coxeterGraphMatrix cg.M).ConnectedComponent, + Q (componentCoxeterGroup cg c) := by + intro c + have key := on_components_PQ c + simp at key + exact key.right + have p_part := assembles_P cg on_componentsP' + have q_part := assembles_Q cg on_componentsQ' + exact And.intro p_part q_part + end Coxeter diff --git a/Coxeter/FiniteOrAffine/TypeA.lean b/Coxeter/FiniteOrAffine/TypeA.lean new file mode 100644 index 0000000..d1a2133 --- /dev/null +++ b/Coxeter/FiniteOrAffine/TypeA.lean @@ -0,0 +1,303 @@ +module + +public import Coxeter.SpecialFeatures +public import Mathlib.Combinatorics.SimpleGraph.Hasse + +/-! +# The Coxeter group of type A + +This file packages mathlib's `CoxeterMatrix.A n` (the Coxeter matrix whose Coxeter-Dynkin diagram +is a path on `n` vertices, corresponding to the symmetric group `S_(n+1)`) into a `CoxeterGroup` +instance, and verifies all of the `SpecialFeatures.lean` properties that apply to it: +`IsCrystallographic`, `IsIrreducible`, and (on `m + 1` generators) `IsFiniteCoxeter`, +`IsPolyFiniteWeyl`, `IsIrreducibleFiniteWeyl`. + +We use the abstract presented group `(CoxeterMatrix.A n).Group` (mathlib gives us a +`CoxeterSystem` on it for free via `CoxeterMatrix.toCoxeterSystem`), exactly as +`Coxeter.componentCoxeterGroup` does for the components of a general Coxeter diagram. We do *not* +identify this group with `Equiv.Perm (Fin (n + 1))` here. + +Finiteness is established via the bilinear form, not via `Finite W`: the (doubled) Gram matrix of +`bil` on type A's standard basis — `1` on the diagonal, `-1/2` on adjacent off-diagonal entries, +`0` elsewhere — is a sum of squares (`sos_identity`/`sum_range_double`): +`2 * (∑ y_i^2 - ∑ y_i y_{i+1}) = y_0^2 + y_m^2 + ∑ (y_i - y_{i+1})^2`. Reading off `≥ 0` gives +`bil.IsPosSemidef`; forcing every square to vanish when the form is `0` gives `bil.Nondegenerate`. + +## Main definitions + +* `Coxeter.typeAGroup` + +## Main statements + +* `Coxeter.typeA_isCrystallographic` +* `Coxeter.typeA_isIrreducible` +* `Coxeter.typeA_isFiniteCoxeter` +* `Coxeter.typeA_isPolyFiniteWeyl` +* `Coxeter.typeA_isIrreducibleFiniteWeyl` +-/ + +@[expose] public section + +namespace Coxeter + +/-- The Coxeter group of type `A` on `n` generators, realized as the abstract group presented by +`CoxeterMatrix.A n` (whose Coxeter-Dynkin diagram is a path on `n` vertices). -/ +@[reducible] noncomputable def typeAGroup (n : ℕ) : CoxeterGroup (CoxeterMatrix.A n).Group where + B := Fin n + M := CoxeterMatrix.A n + cs := (CoxeterMatrix.A n).toCoxeterSystem + +/-- Type `A`'s off-diagonal entries are always `2` or `3`, both in the crystallographic set +`{0, 2, 3, 4, 6}`. -/ +theorem typeA_isCrystallographic (n : ℕ) : @IsCrystallographic _ (typeAGroup n) := by + intro i i' hii' + change (CoxeterMatrix.A n) i i' = 0 ∨ (CoxeterMatrix.A n) i i' = 2 ∨ + (CoxeterMatrix.A n) i i' = 3 ∨ (CoxeterMatrix.A n) i i' = 4 ∨ (CoxeterMatrix.A n) i i' = 6 + unfold CoxeterMatrix.A + simp only [Matrix.of_apply, if_neg hii'] + split_ifs <;> tauto + +/-- Type `A`'s Coxeter-Dynkin diagram is literally the path graph on `n` vertices: two distinct +generators `i ≠ j` are joined exactly when `CoxeterMatrix.A n i j ≠ 2`, which (by the matrix's +definition) happens exactly when `i` and `j` are consecutive. -/ +private theorem coxeterGraphMatrix_typeA_eq_pathGraph (n : ℕ) : + coxeterGraphMatrix (CoxeterMatrix.A n) = SimpleGraph.pathGraph n := by + ext i j + rw [coxeterGraphMatrix, SimpleGraph.fromRel_adj, SimpleGraph.pathGraph_adj] + unfold CoxeterMatrix.A + simp only [Matrix.of_apply, ne_eq] + by_cases h : i = j + · simp [h] + · rw [if_neg h, if_neg (Ne.symm h)] + have hiff1 : ¬(if (j : ℕ) + 1 = i ∨ (i : ℕ) + 1 = j then (3 : ℕ) else 2) = 2 ↔ + ((j : ℕ) + 1 = i ∨ (i : ℕ) + 1 = j) := by + split_ifs with hp + · simp [hp] + · simp [hp] + have hiff2 : ¬(if (i : ℕ) + 1 = j ∨ (j : ℕ) + 1 = i then (3 : ℕ) else 2) = 2 ↔ + ((i : ℕ) + 1 = j ∨ (j : ℕ) + 1 = i) := by + split_ifs with hp + · simp [hp] + · simp [hp] + rw [hiff1, hiff2] + tauto + +/-- Type `A` on `n + 1` generators (`n ≥ 0`, i.e. the Coxeter-Dynkin diagram is nonempty) is +irreducible: its diagram is the path graph on `n + 1` vertices, which is connected. -/ +theorem typeA_isIrreducible (n : ℕ) : @IsIrreducible _ (typeAGroup (n + 1)) := by + unfold IsIrreducible IsIrreducibleMatrix + change (coxeterGraphMatrix (CoxeterMatrix.A (n + 1))).Connected + rw [coxeterGraphMatrix_typeA_eq_pathGraph] + exact SimpleGraph.pathGraph_connected n + +/-! ### Positive definiteness of `bil` for type A + +The tridiagonal quadratic form `Q(y) = ∑_{i simp; ring + | succ m ih => + rw [Finset.sum_range_succ (f := fun i => (y i) ^ 2), + Finset.sum_range_succ (f := fun i => y i * y (i + 1)), + Finset.sum_range_succ (f := fun i => (y i - y (i + 1)) ^ 2)] + linear_combination ih + +/-- The entry function of the (doubled) type-A quadratic form: `1` on the diagonal, `-1/2` on +adjacent off-diagonal entries, `0` elsewhere. -/ +private noncomputable def typeAEntry (i j : ℕ) : ℝ := + if i = j then 1 else if j + 1 = i ∨ i + 1 = j then -(1 / 2) else 0 + +/-- The double sum against `typeAEntry` collapses to the tridiagonal quadratic form `Q(y)` from +`sos_identity`: only the diagonal and immediately-adjacent entries of `typeAEntry` are nonzero. -/ +private theorem sum_range_double (y : ℕ → ℝ) (m : ℕ) : + (∑ i ∈ Finset.range (m + 1), ∑ j ∈ Finset.range (m + 1), y i * y j * typeAEntry i j) + = ∑ i ∈ Finset.range (m + 1), (y i) ^ 2 - ∑ i ∈ Finset.range m, y i * y (i + 1) := by + induction m with + | zero => simp [typeAEntry]; ring + | succ m ih => + have hL : ∀ i ∈ Finset.range (m + 1), + y i * y (m + 1) * typeAEntry i (m + 1) = + if i = m then y i * y (m + 1) * (-(1 / 2)) else 0 := by + intro i hi + simp only [Finset.mem_range] at hi + by_cases hc : i = m + · subst hc + simp [typeAEntry] + · rw [if_neg hc] + unfold typeAEntry + rw [if_neg (by omega : ¬ i = m + 1), + if_neg (by omega : ¬ ((m + 1) + 1 = i ∨ i + 1 = m + 1))] + ring + have hR : ∀ j ∈ Finset.range (m + 1), + y (m + 1) * y j * typeAEntry (m + 1) j = + if j = m then y (m + 1) * y j * (-(1 / 2)) else 0 := by + intro j hj + simp only [Finset.mem_range] at hj + by_cases hc : j = m + · subst hc + simp [typeAEntry] + · rw [if_neg hc] + unfold typeAEntry + rw [if_neg (by omega : ¬ (m + 1) = j), + if_neg (by omega : ¬ (j + 1 = m + 1 ∨ (m + 1) + 1 = j))] + ring + have hmem : m ∈ Finset.range (m + 1) := Finset.self_mem_range_succ m + have expand : ∀ i ∈ Finset.range (m + 1), + ∑ j ∈ Finset.range (m + 1 + 1), y i * y j * typeAEntry i j + = (∑ j ∈ Finset.range (m + 1), y i * y j * typeAEntry i j) + + (if i = m then y i * y (m + 1) * (-(1 / 2)) else 0) := by + intro i hi + rw [Finset.sum_range_succ, hL i hi] + rw [Finset.sum_range_succ (f := fun i => + ∑ j ∈ Finset.range (m + 1 + 1), y i * y j * typeAEntry i j), + Finset.sum_congr rfl expand, Finset.sum_add_distrib, + Finset.sum_ite_eq' (Finset.range (m + 1)) m + (fun i => y i * y (m + 1) * (-(1 / 2 : ℝ))), + if_pos hmem] + rw [Finset.sum_range_succ (f := fun j => y (m + 1) * y j * typeAEntry (m + 1) j), + Finset.sum_congr rfl hR, + Finset.sum_ite_eq' (Finset.range (m + 1)) m + (fun j => y (m + 1) * y j * (-(1 / 2 : ℝ))), + if_pos hmem] + have hdiag : typeAEntry (m + 1) (m + 1) = 1 := if_pos rfl + rw [hdiag, ih, Finset.sum_range_succ (f := fun i => (y i) ^ 2) (n := m + 1), + Finset.sum_range_succ (f := fun i => y i * y (i + 1)) (n := m)] + ring + +/-- The Gram matrix entries of `bil` on standard basis vectors of type A match `typeAEntry`. -/ +private theorem bil_typeA_entries (m : ℕ) (i j : Fin (m + 1)) : + (@bil _ (typeAGroup (m + 1))) (@stdBasis _ (typeAGroup (m + 1)) i) + (@stdBasis _ (typeAGroup (m + 1)) j) = typeAEntry (i : ℕ) (j : ℕ) := by + unfold bil + rw [Matrix.toBilin_single] + change -Real.cos (Real.pi / ((CoxeterMatrix.A (m + 1)) i j : ℝ)) = typeAEntry (i : ℕ) (j : ℕ) + unfold CoxeterMatrix.A typeAEntry + simp only [Matrix.of_apply] + by_cases hij : i = j + · have hij' : (i : ℕ) = (j : ℕ) := by rw [hij] + rw [if_pos hij, if_pos hij'] + norm_num + · have hij' : (i : ℕ) ≠ (j : ℕ) := fun h => hij (Fin.ext h) + rw [if_neg hij, if_neg hij'] + split_ifs with hadj + · rw [show ((3 : ℕ) : ℝ) = 3 by norm_num, Real.cos_pi_div_three] + · rw [show ((2 : ℕ) : ℝ) = 2 by norm_num, Real.cos_pi_div_two] + norm_num + +/-- Extends `x : Fin (m + 1) →₀ ℝ` to a function on all of `ℕ`, vanishing past `m`. -/ +private noncomputable def typeAExtend (m : ℕ) (x : Fin (m + 1) →₀ ℝ) : ℕ → ℝ := + fun k => if h : k < m + 1 then x ⟨k, h⟩ else 0 + +private theorem typeAExtend_apply_fin (m : ℕ) (x : Fin (m + 1) →₀ ℝ) (i : Fin (m + 1)) : + typeAExtend m x (i : ℕ) = x i := by + unfold typeAExtend + rw [dif_pos i.isLt] + +/-- `bil x x` for type A, spelled out as the tridiagonal quadratic form on the `ℕ`-extension of +`x`'s coordinates. -/ +private theorem bil_typeA_apply (m : ℕ) (x : Fin (m + 1) →₀ ℝ) : + (@bil _ (typeAGroup (m + 1))) x x + = ∑ i ∈ Finset.range (m + 1), (typeAExtend m x i) ^ 2 + - ∑ i ∈ Finset.range m, typeAExtend m x i * typeAExtend m x (i + 1) := by + rw [← sum_range_double (typeAExtend m x) m] + have hrepr : (@stdBasis _ (typeAGroup (m + 1))).repr x = x := rfl + have key : (@bil _ (typeAGroup (m + 1))) x x + = ∑ i : Fin (m + 1), ∑ j : Fin (m + 1), + x i * x j * (@bil _ (typeAGroup (m + 1))) + (@stdBasis _ (typeAGroup (m + 1)) i) (@stdBasis _ (typeAGroup (m + 1)) j) := by + rw [← LinearMap.BilinForm.sum_repr_mul_repr_mul + (B := @bil _ (typeAGroup (m + 1))) (@stdBasis _ (typeAGroup (m + 1))) x x, hrepr, + Finsupp.sum_fintype x _ (fun i => by simp)] + refine Finset.sum_congr rfl (fun i _ => ?_) + rw [Finsupp.sum_fintype x _ (fun j => by simp)] + simp only [smul_eq_mul, ← mul_assoc] + rw [key] + have hentry : ∀ i j : Fin (m + 1), + x i * x j * (@bil _ (typeAGroup (m + 1))) + (@stdBasis _ (typeAGroup (m + 1)) i) (@stdBasis _ (typeAGroup (m + 1)) j) + = typeAExtend m x (i : ℕ) * typeAExtend m x (j : ℕ) * typeAEntry (i : ℕ) (j : ℕ) := by + intro i j + rw [bil_typeA_entries, typeAExtend_apply_fin, typeAExtend_apply_fin] + rw [Finset.sum_congr rfl (fun i (_ : i ∈ (Finset.univ : Finset (Fin (m + 1)))) => + Finset.sum_congr rfl (fun j (_ : j ∈ (Finset.univ : Finset (Fin (m + 1)))) => hentry i j))] + rw [Fin.sum_univ_eq_sum_range (fun i => ∑ j : Fin (m + 1), + typeAExtend m x i * typeAExtend m x j * typeAEntry i j) (m + 1)] + refine Finset.sum_congr rfl (fun i _ => ?_) + exact Fin.sum_univ_eq_sum_range (fun j => typeAExtend m x i * typeAExtend m x j * typeAEntry i j) + (m + 1) + +/-- Type A's `bil` is positive semidefinite: `bil x x ≥ 0` for every `x`, since (doubled) it's a +sum of squares by `sos_identity`. -/ +private theorem bil_typeA_isNonneg (m : ℕ) : (@bil _ (typeAGroup (m + 1))).IsNonneg := by + rw [LinearMap.BilinForm.isNonneg_def] + intro x + rw [bil_typeA_apply] + have h := sos_identity (typeAExtend m x) m + have hC : 0 ≤ ∑ i ∈ Finset.range m, (typeAExtend m x i - typeAExtend m x (i + 1)) ^ 2 := + Finset.sum_nonneg (fun i _ => sq_nonneg _) + nlinarith [h, sq_nonneg (typeAExtend m x 0), sq_nonneg (typeAExtend m x m), hC] + +/-- Type A's `bil` is nondegenerate: if `bil x x = 0`, the sum-of-squares identity forces every +`typeAExtend m x i` (`i ≤ m`) to vanish, i.e. `x = 0`. -/ +private theorem bil_typeA_nondegenerate (m : ℕ) : (@bil _ (typeAGroup (m + 1))).Nondegenerate := by + unfold LinearMap.BilinForm.Nondegenerate + rw [LinearMap.BilinForm.nondegenerate_iff' + (hs := (bil_typeA_isNonneg m).nonneg) + (hB := LinearMap.BilinForm.isSymm_iff.mp (@bil_isSymm _ (typeAGroup (m + 1))))] + intro x hx + rcases ((bil_typeA_isNonneg m).nonneg x).lt_or_eq with h | h + · exact h + · exfalso + apply hx + have hzero : (@bil _ (typeAGroup (m + 1))) x x = 0 := h.symm + rw [bil_typeA_apply] at hzero + set y := typeAExtend m x with hy_def + have hsos := sos_identity y m + have hC : 0 ≤ ∑ i ∈ Finset.range m, (y i - y (i + 1)) ^ 2 := + Finset.sum_nonneg (fun i _ => sq_nonneg _) + have h0sq : y 0 ^ 2 = 0 := by nlinarith [hsos, hzero, sq_nonneg (y m), hC] + have hCsum : ∑ i ∈ Finset.range m, (y i - y (i + 1)) ^ 2 = 0 := by + nlinarith [hsos, hzero, sq_nonneg (y 0), sq_nonneg (y m)] + have h0 : y 0 = 0 := sq_eq_zero_iff.mp h0sq + have hstep : ∀ i ∈ Finset.range m, y i = y (i + 1) := by + intro i hi + have hzero_term : (y i - y (i + 1)) ^ 2 = 0 := + (Finset.sum_eq_zero_iff_of_nonneg (fun i _ => sq_nonneg _)).mp hCsum i hi + have := sq_eq_zero_iff.mp hzero_term + linarith + have hall : ∀ i ≤ m, y i = 0 := by + intro i hi + induction i with + | zero => exact h0 + | succ k ih => + have hk : k < m := by omega + rw [← hstep k (Finset.mem_range.mpr hk)] + exact ih (by omega) + apply Finsupp.ext + intro i + have hi : (i : Fin (m + 1)).val ≤ m := by omega + have hi0 : y (i : Fin (m + 1)).val = 0 := hall _ hi + rw [hy_def, typeAExtend_apply_fin] at hi0 + simpa using hi0 + +/-- Type A on `m + 1` generators is of finite type: `bil` is positive semidefinite and +nondegenerate (i.e. positive definite). -/ +theorem typeA_isFiniteCoxeter (m : ℕ) : @IsFiniteCoxeter _ (typeAGroup (m + 1)) := + Or.inr ⟨⟨@bil_isSymm _ (typeAGroup (m + 1)), bil_typeA_isNonneg m⟩, bil_typeA_nondegenerate m⟩ + +/-- Type A on `m + 1` generators is a (product of) finite Weyl group(s). -/ +theorem typeA_isPolyFiniteWeyl (m : ℕ) : @IsPolyFiniteWeyl _ (typeAGroup (m + 1)) := + ⟨typeA_isFiniteCoxeter m, typeA_isCrystallographic (m + 1)⟩ + +/-- Type A on `m + 1` generators is an *irreducible* finite Weyl group. -/ +theorem typeA_isIrreducibleFiniteWeyl (m : ℕ) : @IsIrreducibleFiniteWeyl _ (typeAGroup (m + 1)) := + ⟨typeA_isPolyFiniteWeyl m, typeA_isIrreducible m⟩ + +end Coxeter diff --git a/Coxeter/GeometricRepresentation.lean b/Coxeter/GeometricRepresentation.lean index b47544c..d9478ed 100644 --- a/Coxeter/GeometricRepresentation.lean +++ b/Coxeter/GeometricRepresentation.lean @@ -48,7 +48,7 @@ def stdBasis : Module.Basis (B W) ℝ (V W) := Finsupp.basisSingleOne -- `-cos (π / M i i') = -1`, matching the `m → ∞` limit of `-cos (π / m)`. def bil : LinearMap.BilinForm ℝ (V W) := Matrix.toBilin stdBasis (fun i i' => -cos (π / M i i')) -private theorem bil_isSymm : (@bil W _).IsSymm := by +theorem bil_isSymm : (@bil W _).IsSymm := by rw [LinearMap.BilinForm.isSymm_iff_basis stdBasis] intro i i' unfold bil diff --git a/Coxeter/LinearAlgebra/BilinearForm.lean b/Coxeter/LinearAlgebra/BilinearForm.lean index 830832b..b7d0fd3 100644 --- a/Coxeter/LinearAlgebra/BilinearForm.lean +++ b/Coxeter/LinearAlgebra/BilinearForm.lean @@ -62,26 +62,10 @@ is block diagonal, with each block itself the matrix of a bilinear form `Bk k` o `ιk k →₀ R` (w.r.t. its standard basis `Finsupp.basisSingleOne`), and some block `Bk k₀` is degenerate (not left-separating), then `B` itself is degenerate. -Proof idea (currently unproved — pick up here): -* Unfold `¬ (Bk k₀).SeparatingLeft` (`LinearMap.SeparatingLeft`, `not_forall`) to get `x ≠ 0` in - `ιk k₀ →₀ R` with `∀ y, Bk k₀ x y = 0`. -* The witness for `¬ B.SeparatingLeft` is `x' := x.sum (fun j r => r • b ⟨k₀, j⟩)` — `x` padded - with zeros outside block `k₀`. -* `x' ≠ 0`: `b` is a basis (so `b ⟨k₀, ·⟩` is injective / linearly independent) and `x ≠ 0`. -* `∀ z, B x' z = 0`: reduce to `z = b l` for `l : Σ k, ιk k` via `Module.Basis.ext` (a linear map - vanishing on a basis is the zero map). Then - `B x' (b l) = x.sum (fun j r => r * (toMatrix b B) ⟨k₀, j⟩ l)` - (unfold via `B.flip (b l) : M →ₗ[R] R`, `map_sum` after `unfold Finsupp.sum` — `map_finsupp_sum` - does not exist under that name in this mathlib version, use `map_sum f (fun a => g a (l a)) - l.support` instead — plus `map_smul`/`smul_eq_mul` and the definitional - `(toMatrix b B) i j = B (b i) (b j)`). - Rewrite the matrix entry via `hB` and `Matrix.blockDiagonal'_apply'`: - - if `k₀ ≠ l.1`: every term is `r * 0`, so the sum is `0` (`Finsupp.sum` of the zero function). - - if `k₀ = l.1` (with `m := cast _ l.2 : ιk k₀`): the sum becomes - `x.sum (fun j r => r * (toMatrix Finsupp.basisSingleOne (Bk k₀)) j m)`, which is exactly - `Bk k₀ x (Finsupp.basisSingleOne m)` run through the *same* unfolding (using - `x = x.sum (fun j r => r • Finsupp.basisSingleOne j)`, from `Finsupp.sum_single` + - `Finsupp.coe_basisSingleOne`) — so it equals `0` by `hx`. -/ +The witness for `¬ B.SeparatingLeft` is the padded vector `Finsupp.linearCombination R +(fun j => b ⟨k₀, j⟩) x`, where `x` witnesses the degeneracy of `Bk k₀`: it is nonzero since +`b ⟨k₀, ·⟩` is linearly independent, and it is left-orthogonal to all of `B` since `B`'s matrix +vanishes off the `k₀`-block. -/ theorem LinearMap.BilinForm.not_separatingLeft_of_toMatrix_eq_blockDiagonal' [DecidableEq κ] (b : Module.Basis (Σ k, ιk k) R M) (B : LinearMap.BilinForm R M) (Bk : ∀ k, LinearMap.BilinForm R (ιk k →₀ R)) @@ -89,7 +73,60 @@ theorem LinearMap.BilinForm.not_separatingLeft_of_toMatrix_eq_blockDiagonal' [De Matrix.blockDiagonal' (fun k => LinearMap.BilinForm.toMatrix Finsupp.basisSingleOne (Bk k))) {k₀ : κ} (hdeg : ¬ (Bk k₀).SeparatingLeft) : ¬ B.SeparatingLeft := by - sorry + unfold LinearMap.SeparatingLeft at hdeg ⊢ + push Not at hdeg ⊢ + obtain ⟨x, hx1, hx2⟩ := hdeg + set v : ιk k₀ → M := fun j => b ⟨k₀, j⟩ with hv_def + have hli : LinearIndependent R v := b.linearIndependent.comp _ sigma_mk_injective + refine ⟨Finsupp.linearCombination R v x, fun y => ?_, ?_⟩ + · have hzero : B (Finsupp.linearCombination R v x) = 0 := by + apply b.ext + rintro ⟨lk, lm⟩ + simp only [LinearMap.zero_apply] + have key : B (Finsupp.linearCombination R v x) (b ⟨lk, lm⟩) + = Finsupp.linearCombination R (fun j => B (v j) (b ⟨lk, lm⟩)) x := by + rw [← LinearMap.BilinForm.flip_apply, Finsupp.apply_linearCombination] + rfl + rw [key] + by_cases h : k₀ = lk + · subst h + have hentry : ∀ j, B (v j) (b ⟨k₀, lm⟩) = + Bk k₀ (Finsupp.basisSingleOne j) (Finsupp.basisSingleOne lm) := by + intro j + have h1 : (LinearMap.BilinForm.toMatrix b B) ⟨k₀, j⟩ ⟨k₀, lm⟩ + = B (v j) (b ⟨k₀, lm⟩) := rfl + have h2 : (LinearMap.BilinForm.toMatrix Finsupp.basisSingleOne (Bk k₀)) j lm + = Bk k₀ (Finsupp.basisSingleOne j) (Finsupp.basisSingleOne lm) := rfl + rw [← h1, ← h2, ← Matrix.blockDiagonal'_apply_eq + (fun k => LinearMap.BilinForm.toMatrix Finsupp.basisSingleOne (Bk k)) k₀ j lm] + exact congrFun (congrFun hB ⟨k₀, j⟩) ⟨k₀, lm⟩ + simp_rw [hentry] + have hcomb : Finsupp.linearCombination R (⇑(Finsupp.basisSingleOne (R := R))) x = x := by + rw [Finsupp.linearCombination_apply] + simp [Finsupp.coe_basisSingleOne, Finsupp.sum_single] + have hstep : Bk k₀ x (Finsupp.basisSingleOne lm) + = Finsupp.linearCombination R + (fun j => Bk k₀ (Finsupp.basisSingleOne j) (Finsupp.basisSingleOne lm)) x := by + conv_lhs => rw [← hcomb] + rw [← LinearMap.BilinForm.flip_apply, Finsupp.apply_linearCombination] + rfl + rw [← hstep] + exact hx1 (Finsupp.basisSingleOne lm) + · have hentry : ∀ j, B (v j) (b ⟨lk, lm⟩) = 0 := by + intro j + have h1 : (LinearMap.BilinForm.toMatrix b B) ⟨k₀, j⟩ ⟨lk, lm⟩ + = B (v j) (b ⟨lk, lm⟩) := rfl + rw [← h1, congrFun (congrFun hB ⟨k₀, j⟩) ⟨lk, lm⟩, Matrix.blockDiagonal'_apply_ne _ _ _ h] + rw [show (fun j => B (v j) (b ⟨lk, lm⟩)) = (0 : ιk k₀ → R) from funext hentry, + Finsupp.linearCombination_zero] + rfl + rw [hzero] + rfl + · intro heq + apply hx2 + have : Finsupp.linearCombination R v (0 : ιk k₀ →₀ R) = Finsupp.linearCombination R v x := + by rw [map_zero, heq] + exact (hli this).symm end BlockDiagonal @@ -99,41 +136,151 @@ section real open Real -variable {V : Type*} [AddCommGroup V] [Module ℝ V] - section BlockDiagonalPosSemidef +/-! `IsPosSemidef` only needs an ordered commutative semiring of scalars (not specifically `ℝ`) +so this block-diagonal criterion is stated for a general `R` with a compatible order. -/ + +variable {R : Type*} [CommSemiring R] [Preorder R] [AddLeftMono R] +variable {V : Type*} [AddCommGroup V] [Module R V] variable {κ : Type*} {ιk : κ → Type*} -/-- The positive-semidefinite analogue of -`LinearMap.BilinForm.not_separatingLeft_of_toMatrix_eq_blockDiagonal'`: if the matrix of `B` is -block diagonal with blocks the matrices of `Bk k` (w.r.t. `Finsupp.basisSingleOne`), and every -block `Bk k` is positive semidefinite, then `B` is positive semidefinite. - -Proof idea (currently unproved — pick up here): -* `IsSymm`: `B (b l) (b l') = (toMatrix b B) l l' = blockDiagonal' ... l l'`; this is symmetric in - `l, l'` termwise (`0` off the diagonal blocks, and `(Bk k).IsSymm` on the diagonal block), so - `B.IsSymm` follows from `LinearMap.BilinForm.isSymm_iff_basis b` (already used for `bil_isSymm` - in `Coxeter/GeometricRepresentation.lean`) plus a case split on whether `l, l'` share a block. -* `IsNonneg`, i.e. `∀ x, 0 ≤ B x x`: write `x = b.repr.symm (b.repr x)`; group `b.repr x : (Σ k, ιk - k) →₀ ℝ` by its first (block) coordinate to get, for each block `k` in the *finite* set - `(b.repr x).support.image Sigma.fst`, a vector `xk : ιk k →₀ ℝ` (the restriction of `b.repr x` to - block `k`, via `Finsupp.comapDomain`/`Finsupp.subtypeDomain` composed with `Equiv.sigmaFiberEquiv` - as in `Coxeter/Component.lean`'s `blockEquiv`). Off-diagonal-block terms of `B x x` vanish (same - `blockDiagonal'_apply'` case split as the degenerate-case lemma), so `B x x` reduces to a *finite* - sum `∑ k ∈ s, Bk k xk xk`, and each summand is `≥ 0` by `hpsd k`, hence so is the sum. -/ +/-- Suppose the matrix of a bilinear form `B` +(w.r.t. a basis indexed by a disjoint union `Σ k, ιk k`) +is block diagonal, with each block itself the matrix of a bilinear form `Bk k` on the free module +`ιk k →₀ R` (w.r.t. its standard basis `Finsupp.basisSingleOne`) and that R is +a general ordered commutative semiring. + +Positive-semidefiniteness carries over from the blocks. + +- `IsSymm` follows termwise from `hB`, since off-diagonal-block entries vanish on both sides and +diagonal-block entries agree by each `(Bk k).IsSymm`. +- For `IsNonneg`, `x` is split via +`Finsupp.split`/`splitSupport` (applied to `b.repr x`) into finitely many block components `y k` +with `x = ∑ k, y k`; cross terms `B (y k) (y k')` for `k ≠ k'` vanish by the same block-diagonal +entries, so `B x x` collapses to the finite sum `∑ k, Bk k (l.split k) (l.split k)`, which is +nonnegative termwise by `hpsd`. -/ theorem LinearMap.BilinForm.isPosSemidef_of_toMatrix_eq_blockDiagonal' [DecidableEq κ] - (b : Module.Basis (Σ k, ιk k) ℝ V) (B : LinearMap.BilinForm ℝ V) - (Bk : ∀ k, LinearMap.BilinForm ℝ (ιk k →₀ ℝ)) + (b : Module.Basis (Σ k, ιk k) R V) (B : LinearMap.BilinForm R V) + (Bk : ∀ k, LinearMap.BilinForm R (ιk k →₀ R)) (hB : LinearMap.BilinForm.toMatrix b B = Matrix.blockDiagonal' (fun k => LinearMap.BilinForm.toMatrix Finsupp.basisSingleOne (Bk k))) (hpsd : ∀ k, (Bk k).IsPosSemidef) : B.IsPosSemidef := by - sorry + have hentry_diag : ∀ k (i j : ιk k), B (b ⟨k, i⟩) (b ⟨k, j⟩) = + Bk k (Finsupp.basisSingleOne i) (Finsupp.basisSingleOne j) := by + intro k i j + have h1 : (LinearMap.BilinForm.toMatrix b B) ⟨k, i⟩ ⟨k, j⟩ = B (b ⟨k, i⟩) (b ⟨k, j⟩) := rfl + have h2 : (LinearMap.BilinForm.toMatrix Finsupp.basisSingleOne (Bk k)) i j + = Bk k (Finsupp.basisSingleOne i) (Finsupp.basisSingleOne j) := rfl + rw [← h1, ← h2, ← Matrix.blockDiagonal'_apply_eq + (fun k => LinearMap.BilinForm.toMatrix Finsupp.basisSingleOne (Bk k)) k i j] + exact congrFun (congrFun hB ⟨k, i⟩) ⟨k, j⟩ + have hentry_off : ∀ {k k' : κ} (i : ιk k) (j : ιk k'), k ≠ k' → B (b ⟨k, i⟩) (b ⟨k', j⟩) = 0 := by + intro k k' i j h + have h1 : (LinearMap.BilinForm.toMatrix b B) ⟨k, i⟩ ⟨k', j⟩ = B (b ⟨k, i⟩) (b ⟨k', j⟩) := rfl + rw [← h1, congrFun (congrFun hB ⟨k, i⟩) ⟨k', j⟩, Matrix.blockDiagonal'_apply_ne _ _ _ h] + constructor + · rw [LinearMap.BilinForm.isSymm_iff_basis b] + rintro ⟨k, i⟩ ⟨k', j⟩ + by_cases h : k = k' + · subst h + rw [hentry_diag k i j, hentry_diag k j i, (hpsd k).isSymm.eq] + · rw [hentry_off i j h, hentry_off j i (Ne.symm h)] + · rw [LinearMap.BilinForm.isNonneg_def] + intro x + set l : (Σ k, ιk k) →₀ R := b.repr x with hl_def + set y : κ → V := fun k => Finsupp.linearCombination R (fun i => b ⟨k, i⟩) (l.split k) + with hy_def + have hl_split : l = ∑ k ∈ l.splitSupport, Finsupp.mapDomain (Sigma.mk k) (l.split k) := by + conv_lhs => rw [← Finsupp.sum_single l] + rw [Finsupp.sigma_sum] + exact Finset.sum_congr rfl (fun k _ => rfl) + have hxA : x = ∑ k ∈ l.splitSupport, y k := by + have hx0 : x = Finsupp.linearCombination R b l := (b.linearCombination_repr x).symm + rw [hx0] + conv_lhs => rw [hl_split] + rw [map_sum] + refine Finset.sum_congr rfl (fun k _ => ?_) + rw [hy_def] + exact Finsupp.linearCombination_mapDomain R (Sigma.mk k) (l.split k) + have hcross : ∀ k k' : κ, k ≠ k' → B (y k) (y k') = 0 := by + intro k k' hne + have key1 : B (y k) (y k') + = Finsupp.linearCombination R (fun i => B (b ⟨k, i⟩) (y k')) (l.split k) := by + rw [hy_def, ← LinearMap.BilinForm.flip_apply, Finsupp.apply_linearCombination] + rfl + have key2 : ∀ i, B (b ⟨k, i⟩) (y k') + = Finsupp.linearCombination R (fun j => B (b ⟨k, i⟩) (b ⟨k', j⟩)) (l.split k') := by + intro i + rw [hy_def, Finsupp.apply_linearCombination] + rfl + rw [key1] + have hz : (fun i => B (b ⟨k, i⟩) (y k')) = (0 : ιk k → R) := by + funext i + rw [key2 i] + have hz2 : (fun j => B (b ⟨k, i⟩) (b ⟨k', j⟩)) = (0 : ιk k' → R) := by + funext j + exact hentry_off i j hne + rw [hz2, Finsupp.linearCombination_zero] + rfl + rw [hz, Finsupp.linearCombination_zero] + rfl + have hdiag : ∀ k, B (y k) (y k) = Bk k (l.split k) (l.split k) := by + intro k + have hcombk : Finsupp.linearCombination R (⇑(Finsupp.basisSingleOne (R := R))) (l.split k) + = l.split k := by + rw [Finsupp.linearCombination_apply] + simp [Finsupp.coe_basisSingleOne, Finsupp.sum_single] + have lhs_eq : B (y k) (y k) + = Finsupp.linearCombination R (fun i => + Finsupp.linearCombination R + (fun j => Bk k (Finsupp.basisSingleOne i) (Finsupp.basisSingleOne j)) + (l.split k)) (l.split k) := by + rw [hy_def, ← LinearMap.BilinForm.flip_apply, Finsupp.apply_linearCombination] + congr 1 + congr 1 + funext i + simp only [Function.comp_apply] + rw [LinearMap.BilinForm.flip_apply, Finsupp.apply_linearCombination] + congr 1 + congr 1 + funext j + exact hentry_diag k i j + have rhs_eq : Bk k (l.split k) (l.split k) + = Finsupp.linearCombination R (fun i => + Finsupp.linearCombination R + (fun j => Bk k (Finsupp.basisSingleOne i) (Finsupp.basisSingleOne j)) + (l.split k)) (l.split k) := by + conv_lhs => rw [← hcombk] + rw [← LinearMap.BilinForm.flip_apply, Finsupp.apply_linearCombination] + congr 1 + congr 1 + funext i + simp only [Function.comp_apply] + rw [LinearMap.BilinForm.flip_apply, Finsupp.apply_linearCombination] + rfl + rw [lhs_eq, rhs_eq] + rw [hxA] + simp_rw [map_sum] + conv_rhs => simp [Finset.sum_apply'] + have hcollapse : ∑ k' ∈ l.splitSupport, ∑ k ∈ l.splitSupport, B (y k) (y k') + = ∑ k ∈ l.splitSupport, Bk k (l.split k) (l.split k) := by + rw [Finset.sum_comm] + refine Finset.sum_congr rfl (fun k hk => ?_) + rw [Finset.sum_eq_single k (fun k' _ hne => hcross k k' (Ne.symm hne)) + (fun hk' => absurd hk hk')] + exact hdiag k + conv_rhs => rw [hcollapse] + exact Finset.sum_nonneg (fun k _ => (hpsd k).nonneg (l.split k)) end BlockDiagonalPosSemidef +/-! ### Orthonormal bases and orthogonal complements over `ℝ` -/ + +variable {V : Type*} [AddCommGroup V] [Module ℝ V] + def Orthonormal {ι : Type*} (B : LinearMap.BilinForm ℝ V) (v : ι → V) := (∀ (i : ι), B (v i) (v i) = 1) ∧ LinearMap.IsOrthoᵢ B v diff --git a/Coxeter/SpecialFeatures.lean b/Coxeter/SpecialFeatures.lean index 1c6df4f..15d8bd5 100644 --- a/Coxeter/SpecialFeatures.lean +++ b/Coxeter/SpecialFeatures.lean @@ -189,11 +189,29 @@ individual component, since a connected component's own sub-diagram always has i inhabitant (`SimpleGraph.ConnectedComponent.nonempty_supp`) — so it's never vacuously empty. -/ def IsAffineCoxeterOrEmpty : Prop := IsEmpty (B W) ∨ @IsAffineCoxeter W cg +/-- `bil` being positive semidefinite assembles across connected components unconditionally — no +"or empty" wrapper needed, since `bil` on the trivial module (no generators) is vacuously positive +semidefinite anyway, matching the vacuous truth of `∀ c, ...` over an empty component index. +Follows directly from `Component.lean`'s block-diagonal decomposition +(`bil_toMatrix_blockEquiv_eq_blockDiagonal'`) fed into +`LinearMap.BilinForm.isPosSemidef_of_toMatrix_eq_blockDiagonal'`. -/ +lemma assembles_possemidef : + Assembles fun [W1 : Type*] (cg1 : CoxeterGroup W1) => (@bil W1 cg1).IsPosSemidef := by + unfold Assembles + intro W1 cg1 finitely_many_comp on_components + classical + exact LinearMap.BilinForm.isPosSemidef_of_toMatrix_eq_blockDiagonal' + (stdBasis.reindex (blockEquiv cg1).symm) (@bil W1 cg1) + (fun c => @bil _ (componentCoxeterGroup cg1 c)) + (bil_toMatrix_blockEquiv_eq_blockDiagonal' cg1) on_components + /- -TODO: the proof needs infrastructure that doesn't exist yet — that `bil` is an orthogonal direct -sum of the components' own `bil`s (`bil x x = ∑ c, bil xc xc` where `xc` is `x` restricted to -component `c`, via `Finsupp.filter`/`Finsupp.subtypeDomain`). This is the same missing "block -structure on connected components" noted on `IsPolyAffineWeyl` below. +The empty-diagram case is immediate (`Or.inl empty`). Otherwise, `IsPosSemidef` comes straight from +`assembles_possemidef`, while `¬ Nondegenerate` needs the "or empty" case split: an arbitrary +component is degenerate (`on_arbitrary`), which after converting the one-sided `¬ SeparatingRight` +fact to `¬ SeparatingLeft` (using that each component's `bil` is symmetric) transfers, via +`LinearMap.BilinForm.not_separatingLeft_of_toMatrix_eq_blockDiagonal'`, to +`¬ SeparatingLeft (@bil W1 cg1)`, hence `¬ Nondegenerate`. -/ lemma assembles_affineCoxeter : Assembles @@ -229,7 +247,21 @@ lemma assembles_affineCoxeter : (bil_c c).IsPosSemidef := by intro c exact (on_components' c).left - sorry + classical + have hsep_left_ne : ¬ (bil_c arbitrary_component).SeparatingLeft := by + intro hleft + apply on_arbitrary hleft + intro y hy + apply hleft + intro z + rw [bil_c_def, (@bil_isSymm _ (componentCoxeterGroup cg1 arbitrary_component)).eq] + exact hy z + have hpsd_whole : (@bil W1 cg1).IsPosSemidef := assembles_possemidef cg1 on_components'' + have hdeg_whole : ¬ (@bil W1 cg1).SeparatingLeft := + LinearMap.BilinForm.not_separatingLeft_of_toMatrix_eq_blockDiagonal' + (stdBasis.reindex (blockEquiv cg1).symm) (@bil W1 cg1) bil_c + (bil_toMatrix_blockEquiv_eq_blockDiagonal' cg1) hsep_left_ne + exact ⟨hpsd_whole, fun hnd => hdeg_whole hnd.1⟩ /-- A particular kind of affine Coxeter system (`IsAffineCoxeter`), characterized the classical way. @@ -248,9 +280,10 @@ Concretely: We do not have the classification result available. So we cannot go from `IsAffineCoxeter` to disjoint union of connected `IsAffineCoxeter` and from there to disjoint union of several possibilities all of which have nullity at -most 1. We also do not have the block structure on connected components needed -to write `δ` in terms of `B_a^-1 B_{i0, a_j}` where `a` indexes the components upon -removing `i0` and `a_j` indexes the nodes within that component. +most 1. The block structure on connected components (`Component.lean`'s +`bil_toMatrix_blockEquiv_eq_blockDiagonal'`) is now available, but writing `δ` in terms of +`B_a^-1 B_{i0, a_j}` (where `a` indexes the components upon removing `i0` and `a_j` indexes the +nodes within that component) is still not done. - Descent: fails, worse than `IsAffineCoxeter`. The `∃ i₀, δ` clause pins the *total* nullity of `bil` to exactly `1`; since the kernel of an orthogonal direct sum is the direct sum of the From bdc866afd151a2e0a8ac7fbebb1c6e10e5f5a947 Mon Sep 17 00:00:00 2001 From: Cobord Date: Thu, 9 Jul 2026 01:45:06 -0400 Subject: [PATCH 11/12] finite/affine possibilities, more lemmas about scale factors changing by component etc --- Coxeter.lean | 4 +- Coxeter/CartanMatrix.lean | 497 ++++++++++++++++++ Coxeter/FiniteOrAffine/Affine.lean | 13 + Coxeter/FiniteOrAffine/AffineExceptional.lean | 69 +++ Coxeter/FiniteOrAffine/AffineTypeA.lean | 30 ++ Coxeter/FiniteOrAffine/AffineTypeB.lean | 30 ++ Coxeter/FiniteOrAffine/AffineTypeC.lean | 44 ++ Coxeter/FiniteOrAffine/AffineTypeD.lean | 30 ++ Coxeter/FiniteOrAffine/Exceptional.lean | 108 ++++ Coxeter/FiniteOrAffine/Finite.lean | 14 + Coxeter/FiniteOrAffine/TODO.md | 106 ++++ Coxeter/FiniteOrAffine/TridiagonalForm.lean | 227 ++++++++ Coxeter/FiniteOrAffine/TypeA.lean | 108 +--- Coxeter/FiniteOrAffine/TypeBC.lean | 282 ++++++++++ Coxeter/FiniteOrAffine/TypeD.lean | 108 ++++ Coxeter/FiniteOrAffine/TypeI.lean | 169 ++++++ Coxeter/GeometricRepresentation.lean | 10 +- Coxeter/SpecialFeatures.lean | 160 ++++++ 18 files changed, 1916 insertions(+), 93 deletions(-) create mode 100644 Coxeter/CartanMatrix.lean create mode 100644 Coxeter/FiniteOrAffine/Affine.lean create mode 100644 Coxeter/FiniteOrAffine/AffineExceptional.lean create mode 100644 Coxeter/FiniteOrAffine/AffineTypeA.lean create mode 100644 Coxeter/FiniteOrAffine/AffineTypeB.lean create mode 100644 Coxeter/FiniteOrAffine/AffineTypeC.lean create mode 100644 Coxeter/FiniteOrAffine/AffineTypeD.lean create mode 100644 Coxeter/FiniteOrAffine/Exceptional.lean create mode 100644 Coxeter/FiniteOrAffine/Finite.lean create mode 100644 Coxeter/FiniteOrAffine/TODO.md create mode 100644 Coxeter/FiniteOrAffine/TridiagonalForm.lean create mode 100644 Coxeter/FiniteOrAffine/TypeBC.lean create mode 100644 Coxeter/FiniteOrAffine/TypeD.lean create mode 100644 Coxeter/FiniteOrAffine/TypeI.lean diff --git a/Coxeter.lean b/Coxeter.lean index be039b3..1f4028f 100644 --- a/Coxeter.lean +++ b/Coxeter.lean @@ -3,10 +3,12 @@ module public import Coxeter.Basic public import Coxeter.BraidGroup public import Coxeter.Bruhat +public import Coxeter.CartanMatrix public import Coxeter.Component public import Coxeter.Dihedral public import Coxeter.Data.List.Lemmas -public import Coxeter.FiniteOrAffine.TypeA +public import Coxeter.FiniteOrAffine.Affine +public import Coxeter.FiniteOrAffine.Finite public import Coxeter.GeometricRepresentation public import Coxeter.Hecke public import Coxeter.LinearAlgebra.AssociatedGraded diff --git a/Coxeter/CartanMatrix.lean b/Coxeter/CartanMatrix.lean new file mode 100644 index 0000000..f052e62 --- /dev/null +++ b/Coxeter/CartanMatrix.lean @@ -0,0 +1,497 @@ +module + +public import Coxeter.SpecialFeatures +public import Mathlib.NumberTheory.Niven +public import Mathlib.LinearAlgebra.Ray + +/-! +# Generalized Cartan matrices + +This file packages the classical Kac–Moody **generalized Cartan matrix** realizing a Coxeter +system's `HasGeneralizedCartanMatrix` witness (see `Coxeter.SpecialFeatures`) as an actual matrix, +and connects it to the standard Cartan-integer formula in terms of `bil`. + +## Main definitions + +* `Coxeter.SymmetrizableGeneralizedCartanMatrix` +* `Coxeter.HasGeneralizedCartanMatrix.cartanMatrix` + +## Main statements + +* `Coxeter.HasGeneralizedCartanMatrix.isCrystallographic` +* `Coxeter.HasGeneralizedCartanMatrix.cartanMatrix_apply_eq` +* `Coxeter.HasGeneralizedCartanMatrix.geomRep_mapsTo_lattice` +-/ + +@[expose] public section + +namespace Coxeter + +variable {W : Type*} {cg : CoxeterGroup W} + +/-- The individual condition `2 * scale i' * cos (π / M i i') = n * scale i` looks asymmetric in +`i`/`i'`, but requiring it for *both* orderings (as the `∀ i i'` in `HasGeneralizedCartanMatrix` +already does) pins the two integer witnesses `n`, `m` — the generalized Cartan matrix entries +`a_{i i'}`, `a_{i' i}` — together via their product, which depends only on the unordered pair: +`n * m = 4 * cos (π / M i i') ^ 2`, using `M i i' = M i' i`. This is the familiar Kac–Moody +"Cartan integer product" identity (e.g. `4 cos² (π/M) ∈ {0, 1, 2, 3, 4}` for +`M ∈ {2, 3, 4, 6, 0}` respectively), and confirms the two ordered instances of the condition are not +independent data but two faces of one order-independent constraint. -/ +private theorem generalizedCartanMatrix_mul_eq + (scale : cg.B → ℝ) (hscale : ∀ i, 0 < scale i) (i i' : cg.B) + (n : ℕ) (hn : 2 * scale i' * Real.cos (Real.pi / cg.M i i') = n * scale i) + (m : ℕ) (hm : 2 * scale i * Real.cos (Real.pi / cg.M i i') = m * scale i') : + (n : ℝ) * m = 4 * Real.cos (Real.pi / cg.M i i') ^ 2 := by + have hi := (hscale i).ne' + have hi' := (hscale i').ne' + have key : (n : ℝ) * scale i * (m * scale i') + = (2 * scale i' * Real.cos (Real.pi / cg.M i i')) + * (2 * scale i * Real.cos (Real.pi / cg.M i i')) := by + rw [hn, hm] + have hne : scale i * scale i' ≠ 0 := mul_ne_zero hi hi' + apply mul_right_cancel₀ hne + linarith [key] + +/-- If `4 * cos (π / M) ^ 2` is a natural number for `M : ℕ` (with `M ≠ 1`), then +`M ∈ {0, 2, 3, 4, 6}`. This is the classical crystallographic restriction theorem, reduced to +**Niven's theorem** (`niven_angle_div_pi_eq`, already in Mathlib): the double-angle identity +turns `4 cos² (π / M) = k` into `cos ((2 / M) * π) = (k - 2) / 2`, a *rational* value at a +*rational* multiple of `π`, so Niven's theorem pins `2 / M ∈ {0, 1/3, 1/2, 2/3, 1}` (using +`0 ≤ 2/M ≤ 1`, which needs `M ≠ 1`), matching `M ∈ {0, 6, 4, 3, 2}` respectively. -/ +theorem crystallographic_of_four_cos_sq_pi_div_nat {M : ℕ} (hM1 : M ≠ 1) (k : ℕ) + (hk : (k : ℝ) = 4 * Real.cos (Real.pi / M) ^ 2) : + M = 0 ∨ M = 2 ∨ M = 3 ∨ M = 4 ∨ M = 6 := by + by_cases hM0 : M = 0 + · exact Or.inl hM0 + · have hM2 : 2 ≤ M := by omega + have hMQ : (M : ℚ) ≠ 0 := Nat.cast_ne_zero.mpr hM0 + set r : ℚ := 2 / (M : ℚ) with hr_def + have hrpi : (r : ℝ) * Real.pi = 2 * (Real.pi / M) := by + rw [hr_def]; push_cast; ring + have hcos2mul : Real.cos (2 * (Real.pi / M)) = ((k : ℝ) - 2) / 2 := by + rw [Real.cos_two_mul]; linarith [hk] + have hcos_rat : ∃ q : ℚ, Real.cos ((r : ℝ) * Real.pi) = (q : ℝ) := + ⟨((k : ℚ) - 2) / 2, by rw [hrpi, hcos2mul]; push_cast; ring⟩ + have hr_bound : r ∈ Set.Icc (0 : ℚ) 1 := by + refine ⟨by positivity, ?_⟩ + rw [hr_def, div_le_one (by positivity)] + exact_mod_cast hM2 + have hniven := niven_angle_div_pi_eq hcos_rat hr_bound + simp only [Set.mem_insert_iff, Set.mem_singleton_iff, hr_def] at hniven + rcases hniven with h | h | h | h | h + · exact absurd ((div_eq_zero_iff).mp h) (by simp [hMQ]) + · refine Or.inr (Or.inr (Or.inr (Or.inr ?_))) + have hMeq : (M : ℚ) = 6 := by field_simp [hMQ] at h; linarith + exact_mod_cast hMeq + · refine Or.inr (Or.inr (Or.inr (Or.inl ?_))) + have hMeq : (M : ℚ) = 4 := by field_simp [hMQ] at h; linarith + exact_mod_cast hMeq + · refine Or.inr (Or.inr (Or.inl ?_)) + have hMeq : (M : ℚ) = 3 := by field_simp [hMQ] at h; linarith + exact_mod_cast hMeq + · refine Or.inr (Or.inl ?_) + have hMeq : (M : ℚ) = 2 := by field_simp [hMQ] at h; linarith + exact_mod_cast hMeq + +/-- Every pair of distinct generators has `M i i' ∈ {0, 2, 3, 4, 6}`: the two witnesses for +`(i, i')` and `(i', i)` multiply, via `generalizedCartanMatrix_mul_eq`, to +`4 * cos (π / M i i') ^ 2`, a natural number, and `crystallographic_of_four_cos_sq_pi_div_nat` +turns that into the crystallographic restriction on `M i i'`. -/ +theorem HasGeneralizedCartanMatrix.isCrystallographic (h : @HasGeneralizedCartanMatrix W cg) : + @IsCrystallographic W cg := by + intro i i' hii' + obtain ⟨scale, hpos, hcond⟩ := h + obtain ⟨n, hn⟩ := hcond i i' hii' + obtain ⟨m, hm⟩ := hcond i' i hii'.symm + rw [cg.M.symmetric i' i] at hm + have hprod : (n : ℝ) * m = 4 * Real.cos (Real.pi / cg.M i i') ^ 2 := + generalizedCartanMatrix_mul_eq scale hpos i i' n hn m hm + exact crystallographic_of_four_cos_sq_pi_div_nat (cg.M.off_diagonal i i' hii') (n * m) + (by exact_mod_cast hprod) + +/-- Whether *this specific* proof's extracted scale (`h.choose` — whatever `Classical.choice` +happens to have produced) satisfies the standard Kac–Moody symmetrization convention: integer +squared root lengths (`h.choose i ^ 2 = sqLen i` for some `sqLen : cg.B → ℕ`), taken in lowest +terms on each connected component of the Coxeter diagram (no integer `d > 1` divides every `sqLen +i` for `i` in that component). + +This is a property of one particular witness, not an existence claim: it does not assert that a +scale satisfying it exists, nor is it automatically true of every `HasGeneralizedCartanMatrix` +proof — `h.choose` may just as well be some non-minimal or irrational-valued scale. Even when it +does hold, it does not pin `h.choose` down to a canonical choice: at a multi-bond (e.g. `M i i' = +4`, where `n * m = 2` forces `(n, m) = (1, 2)` or `(2, 1)`), the discrete long/short assignment is +untouched by minimality — two scales can both be integer-squared and primitive on a component while +disagreeing by a long/short swap there. -/ +def HasGeneralizedCartanMatrix.IsMinimal (h : @HasGeneralizedCartanMatrix W cg) : Prop := + ∃ sqLen : cg.B → ℕ, + (∀ i, 0 < sqLen i) ∧ + (∀ i, h.choose i ^ 2 = sqLen i) ∧ + ∀ c : (coxeterGraphMatrix cg.M).ConnectedComponent, + ¬ ∃ d : ℕ, 1 < d ∧ ∀ i, (coxeterGraphMatrix cg.M).connectedComponentMk i = c → d ∣ sqLen i + +/-- `cos (π / M) = 0` exactly at `M = 2`, for *every* `M : ℕ` — no crystallographic restriction on +`M` is needed: `π / M` and `π / 2` both lie in `[0, π]`, where `cos` is injective, so matching +`cos (π / M) = 0 = cos (π / 2)` already forces `π / M = π / 2`, i.e. `M = 2`. -/ +private theorem cos_pi_div_M_eq_zero_iff (M : ℕ) : Real.cos (Real.pi / M) = 0 ↔ M = 2 := by + constructor + · intro h + rcases Nat.eq_zero_or_pos M with hM0 | hMpos + · simp [hM0] at h + · have hmem1 : Real.pi / M ∈ Set.Icc (0 : ℝ) Real.pi := + ⟨by positivity, div_le_self Real.pi_pos.le (by exact_mod_cast hMpos)⟩ + have hmem2 : Real.pi / 2 ∈ Set.Icc (0 : ℝ) Real.pi := + ⟨by positivity, div_le_self Real.pi_pos.le one_le_two⟩ + have heq : Real.pi / (M : ℝ) = Real.pi / 2 := + Real.injOn_cos hmem1 hmem2 (by rw [h, Real.cos_pi_div_two]) + rw [div_eq_div_iff (by exact_mod_cast hMpos.ne') two_ne_zero] at heq + have h2 : (2 : ℝ) = M := mul_left_cancel₀ Real.pi_ne_zero heq + exact_mod_cast h2.symm + · rintro rfl + norm_num [Real.cos_pi_div_two] + +/-- The integer witness in `HasGeneralizedCartanMatrix`'s defining condition vanishes exactly when +`M i i' = 2` (i.e. the two generators commute), and is otherwise nonzero — since +`cos (π / M i i') = 0` exactly at `M i i' = 2`, and `scale` is everywhere positive. -/ +private theorem generalizedCartanMatrix_witness_eq_zero_iff (i i' : cg.B) + (scale : cg.B → ℝ) (hscale : ∀ i, 0 < scale i) (n : ℕ) + (hn : 2 * scale i' * Real.cos (Real.pi / cg.M i i') = n * scale i) : + n = 0 ↔ cg.M i i' = 2 := by + rw [← cos_pi_div_M_eq_zero_iff (cg.M i i')] + constructor + · intro h0 + subst h0 + have hn' : 2 * scale i' * Real.cos (Real.pi / cg.M i i') = 0 := by rw [hn]; norm_num + have h2 : (2 : ℝ) * scale i' ≠ 0 := mul_ne_zero two_ne_zero (hscale i').ne' + exact (mul_eq_zero.mp hn').resolve_left h2 + · intro hcos + rw [hcos, mul_zero] at hn + have := (mul_eq_zero.mp hn.symm).resolve_right (hscale i).ne' + exact_mod_cast this + +/-- Excluding `M i i' = 0` (the infinite-dihedral case) pins the ordered pair of witnesses `(n, m)` +for `(i, i')` and `(i', i)` down to one of only *six* possibilities, two at a time per remaining +crystallographic value of `M i i'`: `M i i' = 2` forces `(n, m) = (0, 0)`; `M i i' = 3` forces +`(n, m) = (1, 1)` (`n * m = 1` leaves no room for a long/short distinction); `M i i' = 4` allows +`(n, m) = (1, 2)` or `(2, 1)` (the long/short choice); `M i i' = 6` allows `(n, m) = (1, 3)` or +`(3, 1)`. Without excluding `M i i' = 0`, a seventh, ambiguous case (`M i i' = 0`, `n * m = 4`, +hence `(n, m) ∈ {(1, 4), (2, 2), (4, 1)}`) would also be possible. -/ +theorem generalizedCartanMatrix_pair_mem_of_ne_zero + (scale : cg.B → ℝ) (hscale : ∀ i, 0 < scale i) (i i' : cg.B) (hii' : i ≠ i') + (n : ℕ) (hn : 2 * scale i' * Real.cos (Real.pi / cg.M i i') = n * scale i) + (m : ℕ) (hm : 2 * scale i * Real.cos (Real.pi / cg.M i i') = m * scale i') + (hM0 : cg.M i i' ≠ 0) : + (n = 0 ∧ m = 0) ∨ (n = 1 ∧ m = 1) ∨ (n = 1 ∧ m = 2) ∨ (n = 2 ∧ m = 1) ∨ + (n = 1 ∧ m = 3) ∨ (n = 3 ∧ m = 1) := by + have hprod : (n : ℝ) * m = 4 * Real.cos (Real.pi / cg.M i i') ^ 2 := + generalizedCartanMatrix_mul_eq scale hscale i i' n hn m hm + rcases crystallographic_of_four_cos_sq_pi_div_nat (cg.M.off_diagonal i i' hii') (n * m) + (by exact_mod_cast hprod) with h0 | h2 | h3 | h4 | h6 + · exact absurd h0 hM0 + · have hm' : 2 * scale i * Real.cos (Real.pi / cg.M i' i) = m * scale i' := by + rw [cg.M.symmetric i' i]; exact hm + have h2' : cg.M i' i = 2 := by rw [cg.M.symmetric i' i]; exact h2 + exact Or.inl ⟨(generalizedCartanMatrix_witness_eq_zero_iff i i' scale hscale n hn).mpr h2, + (generalizedCartanMatrix_witness_eq_zero_iff i' i scale hscale m hm').mpr h2'⟩ + · have hcos : Real.cos (Real.pi / cg.M i i') = 1 / 2 := by + rw [h3]; norm_num [Real.cos_pi_div_three] + rw [hcos] at hprod + have hnm : n * m = 1 := by + have : (n : ℝ) * m = 1 := by rw [hprod]; norm_num + exact_mod_cast this + have hn0 : 0 < n := Nat.pos_of_ne_zero fun h => by simp [h] at hnm + have hnle : n ≤ 1 := Nat.le_of_dvd (by norm_num) ⟨m, hnm.symm⟩ + interval_cases n; omega + · have hcos : Real.cos (Real.pi / cg.M i i') = Real.sqrt 2 / 2 := by + rw [h4]; norm_num [Real.cos_pi_div_four] + rw [hcos] at hprod + have hnm : n * m = 2 := by + have h2sq : (Real.sqrt 2 / 2) ^ 2 = 1 / 2 := by + rw [div_pow, Real.sq_sqrt (by norm_num : (2 : ℝ) ≥ 0)]; norm_num + have : (n : ℝ) * m = 2 := by rw [hprod, h2sq]; norm_num + exact_mod_cast this + have hn0 : 0 < n := Nat.pos_of_ne_zero fun h => by simp [h] at hnm + have hm0 : 0 < m := Nat.pos_of_ne_zero fun h => by simp [h] at hnm + have hnle : n ≤ 2 := Nat.le_of_dvd (by norm_num) ⟨m, hnm.symm⟩ + interval_cases n <;> omega + · have hcos : Real.cos (Real.pi / cg.M i i') = Real.sqrt 3 / 2 := by + rw [h6]; norm_num [Real.cos_pi_div_six] + rw [hcos] at hprod + have hnm : n * m = 3 := by + have h3sq : (Real.sqrt 3 / 2) ^ 2 = 3 / 4 := by + rw [div_pow, Real.sq_sqrt (by norm_num : (3 : ℝ) ≥ 0)]; norm_num + have : (n : ℝ) * m = 3 := by rw [hprod, h3sq]; norm_num + exact_mod_cast this + have hn0 : 0 < n := Nat.pos_of_ne_zero fun h => by simp [h] at hnm + have hm0 : 0 < m := Nat.pos_of_ne_zero fun h => by simp [h] at hnm + have hnle : n ≤ 3 := Nat.le_of_dvd (by norm_num) ⟨m, hnm.symm⟩ + interval_cases n <;> omega + +/-- A **symmetrizable generalized Cartan matrix** in the Kac–Moody sense: an integer matrix on a +generating set `B` with `2` on the diagonal, nonpositive off-diagonal entries, and the "symmetric +vanishing" condition `a i i' = 0 ↔ a i' i = 0` off the diagonal — together with a choice of +symmetrizing constants `d` witnessing symmetrizability. (Not every generalized Cartan matrix in the +classical sense is symmetrizable; requiring `d`/`d_symm` here means this structure only ever +represents the symmetrizable ones — which is all that ever arises from a Coxeter system's +`HasGeneralizedCartanMatrix`, via `HasGeneralizedCartanMatrix.cartanMatrix`.) -/ +structure SymmetrizableGeneralizedCartanMatrix (B : Type*) where + /-- The matrix entries. -/ + a : B → B → ℤ + /-- The diagonal is always `2`. -/ + diag : ∀ i, a i i = 2 + /-- Off-diagonal entries are nonpositive. -/ + off_diag_nonpos : ∀ i i', i ≠ i' → a i i' ≤ 0 + /-- An off-diagonal entry vanishes iff its "partner" does. -/ + off_diag_zero_iff : ∀ i i', i ≠ i' → (a i i' = 0 ↔ a i' i = 0) + /-- Symmetrizing constants, as a *ray* `Module.Ray ℝ (B → ℝ)` (nonzero vectors up to a + *positive* scalar) rather than a bare vector: only the *ratios* `d i / d i'` matter for `d_symm` + below, quotienting by the positive overall scalar also rules out the vacuous `d = 0`, and using + `Module.Ray` instead of the finer projective space `ℙ ℝ (B → ℝ)` avoids conflating a valid + positive `d` with `-d` (a genuinely different, disallowed sign choice). When `B` is empty, `B → ℝ` + has only the zero vector, so `Module.Ray ℝ (B → ℝ)` itself has no elements — the left summand + records a proof of `IsEmpty B` to cover exactly that case, where there is nothing to symmetrize + anyway. -/ + d : PLift (IsEmpty B) ⊕ Module.Ray ℝ (B → ℝ) + /-- The `d`'s symmetrize `a` (vacuously, if `B` is empty). -/ + d_symm : d.elim (fun _ => True) + fun p => ∀ i i', p.someVector i * (a i i' : ℝ) = p.someVector i' * (a i' i : ℝ) + +namespace SymmetrizableGeneralizedCartanMatrix + +variable {B : Type*} (M : SymmetrizableGeneralizedCartanMatrix B) + +/-- The symmetrizing value at `i` +read off a representative vector of the ray `M.d` +Because i is provided, this is not in the +vacuous empty B case. -/ +noncomputable def dVal (i : B) : ℝ := M.d.elim (fun _ => 0) fun p => p.someVector i + +/-- The **symmetrized matrix** `S := D * A` +i.e. `S i i' = d_i * a i i'`. +d_i is chosen with someVector so it should only +be interpreted literally up to scaling. -/ +noncomputable def S (i i' : B) : ℝ := M.dVal i * (M.a i i' : ℝ) + +/-- `S` is symmetric +this is exactly `d_symm` restated in terms of `dVal`/`S`. +Having `i : B` in hand already rules out `B` being empty, +so `M.d` can only be the `Sum.inr` (ray) branch. -/ +theorem S_symm (i i' : B) : M.S i i' = M.S i' i := by + have hd := M.d_symm + unfold S dVal + rcases hM : M.d with h | p + · exact h.down.elim i + · rw [hM] at hd; simpa using hd i i' + +open Classical in +/-- `S` realized as a bilinear form on the finitely-supported functions `B →₀ ℝ` +via the standard basis — mirroring `Coxeter.bil`. +Working with `B →₀ ℝ` (not `B → ℝ`) is what lets this make sense +even when the generating set `B` is infinite. -/ +noncomputable def bil : LinearMap.BilinForm ℝ (B →₀ ℝ) := + Matrix.toBilin Finsupp.basisSingleOne M.S + +/-- `S` is positive semidefinite. -/ +def IsPosSemidef : Prop := M.bil.IsPosSemidef + +/-- `S` is positive definite +stated, as with `Coxeter.IsFiniteCoxeter` +as positive semidefinite and nondegenerate. +(`IsPosDef` isn't a separate notion in Mathlib for bilinear forms). -/ +def IsPosDef : Prop := M.bil.IsPosSemidef ∧ M.bil.Nondegenerate + +end SymmetrizableGeneralizedCartanMatrix + +/-- `scale i ^ 2` is nonzero as soon as `B` is nonempty (`scale` is everywhere positive). -/ +theorem generalizedCartanMatrix_scaleSq_ne_zero + (scale : cg.B → ℝ) (hscale : ∀ i, 0 < scale i) (hB : ¬ IsEmpty cg.B) : + (fun i => scale i ^ 2 : cg.B → ℝ) ≠ 0 := by + rw [ne_eq, funext_iff] + push Not + obtain ⟨i⟩ := not_isEmpty_iff.mp hB + exact ⟨i, by have := hscale i; positivity⟩ + +open Classical in +/-- The `d` field of `GeneralizedCartanMatrix`, built from a `HasGeneralizedCartanMatrix`-style +`scale`: the ray `⟦scale i ^ 2⟧` when `B` is nonempty, or a record of `IsEmpty B` otherwise. -/ +noncomputable def generalizedCartanMatrix_dValue + (scale : cg.B → ℝ) (hscale : ∀ i, 0 < scale i) : + PLift (IsEmpty cg.B) ⊕ Module.Ray ℝ (cg.B → ℝ) := + if hB : IsEmpty cg.B then Sum.inl ⟨hB⟩ + else Sum.inr (rayOfNeZero ℝ (fun i => scale i ^ 2) + (generalizedCartanMatrix_scaleSq_ne_zero scale hscale hB)) + +/-- `someVector` of a ray built from a nonzero vector `v` is `t • v` for some *positive* `t`: `v` +and `someVector` give the same ray (`someVector_ray`), so they're `SameRay`, and +`SameRay.exists_pos_right` turns that into a positive scalar. -/ +private theorem exists_pos_smul_someVector_eq + {v : cg.B → ℝ} (hv : v ≠ 0) : + ∃ t : ℝ, 0 < t ∧ (rayOfNeZero ℝ v hv).someVector = t • v := by + have hsame : SameRay ℝ (rayOfNeZero ℝ v hv).someVector v := + (ray_eq_iff (rayOfNeZero ℝ v hv).someVector_ne_zero hv).mp + (rayOfNeZero ℝ v hv).someVector_ray + exact hsame.exists_pos_right (rayOfNeZero ℝ v hv).someVector_ne_zero hv + +open Classical in +/-- `generalizedCartanMatrix_dValue` symmetrizes the off-diagonal entries `-n`/`-m` coming from +`scale_ii'`'s witnesses: on the nonempty branch, its representative (`someVector`) is `scale i ^ 2` +up to one common *positive* scalar `t` (`exists_pos_smul_someVector_eq`), which cancels out of the +symmetrizing equation, leaving exactly `scale_ratio_sq_eq_of_generalizedCartanMatrix_cond`. -/ +theorem generalizedCartanMatrix_dValue_symm + (scale : cg.B → ℝ) (hscale : ∀ i, 0 < scale i) + (scale_ii' : ∀ i i' : cg.B, i ≠ i' → + ∃ n : ℕ, 2 * scale i' * Real.cos (Real.pi / cg.M i i') = n * scale i) : + (generalizedCartanMatrix_dValue scale hscale).elim (fun _ => True) + fun p => ∀ i i', + p.someVector i * ((if hii' : i = i' then (2 : ℤ) else -(scale_ii' i i' hii').choose : ℤ) + : ℝ) = + p.someVector i' * ((if hii' : i' = i then (2 : ℤ) else -(scale_ii' i' i hii').choose : ℤ) + : ℝ) := by + unfold generalizedCartanMatrix_dValue + by_cases hB : IsEmpty cg.B + · simp [dif_pos hB] + · simp only [dif_neg hB, Sum.elim_inr] + intro i i' + by_cases hii' : i = i' + · subst hii'; rfl + · obtain ⟨t, ht, hteq⟩ := + exists_pos_smul_someVector_eq (generalizedCartanMatrix_scaleSq_ne_zero scale hscale hB) + have hrep : ∀ j, (rayOfNeZero ℝ (fun i => scale i ^ 2) + (generalizedCartanMatrix_scaleSq_ne_zero scale hscale hB)).someVector j = + t * scale j ^ 2 := fun j => by rw [hteq]; rfl + rw [hrep i, hrep i'] + simp only [dif_neg hii', dif_neg (Ne.symm hii')] + have hn := (scale_ii' i i' hii').choose_spec + have hm' : 2 * scale i * Real.cos (Real.pi / cg.M i i') = + (scale_ii' i' i (Ne.symm hii')).choose * scale i' := by + rw [← cg.M.symmetric i' i]; exact (scale_ii' i' i (Ne.symm hii')).choose_spec + have hratio := scale_ratio_sq_eq_of_generalizedCartanMatrix_cond scale i i' _ hn _ hm' + push_cast + linear_combination t * (-hratio) + +open Classical in +/-- Realize the generalized Cartan matrix promised by `HasGeneralizedCartanMatrix`. Its +off-diagonal entry `a i i'` is `-n`, the negation of the integer witness `n` from +`HasGeneralizedCartanMatrix` satisfying `2 * scale i' * cos (π / M i i') = n * scale i` — negated +to match the Kac–Moody sign convention `a i i' ≤ 0`, since `n ≥ 0` (as `cos (π / M i i') ≥ 0` for +every crystallographic `M i i'`, and `scale` is positive). -/ +noncomputable def HasGeneralizedCartanMatrix.cartanMatrix (h : @HasGeneralizedCartanMatrix W cg) : + SymmetrizableGeneralizedCartanMatrix cg.B := + let scale := h.choose + let scale_pos := h.choose_spec.1 + let scale_ii' := h.choose_spec.2 + { a := fun i i' => if hii' : i = i' then 2 else -(scale_ii' i i' hii').choose + diag := fun i => by simp + off_diag_nonpos := fun i i' hii' => by + simp only [dif_neg hii', neg_nonpos] + exact Int.natCast_nonneg _ + off_diag_zero_iff := fun i i' hii' => by + simp only [dif_neg hii', dif_neg (Ne.symm hii'), neg_eq_zero, Nat.cast_eq_zero] + rw [generalizedCartanMatrix_witness_eq_zero_iff i i' scale scale_pos _ + (scale_ii' i i' hii').choose_spec, + generalizedCartanMatrix_witness_eq_zero_iff i' i scale scale_pos _ + (scale_ii' i' i (Ne.symm hii')).choose_spec, + cg.M.symmetric i i'] + d := generalizedCartanMatrix_dValue scale scale_pos + d_symm := generalizedCartanMatrix_dValue_symm scale scale_pos scale_ii' } + +/-- The Kac–Moody Cartan-integer formula: `a i i'` equals the usual `2⟨αᵢ', αᵢ⟩ / ⟨αᵢ, αᵢ⟩` ratio +(writing `⟨·,·⟩` for `bil`), computed on the *rescaled* roots `scale i • stdBasis i`. The numerator +is symmetric in `i`/`i'` (`bil` is a symmetric form), and the denominator `⟨αᵢ,αᵢ⟩ = scale i ^ 2` is +positive regardless of which root's self-pairing is used to normalize — so the sign of `a i i'` +comes entirely from the numerator, matching `off_diag_nonpos`. -/ +private theorem HasGeneralizedCartanMatrix.cartanMatrix_apply_eq + (h : @HasGeneralizedCartanMatrix W cg) (i i' : cg.B) (hii' : i ≠ i') : + (h.cartanMatrix.a i i' : ℝ) = + 2 * bil (h.choose i' • stdBasis i') (h.choose i • stdBasis i) / + bil (h.choose i • stdBasis i) (h.choose i • stdBasis i) := by + have hn := (h.choose_spec.2 i i' hii').choose_spec + have hi := (h.choose_spec.1 i).ne' + classical + have key : h.cartanMatrix.a i i' = -(h.choose_spec.2 i i' hii').choose := by + change (if hii' : i = i' then (2 : ℤ) else -(h.choose_spec.2 i i' hii').choose) = _ + rw [dif_neg hii'] + have hbil_off : bil (stdBasis i') (stdBasis i) = -Real.cos (Real.pi / cg.M i i') := by + rw [bil_eq, cg.M.symmetric i' i] + have hden : bil (h.choose i • stdBasis i) (h.choose i • stdBasis i) + = h.choose i * h.choose i := by + simp only [map_smul, LinearMap.smul_apply, smul_eq_mul, bil_diag, mul_one] + have hnum : bil (h.choose i' • stdBasis i') (h.choose i • stdBasis i) + = -(h.choose i' * h.choose i * Real.cos (Real.pi / cg.M i i')) := by + simp only [map_smul, LinearMap.smul_apply, smul_eq_mul, hbil_off] + ring + rw [key, hden, hnum, eq_div_iff (mul_ne_zero hi hi)] + push_cast + linear_combination h.choose i * hn + +/-- The concrete payoff of `cartanMatrix_apply_eq`: the reflection formula `s_i(αᵢ') = αᵢ' - +a_{i i'} αᵢ`, valid for *every* pair `i, i'` (including `i = i'`, via `diag`). Since +`h.cartanMatrix.a i i' : ℤ`, this exhibits `geomRepAux i` sending each rescaled root +`scale i' • stdBasis i'` to an integer combination of the rescaled roots `scale i • stdBasis i` and +`scale i' • stdBasis i'` — i.e. `geomRepAux i` preserves the lattice `ℤ`-spanned by +`{scale j • stdBasis j : j}`. -/ +private theorem HasGeneralizedCartanMatrix.geomRepAux_smul_stdBasis + (h : @HasGeneralizedCartanMatrix W cg) (i i' : cg.B) : + geomRepAux i (h.choose i' • stdBasis i') = + h.choose i' • stdBasis i' - (h.cartanMatrix.a i i' : ℝ) • (h.choose i • stdBasis i) := by + have hi := (h.choose_spec.1 i).ne' + have hscalar : 2 * bil (stdBasis i) (h.choose i' • stdBasis i') + = (h.cartanMatrix.a i i' : ℝ) * h.choose i := by + by_cases hii' : i = i' + · subst hii' + rw [h.cartanMatrix.diag, map_smul, smul_eq_mul, bil_diag] + push_cast; ring + · have key := h.cartanMatrix_apply_eq i i' hii' + have hden : bil (h.choose i • stdBasis i) (h.choose i • stdBasis i) + = h.choose i * h.choose i := by + simp only [map_smul, LinearMap.smul_apply, smul_eq_mul, bil_diag, mul_one] + rw [hden, eq_div_iff (mul_ne_zero hi hi)] at key + simp only [map_smul, LinearMap.smul_apply, smul_eq_mul] at key + rw [bil_isSymm.eq (stdBasis i') (stdBasis i)] at key + apply mul_right_cancel₀ hi + simp only [map_smul, smul_eq_mul] + linear_combination -key + rw [geomRepAux_apply, hscalar, mul_smul] + +/-- The `ℤ`-lattice spanned by the rescaled roots `scale j • stdBasis j` promised by +`HasGeneralizedCartanMatrix`. -/ +noncomputable def HasGeneralizedCartanMatrix.lattice (h : @HasGeneralizedCartanMatrix W cg) : + Submodule ℤ (V W) := + Submodule.span ℤ (Set.range fun j => h.choose j • stdBasis j) + +/-- `geomRepAux i` preserves the *whole* lattice `h.lattice`, not just its generators: since +`geomRepAux i` is `ℝ`-linear (hence also `ℤ`-linear) and, by `geomRepAux_smul_stdBasis`, sends each +generator `scale i' • stdBasis i'` back into `h.lattice`, it sends the entire `ℤ`-span into itself. +This is the honest statement of lattice preservation — every simple reflection maps `h.lattice` +into `h.lattice`. -/ +private theorem HasGeneralizedCartanMatrix.geomRepAux_mapsTo_lattice + (h : @HasGeneralizedCartanMatrix W cg) (i : cg.B) : + Set.MapsTo (geomRepAux i) h.lattice h.lattice := by + rw [Set.mapsTo_iff_image_subset] + change Submodule.map ((geomRepAux i).toLinearMap.restrictScalars ℤ) h.lattice ≤ h.lattice + rw [HasGeneralizedCartanMatrix.lattice, LinearMap.map_span_le] + rintro _ ⟨j, rfl⟩ + rw [LinearMap.restrictScalars_apply, LinearEquiv.coe_toLinearMap, h.geomRepAux_smul_stdBasis i j, + Int.cast_smul_eq_zsmul] + exact sub_mem (Submodule.subset_span (Set.mem_range_self j)) + (Submodule.smul_mem _ (h.cartanMatrix.a i j) (Submodule.subset_span (Set.mem_range_self i))) + +/-- `geomRep w` preserves `h.lattice` for *every* group element `w`, not just simple reflections: +the simple reflections generate `W` (`CoxeterSystem.simple_induction`), lattice preservation holds +at the identity and at each simple reflection (`geomRepAux_mapsTo_lattice`), and is closed under +multiplication (composition of `Set.MapsTo`s) — so it holds everywhere. This is the honest, +whole-group statement of lattice preservation. -/ +theorem HasGeneralizedCartanMatrix.geomRep_mapsTo_lattice (h : @HasGeneralizedCartanMatrix W cg) + (w : W) : Set.MapsTo (geomRep w) h.lattice h.lattice := by + refine cg.cs.simple_induction (p := fun w => Set.MapsTo (geomRep w) h.lattice h.lattice) + w (fun i => ?_) ?_ (fun w w' hw hw' => ?_) + · dsimp only + rw [geomRep_simple] + exact h.geomRepAux_mapsTo_lattice i + · dsimp only + rw [map_one] + exact Set.mapsTo_id _ + · dsimp only at hw hw' ⊢ + rw [map_mul] + exact hw.comp hw' + +end Coxeter diff --git a/Coxeter/FiniteOrAffine/Affine.lean b/Coxeter/FiniteOrAffine/Affine.lean new file mode 100644 index 0000000..ed8b554 --- /dev/null +++ b/Coxeter/FiniteOrAffine/Affine.lean @@ -0,0 +1,13 @@ +module + +public import Coxeter.FiniteOrAffine.AffineExceptional +public import Coxeter.FiniteOrAffine.AffineTypeA +public import Coxeter.FiniteOrAffine.AffineTypeB +public import Coxeter.FiniteOrAffine.AffineTypeC +public import Coxeter.FiniteOrAffine.AffineTypeD + +/-! +# Affine Coxeter group stubs + +This module re-exports the per-family affine Coxeter stubs. +-/ diff --git a/Coxeter/FiniteOrAffine/AffineExceptional.lean b/Coxeter/FiniteOrAffine/AffineExceptional.lean new file mode 100644 index 0000000..8d1ab3f --- /dev/null +++ b/Coxeter/FiniteOrAffine/AffineExceptional.lean @@ -0,0 +1,69 @@ +module + +public import Coxeter.SpecialFeatures + +/-! +# Exceptional affine Coxeter groups + +This file reserves names for the exceptional affine Coxeter matrices and Coxeter groups. The matrix +definitions and classification proofs are intentionally left as stubs. +-/ + +@[expose] public section + +namespace Coxeter + +axiom affineTypeE6Matrix : CoxeterMatrix (Fin 7) +axiom affineTypeE7Matrix : CoxeterMatrix (Fin 8) +axiom affineTypeE8Matrix : CoxeterMatrix (Fin 9) +axiom affineTypeF4Matrix : CoxeterMatrix (Fin 5) +axiom affineTypeG2Matrix : CoxeterMatrix (Fin 3) + +@[reducible] noncomputable def affineTypeE6Group : CoxeterGroup affineTypeE6Matrix.Group where + B := Fin 7 + M := affineTypeE6Matrix + cs := affineTypeE6Matrix.toCoxeterSystem + +@[reducible] noncomputable def affineTypeE7Group : CoxeterGroup affineTypeE7Matrix.Group where + B := Fin 8 + M := affineTypeE7Matrix + cs := affineTypeE7Matrix.toCoxeterSystem + +@[reducible] noncomputable def affineTypeE8Group : CoxeterGroup affineTypeE8Matrix.Group where + B := Fin 9 + M := affineTypeE8Matrix + cs := affineTypeE8Matrix.toCoxeterSystem + +@[reducible] noncomputable def affineTypeF4Group : CoxeterGroup affineTypeF4Matrix.Group where + B := Fin 5 + M := affineTypeF4Matrix + cs := affineTypeF4Matrix.toCoxeterSystem + +@[reducible] noncomputable def affineTypeG2Group : CoxeterGroup affineTypeG2Matrix.Group where + B := Fin 3 + M := affineTypeG2Matrix + cs := affineTypeG2Matrix.toCoxeterSystem + +proof_wanted affineTypeE6_isIrreducibleAffineCoxeter : + @IsIrreducibleAffineCoxeter _ affineTypeE6Group +proof_wanted affineTypeE7_isIrreducibleAffineCoxeter : + @IsIrreducibleAffineCoxeter _ affineTypeE7Group +proof_wanted affineTypeE8_isIrreducibleAffineCoxeter : + @IsIrreducibleAffineCoxeter _ affineTypeE8Group +proof_wanted affineTypeF4_isIrreducibleAffineCoxeter : + @IsIrreducibleAffineCoxeter _ affineTypeF4Group +proof_wanted affineTypeG2_isIrreducibleAffineCoxeter : + @IsIrreducibleAffineCoxeter _ affineTypeG2Group + +proof_wanted affineTypeE6_isIrreducibleAffineWeyl : + @IsIrreducibleAffineWeyl _ affineTypeE6Group +proof_wanted affineTypeE7_isIrreducibleAffineWeyl : + @IsIrreducibleAffineWeyl _ affineTypeE7Group +proof_wanted affineTypeE8_isIrreducibleAffineWeyl : + @IsIrreducibleAffineWeyl _ affineTypeE8Group +proof_wanted affineTypeF4_isIrreducibleAffineWeyl : + @IsIrreducibleAffineWeyl _ affineTypeF4Group +proof_wanted affineTypeG2_isIrreducibleAffineWeyl : + @IsIrreducibleAffineWeyl _ affineTypeG2Group + +end Coxeter diff --git a/Coxeter/FiniteOrAffine/AffineTypeA.lean b/Coxeter/FiniteOrAffine/AffineTypeA.lean new file mode 100644 index 0000000..da2c3d1 --- /dev/null +++ b/Coxeter/FiniteOrAffine/AffineTypeA.lean @@ -0,0 +1,30 @@ +module + +public import Coxeter.SpecialFeatures + +/-! +# Affine Coxeter groups of type A + +This file reserves names for the affine type `A` Coxeter matrix and Coxeter group. The matrix +definition and classification proof are intentionally left as stubs. +-/ + +@[expose] public section + +namespace Coxeter + +axiom affineTypeAMatrix (n : ℕ) : CoxeterMatrix (Fin (n + 1)) + +@[reducible] noncomputable def affineTypeAGroup (n : ℕ) [NeZero n] : + CoxeterGroup (affineTypeAMatrix n).Group where + B := Fin (n + 1) + M := affineTypeAMatrix n + cs := (affineTypeAMatrix n).toCoxeterSystem + +proof_wanted affineTypeA_isIrreducibleAffineCoxeter (n : ℕ) [NeZero n] : + @IsIrreducibleAffineCoxeter _ (affineTypeAGroup n) + +proof_wanted affineTypeA_isIrreducibleAffineWeyl (n : ℕ) [NeZero n] : + @IsIrreducibleAffineWeyl _ (affineTypeAGroup n) + +end Coxeter diff --git a/Coxeter/FiniteOrAffine/AffineTypeB.lean b/Coxeter/FiniteOrAffine/AffineTypeB.lean new file mode 100644 index 0000000..898b787 --- /dev/null +++ b/Coxeter/FiniteOrAffine/AffineTypeB.lean @@ -0,0 +1,30 @@ +module + +public import Coxeter.SpecialFeatures + +/-! +# Affine Coxeter groups of type B + +This file reserves names for the affine type `B` Coxeter matrix and Coxeter group. The matrix +definition and classification proof are intentionally left as stubs. +-/ + +@[expose] public section + +namespace Coxeter + +axiom affineTypeBMatrix (n : ℕ) : CoxeterMatrix (Fin (n + 1)) + +@[reducible] noncomputable def affineTypeBGroup (n : ℕ) (_ : 2 ≤ n) : + CoxeterGroup (affineTypeBMatrix n).Group where + B := Fin (n + 1) + M := affineTypeBMatrix n + cs := (affineTypeBMatrix n).toCoxeterSystem + +proof_wanted affineTypeB_isIrreducibleAffineCoxeter (n : ℕ) (hn : 2 ≤ n) : + @IsIrreducibleAffineCoxeter _ (affineTypeBGroup n hn) + +proof_wanted affineTypeB_isIrreducibleAffineWeyl (n : ℕ) (hn : 2 ≤ n) : + @IsIrreducibleAffineWeyl _ (affineTypeBGroup n hn) + +end Coxeter diff --git a/Coxeter/FiniteOrAffine/AffineTypeC.lean b/Coxeter/FiniteOrAffine/AffineTypeC.lean new file mode 100644 index 0000000..0a5f458 --- /dev/null +++ b/Coxeter/FiniteOrAffine/AffineTypeC.lean @@ -0,0 +1,44 @@ +module + +public import Coxeter.FiniteOrAffine.AffineTypeB +public import Coxeter.SpecialFeatures + +/-! +# Affine Coxeter groups of type C + +This file reserves names for the affine type `C` Coxeter matrix and Coxeter group. The matrix +definition and classification proof are intentionally left as stubs. +-/ + +@[expose] public section + +namespace Coxeter + +axiom affineTypeCMatrix (n : ℕ) : CoxeterMatrix (Fin (n + 1)) + +@[reducible] noncomputable def affineTypeCGroup (n : ℕ) (_ : 2 ≤ n) : + CoxeterGroup (affineTypeCMatrix n).Group where + B := Fin (n + 1) + M := affineTypeCMatrix n + cs := (affineTypeCMatrix n).toCoxeterSystem + +proof_wanted affineTypeC_isIrreducibleAffineCoxeter (n : ℕ) (hn : 2 ≤ n) : + @IsIrreducibleAffineCoxeter _ (affineTypeCGroup n hn) + +proof_wanted affineTypeC_isIrreducibleAffineWeyl (n : ℕ) (hn : 2 ≤ n) : + @IsIrreducibleAffineWeyl _ (affineTypeCGroup n hn) + +/-! ### Accidental low-rank affine identifications -/ + +section Accidentals + +/-- The Coxeter-system-level accidental identification `C₂-hat = B₂-hat`. + +The matrix-level identification is not public; the affine matrices are currently stubs. -/ +proof_wanted affineTypeC_two_identifies_affineTypeB_two : + HEq (@CoxeterGroup.cs _ (affineTypeCGroup 2 (by omega))) + (@CoxeterGroup.cs _ (affineTypeBGroup 2 (by omega))) + +end Accidentals + +end Coxeter diff --git a/Coxeter/FiniteOrAffine/AffineTypeD.lean b/Coxeter/FiniteOrAffine/AffineTypeD.lean new file mode 100644 index 0000000..e821832 --- /dev/null +++ b/Coxeter/FiniteOrAffine/AffineTypeD.lean @@ -0,0 +1,30 @@ +module + +public import Coxeter.SpecialFeatures + +/-! +# Affine Coxeter groups of type D + +This file reserves names for the affine type `D` Coxeter matrix and Coxeter group. The matrix +definition and classification proof are intentionally left as stubs. +-/ + +@[expose] public section + +namespace Coxeter + +axiom affineTypeDMatrix (n : ℕ) : CoxeterMatrix (Fin (n + 1)) + +@[reducible] noncomputable def affineTypeDGroup (n : ℕ) [NeZero n] : + CoxeterGroup (affineTypeDMatrix n).Group where + B := Fin (n + 1) + M := affineTypeDMatrix n + cs := (affineTypeDMatrix n).toCoxeterSystem + +proof_wanted affineTypeD_isIrreducibleAffineCoxeter (n : ℕ) [NeZero n] : + @IsIrreducibleAffineCoxeter _ (affineTypeDGroup n) + +proof_wanted affineTypeD_isIrreducibleAffineWeyl (n : ℕ) [NeZero n] : + @IsIrreducibleAffineWeyl _ (affineTypeDGroup n) + +end Coxeter diff --git a/Coxeter/FiniteOrAffine/Exceptional.lean b/Coxeter/FiniteOrAffine/Exceptional.lean new file mode 100644 index 0000000..3c26c83 --- /dev/null +++ b/Coxeter/FiniteOrAffine/Exceptional.lean @@ -0,0 +1,108 @@ +module + +public import Coxeter.SpecialFeatures + +/-! +# Exceptional finite Coxeter groups + +This file packages mathlib's exceptional finite Coxeter matrices as `CoxeterGroup`s. + +The classification proofs are intentionally left as `proof_wanted` stubs. +-/ + +@[expose] public section + +namespace Coxeter + +@[reducible] noncomputable def typeE6Group : CoxeterGroup CoxeterMatrix.E₆.Group where + B := Fin 6 + M := CoxeterMatrix.E₆ + cs := CoxeterMatrix.E₆.toCoxeterSystem + +@[reducible] noncomputable def typeE7Group : CoxeterGroup CoxeterMatrix.E₇.Group where + B := Fin 7 + M := CoxeterMatrix.E₇ + cs := CoxeterMatrix.E₇.toCoxeterSystem + +@[reducible] noncomputable def typeE8Group : CoxeterGroup CoxeterMatrix.E₈.Group where + B := Fin 8 + M := CoxeterMatrix.E₈ + cs := CoxeterMatrix.E₈.toCoxeterSystem + +@[reducible] noncomputable def typeF4Group : CoxeterGroup CoxeterMatrix.F₄.Group where + B := Fin 4 + M := CoxeterMatrix.F₄ + cs := CoxeterMatrix.F₄.toCoxeterSystem + +@[reducible] noncomputable def typeG2Group : CoxeterGroup CoxeterMatrix.G₂.Group where + B := Fin 2 + M := CoxeterMatrix.G₂ + cs := CoxeterMatrix.G₂.toCoxeterSystem + +@[reducible] noncomputable def typeH3Group : CoxeterGroup CoxeterMatrix.H₃.Group where + B := Fin 3 + M := CoxeterMatrix.H₃ + cs := CoxeterMatrix.H₃.toCoxeterSystem + +@[reducible] noncomputable def typeH4Group : CoxeterGroup CoxeterMatrix.H₄.Group where + B := Fin 4 + M := CoxeterMatrix.H₄ + cs := CoxeterMatrix.H₄.toCoxeterSystem + +theorem typeE6_isCrystallographic : @IsCrystallographic _ typeE6Group := by + intro i i' hii' + change Fin 6 at i + change Fin 6 at i' + change CoxeterMatrix.E₆ i i' = 0 ∨ CoxeterMatrix.E₆ i i' = 2 ∨ + CoxeterMatrix.E₆ i i' = 3 ∨ CoxeterMatrix.E₆ i i' = 4 ∨ + CoxeterMatrix.E₆ i i' = 6 + fin_cases i <;> fin_cases i' <;> simp at hii' <;> norm_num [CoxeterMatrix.E₆] + +theorem typeE7_isCrystallographic : @IsCrystallographic _ typeE7Group := by + intro i i' hii' + change Fin 7 at i + change Fin 7 at i' + change CoxeterMatrix.E₇ i i' = 0 ∨ CoxeterMatrix.E₇ i i' = 2 ∨ + CoxeterMatrix.E₇ i i' = 3 ∨ CoxeterMatrix.E₇ i i' = 4 ∨ + CoxeterMatrix.E₇ i i' = 6 + fin_cases i <;> fin_cases i' <;> simp at hii' <;> norm_num [CoxeterMatrix.E₇] + +theorem typeE8_isCrystallographic : @IsCrystallographic _ typeE8Group := by + intro i i' hii' + change Fin 8 at i + change Fin 8 at i' + change CoxeterMatrix.E₈ i i' = 0 ∨ CoxeterMatrix.E₈ i i' = 2 ∨ + CoxeterMatrix.E₈ i i' = 3 ∨ CoxeterMatrix.E₈ i i' = 4 ∨ + CoxeterMatrix.E₈ i i' = 6 + fin_cases i <;> fin_cases i' <;> simp at hii' <;> norm_num [CoxeterMatrix.E₈] + +theorem typeF4_isCrystallographic : @IsCrystallographic _ typeF4Group := by + intro i i' hii' + change Fin 4 at i + change Fin 4 at i' + change CoxeterMatrix.F₄ i i' = 0 ∨ CoxeterMatrix.F₄ i i' = 2 ∨ + CoxeterMatrix.F₄ i i' = 3 ∨ CoxeterMatrix.F₄ i i' = 4 ∨ + CoxeterMatrix.F₄ i i' = 6 + fin_cases i <;> fin_cases i' <;> simp at hii' <;> norm_num [CoxeterMatrix.F₄] + +theorem typeG2_isCrystallographic : @IsCrystallographic _ typeG2Group := by + intro i i' hii' + change Fin 2 at i + change Fin 2 at i' + change CoxeterMatrix.G₂ i i' = 0 ∨ CoxeterMatrix.G₂ i i' = 2 ∨ + CoxeterMatrix.G₂ i i' = 3 ∨ CoxeterMatrix.G₂ i i' = 4 ∨ + CoxeterMatrix.G₂ i i' = 6 + fin_cases i <;> fin_cases i' <;> simp at hii' <;> norm_num [CoxeterMatrix.G₂] + +proof_wanted typeE6_isIrreducibleFiniteWeyl : @IsIrreducibleFiniteWeyl _ typeE6Group +proof_wanted typeE7_isIrreducibleFiniteWeyl : @IsIrreducibleFiniteWeyl _ typeE7Group +proof_wanted typeE8_isIrreducibleFiniteWeyl : @IsIrreducibleFiniteWeyl _ typeE8Group +proof_wanted typeF4_isIrreducibleFiniteWeyl : @IsIrreducibleFiniteWeyl _ typeF4Group +proof_wanted typeG2_isIrreducibleFiniteWeyl : @IsIrreducibleFiniteWeyl _ typeG2Group + +proof_wanted typeH3_isIrreducible : @IsIrreducible _ typeH3Group +proof_wanted typeH4_isIrreducible : @IsIrreducible _ typeH4Group +proof_wanted typeH3_isFiniteCoxeter : @IsFiniteCoxeter _ typeH3Group +proof_wanted typeH4_isFiniteCoxeter : @IsFiniteCoxeter _ typeH4Group + +end Coxeter diff --git a/Coxeter/FiniteOrAffine/Finite.lean b/Coxeter/FiniteOrAffine/Finite.lean new file mode 100644 index 0000000..f5ae6d0 --- /dev/null +++ b/Coxeter/FiniteOrAffine/Finite.lean @@ -0,0 +1,14 @@ +module + +public import Coxeter.FiniteOrAffine.Exceptional +public import Coxeter.FiniteOrAffine.TridiagonalForm +public import Coxeter.FiniteOrAffine.TypeA +public import Coxeter.FiniteOrAffine.TypeBC +public import Coxeter.FiniteOrAffine.TypeD +public import Coxeter.FiniteOrAffine.TypeI + +/-! +# Finite Coxeter group stubs + +This module re-exports the per-family finite Coxeter stubs. +-/ diff --git a/Coxeter/FiniteOrAffine/TODO.md b/Coxeter/FiniteOrAffine/TODO.md new file mode 100644 index 0000000..7cea235 --- /dev/null +++ b/Coxeter/FiniteOrAffine/TODO.md @@ -0,0 +1,106 @@ +# FiniteOrAffine: open `axiom`/`proof_wanted` stubs + +Inventory of everything in this directory that is not yet a real proof, as of this writing. +Grouped by file; each item names the declaration and what's needed to close it. + +## Finite types + +### TypeD.lean +- `axiom typeD_isFiniteCoxeter (n : ℕ) : @IsFiniteCoxeter _ (typeDGroup (n + 4))` — must stay an + `axiom` (or become a real proof), not `proof_wanted`, since `typeD_isPolyFiniteWeyl` below + depends on it as a real term. `D_n`'s Coxeter-Dynkin diagram is a *fork* (a path with one extra + branch at one end), not a straight path, so it does not directly fit + `Coxeter.FiniteOrAffine.TridiagonalForm`'s path-with-one-reweighted-edge machinery (used for + type `B`/`C`). Positive-definiteness needs its own SOS argument (or a fork-shaped generalization + of `TridiagonalForm`). +- `proof_wanted typeD_isIrreducible (n : ℕ) : @IsIrreducible _ (typeDGroup (n + 4))` — should + follow the same pattern as `typeA_isIrreducible`/`typeBC_isIrreducible`: show + `coxeterGraphMatrix (typeDMatrix (n + 4))` is connected (it's a fork, still connected). +- `proof_wanted typeD_isIrreducibleFiniteWeyl (n : ℕ) : @IsIrreducibleFiniteWeyl _ (typeDGroup (n + 4))` + — trivial once the two items above land: `⟨typeD_isPolyFiniteWeyl n, typeD_isIrreducible n⟩` + (mirrors `typeBC_isIrreducibleFiniteWeyl`). + +### Exceptional.lean +- `proof_wanted typeE6_isIrreducibleFiniteWeyl : @IsIrreducibleFiniteWeyl _ typeE6Group` +- `proof_wanted typeE7_isIrreducibleFiniteWeyl : @IsIrreducibleFiniteWeyl _ typeE7Group` +- `proof_wanted typeE8_isIrreducibleFiniteWeyl : @IsIrreducibleFiniteWeyl _ typeE8Group` +- `proof_wanted typeF4_isIrreducibleFiniteWeyl : @IsIrreducibleFiniteWeyl _ typeF4Group` +- `proof_wanted typeG2_isIrreducibleFiniteWeyl : @IsIrreducibleFiniteWeyl _ typeG2Group` + — each needs `IsIrreducible` (diagram connectivity, checkable by `fin_cases`/`decide` since + these are small fixed-rank matrices) plus `IsPolyFiniteWeyl` (`IsFiniteCoxeter ∧ + IsCrystallographic`; crystallographic is already proved for all five). `IsFiniteCoxeter` needs + positive-definiteness of `bil` — these are fixed, small finite matrices (rank ≤ 8), so in + principle decidable/computable rather than needing a general SOS argument. +- `proof_wanted typeH3_isIrreducible : @IsIrreducible _ typeH3Group` +- `proof_wanted typeH4_isIrreducible : @IsIrreducible _ typeH4Group` — diagram connectivity, + should be straightforward (`fin_cases`/`decide` on the fixed rank-3/4 matrix). +- `proof_wanted typeH3_isFiniteCoxeter : @IsFiniteCoxeter _ typeH3Group` +- `proof_wanted typeH4_isFiniteCoxeter : @IsFiniteCoxeter _ typeH4Group` — `H₃`/`H₄` are + *non-crystallographic* (golden-ratio entries, `cos(π/5)`), so this needs its own + positive-definiteness argument; not crystallographic, so no `IsPolyFiniteWeyl`/Weyl statement + applies to these two, only `IsIrreducible ∧ IsFiniteCoxeter` (there's no + `typeH3_isIrreducibleFiniteWeyl` target, consistent with `H₃`/`H₄` not being Weyl groups). + +## Affine types + +Every affine file's *matrix* is still an `axiom` (no actual `CoxeterMatrix` definition yet), which +blocks every downstream `proof_wanted` in that file. Matrix definitions should mirror +`TypeD.lean`'s `typeDMatrix`-style construction (explicit `Matrix.of` with the standard affine +Dynkin diagram shape) or reuse mathlib's affine matrices if/when available. + +### AffineTypeA.lean +- `axiom affineTypeAMatrix (n : ℕ) : CoxeterMatrix (Fin (n + 1))` +- `proof_wanted affineTypeA_isIrreducibleAffineCoxeter (n : ℕ) [NeZero n] : @IsIrreducibleAffineCoxeter _ (affineTypeAGroup n)` +- `proof_wanted affineTypeA_isIrreducibleAffineWeyl (n : ℕ) [NeZero n] : @IsIrreducibleAffineWeyl _ (affineTypeAGroup n)` + +### AffineTypeB.lean +- `axiom affineTypeBMatrix (n : ℕ) : CoxeterMatrix (Fin (n + 1))` +- `proof_wanted affineTypeB_isIrreducibleAffineCoxeter (n : ℕ) (hn : 2 ≤ n) : @IsIrreducibleAffineCoxeter _ (affineTypeBGroup n hn)` +- `proof_wanted affineTypeB_isIrreducibleAffineWeyl (n : ℕ) (hn : 2 ≤ n) : @IsIrreducibleAffineWeyl _ (affineTypeBGroup n hn)` + +### AffineTypeC.lean +- `axiom affineTypeCMatrix (n : ℕ) : CoxeterMatrix (Fin (n + 1))` +- `proof_wanted affineTypeC_isIrreducibleAffineCoxeter (n : ℕ) (hn : 2 ≤ n) : @IsIrreducibleAffineCoxeter _ (affineTypeCGroup n hn)` +- `proof_wanted affineTypeC_isIrreducibleAffineWeyl (n : ℕ) (hn : 2 ≤ n) : @IsIrreducibleAffineWeyl _ (affineTypeCGroup n hn)` +- `proof_wanted affineTypeC_two_identifies_affineTypeB_two : HEq (@CoxeterGroup.cs _ (affineTypeCGroup 2 _)) (@CoxeterGroup.cs _ (affineTypeBGroup 2 _))` + — the accidental `C₂-hat = B₂-hat` identification; blocked on both `affineTypeCMatrix` and + `affineTypeBMatrix` actually being defined (currently axioms), same shape as + `typeBC_one_identifies_typeA_one` once they are. + +### AffineTypeD.lean +- `axiom affineTypeDMatrix (n : ℕ) : CoxeterMatrix (Fin (n + 1))` +- `proof_wanted affineTypeD_isIrreducibleAffineCoxeter (n : ℕ) [NeZero n] : @IsIrreducibleAffineCoxeter _ (affineTypeDGroup n)` +- `proof_wanted affineTypeD_isIrreducibleAffineWeyl (n : ℕ) [NeZero n] : @IsIrreducibleAffineWeyl _ (affineTypeDGroup n)` + +### AffineExceptional.lean +- `axiom affineTypeE6Matrix : CoxeterMatrix (Fin 7)` +- `axiom affineTypeE7Matrix : CoxeterMatrix (Fin 8)` +- `axiom affineTypeE8Matrix : CoxeterMatrix (Fin 9)` +- `axiom affineTypeF4Matrix : CoxeterMatrix (Fin 5)` +- `axiom affineTypeG2Matrix : CoxeterMatrix (Fin 3)` +- `proof_wanted affineTypeE6_isIrreducibleAffineCoxeter : @IsIrreducibleAffineCoxeter _ affineTypeE6Group` +- `proof_wanted affineTypeE7_isIrreducibleAffineCoxeter : @IsIrreducibleAffineCoxeter _ affineTypeE7Group` +- `proof_wanted affineTypeE8_isIrreducibleAffineCoxeter : @IsIrreducibleAffineCoxeter _ affineTypeE8Group` +- `proof_wanted affineTypeF4_isIrreducibleAffineCoxeter : @IsIrreducibleAffineCoxeter _ affineTypeF4Group` +- `proof_wanted affineTypeG2_isIrreducibleAffineCoxeter : @IsIrreducibleAffineCoxeter _ affineTypeG2Group` +- `proof_wanted affineTypeE6_isIrreducibleAffineWeyl : @IsIrreducibleAffineWeyl _ affineTypeE6Group` +- `proof_wanted affineTypeE7_isIrreducibleAffineWeyl : @IsIrreducibleAffineWeyl _ affineTypeE7Group` +- `proof_wanted affineTypeE8_isIrreducibleAffineWeyl : @IsIrreducibleAffineWeyl _ affineTypeE8Group` +- `proof_wanted affineTypeF4_isIrreducibleAffineWeyl : @IsIrreducibleAffineWeyl _ affineTypeF4Group` +- `proof_wanted affineTypeG2_isIrreducibleAffineWeyl : @IsIrreducibleAffineWeyl _ affineTypeG2Group` + +## Suggested order of attack + +1. `TypeD.lean`'s `typeD_isIrreducible` and `typeD_isIrreducibleFiniteWeyl` — cheap, unblocks the + file entirely except for `typeD_isFiniteCoxeter`'s SOS argument. +2. `Exceptional.lean`'s `IsIrreducible` goals for `H₃`/`H₄` — connectivity only, cheap. +3. `TypeD.lean`'s `typeD_isFiniteCoxeter` (downgrade `axiom` → real proof) — needs a fork-shaped + SOS identity; could motivate a second generalization in `TridiagonalForm.lean` (or a sibling + file) analogous to the `lastEdge`-reweighting one already there for type `B`/`C`. +4. `Exceptional.lean`'s five `IsIrreducibleFiniteWeyl` goals and two `H₃`/`H₄` `IsFiniteCoxeter` + goals — fixed small rank, so brute-force/`decide`-style positive-definiteness may be more + tractable than a general argument; the rank-2 machinery in `Coxeter.GeometricRepresentation` + (`bil_restrict_E_diag`/`bil_restrict_E_isPosSemidef`/`bil_restrict_E_nondegenerate_iff`, now + public) generalizes to any pair of generators, not just rank-2 whole diagrams, and may help. +5. Affine files last: every affine matrix is currently just an `axiom`, so nothing there can be + proved until the actual matrices are defined. diff --git a/Coxeter/FiniteOrAffine/TridiagonalForm.lean b/Coxeter/FiniteOrAffine/TridiagonalForm.lean new file mode 100644 index 0000000..15fbba6 --- /dev/null +++ b/Coxeter/FiniteOrAffine/TridiagonalForm.lean @@ -0,0 +1,227 @@ +module + +public import Coxeter.SpecialFeatures + +/-! +# Tridiagonal sum-of-squares identities + +Generic algebraic lemmas about tridiagonal ("path graph") quadratic forms, shared by the +positive-definiteness arguments for `Coxeter.FiniteOrAffine.TypeA` and +`Coxeter.FiniteOrAffine.TypeBC`. + +The tridiagonal quadratic form `Q(y) = ∑_{i simp; ring + | succ m ih => + rw [Finset.sum_range_succ (f := fun i => (y i) ^ 2), + Finset.sum_range_succ (f := fun i => y i * y (i + 1)), + Finset.sum_range_succ (f := fun i => (y i - y (i + 1)) ^ 2)] + linear_combination ih + +/-- The entry function of the (doubled) tridiagonal ("path graph") quadratic form: `1` on the +diagonal, `-1/2` on adjacent off-diagonal entries, `0` elsewhere. -/ +noncomputable def pathEntry (i j : ℕ) : ℚ := + if i = j then 1 else if j + 1 = i ∨ i + 1 = j then -(1 / 2) else 0 + +/-- The double sum against `pathEntry` collapses to the tridiagonal quadratic form `Q(y)` from +`sos_identity`: only the diagonal and immediately-adjacent entries of `pathEntry` are nonzero. -/ +theorem pathEntry_sum_range_double (y : ℕ → ℝ) (m : ℕ) : + (∑ i ∈ Finset.range (m + 1), ∑ j ∈ Finset.range (m + 1), y i * y j * pathEntry i j) + = ∑ i ∈ Finset.range (m + 1), (y i) ^ 2 - ∑ i ∈ Finset.range m, y i * y (i + 1) := by + induction m with + | zero => simp [pathEntry]; ring + | succ m ih => + have hL : ∀ i ∈ Finset.range (m + 1), + y i * y (m + 1) * pathEntry i (m + 1) = + if i = m then y i * y (m + 1) * (-(1 / 2)) else 0 := by + intro i hi + simp only [Finset.mem_range] at hi + by_cases hc : i = m + · subst hc + simp [pathEntry] + · rw [if_neg hc] + unfold pathEntry + rw [if_neg (by omega : ¬ i = m + 1), + if_neg (by omega : ¬ ((m + 1) + 1 = i ∨ i + 1 = m + 1))] + ring + have hR : ∀ j ∈ Finset.range (m + 1), + y (m + 1) * y j * pathEntry (m + 1) j = + if j = m then y (m + 1) * y j * (-(1 / 2)) else 0 := by + intro j hj + simp only [Finset.mem_range] at hj + by_cases hc : j = m + · subst hc + simp [pathEntry] + · rw [if_neg hc] + unfold pathEntry + rw [if_neg (by omega : ¬ (m + 1) = j), + if_neg (by omega : ¬ (j + 1 = m + 1 ∨ (m + 1) + 1 = j))] + ring + have hmem : m ∈ Finset.range (m + 1) := Finset.self_mem_range_succ m + have expand : ∀ i ∈ Finset.range (m + 1), + ∑ j ∈ Finset.range (m + 1 + 1), y i * y j * pathEntry i j + = (∑ j ∈ Finset.range (m + 1), y i * y j * pathEntry i j) + + (if i = m then y i * y (m + 1) * (-(1 / 2)) else 0) := by + intro i hi + rw [Finset.sum_range_succ, hL i hi] + rw [Finset.sum_range_succ (f := fun i => + ∑ j ∈ Finset.range (m + 1 + 1), y i * y j * pathEntry i j), + Finset.sum_congr rfl expand, Finset.sum_add_distrib, + Finset.sum_ite_eq' (Finset.range (m + 1)) m + (fun i => y i * y (m + 1) * (-(1 / 2 : ℝ))), + if_pos hmem] + rw [Finset.sum_range_succ (f := fun j => y (m + 1) * y j * pathEntry (m + 1) j), + Finset.sum_congr rfl hR, + Finset.sum_ite_eq' (Finset.range (m + 1)) m + (fun j => y (m + 1) * y j * (-(1 / 2 : ℝ))), + if_pos hmem] + have hdiag : pathEntry (m + 1) (m + 1) = 1 := if_pos rfl + rw [hdiag, ih, Finset.sum_range_succ (f := fun i => (y i) ^ 2) (n := m + 1), + Finset.sum_range_succ (f := fun i => y i * y (i + 1)) (n := m)] + ring + +/-! ### A path graph with one modified edge + +The same tridiagonal quadratic form, but on `n + 2` vertices, with the *last* edge (between +generators `n` and `n + 1`) reweighted from `-1/2` to `-k/2` for an arbitrary `k : ℝ`. -/ + +/-- Sum-of-squares identity for the tridiagonal (doubled) quadratic form on `n + 2` generators +whose last edge `(n, n + 1)` has weight `-k/2` instead of `-1/2`: `sos_identity` on the first +`n + 1` generators, plus completing the square on the last edge. The leftover +`(2 - k ^ 2) * y (n + 1) ^ 2` term vanishes exactly when `k ^ 2 = 2`. -/ +theorem sos_identity_lastEdge (n : ℕ) (y : ℕ → ℝ) (k : ℝ) : + 2 * (∑ i ∈ Finset.range (n + 2), (y i) ^ 2 - ∑ i ∈ Finset.range n, y i * y (i + 1) + - k * y n * y (n + 1)) + = y 0 ^ 2 + ∑ i ∈ Finset.range n, (y i - y (i + 1)) ^ 2 + + (y n - k * y (n + 1)) ^ 2 + (2 - k ^ 2) * y (n + 1) ^ 2 := by + have hA := sos_identity y n + rw [Finset.sum_range_succ (f := fun i => (y i) ^ 2) (n := n + 1)] + linear_combination hA + +/-- The entry function of the (doubled) tridiagonal quadratic form on `n + 2` generators, with the +last edge `(n, n + 1)` reweighted from `-1/2` to `-k/2`: `1` on the diagonal, `-k/2` on the last +edge, `-1/2` on the other adjacent off-diagonal entries, `0` elsewhere. -/ +noncomputable def lastEdgeEntry (n : ℕ) (k : ℝ) (i j : ℕ) : ℝ := + if i = j then 1 + else if (i = n ∧ j = n + 1) ∨ (j = n ∧ i = n + 1) then -(k / 2) + else if j + 1 = i ∨ i + 1 = j then -(1 / 2) else 0 + +/-- `lastEdgeEntry` is symmetric: its diagonal, special-pair, and adjacency conditions are all +symmetric under swapping the two indices. -/ +theorem lastEdgeEntry_symm (n : ℕ) (k : ℝ) (i j : ℕ) : + lastEdgeEntry n k i j = lastEdgeEntry n k j i := by + unfold lastEdgeEntry + by_cases hij : i = j + · simp [hij] + · rw [if_neg hij, if_neg (Ne.symm hij)] + by_cases hspec : (i = n ∧ j = n + 1) ∨ (j = n ∧ i = n + 1) + · rw [if_pos hspec, if_pos (Or.symm hspec)] + · rw [if_neg hspec, if_neg (fun h => hspec (Or.symm h))] + by_cases hadj : j + 1 = i ∨ i + 1 = j + · rw [if_pos hadj, if_pos (Or.symm hadj)] + · rw [if_neg hadj, if_neg (fun h => hadj (Or.symm h))] + +theorem lastEdgeEntry_diag (n : ℕ) (k : ℝ) (i : ℕ) : lastEdgeEntry n k i i = 1 := by + unfold lastEdgeEntry; rw [if_pos rfl] + +theorem lastEdgeEntry_last_row (n : ℕ) (k : ℝ) {i : ℕ} (hi : i < n) : + lastEdgeEntry n k i (n + 1) = 0 := by + unfold lastEdgeEntry + rw [if_neg (by omega), if_neg (by omega), if_neg (by omega)] + +theorem lastEdgeEntry_special (n : ℕ) (k : ℝ) : lastEdgeEntry n k n (n + 1) = -(k / 2) := by + unfold lastEdgeEntry + rw [if_neg (by omega), if_pos (Or.inl ⟨rfl, rfl⟩)] + +/-- Away from the last edge, `lastEdgeEntry` agrees with `pathEntry`. -/ +theorem lastEdgeEntry_eq_pathEntry (n : ℕ) (k : ℝ) {i j : ℕ} (hi : i < n + 1) (hj : j < n + 1) : + lastEdgeEntry n k i j = (pathEntry i j : ℝ) := by + unfold lastEdgeEntry pathEntry + have hspec : ¬((i = n ∧ j = n + 1) ∨ (j = n ∧ i = n + 1)) := by omega + by_cases hij : i = j + · simp [hij] + · rw [if_neg hij, if_neg hij, if_neg hspec] + split_ifs <;> norm_num + +/-- The double sum against `lastEdgeEntry` collapses to the tridiagonal quadratic form from +`sos_identity_lastEdge`: on the first `n + 1` generators it agrees with `pathEntry` +(`pathEntry_sum_range_double`), and the remaining corner terms involving generator `n + 1` collapse +(via `lastEdgeEntry_symm`) to twice the single `(n, n + 1)`-entry contribution plus the diagonal. -/ +theorem lastEdgeEntry_sum_range_double (n : ℕ) (k : ℝ) (y : ℕ → ℝ) : + (∑ i ∈ Finset.range (n + 2), ∑ j ∈ Finset.range (n + 2), y i * y j * lastEdgeEntry n k i j) + = ∑ i ∈ Finset.range (n + 2), (y i) ^ 2 - ∑ i ∈ Finset.range n, y i * y (i + 1) + - k * y n * y (n + 1) := by + have hsquare : ∑ i ∈ Finset.range (n + 1), ∑ j ∈ Finset.range (n + 1), + y i * y j * lastEdgeEntry n k i j + = ∑ i ∈ Finset.range (n + 1), (y i) ^ 2 - ∑ i ∈ Finset.range n, y i * y (i + 1) := by + rw [← pathEntry_sum_range_double y n] + exact Finset.sum_congr rfl (fun i hi => Finset.sum_congr rfl (fun j hj => + by rw [lastEdgeEntry_eq_pathEntry n k (Finset.mem_range.mp hi) (Finset.mem_range.mp hj)])) + have hcorner : ∀ i ∈ Finset.range (n + 1), + y i * y (n + 1) * lastEdgeEntry n k i (n + 1) = + if i = n then y i * y (n + 1) * (-(k / 2)) else 0 := by + intro i hi + simp only [Finset.mem_range] at hi + by_cases hc : i = n + · rw [if_pos hc, hc, lastEdgeEntry_special] + · rw [if_neg hc, lastEdgeEntry_last_row n k (show i < n by omega)]; ring + have hrow : ∑ i ∈ Finset.range (n + 1), y i * y (n + 1) * lastEdgeEntry n k i (n + 1) + = y n * y (n + 1) * (-(k / 2)) := by + rw [Finset.sum_congr rfl hcorner, + Finset.sum_ite_eq' (Finset.range (n + 1)) n (fun i => y i * y (n + 1) * (-(k / 2))), + if_pos (Finset.self_mem_range_succ n)] + have hcol : ∑ j ∈ Finset.range (n + 1), y (n + 1) * y j * lastEdgeEntry n k (n + 1) j + = y n * y (n + 1) * (-(k / 2)) := by + rw [← hrow] + refine Finset.sum_congr rfl (fun j _ => ?_) + rw [lastEdgeEntry_symm n k (n + 1) j] + ring + have hstep : (∑ i ∈ Finset.range (n + 2), ∑ j ∈ Finset.range (n + 2), + y i * y j * lastEdgeEntry n k i j) + = (∑ i ∈ Finset.range (n + 1), ∑ j ∈ Finset.range (n + 1), + y i * y j * lastEdgeEntry n k i j) + + (∑ i ∈ Finset.range (n + 1), y i * y (n + 1) * lastEdgeEntry n k i (n + 1)) + + ((∑ j ∈ Finset.range (n + 1), y (n + 1) * y j * lastEdgeEntry n k (n + 1) j) + + y (n + 1) * y (n + 1) * lastEdgeEntry n k (n + 1) (n + 1)) := by + rw [Finset.sum_range_succ (f := fun i => + ∑ j ∈ Finset.range (n + 2), y i * y j * lastEdgeEntry n k i j) (n := n + 1)] + congr 1 + · rw [Finset.sum_congr rfl (fun i (_ : i ∈ Finset.range (n + 1)) => + Finset.sum_range_succ (f := fun j => y i * y j * lastEdgeEntry n k i j) (n := n + 1)), + Finset.sum_add_distrib] + · exact Finset.sum_range_succ (f := fun j => y (n + 1) * y j * lastEdgeEntry n k (n + 1) j) + (n := n + 1) + rw [hstep, hsquare, hrow, hcol, lastEdgeEntry_diag, + Finset.sum_range_succ (f := fun i => (y i) ^ 2) (n := n + 1)] + ring + +end Coxeter diff --git a/Coxeter/FiniteOrAffine/TypeA.lean b/Coxeter/FiniteOrAffine/TypeA.lean index d1a2133..3c954e7 100644 --- a/Coxeter/FiniteOrAffine/TypeA.lean +++ b/Coxeter/FiniteOrAffine/TypeA.lean @@ -1,5 +1,6 @@ module +public import Coxeter.FiniteOrAffine.TridiagonalForm public import Coxeter.SpecialFeatures public import Mathlib.Combinatorics.SimpleGraph.Hasse @@ -42,14 +43,16 @@ namespace Coxeter /-- The Coxeter group of type `A` on `n` generators, realized as the abstract group presented by `CoxeterMatrix.A n` (whose Coxeter-Dynkin diagram is a path on `n` vertices). -/ -@[reducible] noncomputable def typeAGroup (n : ℕ) : CoxeterGroup (CoxeterMatrix.A n).Group where +@[reducible] noncomputable def typeAGroup (n : ℕ) [NeZero n] : + CoxeterGroup (CoxeterMatrix.A n).Group where B := Fin n M := CoxeterMatrix.A n cs := (CoxeterMatrix.A n).toCoxeterSystem /-- Type `A`'s off-diagonal entries are always `2` or `3`, both in the crystallographic set `{0, 2, 3, 4, 6}`. -/ -theorem typeA_isCrystallographic (n : ℕ) : @IsCrystallographic _ (typeAGroup n) := by +theorem typeA_isCrystallographic (n : ℕ) [NeZero n] : + @IsCrystallographic _ (typeAGroup n) := by intro i i' hii' change (CoxeterMatrix.A n) i i' = 0 ∨ (CoxeterMatrix.A n) i i' = 2 ∨ (CoxeterMatrix.A n) i i' = 3 ∨ (CoxeterMatrix.A n) i i' = 4 ∨ (CoxeterMatrix.A n) i i' = 6 @@ -92,93 +95,20 @@ theorem typeA_isIrreducible (n : ℕ) : @IsIrreducible _ (typeAGroup (n + 1)) := /-! ### Positive definiteness of `bil` for type A -The tridiagonal quadratic form `Q(y) = ∑_{i simp; ring - | succ m ih => - rw [Finset.sum_range_succ (f := fun i => (y i) ^ 2), - Finset.sum_range_succ (f := fun i => y i * y (i + 1)), - Finset.sum_range_succ (f := fun i => (y i - y (i + 1)) ^ 2)] - linear_combination ih - -/-- The entry function of the (doubled) type-A quadratic form: `1` on the diagonal, `-1/2` on -adjacent off-diagonal entries, `0` elsewhere. -/ -private noncomputable def typeAEntry (i j : ℕ) : ℝ := - if i = j then 1 else if j + 1 = i ∨ i + 1 = j then -(1 / 2) else 0 - -/-- The double sum against `typeAEntry` collapses to the tridiagonal quadratic form `Q(y)` from -`sos_identity`: only the diagonal and immediately-adjacent entries of `typeAEntry` are nonzero. -/ -private theorem sum_range_double (y : ℕ → ℝ) (m : ℕ) : - (∑ i ∈ Finset.range (m + 1), ∑ j ∈ Finset.range (m + 1), y i * y j * typeAEntry i j) - = ∑ i ∈ Finset.range (m + 1), (y i) ^ 2 - ∑ i ∈ Finset.range m, y i * y (i + 1) := by - induction m with - | zero => simp [typeAEntry]; ring - | succ m ih => - have hL : ∀ i ∈ Finset.range (m + 1), - y i * y (m + 1) * typeAEntry i (m + 1) = - if i = m then y i * y (m + 1) * (-(1 / 2)) else 0 := by - intro i hi - simp only [Finset.mem_range] at hi - by_cases hc : i = m - · subst hc - simp [typeAEntry] - · rw [if_neg hc] - unfold typeAEntry - rw [if_neg (by omega : ¬ i = m + 1), - if_neg (by omega : ¬ ((m + 1) + 1 = i ∨ i + 1 = m + 1))] - ring - have hR : ∀ j ∈ Finset.range (m + 1), - y (m + 1) * y j * typeAEntry (m + 1) j = - if j = m then y (m + 1) * y j * (-(1 / 2)) else 0 := by - intro j hj - simp only [Finset.mem_range] at hj - by_cases hc : j = m - · subst hc - simp [typeAEntry] - · rw [if_neg hc] - unfold typeAEntry - rw [if_neg (by omega : ¬ (m + 1) = j), - if_neg (by omega : ¬ (j + 1 = m + 1 ∨ (m + 1) + 1 = j))] - ring - have hmem : m ∈ Finset.range (m + 1) := Finset.self_mem_range_succ m - have expand : ∀ i ∈ Finset.range (m + 1), - ∑ j ∈ Finset.range (m + 1 + 1), y i * y j * typeAEntry i j - = (∑ j ∈ Finset.range (m + 1), y i * y j * typeAEntry i j) - + (if i = m then y i * y (m + 1) * (-(1 / 2)) else 0) := by - intro i hi - rw [Finset.sum_range_succ, hL i hi] - rw [Finset.sum_range_succ (f := fun i => - ∑ j ∈ Finset.range (m + 1 + 1), y i * y j * typeAEntry i j), - Finset.sum_congr rfl expand, Finset.sum_add_distrib, - Finset.sum_ite_eq' (Finset.range (m + 1)) m - (fun i => y i * y (m + 1) * (-(1 / 2 : ℝ))), - if_pos hmem] - rw [Finset.sum_range_succ (f := fun j => y (m + 1) * y j * typeAEntry (m + 1) j), - Finset.sum_congr rfl hR, - Finset.sum_ite_eq' (Finset.range (m + 1)) m - (fun j => y (m + 1) * y j * (-(1 / 2 : ℝ))), - if_pos hmem] - have hdiag : typeAEntry (m + 1) (m + 1) = 1 := if_pos rfl - rw [hdiag, ih, Finset.sum_range_succ (f := fun i => (y i) ^ 2) (n := m + 1), - Finset.sum_range_succ (f := fun i => y i * y (i + 1)) (n := m)] - ring - -/-- The Gram matrix entries of `bil` on standard basis vectors of type A match `typeAEntry`. -/ +/-- The Gram matrix entries of `bil` on standard basis vectors of type A match `pathEntry`. -/ private theorem bil_typeA_entries (m : ℕ) (i j : Fin (m + 1)) : (@bil _ (typeAGroup (m + 1))) (@stdBasis _ (typeAGroup (m + 1)) i) - (@stdBasis _ (typeAGroup (m + 1)) j) = typeAEntry (i : ℕ) (j : ℕ) := by + (@stdBasis _ (typeAGroup (m + 1)) j) = pathEntry (i : ℕ) (j : ℕ) := by unfold bil rw [Matrix.toBilin_single] - change -Real.cos (Real.pi / ((CoxeterMatrix.A (m + 1)) i j : ℝ)) = typeAEntry (i : ℕ) (j : ℕ) - unfold CoxeterMatrix.A typeAEntry + change -Real.cos (Real.pi / ((CoxeterMatrix.A (m + 1)) i j : ℝ)) = pathEntry (i : ℕ) (j : ℕ) + unfold CoxeterMatrix.A pathEntry simp only [Matrix.of_apply] by_cases hij : i = j · have hij' : (i : ℕ) = (j : ℕ) := by rw [hij] @@ -187,7 +117,7 @@ private theorem bil_typeA_entries (m : ℕ) (i j : Fin (m + 1)) : · have hij' : (i : ℕ) ≠ (j : ℕ) := fun h => hij (Fin.ext h) rw [if_neg hij, if_neg hij'] split_ifs with hadj - · rw [show ((3 : ℕ) : ℝ) = 3 by norm_num, Real.cos_pi_div_three] + · rw [show ((3 : ℕ) : ℝ) = 3 by norm_num, Real.cos_pi_div_three]; norm_num · rw [show ((2 : ℕ) : ℝ) = 2 by norm_num, Real.cos_pi_div_two] norm_num @@ -206,7 +136,7 @@ private theorem bil_typeA_apply (m : ℕ) (x : Fin (m + 1) →₀ ℝ) : (@bil _ (typeAGroup (m + 1))) x x = ∑ i ∈ Finset.range (m + 1), (typeAExtend m x i) ^ 2 - ∑ i ∈ Finset.range m, typeAExtend m x i * typeAExtend m x (i + 1) := by - rw [← sum_range_double (typeAExtend m x) m] + rw [← pathEntry_sum_range_double (typeAExtend m x) m] have hrepr : (@stdBasis _ (typeAGroup (m + 1))).repr x = x := rfl have key : (@bil _ (typeAGroup (m + 1))) x x = ∑ i : Fin (m + 1), ∑ j : Fin (m + 1), @@ -222,15 +152,15 @@ private theorem bil_typeA_apply (m : ℕ) (x : Fin (m + 1) →₀ ℝ) : have hentry : ∀ i j : Fin (m + 1), x i * x j * (@bil _ (typeAGroup (m + 1))) (@stdBasis _ (typeAGroup (m + 1)) i) (@stdBasis _ (typeAGroup (m + 1)) j) - = typeAExtend m x (i : ℕ) * typeAExtend m x (j : ℕ) * typeAEntry (i : ℕ) (j : ℕ) := by + = typeAExtend m x (i : ℕ) * typeAExtend m x (j : ℕ) * pathEntry (i : ℕ) (j : ℕ) := by intro i j rw [bil_typeA_entries, typeAExtend_apply_fin, typeAExtend_apply_fin] rw [Finset.sum_congr rfl (fun i (_ : i ∈ (Finset.univ : Finset (Fin (m + 1)))) => Finset.sum_congr rfl (fun j (_ : j ∈ (Finset.univ : Finset (Fin (m + 1)))) => hentry i j))] rw [Fin.sum_univ_eq_sum_range (fun i => ∑ j : Fin (m + 1), - typeAExtend m x i * typeAExtend m x j * typeAEntry i j) (m + 1)] + typeAExtend m x i * typeAExtend m x j * pathEntry i j) (m + 1)] refine Finset.sum_congr rfl (fun i _ => ?_) - exact Fin.sum_univ_eq_sum_range (fun j => typeAExtend m x i * typeAExtend m x j * typeAEntry i j) + exact Fin.sum_univ_eq_sum_range (fun j => typeAExtend m x i * typeAExtend m x j * pathEntry i j) (m + 1) /-- Type A's `bil` is positive semidefinite: `bil x x ≥ 0` for every `x`, since (doubled) it's a diff --git a/Coxeter/FiniteOrAffine/TypeBC.lean b/Coxeter/FiniteOrAffine/TypeBC.lean new file mode 100644 index 0000000..f062319 --- /dev/null +++ b/Coxeter/FiniteOrAffine/TypeBC.lean @@ -0,0 +1,282 @@ +module + +public import Coxeter.FiniteOrAffine.TridiagonalForm +public import Coxeter.FiniteOrAffine.TypeA +public import Coxeter.SpecialFeatures + +/-! +# The Coxeter groups of finite type B/C + +Finite types `Bₙ` and `Cₙ` have the same Coxeter system. This file packages that shared Coxeter +system as `typeBCGroup`. + +The classification proofs are intentionally left as `proof_wanted` stubs. + +For mathlib's current uniform matrix definition, the first nonempty rank satisfies `BC₁ = A₁`. +-/ + +@[expose] public section + +namespace Coxeter + +/-- The shared finite Coxeter group of types `B` and `C` on `n` generators, realized as the +abstract group presented by `CoxeterMatrix.B n`. -/ +@[reducible] noncomputable def typeBCGroup (n : ℕ) [NeZero n] : + CoxeterGroup (CoxeterMatrix.B n).Group where + B := Fin n + M := CoxeterMatrix.B n + cs := (CoxeterMatrix.B n).toCoxeterSystem + +/-- Type `BC`'s off-diagonal entries are always `2`, `3`, or `4`, hence crystallographic. -/ +theorem typeBC_isCrystallographic (n : ℕ) [NeZero n] : + @IsCrystallographic _ (typeBCGroup n) := by + intro i i' hii' + change (CoxeterMatrix.B n) i i' = 0 ∨ (CoxeterMatrix.B n) i i' = 2 ∨ + (CoxeterMatrix.B n) i i' = 3 ∨ (CoxeterMatrix.B n) i i' = 4 ∨ + (CoxeterMatrix.B n) i i' = 6 + unfold CoxeterMatrix.B + simp only [Matrix.of_apply, if_neg hii'] + split_ifs <;> tauto + +private theorem coxeterGraphMatrix_typeBC_eq_pathGraph (n : ℕ) : + coxeterGraphMatrix (CoxeterMatrix.B n) = SimpleGraph.pathGraph n := by + ext i j + rw [coxeterGraphMatrix, SimpleGraph.fromRel_adj, SimpleGraph.pathGraph_adj] + unfold CoxeterMatrix.B + simp only [Matrix.of_apply, ne_eq] + by_cases h : i = j + · simp [h] + · rw [if_neg h, if_neg (Ne.symm h)] + have key : ∀ p q : Fin n, p ≠ q → + (¬(if (p : ℕ) = n - 1 ∧ (q : ℕ) = n - 2 ∨ (q : ℕ) = n - 1 ∧ (p : ℕ) = n - 2 then (4 : ℕ) + else if (q : ℕ) + 1 = p ∨ (p : ℕ) + 1 = q then 3 else 2) = 2 ↔ + ((q : ℕ) + 1 = p ∨ (p : ℕ) + 1 = q)) := by + intro p q hpq + have hp := p.isLt + have hq := q.isLt + have hpq' : (p : ℕ) ≠ (q : ℕ) := fun he => hpq (Fin.val_injective he) + have hspec : ((p : ℕ) = n - 1 ∧ (q : ℕ) = n - 2 ∨ (q : ℕ) = n - 1 ∧ (p : ℕ) = n - 2) → + ((q : ℕ) + 1 = p ∨ (p : ℕ) + 1 = q) := by + rintro (⟨hp1, hq1⟩ | ⟨hq1, hp1⟩) <;> omega + split_ifs with hA hB + · simp [hspec hA] + · simp [hB] + · simp [hB] + have hiff1 := key i j h + have hiff2 := key j i (Ne.symm h) + rw [hiff1, hiff2] + tauto + +/-- Type `BC` on `n + 2` generators (so the Coxeter-Dynkin diagram has at least two vertices, hence +the special `4`-edge is present) is irreducible: its diagram is the path graph on `n + 2` vertices, +which is connected. -/ +theorem typeBC_isIrreducible (n : ℕ) : @IsIrreducible _ (typeBCGroup (n + 2)) := by + unfold IsIrreducible IsIrreducibleMatrix + change (coxeterGraphMatrix (CoxeterMatrix.B (n + 2))).Connected + rw [coxeterGraphMatrix_typeBC_eq_pathGraph] + exact SimpleGraph.pathGraph_connected (n + 1) + +/-! ### Positive definiteness of `bil` for type B/C + +Type `B`/`C`'s Coxeter matrix is the tridiagonal ("path graph") form from +`Coxeter.FiniteOrAffine.TridiagonalForm` with its last edge (between generators `n` and `n + 1`, +out of `n + 2` total) reweighted from `-1/2` to `-√2/2` (it comes from `M = 4`, i.e. +`-cos (π/4) = -√2/2`, rather than `M = 3`). Since `(√2)^2 = 2`, `sos_identity_lastEdge`'s leftover +correction term vanishes, giving a clean sum-of-squares identity for the whole form. -/ + +/-- `CoxeterMatrix.B (n + 2)` at two distinct generators, with the "size minus 1/2" arithmetic +already resolved to `n + 1`/`n`. -/ +private theorem coxeterMatrix_B_apply (n : ℕ) {i j : Fin (n + 2)} (hij : i ≠ j) : + (CoxeterMatrix.B (n + 2)) i j = + if (i : ℕ) = n ∧ (j : ℕ) = n + 1 ∨ (j : ℕ) = n ∧ (i : ℕ) = n + 1 then (4 : ℕ) + else if (j : ℕ) + 1 = i ∨ (i : ℕ) + 1 = j then 3 else 2 := by + unfold CoxeterMatrix.B + simp only [Matrix.of_apply, if_neg hij] + have h1 : n + 2 - 1 = n + 1 := by omega + have h2 : n + 2 - 2 = n := by omega + rw [h1, h2] + have hiff : ((i : ℕ) = n + 1 ∧ (j : ℕ) = n ∨ (j : ℕ) = n + 1 ∧ (i : ℕ) = n) ↔ + ((i : ℕ) = n ∧ (j : ℕ) = n + 1 ∨ (j : ℕ) = n ∧ (i : ℕ) = n + 1) := by tauto + simp only [hiff] + +/-- The Gram matrix entries of `bil` on standard basis vectors of type `B`/`C` match +`lastEdgeEntry n √2`. -/ +private theorem bil_typeBC_entries (n : ℕ) (i j : Fin (n + 2)) : + (@bil _ (typeBCGroup (n + 2))) (@stdBasis _ (typeBCGroup (n + 2)) i) + (@stdBasis _ (typeBCGroup (n + 2)) j) = lastEdgeEntry n (Real.sqrt 2) (i : ℕ) (j : ℕ) := by + unfold bil + rw [Matrix.toBilin_single] + change -Real.cos (Real.pi / ((CoxeterMatrix.B (n + 2)) i j : ℝ)) + = lastEdgeEntry n (Real.sqrt 2) (i : ℕ) (j : ℕ) + by_cases hij : i = j + · have hij' : (i : ℕ) = (j : ℕ) := by rw [hij] + unfold CoxeterMatrix.B lastEdgeEntry + simp only [Matrix.of_apply, if_pos hij, if_pos hij'] + norm_num + · have hij' : (i : ℕ) ≠ (j : ℕ) := fun h => hij (Fin.ext h) + rw [coxeterMatrix_B_apply n hij] + unfold lastEdgeEntry + rw [if_neg hij'] + split_ifs with hspec hadj + · rw [show ((4 : ℕ) : ℝ) = 4 by norm_num, Real.cos_pi_div_four] + · rw [show ((3 : ℕ) : ℝ) = 3 by norm_num, Real.cos_pi_div_three] + · rw [show ((2 : ℕ) : ℝ) = 2 by norm_num, Real.cos_pi_div_two] + norm_num + +/-- Extends `x : Fin (n + 2) →₀ ℝ` to a function on all of `ℕ`, vanishing past `n + 1`. -/ +private noncomputable def typeBCExtend (n : ℕ) (x : Fin (n + 2) →₀ ℝ) : ℕ → ℝ := + fun k => if h : k < n + 2 then x ⟨k, h⟩ else 0 + +private theorem typeBCExtend_apply_fin (n : ℕ) (x : Fin (n + 2) →₀ ℝ) (i : Fin (n + 2)) : + typeBCExtend n x (i : ℕ) = x i := by + unfold typeBCExtend + rw [dif_pos i.isLt] + +/-- Sum-of-squares identity for the type-`B`/`C` (doubled) quadratic form on `n + 2` generators: +`sos_identity_lastEdge` at `k = √2`, whose leftover `(2 - k ^ 2) * y (n + 1) ^ 2` term vanishes +since `(√2) ^ 2 = 2`. -/ +private theorem sos_identity_BC (n : ℕ) (y : ℕ → ℝ) : + 2 * (∑ i ∈ Finset.range (n + 2), (y i) ^ 2 - ∑ i ∈ Finset.range n, y i * y (i + 1) + - Real.sqrt 2 * y n * y (n + 1)) + = y 0 ^ 2 + ∑ i ∈ Finset.range n, (y i - y (i + 1)) ^ 2 + + (y n - Real.sqrt 2 * y (n + 1)) ^ 2 := by + have h := sos_identity_lastEdge n y (Real.sqrt 2) + have hsq : Real.sqrt 2 ^ 2 = 2 := Real.sq_sqrt (by norm_num) + rw [hsq, sub_self, zero_mul, add_zero] at h + exact h + +/-- `bil x x` for type `B`/`C`, spelled out as the tridiagonal quadratic form on the +`ℕ`-extension of `x`'s coordinates. -/ +private theorem bil_typeBC_apply (n : ℕ) (x : Fin (n + 2) →₀ ℝ) : + (@bil _ (typeBCGroup (n + 2))) x x + = ∑ i ∈ Finset.range (n + 2), (typeBCExtend n x i) ^ 2 + - ∑ i ∈ Finset.range n, typeBCExtend n x i * typeBCExtend n x (i + 1) + - Real.sqrt 2 * typeBCExtend n x n * typeBCExtend n x (n + 1) := by + rw [← lastEdgeEntry_sum_range_double n (Real.sqrt 2) (typeBCExtend n x)] + have hrepr : (@stdBasis _ (typeBCGroup (n + 2))).repr x = x := rfl + have key : (@bil _ (typeBCGroup (n + 2))) x x + = ∑ i : Fin (n + 2), ∑ j : Fin (n + 2), + x i * x j * (@bil _ (typeBCGroup (n + 2))) + (@stdBasis _ (typeBCGroup (n + 2)) i) (@stdBasis _ (typeBCGroup (n + 2)) j) := by + rw [← LinearMap.BilinForm.sum_repr_mul_repr_mul + (B := @bil _ (typeBCGroup (n + 2))) (@stdBasis _ (typeBCGroup (n + 2))) x x, hrepr, + Finsupp.sum_fintype x _ (fun i => by simp)] + refine Finset.sum_congr rfl (fun i _ => ?_) + rw [Finsupp.sum_fintype x _ (fun j => by simp)] + simp only [smul_eq_mul, ← mul_assoc] + rw [key] + have hentry : ∀ i j : Fin (n + 2), + x i * x j * (@bil _ (typeBCGroup (n + 2))) + (@stdBasis _ (typeBCGroup (n + 2)) i) (@stdBasis _ (typeBCGroup (n + 2)) j) + = typeBCExtend n x (i : ℕ) * typeBCExtend n x (j : ℕ) + * lastEdgeEntry n (Real.sqrt 2) (i : ℕ) (j : ℕ) := by + intro i j + rw [bil_typeBC_entries, typeBCExtend_apply_fin, typeBCExtend_apply_fin] + rw [Finset.sum_congr rfl (fun i (_ : i ∈ (Finset.univ : Finset (Fin (n + 2)))) => + Finset.sum_congr rfl (fun j (_ : j ∈ (Finset.univ : Finset (Fin (n + 2)))) => hentry i j))] + rw [Fin.sum_univ_eq_sum_range (fun i => ∑ j : Fin (n + 2), + typeBCExtend n x i * typeBCExtend n x j * lastEdgeEntry n (Real.sqrt 2) i j) (n + 2)] + refine Finset.sum_congr rfl (fun i _ => ?_) + exact Fin.sum_univ_eq_sum_range + (fun j => typeBCExtend n x i * typeBCExtend n x j * lastEdgeEntry n (Real.sqrt 2) i j) (n + 2) + +/-- Type `B`/`C`'s `bil` is positive semidefinite: `bil x x ≥ 0` for every `x`, since (doubled) +it's a sum of squares by `sos_identity_BC`. -/ +private theorem bil_typeBC_isNonneg (n : ℕ) : (@bil _ (typeBCGroup (n + 2))).IsNonneg := by + rw [LinearMap.BilinForm.isNonneg_def] + intro x + rw [bil_typeBC_apply] + have h := sos_identity_BC n (typeBCExtend n x) + have hC : 0 ≤ ∑ i ∈ Finset.range n, (typeBCExtend n x i - typeBCExtend n x (i + 1)) ^ 2 := + Finset.sum_nonneg (fun i _ => sq_nonneg _) + nlinarith [h, sq_nonneg (typeBCExtend n x 0), + sq_nonneg (typeBCExtend n x n - Real.sqrt 2 * typeBCExtend n x (n + 1)), hC] + +/-- Type `B`/`C`'s `bil` is nondegenerate: if `bil x x = 0`, the sum-of-squares identity forces +every `typeBCExtend n x i` (`i ≤ n + 1`) to vanish, i.e. `x = 0`. -/ +private theorem bil_typeBC_nondegenerate (n : ℕ) : + (@bil _ (typeBCGroup (n + 2))).Nondegenerate := by + unfold LinearMap.BilinForm.Nondegenerate + rw [LinearMap.BilinForm.nondegenerate_iff' + (hs := (bil_typeBC_isNonneg n).nonneg) + (hB := LinearMap.BilinForm.isSymm_iff.mp (@bil_isSymm _ (typeBCGroup (n + 2))))] + intro x hx + rcases ((bil_typeBC_isNonneg n).nonneg x).lt_or_eq with h | h + · exact h + · exfalso + apply hx + have hzero : (@bil _ (typeBCGroup (n + 2))) x x = 0 := h.symm + rw [bil_typeBC_apply] at hzero + set y := typeBCExtend n x with hy_def + have hsos := sos_identity_BC n y + have hC : 0 ≤ ∑ i ∈ Finset.range n, (y i - y (i + 1)) ^ 2 := + Finset.sum_nonneg (fun i _ => sq_nonneg _) + have hlastsq : (y n - Real.sqrt 2 * y (n + 1)) ^ 2 = 0 := by + nlinarith [hsos, hzero, sq_nonneg (y 0), hC] + have h0sq : y 0 ^ 2 = 0 := by nlinarith [hsos, hzero, hlastsq, hC] + have hCsum : ∑ i ∈ Finset.range n, (y i - y (i + 1)) ^ 2 = 0 := by + nlinarith [hsos, hzero, hlastsq, sq_nonneg (y 0)] + have h0 : y 0 = 0 := sq_eq_zero_iff.mp h0sq + have hstep : ∀ i ∈ Finset.range n, y i = y (i + 1) := by + intro i hi + have hzero_term : (y i - y (i + 1)) ^ 2 = 0 := + (Finset.sum_eq_zero_iff_of_nonneg (fun i _ => sq_nonneg _)).mp hCsum i hi + have := sq_eq_zero_iff.mp hzero_term + linarith + have hall : ∀ i ≤ n, y i = 0 := by + intro i hi + induction i with + | zero => exact h0 + | succ k ih => + have hk : k < n := by omega + rw [← hstep k (Finset.mem_range.mpr hk)] + exact ih (by omega) + have hn0 : y n = 0 := hall n le_rfl + have hlast : y n - Real.sqrt 2 * y (n + 1) = 0 := sq_eq_zero_iff.mp hlastsq + have hn1 : y (n + 1) = 0 := by + rw [hn0] at hlast + have hmul : Real.sqrt 2 * y (n + 1) = 0 := by linarith + rcases mul_eq_zero.mp hmul with h | h + · exact absurd h (by positivity) + · exact h + apply Finsupp.ext + intro i + have hi0 : y (i : Fin (n + 2)).val = 0 := by + rcases lt_or_ge (i : Fin (n + 2)).val (n + 1) with h | h + · exact hall _ (by omega) + · have heq : (i : Fin (n + 2)).val = n + 1 := by omega + rw [heq]; exact hn1 + rw [hy_def, typeBCExtend_apply_fin] at hi0 + simpa using hi0 + +theorem typeBC_isFiniteCoxeter (n : ℕ) : @IsFiniteCoxeter _ (typeBCGroup (n + 2)) := + Or.inr ⟨⟨@bil_isSymm _ (typeBCGroup (n + 2)), bil_typeBC_isNonneg n⟩, bil_typeBC_nondegenerate n⟩ + +theorem typeBC_isPolyFiniteWeyl (n : ℕ) : @IsPolyFiniteWeyl _ (typeBCGroup (n + 2)) := + ⟨typeBC_isFiniteCoxeter n, typeBC_isCrystallographic (n + 2)⟩ + +/-- Type `B`/`C` on `n + 2` generators is an *irreducible* finite Weyl group. -/ +theorem typeBC_isIrreducibleFiniteWeyl (n : ℕ) : @IsIrreducibleFiniteWeyl _ (typeBCGroup (n + 2)) := + ⟨typeBC_isPolyFiniteWeyl n, typeBC_isIrreducible n⟩ + +/-! ### Small-rank accidental identifications -/ + +section Accidentals + +private theorem coxeterMatrix_B_one_eq_A_one : CoxeterMatrix.B 1 = CoxeterMatrix.A 1 := by + ext i j + fin_cases i + fin_cases j + rfl + +/-- The Coxeter-system-level accidental identification `BC₁ = A₁`. + +The entrywise matrix equality used to prove this is private. -/ +theorem typeBC_one_identifies_typeA_one : + HEq (@CoxeterGroup.cs _ (typeBCGroup 1)) (@CoxeterGroup.cs _ (typeAGroup 1)) := by + change HEq (CoxeterMatrix.B 1).toCoxeterSystem (CoxeterMatrix.A 1).toCoxeterSystem + rw [← coxeterMatrix_B_one_eq_A_one] + +end Accidentals + +end Coxeter diff --git a/Coxeter/FiniteOrAffine/TypeD.lean b/Coxeter/FiniteOrAffine/TypeD.lean new file mode 100644 index 0000000..aa09cb1 --- /dev/null +++ b/Coxeter/FiniteOrAffine/TypeD.lean @@ -0,0 +1,108 @@ +module + +public import Coxeter.FiniteOrAffine.TypeA +public import Coxeter.SpecialFeatures + +/-! +# The Coxeter group of type D + +This file packages the finite Coxeter group of type `D`. + +The classification proofs are intentionally left as `proof_wanted` stubs. + +Mathlib's current uniform `CoxeterMatrix.D` formula has the wrong small-rank behavior at `n = 3`, +where it produces a triangle rather than the classical `D₃ = A₃`. The local `typeDMatrix` +normalizes the small ranks by using type `A` for `n ≤ 3`, and uses mathlib's `CoxeterMatrix.D` +from rank `4` onward. +-/ + +@[expose] public section + +namespace Coxeter + +/-- The Coxeter matrix of finite type `D` on `n` generators. + +For `n ≤ 3` this is normalized to the classical accidental type `Aₙ`; from rank `4` onward it is +mathlib's `CoxeterMatrix.D n`. -/ +noncomputable def typeDMatrix (n : ℕ) : CoxeterMatrix (Fin n) := + if n ≤ 3 then CoxeterMatrix.A n else CoxeterMatrix.D n + +/-- The Coxeter group of finite type `D` on `n` generators, realized as the abstract group +presented by `typeDMatrix n`. -/ +@[reducible] noncomputable def typeDGroup (n : ℕ) [NeZero n] : + CoxeterGroup (typeDMatrix n).Group where + B := Fin n + M := typeDMatrix n + cs := (typeDMatrix n).toCoxeterSystem + +/-- Type `D`'s normalized matrix is crystallographic in every nonempty rank. -/ +theorem typeD_isCrystallographic (n : ℕ) [NeZero n] : + @IsCrystallographic _ (typeDGroup n) := by + intro i i' hii' + change (typeDMatrix n) i i' = 0 ∨ (typeDMatrix n) i i' = 2 ∨ + (typeDMatrix n) i i' = 3 ∨ (typeDMatrix n) i i' = 4 ∨ + (typeDMatrix n) i i' = 6 + unfold typeDMatrix + by_cases h : n ≤ 3 + · simp only [if_pos h] + unfold CoxeterMatrix.A + simp only [Matrix.of_apply, if_neg hii'] + split_ifs <;> tauto + · simp only [if_neg h] + unfold CoxeterMatrix.D + simp only [Matrix.of_apply, if_neg hii'] + split_ifs <;> tauto + +proof_wanted typeD_isIrreducible (n : ℕ) : @IsIrreducible _ (typeDGroup (n + 4)) + +axiom typeD_isFiniteCoxeter (n : ℕ) : @IsFiniteCoxeter _ (typeDGroup (n + 4)) + +theorem typeD_isPolyFiniteWeyl (n : ℕ) : @IsPolyFiniteWeyl _ (typeDGroup (n + 4)) := + ⟨typeD_isFiniteCoxeter n, typeD_isCrystallographic (n + 4)⟩ + +proof_wanted typeD_isIrreducibleFiniteWeyl (n : ℕ) : + @IsIrreducibleFiniteWeyl _ (typeDGroup (n + 4)) + +/-! ### Small-rank accidental identifications -/ + +section Accidentals + +private theorem typeDMatrix_one_eq_A_one : typeDMatrix 1 = CoxeterMatrix.A 1 := by + unfold typeDMatrix + simp + +private theorem typeDMatrix_two_eq_A_two : typeDMatrix 2 = CoxeterMatrix.A 2 := by + unfold typeDMatrix + simp + +private theorem typeDMatrix_three_eq_A_three : typeDMatrix 3 = CoxeterMatrix.A 3 := by + unfold typeDMatrix + simp + +/-- The Coxeter-system-level accidental identification `D₁ = A₁`. + +The entrywise matrix equality used to prove this is private. -/ +theorem typeD_one_identifies_typeA_one : + HEq (@CoxeterGroup.cs _ (typeDGroup 1)) (@CoxeterGroup.cs _ (typeAGroup 1)) := by + change HEq (typeDMatrix 1).toCoxeterSystem (CoxeterMatrix.A 1).toCoxeterSystem + rw [← typeDMatrix_one_eq_A_one] + +/-- The Coxeter-system-level accidental identification `D₂ = A₂`. + +The entrywise matrix equality used to prove this is private. -/ +theorem typeD_two_identifies_typeA_two : + HEq (@CoxeterGroup.cs _ (typeDGroup 2)) (@CoxeterGroup.cs _ (typeAGroup 2)) := by + change HEq (typeDMatrix 2).toCoxeterSystem (CoxeterMatrix.A 2).toCoxeterSystem + rw [← typeDMatrix_two_eq_A_two] + +/-- The Coxeter-system-level accidental identification `D₃ = A₃`. + +The entrywise matrix equality used to prove this is private. -/ +theorem typeD_three_identifies_typeA_three : + HEq (@CoxeterGroup.cs _ (typeDGroup 3)) (@CoxeterGroup.cs _ (typeAGroup 3)) := by + change HEq (typeDMatrix 3).toCoxeterSystem (CoxeterMatrix.A 3).toCoxeterSystem + rw [← typeDMatrix_three_eq_A_three] + +end Accidentals + +end Coxeter diff --git a/Coxeter/FiniteOrAffine/TypeI.lean b/Coxeter/FiniteOrAffine/TypeI.lean new file mode 100644 index 0000000..da47af2 --- /dev/null +++ b/Coxeter/FiniteOrAffine/TypeI.lean @@ -0,0 +1,169 @@ +module + +public import Coxeter.FiniteOrAffine.Exceptional +public import Coxeter.FiniteOrAffine.TypeA +public import Coxeter.FiniteOrAffine.TypeBC +public import Coxeter.SpecialFeatures + +/-! +# The rank-two Coxeter groups of type I + +This file packages mathlib's `CoxeterMatrix.I m` as a `CoxeterGroup`. + +The rank-two crystallographic cases include the standard accidental identifications +`I₂(3) = A₂`, `I₂(4) = BC₂`, and `I₂(6) = G₂`. +-/ + +@[expose] public section + +namespace Coxeter + +/-- The rank-two Coxeter group `I₂(m + 2)`, realized as the abstract group presented by +`CoxeterMatrix.I m`. -/ +@[reducible] noncomputable def typeIGroup (m : ℕ) : CoxeterGroup (CoxeterMatrix.I m).Group where + B := Fin 2 + M := CoxeterMatrix.I m + cs := (CoxeterMatrix.I m).toCoxeterSystem + +/-- Type `I₂(m + 2)`'s Coxeter-Dynkin diagram is the complete graph on `Fin 2`: its only +off-diagonal entry is `m + 2 ≠ 2` because `m ≠ 0`, so the two generators are always joined. -/ +private theorem coxeterGraphMatrix_typeI_eq_top (m : ℕ) [m_nz : NeZero m] : + coxeterGraphMatrix (CoxeterMatrix.I m) = ⊤ := by + ext i j + rw [coxeterGraphMatrix, SimpleGraph.fromRel_adj, SimpleGraph.top_adj] + unfold CoxeterMatrix.I + simp only [Matrix.of_apply] + by_cases h : i = j + · simp [h] + · simp [h] + have m_nz' := m_nz.ne + simp only [Or.inl m_nz'] + +/-- Type `I₂(m + 2)` is irreducible: its diagram is the complete graph on two vertices, which is +connected. -/ +theorem typeI_isIrreducible (m : ℕ) [NeZero m] : @IsIrreducible _ (typeIGroup m) := by + unfold IsIrreducible IsIrreducibleMatrix + change (coxeterGraphMatrix (CoxeterMatrix.I m)).Connected + rw [coxeterGraphMatrix_typeI_eq_top] + exact SimpleGraph.connected_top + +/-- Every `Fin 2 →₀ ℝ` vector decomposes into its two coordinates against `Finsupp.single`. This is +stated concretely over `Fin 2` (rather than `B (typeIGroup m)`) to avoid needing typeclass search +to see through the reducible `typeIGroup` definition; `typeI_stdBasis_decomp` bridges it back. -/ +private theorem finsupp_fin_two_decomp (x : Fin 2 →₀ ℝ) : + x = x 0 • Finsupp.single (0 : Fin 2) (1 : ℝ) + x 1 • Finsupp.single (1 : Fin 2) (1 : ℝ) := by + apply Finsupp.ext + intro a + fin_cases a <;> simp + +/-- Every vector of `typeIGroup m`'s two-dimensional representation decomposes into its two +standard-basis coordinates. -/ +private theorem typeI_stdBasis_decomp (m : ℕ) (x : @V _ (typeIGroup m)) : + x = x (0 : Fin 2) • (@stdBasis _ (typeIGroup m)) (0 : Fin 2) + + x (1 : Fin 2) • (@stdBasis _ (typeIGroup m)) (1 : Fin 2) := by + have hs0 : (@stdBasis _ (typeIGroup m)) (0 : Fin 2) = Finsupp.single (0 : Fin 2) (1 : ℝ) := + congrFun Finsupp.coe_basisSingleOne (0 : Fin 2) + have hs1 : (@stdBasis _ (typeIGroup m)) (1 : Fin 2) = Finsupp.single (1 : Fin 2) (1 : ℝ) := + congrFun Finsupp.coe_basisSingleOne (1 : Fin 2) + rw [hs0, hs1] + exact finsupp_fin_two_decomp x + +/-- Type `I₂(m + 2)` is of finite type: `bil` is positive semidefinite and nondegenerate (i.e. +positive definite). By `bil_restrict_E_diag` (Bourbaki Ch V, §4, Proposition 1), the Gram form on +the two generators is `(x - y cos θ)^2 + (y sin θ)^2` with `θ = π/(m + 2) ∈ (0, π/2]`, so +`sin θ > 0` and the form is positive definite. -/ +theorem typeI_isFiniteCoxeter (m : ℕ) : @IsFiniteCoxeter _ (typeIGroup m) := by + right + have hM : (typeIGroup m).M (0 : Fin 2) (1 : Fin 2) = m + 2 := rfl + have hsin : 0 < Real.sin (Real.pi / ((typeIGroup m).M (0 : Fin 2) (1 : Fin 2) : ℝ)) := by + rw [hM] + apply Real.sin_pos_of_pos_of_lt_pi + · positivity + · apply div_lt_self Real.pi_pos + push_cast + linarith [Nat.cast_nonneg (α := ℝ) m] + have hnonneg : ∀ x : @V _ (typeIGroup m), 0 ≤ (@bil _ (typeIGroup m)) x x := by + intro x + rw [typeI_stdBasis_decomp m x, @bil_restrict_E_diag _ (typeIGroup m)] + positivity + refine ⟨⟨@bil_isSymm _ (typeIGroup m), ?_⟩, ?_⟩ + · rw [LinearMap.BilinForm.isNonneg_def] + exact hnonneg + · unfold LinearMap.BilinForm.Nondegenerate + rw [LinearMap.BilinForm.nondegenerate_iff' + (hs := hnonneg) + (hB := LinearMap.BilinForm.isSymm_iff.mp (@bil_isSymm _ (typeIGroup m)))] + intro x hx + rcases (hnonneg x).lt_or_eq with h | h + · exact h + · exfalso + apply hx + have hzero : (@bil _ (typeIGroup m)) x x = 0 := h.symm + rw [typeI_stdBasis_decomp m x, @bil_restrict_E_diag _ (typeIGroup m)] at hzero + have h1 : x (1 : Fin 2) * Real.sin (Real.pi / (typeIGroup m).M (0 : Fin 2) (1 : Fin 2)) + = 0 := by + nlinarith [sq_nonneg (x (0 : Fin 2) + - x (1 : Fin 2) * Real.cos (Real.pi / (typeIGroup m).M (0 : Fin 2) (1 : Fin 2))), + hzero] + have hx1 : x (1 : Fin 2) = 0 := by + rcases mul_eq_zero.mp h1 with h' | h' + · exact h' + · exact absurd h' (ne_of_gt hsin) + have h0sq : (x (0 : Fin 2) + - x (1 : Fin 2) * Real.cos (Real.pi / (typeIGroup m).M (0 : Fin 2) (1 : Fin 2))) ^ 2 + = 0 := by + nlinarith [sq_nonneg (x (1 : Fin 2) + * Real.sin (Real.pi / (typeIGroup m).M (0 : Fin 2) (1 : Fin 2))), hzero] + have h0 : x (0 : Fin 2) = 0 := by + have := sq_eq_zero_iff.mp h0sq + rw [hx1] at this + simpa using this + rw [typeI_stdBasis_decomp m x, h0, hx1] + simp + +/-! ### Accidental rank-two identifications -/ + +section Accidentals + +private theorem coxeterMatrix_I_one_eq_A_two : CoxeterMatrix.I 1 = CoxeterMatrix.A 2 := by + ext i j + fin_cases i <;> fin_cases j <;> rfl + +private theorem coxeterMatrix_I_two_eq_B_two : CoxeterMatrix.I 2 = CoxeterMatrix.B 2 := by + ext i j + fin_cases i <;> fin_cases j <;> rfl + +private theorem coxeterMatrix_I_four_eq_G_two : CoxeterMatrix.I 4 = CoxeterMatrix.G₂ := by + ext i j + fin_cases i <;> fin_cases j <;> rfl + +/-- The Coxeter-system-level accidental identification `I₂(3) = A₂`. + +Mathlib's `CoxeterMatrix.I m` represents `I₂(m + 2)`, so `m = 1` is the `I₂(3)` case. +The entrywise matrix equality used to prove this is private. -/ +theorem typeI_three_identifies_typeA_two : + HEq (@CoxeterGroup.cs _ (typeIGroup 1)) (@CoxeterGroup.cs _ (typeAGroup 2)) := by + change HEq (CoxeterMatrix.I 1).toCoxeterSystem (CoxeterMatrix.A 2).toCoxeterSystem + rw [← coxeterMatrix_I_one_eq_A_two] + +/-- The Coxeter-system-level accidental identification `I₂(4) = BC₂`. + +Mathlib's `CoxeterMatrix.I m` represents `I₂(m + 2)`, so `m = 2` is the `I₂(4)` case. +The entrywise matrix equality used to prove this is private. -/ +theorem typeI_four_identifies_typeBC_two : + HEq (@CoxeterGroup.cs _ (typeIGroup 2)) (@CoxeterGroup.cs _ (typeBCGroup 2)) := by + change HEq (CoxeterMatrix.I 2).toCoxeterSystem (CoxeterMatrix.B 2).toCoxeterSystem + rw [← coxeterMatrix_I_two_eq_B_two] + +/-- The Coxeter-system-level accidental identification `I₂(6) = G₂`. + +Mathlib's `CoxeterMatrix.I m` represents `I₂(m + 2)`, so `m = 4` is the `I₂(6)` case. +The entrywise matrix equality used to prove this is private. -/ +theorem typeI_six_identifies_typeG_two : + HEq (@CoxeterGroup.cs _ (typeIGroup 4)) (@CoxeterGroup.cs _ typeG2Group) := by + change HEq (CoxeterMatrix.I 4).toCoxeterSystem CoxeterMatrix.G₂.toCoxeterSystem + rw [← coxeterMatrix_I_four_eq_G_two] + +end Accidentals + +end Coxeter diff --git a/Coxeter/GeometricRepresentation.lean b/Coxeter/GeometricRepresentation.lean index d9478ed..3330c61 100644 --- a/Coxeter/GeometricRepresentation.lean +++ b/Coxeter/GeometricRepresentation.lean @@ -55,12 +55,12 @@ theorem bil_isSymm : (@bil W _).IsSymm := by rw [Matrix.toBilin_single, Matrix.toBilin_single, M.symmetric i i'] @[simp] -private theorem bil_eq (i i' : B W) : bil (stdBasis i) (stdBasis i') = -cos (π / M i i') := by +theorem bil_eq (i i' : B W) : bil (stdBasis i) (stdBasis i') = -cos (π / M i i') := by unfold bil rw [Matrix.toBilin_single] @[simp] -private theorem bil_diag (i : B W) : bil (stdBasis i) (stdBasis i) = 1 := by +theorem bil_diag (i : B W) : bil (stdBasis i) (stdBasis i) = 1 := by rw [bil_eq] simp @@ -117,6 +117,8 @@ theorem geomRepAux_stdBasis (i : B W) : geomRepAux i (stdBasis i) = -stdBasis i match_scalars norm_num +section just_two + private def E (i i' : B W) : Submodule ℝ (V W) := supported ℝ _ {i, i'} private theorem E_eq_span (i i' : B W) : E i i' = Submodule.span ℝ {stdBasis i, stdBasis i'} := by @@ -133,7 +135,7 @@ private theorem E_symm (i i' : B W) : E i i' = E i' i := by unfold E rw [Set.pair_comm] -private theorem bil_restrict_E_diag (i i' : B W) (x y : ℝ) : +theorem bil_restrict_E_diag (i i' : B W) (x y : ℝ) : bil (x • stdBasis i + y • stdBasis i') (x • stdBasis i + y • stdBasis i') = (x - y * cos (π / M i i')) ^ 2 + (y * sin (π / M i i')) ^ 2 := by calc @@ -544,6 +546,8 @@ private theorem orderOf_geomRepAux_mul_geomRepAux₂ : end finite_order +end just_two + theorem geomRepAux_liftable : (@M W).IsLiftable geomRepAux := by intro i i' have h : M i i' = 0 ∨ M i i' = 1 ∨ M i i' ≥ 2 := by lia diff --git a/Coxeter/SpecialFeatures.lean b/Coxeter/SpecialFeatures.lean index 15d8bd5..827120a 100644 --- a/Coxeter/SpecialFeatures.lean +++ b/Coxeter/SpecialFeatures.lean @@ -35,6 +35,7 @@ orthogonal direct sum decomposition of `bil`. * `Coxeter.IsPolyFiniteWeyl` * `Coxeter.IsIrreducibleFiniteWeyl` * `Coxeter.IsAffineCoxeter` +* `Coxeter.IsIrreducibleAffineCoxeter` * `Coxeter.IsPolyAffineWeyl` * `Coxeter.IsIrreducibleAffineWeyl` -/ @@ -110,6 +111,158 @@ lemma assembles_crystallographic : · exact Or.inr (Or.inl (M_eq_two_of_connectedComponentMk_ne cg1 (fun heq => same_comp (SimpleGraph.ConnectedComponent.eq.mp heq)))) +/-- `W` *has a generalized Cartan matrix* realizing its Coxeter matrix: there is an explicit +positive length-rescaling `scale : cg.B → ℝ` of the simple roots making every simple reflection +integral with respect to the rescaled basis. Concretely, for every `i ≠ i'`, +`2 * scale i' * cos (π / M i i')` must be an natural multiple of `scale i` — this is exactly the +condition for the reflection `geomRepAux i` to send the rescaled root `scale i' • stdBasis i'` +back into the `ℤ`-span of the rescaled roots `{scale j • stdBasis j}`. The witness `n : ℕ` for the +pair `(i, i')` is always nonnegative by construction — this is exactly right, since (see +`Coxeter.CartanMatrix`, notably `HasGeneralizedCartanMatrix.cartanMatrix`) it is the *negation* +`-n` of the generalized Cartan matrix entry `a_{i i'}` in the Kac–Moody sense (whose off-diagonal +entries are `≤ 0`). + +This already forces `IsCrystallographic` (`HasGeneralizedCartanMatrix.isCrystallographic` in +`Coxeter.CartanMatrix`): the two witnesses for `(i, i')` and `(i', i)` multiply to +`4 * cos (π / M i i') ^ 2`, a natural number, which pins `M i i' ∈ {0, 2, 3, 4, 6}`. + +- Descent: holds — restricting a global `scale` to a component's generators still satisfies that + component's own condition. +- Assembly: holds. `assembles_hasGeneralizedCartanMatrix`: cross-component pairs already satisfy + the condition for free (`cos (π/2) = 0`, witnessed by `n = 0`), so gluing each component's own + scale function together gives a scale on the whole diagram. -/ +def HasGeneralizedCartanMatrix : Prop := + ∃ scale : cg.B → ℝ, (∀ i, 0 < scale i) ∧ + ∀ i i' : cg.B, i ≠ i' → ∃ n : ℕ, 2 * scale i' * Real.cos (Real.pi / cg.M i i') = n * scale i + +/-- Dividing `HasGeneralizedCartanMatrix`'s defining condition at `(i, i')` by the same condition +at the reversed pair `(i', i)` pins the ratio `n / m` of the two integer witnesses to be exactly the +*square* of the scale ratio `scale i' / scale i` — equivalently, in the cleared-denominator form +proved here, `n * scale i ^ 2 = m * scale i' ^ 2`. (This is the same pair of equations used in +`Coxeter.CartanMatrix.generalizedCartanMatrix_mul_eq` to get the *product* `n * m = 4 cos²(π/M)`; +here we instead eliminate `cos` to compare `scale i` against `scale i'` directly, with no positivity +hypothesis needed.) Consequently, two scales agreeing on `n` and `m` at a pair `(i, i')` must have +the same ratio `scale i' / scale i`, since positive reals with equal squares are equal. -/ +lemma scale_ratio_sq_eq_of_generalizedCartanMatrix_cond + (scale : cg.B → ℝ) (i i' : cg.B) + (n : ℕ) (hn : 2 * scale i' * Real.cos (Real.pi / cg.M i i') = n * scale i) + (m : ℕ) (hm : 2 * scale i * Real.cos (Real.pi / cg.M i i') = m * scale i') : + (n : ℝ) * scale i ^ 2 = m * scale i' ^ 2 := by + linear_combination scale i' * hm - scale i * hn + +/-- Rescaling `scale` by a factor `t` that depends only on the connected component of each +generator preserves `HasGeneralizedCartanMatrix`'s pairwise condition. Within a component, `i` and +`i'` get multiplied by the *same* factor (`t` agrees on a component), so it cancels and the same +witness `n` still works; across components the condition holds via `n = 0` regardless of any +rescaling, since `M i i' = 2` gives `cos (π / M i i') = 0` there. -/ +lemma hasGeneralizedCartanMatrix_cond_of_rescale + (scale : cg.B → ℝ) (t : (coxeterGraphMatrix cg.M).ConnectedComponent → ℝ) + (hcond : ∀ i i' : cg.B, i ≠ i' → + ∃ n : ℕ, 2 * scale i' * Real.cos (Real.pi / cg.M i i') = n * scale i) : + ∀ i i' : cg.B, i ≠ i' → + ∃ n : ℕ, + 2 * (t ((coxeterGraphMatrix cg.M).connectedComponentMk i') * scale i') * + Real.cos (Real.pi / cg.M i i') = + n * (t ((coxeterGraphMatrix cg.M).connectedComponentMk i) * scale i) := by + intro i i' hii' + by_cases same_comp : (coxeterGraphMatrix cg.M).Reachable i i' + · obtain ⟨n, hn⟩ := hcond i i' hii' + have ht : t ((coxeterGraphMatrix cg.M).connectedComponentMk i) = + t ((coxeterGraphMatrix cg.M).connectedComponentMk i') := + congrArg t (SimpleGraph.ConnectedComponent.sound same_comp) + refine ⟨n, ?_⟩ + rw [ht] + linear_combination t ((coxeterGraphMatrix cg.M).connectedComponentMk i') * hn + · refine ⟨0, ?_⟩ + rw [M_eq_two_of_connectedComponentMk_ne cg + (fun heq => same_comp (SimpleGraph.ConnectedComponent.eq.mp heq))] + simp + +/-- Renormalize an a priori `HasGeneralizedCartanMatrix` witness `a_priori_scale` so that, on each +connected component `c`, the chosen representative `(component_reps c).1` gets exactly the +*prescribed* scale `(component_reps c).2`, rather than whatever value `a_priori_scale` happened to +give it. `HasGeneralizedCartanMatrix`'s defining condition only pins the *ratio* `scale i / scale +i'` between generators sharing a component (and says nothing at all about cross-component ratios, +where `n = 0` works regardless), so multiplying every generator of one component by a single +positive constant is always still a valid witness — and the constant needed to hit the prescribed +target `(component_reps c).2` at the representative is +`(component_reps c).2 / a_priori_scale (component_reps c).1`. -/ +noncomputable def scale_fixing + (a_priori_scale : cg.B → ℝ) + (a_priori_scale_proof : + (∀ i, 0 < a_priori_scale i) ∧ + ∀ i i' : cg.B, i ≠ i' → + ∃ n : ℕ, + 2 * a_priori_scale i' * Real.cos (Real.pi / cg.M i i') = + n * a_priori_scale i + ) + (component_reps : (coxeterGraphMatrix cg.M).ConnectedComponent -> cg.B × ℝ) + (component_reps_pos : ∀ c, 0 < (component_reps c).2) + (component_reps_mem : ∀ c, + (coxeterGraphMatrix cg.M).connectedComponentMk (component_reps c).1 = c) + : {new_scale: cg.B → ℝ // + (∀ i, 0 < new_scale i) ∧ + (∀ i i' : cg.B, i ≠ i' → + ∃ n : ℕ, + 2 * new_scale i' * Real.cos (Real.pi / cg.M i i') = + n * new_scale i + ) ∧ + (∀ c : (coxeterGraphMatrix cg.M).ConnectedComponent, + new_scale (component_reps c).1 = (component_reps c).2) + } := by + let cg1_graph := coxeterGraphMatrix cg.M + let rep : cg1_graph.ConnectedComponent → cg.B := fun c => (component_reps c).1 + let target : cg1_graph.ConnectedComponent → ℝ := fun c => (component_reps c).2 + let t : cg1_graph.ConnectedComponent → ℝ := fun c => target c / a_priori_scale (rep c) + let new_scale_candidate : cg.B → ℝ := + fun i => t (cg1_graph.connectedComponentMk i) * a_priori_scale i + refine ⟨new_scale_candidate, fun i => ?_, ?_, fun c => ?_⟩ + · exact mul_pos (div_pos (component_reps_pos _) (a_priori_scale_proof.1 _)) + (a_priori_scale_proof.1 i) + · exact hasGeneralizedCartanMatrix_cond_of_rescale a_priori_scale t a_priori_scale_proof.2 + · change t (cg1_graph.connectedComponentMk (rep c)) * a_priori_scale (rep c) = target c + rw [component_reps_mem c] + exact div_mul_cancel₀ _ (a_priori_scale_proof.1 (rep c)).ne' + +/- +Cross-component pairs already satisfy the condition for free (`cos (π/2) = 0`, witnessed by +`n = 0` regardless of scale), so gluing each component's own scale function together (indexed by +`coxeterGraphMatrix.connectedComponentMk`) gives a scale on all of `cg1.B` satisfying the condition +on every pair — hence `cg1.HasGeneralizedCartanMatrix` holds iff every component does. +-/ +lemma assembles_hasGeneralizedCartanMatrix : + Assembles + fun [W1 : Type*] (cg1 : CoxeterGroup W1) => @HasGeneralizedCartanMatrix W1 cg1 + := by + unfold Assembles + intro W1 cg1 finitely_many_comp on_components + choose scale_c hscale_c_pos hscale_c_cond using on_components + set cg1_graph := coxeterGraphMatrix cg1.M + refine ⟨fun i => scale_c (cg1_graph.connectedComponentMk i) ⟨i, rfl⟩, + fun i => hscale_c_pos _ _, ?_⟩ + intro i i' hii' + dsimp only + by_cases same_comp : cg1_graph.Reachable i i' + · have heq : cg1_graph.connectedComponentMk i = cg1_graph.connectedComponentMk i' := + SimpleGraph.ConnectedComponent.sound same_comp + have hi : i ∈ (cg1_graph.connectedComponentMk i).supp := rfl + have hi' : i' ∈ (cg1_graph.connectedComponentMk i).supp := heq.symm + have hne : (⟨i, hi⟩ : (cg1_graph.connectedComponentMk i).supp) ≠ ⟨i', hi'⟩ := + fun h => hii' (congrArg Subtype.val h) + obtain ⟨n, hn⟩ := hscale_c_cond (cg1_graph.connectedComponentMk i) ⟨i, hi⟩ ⟨i', hi'⟩ hne + refine ⟨n, ?_⟩ + have transport : ∀ {c c' : cg1_graph.ConnectedComponent} (h : c = c') {x : cg1.B} + (hx : x ∈ c.supp), scale_c c ⟨x, hx⟩ = scale_c c' ⟨x, h ▸ hx⟩ := by + rintro c c' rfl x hx + rfl + rw [transport heq hi'] at hn + rw [M_eq_componentMatrix cg1 (cg1_graph.connectedComponentMk i) ⟨i, hi⟩ ⟨i', hi'⟩] + exact hn + · refine ⟨0, ?_⟩ + rw [M_eq_two_of_connectedComponentMk_ne cg1 + (fun heq => same_comp (SimpleGraph.ConnectedComponent.eq.mp heq))] + simp + /-- A Coxeter matrix is *irreducible* if its Coxeter diagram (`coxeterGraphMatrix`) is connected. -/ def IsIrreducibleMatrix {B1 : Type*} (M1 : CoxeterMatrix B1) : Prop := (coxeterGraphMatrix M1).Connected @@ -180,6 +333,13 @@ It is at least 1, but can be more. def IsAffineCoxeter : Prop := (@bil W _).IsPosSemidef ∧ ¬ (@bil W _).Nondegenerate +/-- `W` is an *irreducible affine Coxeter group*: `IsAffineCoxeter` together with +`IsIrreducible`. This is the broad affine-Coxeter predicate and does not require +crystallographic entries or a finite Weyl part. Use `IsIrreducibleAffineWeyl` for the stronger +root-system/Weyl refinement. -/ +def IsIrreducibleAffineCoxeter : Prop := + @IsAffineCoxeter W cg ∧ @IsIrreducible W cg + /-- `IsAffineCoxeter`, or `cg` has no generators at all. Plain `IsAffineCoxeter` isn't an instance of `Assembles`: on the empty diagram (zero components), `V W` is the trivial module, on which `bil` is vacuously `Nondegenerate`, so `IsAffineCoxeter` is false there while `∀ c, IsAffineCoxeter From 66873bda7263efdb1b6ecf01604d0b79eac16216 Mon Sep 17 00:00:00 2001 From: Cobord Date: Thu, 9 Jul 2026 02:28:15 -0400 Subject: [PATCH 12/12] potential features --- TODO.md | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100644 TODO.md diff --git a/TODO.md b/TODO.md new file mode 100644 index 0000000..59196c5 --- /dev/null +++ b/TODO.md @@ -0,0 +1,53 @@ +# Project-wide TODO + +For the finite/affine Coxeter-type classification stubs, see +[Coxeter/FiniteOrAffine/TODO.md](Coxeter/FiniteOrAffine/TODO.md). + +## General parabolic subgroups + +Not started. `Coxeter/Dihedral.lean` only covers the rank-two case (`rankTwoSubgroup i i'`, +generated by two simple reflections). The general case, for an arbitrary subset `J : Set (B W)` of +generators: + +- **Do prove directly** — these generalize `Dihedral.lean`'s existing rank-2 proofs with no new + theory needed, just replacing `{i, i'}` by `J`: + - `exists_confined_word`/`exists_confined_reduced_word`: every element of + `Subgroup.closure (cs.simple '' J)` has a (reduced) word using only letters from `J`. The + `Subgroup.closure_induction` proof doesn't depend on `J` having two elements. + - `exists_minimal_rightCosetRep`: every `w` factors as `w = w^J * v` with `v ∈ W_J` and `w^J` + having no right descent in `J`. The strong-induction-on-length proof (repeatedly cancel *any* + descent in `J`) also doesn't depend on rank 2. + - **Double coset representatives**: for `I, J : Set (B W)`, every double coset `W_I \ w W_J` has + a minimal-length representative — repeatedly cancel *either* a left descent in `I` or a right + descent in `J` off `w`; strictly decreases length each time, so terminates, same shape as + `exists_minimal_rightCosetRep`. Uniqueness of the minimal representative is the standard next + step (Deodhar/Kilmoyer); likely needs a bit more than the one-sided case but should still be + strong-exchange/deletion-property territory, not the deferred Tier-2 isomorphism below. + +- **Don't prove in general** — leave as deferred data, same principle as `Matsumoto` + (`Coxeter/Basic.lean:191`) and `DihedralSubProperties` (`Coxeter/Hecke.lean:989`): the fact that + `W_J` is itself a Coxeter system on `J` with the restricted matrix `M|_J` (i.e. the natural map + from the abstract presented group on `M|_J` into `W` is injective and length-preserving). The + general proof is heavy (root-system/inversion-counting territory); callers needing it for a + specific `J` (often small or finite) can supply a focused proof directly. Bundle it as + structure/class data analogous to `IsComponentOf`, not as a theorem to prove once and for all. + +- **Explicitly leave `Coxeter/Component.lean`'s `IsComponentOf` alone.** It already has the right + shape for the deferred-data treatment above, but it is *not* to be generalized into or replaced + by a general-`J` version: connected components have their own special uses (the finite/affine + classification's `Assembles`/descent machinery in `Coxeter/SpecialFeatures.lean` is built + specifically around connectivity, not arbitrary subsets) that a general parabolic construction + wouldn't preserve or simplify. + +## Hecke algebras (Coxeter/Hecke.lean) + +### `q = 1` specialization: package as a genuine isomorphism, not just a surjection + +`qOneAlgHom : HeckeAlgebraOne W →ₐ[ℤ] MonoidAlgebra ℤ W` (the single-parameter Hecke algebra +collapsing to the integral group algebra at `v = 1`) is proven surjective +(`qOneAlgHom_surjective`), and separately `qOneAlgHom0_T_linearIndependent` (conditional on +`[Matsumoto W]`) shows the specialized `{T_w}` are linearly independent — but nothing packages +these into an actual `AlgEquiv`/`Bijective` statement. This looks mechanical: combine the existing +surjectivity and linear-independence-hence-injectivity facts (plus a spanning/dimension argument, +likely already available via the `T_span`/`basis` machinery used elsewhere in the file) into +`HeckeAlgebraOne W ≃ₐ[ℤ] MonoidAlgebra ℤ W`. Worth just doing.