From bf80767ec1e0b13ee6366bc9126735edc50fc955 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 18 May 2026 00:51:34 +0900 Subject: [PATCH 01/34] Vendor Brauer group core --- LeanPool.lean | 24 + LeanPool/BrauerGroupNew.lean | 28 + LeanPool/BrauerGroupNew/CentralSimple.lean | 621 +++++++++++++++++ LeanPool/BrauerGroupNew/Centralizer.lean | 170 +++++ LeanPool/BrauerGroupNew/ExtendScalar.lean | 179 +++++ LeanPool/BrauerGroupNew/FieldCat.lean | 317 +++++++++ .../BrauerGroupNew/LemmasAboutSimpleRing.lean | 91 +++ LeanPool/BrauerGroupNew/Mathlib.lean | 14 + LeanPool/BrauerGroupNew/Mathlib/Algebra.lean | 13 + .../Mathlib/Algebra/Algebra.lean | 13 + .../Mathlib/Algebra/Algebra/Subalgebra.lean | 15 + .../Algebra/Algebra/Subalgebra/Basic.lean | 18 + .../Algebra/Algebra/Subalgebra/Directed.lean | 19 + .../Algebra/Algebra/Subalgebra/Lattice.lean | 15 + .../BrauerGroupNew/Mathlib/RingTheory.lean | 13 + .../Mathlib/RingTheory/TwoSidedIdeal.lean | 14 + .../RingTheory/TwoSidedIdeal/Kernel.lean | 27 + .../RingTheory/TwoSidedIdeal/Operations.lean | 44 ++ .../BrauerGroupNew/MatrixCenterEquiv.lean | 126 ++++ .../BrauerGroupNew/MatrixEquivTensor.lean | 131 ++++ LeanPool/BrauerGroupNew/Subfield.lean | 14 + LeanPool/BrauerGroupNew/Subfield/Defs.lean | 133 ++++ .../Subfield/FiniteDimensional.lean | 15 + LeanPool/BrauerGroupNew/TwoSidedIdeal.lean | 179 +++++ LeanPool/BrauerGroupNew/Wedderburn.lean | 625 ++++++++++++++++++ LeanPool/projects.yml | 38 ++ 26 files changed, 2896 insertions(+) create mode 100644 LeanPool/BrauerGroupNew.lean create mode 100644 LeanPool/BrauerGroupNew/CentralSimple.lean create mode 100644 LeanPool/BrauerGroupNew/Centralizer.lean create mode 100644 LeanPool/BrauerGroupNew/ExtendScalar.lean create mode 100644 LeanPool/BrauerGroupNew/FieldCat.lean create mode 100644 LeanPool/BrauerGroupNew/LemmasAboutSimpleRing.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/Algebra.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Subalgebra.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Subalgebra/Basic.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Subalgebra/Directed.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Subalgebra/Lattice.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RingTheory.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal/Kernel.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal/Operations.lean create mode 100644 LeanPool/BrauerGroupNew/MatrixCenterEquiv.lean create mode 100644 LeanPool/BrauerGroupNew/MatrixEquivTensor.lean create mode 100644 LeanPool/BrauerGroupNew/Subfield.lean create mode 100644 LeanPool/BrauerGroupNew/Subfield/Defs.lean create mode 100644 LeanPool/BrauerGroupNew/Subfield/FiniteDimensional.lean create mode 100644 LeanPool/BrauerGroupNew/TwoSidedIdeal.lean create mode 100644 LeanPool/BrauerGroupNew/Wedderburn.lean diff --git a/LeanPool.lean b/LeanPool.lean index 39c8ce5387..19895d6ae8 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -29,6 +29,30 @@ import LeanPool.ArchonFirstProofResults.FirstProof6.Auxiliary.OneSidedBarrier import LeanPool.ArchonFirstProofResults.FirstProof6.Auxiliary.ResolventBound import LeanPool.ArchonFirstProofResults.FirstProof6.Problem6 import LeanPool.Basic +import LeanPool.BrauerGroupNew +import LeanPool.BrauerGroupNew.CentralSimple +import LeanPool.BrauerGroupNew.Centralizer +import LeanPool.BrauerGroupNew.ExtendScalar +import LeanPool.BrauerGroupNew.FieldCat +import LeanPool.BrauerGroupNew.LemmasAboutSimpleRing +import LeanPool.BrauerGroupNew.Mathlib +import LeanPool.BrauerGroupNew.Mathlib.Algebra +import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra +import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Subalgebra +import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Subalgebra.Basic +import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Subalgebra.Directed +import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Subalgebra.Lattice +import LeanPool.BrauerGroupNew.Mathlib.RingTheory +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Kernel +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Operations +import LeanPool.BrauerGroupNew.MatrixCenterEquiv +import LeanPool.BrauerGroupNew.MatrixEquivTensor +import LeanPool.BrauerGroupNew.Subfield +import LeanPool.BrauerGroupNew.Subfield.Defs +import LeanPool.BrauerGroupNew.Subfield.FiniteDimensional +import LeanPool.BrauerGroupNew.TwoSidedIdeal +import LeanPool.BrauerGroupNew.Wedderburn import LeanPool.Clawristotle import LeanPool.Clawristotle.CoulombConcreteTheorem42 import LeanPool.Clawristotle.CoulombFlux diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean new file mode 100644 index 0000000000..b0979514fb --- /dev/null +++ b/LeanPool/BrauerGroupNew.lean @@ -0,0 +1,28 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.CentralSimple +import LeanPool.BrauerGroupNew.Centralizer +import LeanPool.BrauerGroupNew.ExtendScalar +import LeanPool.BrauerGroupNew.FieldCat +import LeanPool.BrauerGroupNew.LemmasAboutSimpleRing +import LeanPool.BrauerGroupNew.MatrixCenterEquiv +import LeanPool.BrauerGroupNew.MatrixEquivTensor +import LeanPool.BrauerGroupNew.TwoSidedIdeal +import LeanPool.BrauerGroupNew.Wedderburn +import LeanPool.BrauerGroupNew.Mathlib +import LeanPool.BrauerGroupNew.Subfield + +/-! +# Brauer Group Core + +Source: url:https://github.com/Whysoserioushah/BrauerGroup_new +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +Status: verified +Main declarations: `Wedderburn_Artin`, `IsCentralSimple.TensorProduct.simple`, `CSA_implies_CSA` +Tags: algebra, ring-theory, central-simple-algebras, brauer-groups +MSC: 16K20, 16K50, 16S35 +-/ diff --git a/LeanPool/BrauerGroupNew/CentralSimple.lean b/LeanPool/BrauerGroupNew/CentralSimple.lean new file mode 100644 index 0000000000..ffbe772167 --- /dev/null +++ b/LeanPool/BrauerGroupNew/CentralSimple.lean @@ -0,0 +1,621 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ +/- +Copyright (c) 2024 Kevin Buzzard. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Jujian Zhang, Kevin Buzzard +-/ +import LeanPool.BrauerGroupNew.Centralizer +import LeanPool.BrauerGroupNew.Wedderburn +import Mathlib.Algebra.Central.Basic +import Mathlib.RingTheory.Flat.Basic +/-! +# Characteristic predicate for central simple algebras +In this file we define the predicate `IsCentralSimple K D` where `K` is a field +and `D` is a (noncommutative) `K`-algebra. +Note that the predicate makes sense just for `K` a `CommRing` but it doesn't give the +right definition; for a commutative ring base one should use the theory of Azumaya algebras. +This adds an extra layer of complication which we don't need. In fact ideals of `K` +immediately give rise to nontrivial quotients of `D` so there are no central simple +algebras in this case according to our definition. +-/ +universe u v w +open Module +-- class IsCentralSimple +-- (K : Type u) [Field K] (D : Type v) [Ring D] [Algebra K D] : Prop where +-- is_central : Subalgebra.center K D ≤ ⊥ +-- [is_simple : IsSimpleRing D] +-- lemma IsCentralSimple.center_eq +-- (K D : Type*) [Field K] [Ring D] [Algebra K D] [IsCentralSimple K D] : +-- Subalgebra.center K D = ⊥ := +-- le_antisymm IsCentralSimple.is_central <| by +-- rintro _ ⟨x, rfl⟩ +-- rw [Subalgebra.mem_center_iff] +-- exact (Algebra.commutes' x · |>.symm) +variable (K : Type u) [Field K] +open Matrix in +instance MatrixRing.isCentral (ι : Type) [Fintype ι] [Nonempty ι] [DecidableEq ι] : + Algebra.IsCentral K (Matrix ι ι K) where + out _ h := mem_range_scalar_of_commute_single fun _ _ _ => + Subalgebra.mem_center_iff.mp h _ +namespace IsCentralSimple +variable (D : Type v) [Ring D] [Algebra K D] +/- +\begin{lemma} + \label{IsCentralSimple.baseChange} + If DD is a central simple algebra over~KK and L/KL/K is a field extension, then L⊗KDL\otimes_KD + is a central simple algebra over~LL. +\end{lemma} +\begin{proof} + This is not too hard: it's lemma b of section 12.4 in Peirce's "Associative algebras". + Will maybe write more on Saturday. +\end{proof} +-/ +open scoped TensorProduct +instance (B : Type*) [Ring B] [Algebra K B] : Algebra K (Subring.center B) := + RingHom.toAlgebra <| (algebraMap K B).codRestrict _ fun x ↦ by + rw [Subring.mem_center_iff] + exact fun y ↦ Algebra.commutes x y |>.symm +lemma _root_.IsCentralSimple.TensorProduct.sum_tmul_basis_right_eq_zero' + (B : Type*) [Ring B] [Algebra K B] + (C : Type*) [Ring C] [Algebra K C] + {ιC : Type*} (𝒞 : Basis ιC K C) + (s : Finset ιC) (b : ιC → B) + (h : ∑ i ∈ s, b i ⊗ₜ[K] 𝒞 i = 0) : + ∀ i ∈ s, b i = 0 := by + classical + intro i + have := TensorProduct.sum_tmul_basis_right_eq_zero (κ := ιC) 𝒞 (M := B) + { support := s.filter fun i ↦ b i ≠ 0 + toFun x := if x ∈ s then b x else 0 + mem_support_toFun := by simp } + (by + simp only [Finsupp.sum, ne_eq, Finsupp.coe_mk, Finset.sum_filter, ite_not] + convert h using 1 + congr! + aesop) + simpa using Finsupp.ext_iff.mp this i +lemma _root_.IsCentralSimple.TensorProduct.sum_tmul_basis_left_eq_zero' + (B : Type*) [Ring B] [Algebra K B] + (C : Type*) [Ring C] [Algebra K C] + {ιB : Type*} (ℬ : Basis ιB K B) + (s : Finset ιB) (c : ιB → C) + (h : ∑ i ∈ s, ℬ i ⊗ₜ[K] c i = 0) : + ∀ i ∈ s, c i = 0 := by + apply TensorProduct.sum_tmul_basis_right_eq_zero' K C B ℬ s c + apply_fun TensorProduct.comm K B C at h + simpa using h +lemma _root_.IsCentralSimple.TensorProduct.left_tensor_base_sup_base_tensor_right + (K B C : Type*) [CommRing K] [Ring B] [Algebra K B] [Ring C] [Algebra K C] : + (Algebra.TensorProduct.map (AlgHom.id K B) (Algebra.ofId K C)).range ⊔ + (Algebra.TensorProduct.map (Algebra.ofId K B) (AlgHom.id K C)).range = ⊤ := by + rw [eq_top_iff] + rintro x - + induction x using TensorProduct.induction_on with + | zero => exact Subalgebra.zero_mem _ + | tmul b c => + rw [show b ⊗ₜ[K] c = b ⊗ₜ[K] 1 * 1 ⊗ₜ[K] c by simp] + exact Algebra.mul_mem_sup ⟨b ⊗ₜ 1, by simp⟩ ⟨1 ⊗ₜ c, by simp⟩ + | add x y hx hy => + exact Subalgebra.add_mem _ hx hy +-- We need to restrict the universe, because we used properties of flatness. +lemma _root_.IsCentralSimple.TensorProduct.submodule_tensor_inf_tensor_submodule + (B C : Type u) [AddCommGroup B] [Module K B] [AddCommGroup C] [Module K C] + (b : Submodule K B) (c : Submodule K C) : + LinearMap.range (TensorProduct.map b.subtype .id) ⊓ + LinearMap.range (TensorProduct.map .id c.subtype) = + LinearMap.range (TensorProduct.map b.subtype c.subtype) := by + refine le_antisymm ?_ ?_ + · letI : Module.Flat K (B ⧸ b) := Module.Flat.of_free + let u : b ⊗[K] c →ₗ[K] B ⊗[K] c := TensorProduct.map b.subtype LinearMap.id + let v : B ⊗[K] c →ₗ[K] (B ⧸ b) ⊗[K] c := + TensorProduct.map (Submodule.mkQ _) LinearMap.id + have exactuv : Function.Exact u v := by + apply rTensor_exact _ _ (Submodule.mkQ_surjective _) + rw [LinearMap.exact_iff] + simp only [Submodule.ker_mkQ, Submodule.range_subtype] + let u' : b ⊗[K] C →ₗ[K] B ⊗[K] C := TensorProduct.map b.subtype LinearMap.id + let v' : B ⊗[K] C →ₗ[K] (B ⧸ b) ⊗[K] C := TensorProduct.map (Submodule.mkQ _) LinearMap.id + have exactu'v' : Function.Exact u' v' := by + apply rTensor_exact _ _ (Submodule.mkQ_surjective _) + rw [LinearMap.exact_iff] + simp only [Submodule.ker_mkQ, Submodule.range_subtype] + let α : b ⊗[K] c →ₗ[K] b ⊗[K] C := TensorProduct.map LinearMap.id c.subtype + let β : B ⊗[K] c →ₗ[K] B ⊗[K] C := TensorProduct.map LinearMap.id c.subtype + let γ : (B ⧸ b) ⊗[K] c →ₗ[K] (B ⧸ b) ⊗[K] C := TensorProduct.map LinearMap.id c.subtype + have γ_inj : Function.Injective γ := + Module.Flat.iff_lTensor_preserves_injective_linearMap (R := K) (M := B ⧸ b)|>.1 inferInstance + c.subtype c.injective_subtype + rintro z (hz : z ∈ LinearMap.range u' ⊓ LinearMap.range β) + obtain ⟨z, rfl⟩ := hz.2 + have comm0 : v' ∘ₗ β = γ ∘ₗ v := by + ext + simp [v', β, γ, v] + have hz1 : v' (β z) = γ (v z) := congr($comm0 z) + have hz2 : v' (β z) = 0 := by + rw [← LinearMap.mem_ker] + rw [LinearMap.exact_iff] at exactu'v' + rw [exactu'v'] + exact hz.1 + rw [hz2] at hz1 + have hz3 : v z ∈ LinearMap.ker γ := by rw [LinearMap.mem_ker]; exact hz1.symm + replace hz3 : v z = 0 := by + rw [← LinearMap.ker_eq_bot] at γ_inj; rw [γ_inj] at hz3; exact hz3 + replace hz3 : z ∈ LinearMap.ker v := hz3 + replace hz3 : z ∈ LinearMap.range u := by + rw [LinearMap.exact_iff] at exactuv + rwa [← exactuv] + obtain ⟨z, rfl⟩ := hz3 + change (β ∘ₗ u) z ∈ _ + have comm1 : β ∘ₗ u = u' ∘ₗ α := by + ext + simp [β, u, u', α] + rw [comm1, LinearMap.comp_apply] + refine ⟨z, ?_⟩ + simp only [u', α] + change _ = (TensorProduct.map b.subtype .id ∘ₗ TensorProduct.map .id c.subtype) z + rw [← TensorProduct.map_comp, LinearMap.comp_id, LinearMap.id_comp] + · rintro _ ⟨x, rfl⟩ + refine ⟨⟨TensorProduct.map LinearMap.id c.subtype x, ?_⟩, + ⟨TensorProduct.map b.subtype LinearMap.id x, ?_⟩⟩ + · change (TensorProduct.map b.subtype LinearMap.id ∘ₗ + TensorProduct.map LinearMap.id c.subtype) x = _ + rw [← TensorProduct.map_comp] + rfl + · change (TensorProduct.map LinearMap.id c.subtype ∘ₗ + TensorProduct.map b.subtype LinearMap.id) x = _ + rw [← TensorProduct.map_comp] + rfl +-- We need to restrict the universe, because we used properties of flatness. +lemma center_tensorProduct + (B C : Type u) [Ring B] [Algebra K B] [Ring C] [Algebra K C] : + Subalgebra.center K (B ⊗[K] C) = + (Algebra.TensorProduct.map (Subalgebra.center K B).val + (Subalgebra.center K C).val).range := by + rw [show Subalgebra.center K (B ⊗[K] C) = Subalgebra.centralizer K (⊤ : Subalgebra K (B ⊗[K] C)) + by simp, ← TensorProduct.left_tensor_base_sup_base_tensor_right K B C, + Subalgebra.centralizer_sup, Subalgebra.centralizer_tensorProduct_eq_center_tensorProduct_left, + Subalgebra.centralizer_tensorProduct_eq_center_tensorProduct_right] + suffices eq : + Subalgebra.toSubmodule (Algebra.TensorProduct.map (Subalgebra.center K B).val (.id K C)).range ⊓ + Subalgebra.toSubmodule (Algebra.TensorProduct.map (.id K B) (Subalgebra.center K C).val).range = + Subalgebra.toSubmodule (Algebra.TensorProduct.map (Subalgebra.center K B).val + (Subalgebra.center K C).val).range by + apply_fun Subalgebra.toSubmodule using Subalgebra.toSubmodule_injective + rw [← eq] + ext x + simp only [Algebra.inf_toSubmodule, Submodule.mem_inf, Subalgebra.mem_toSubmodule, + AlgHom.mem_range] + have eq1 : + Subalgebra.toSubmodule (Algebra.TensorProduct.map (Subalgebra.center K B).val (.id K C)).range + = LinearMap.range (TensorProduct.map (Subalgebra.center K B).val.toLinearMap .id) := rfl + rw [eq1] + have eq2 : + Subalgebra.toSubmodule (Algebra.TensorProduct.map (.id K B) (Subalgebra.center K C).val).range + = LinearMap.range (TensorProduct.map .id (Subalgebra.center K C).val.toLinearMap) := rfl + rw [eq2] + have eq3 : + Subalgebra.toSubmodule (Algebra.TensorProduct.map (Subalgebra.center K B).val + (Subalgebra.center K C).val).range = + LinearMap.range (TensorProduct.map (Subalgebra.center K B).val.toLinearMap + (Subalgebra.center K C).val.toLinearMap) := by + rfl + rw [eq3] + have := TensorProduct.submodule_tensor_inf_tensor_submodule K B C + (Subalgebra.toSubmodule <| .center K B) + (Subalgebra.toSubmodule <| .center K C) + have eq4 : (Subalgebra.toSubmodule (Subalgebra.center K B)).subtype = + (Subalgebra.center K B).val.toLinearMap := by rfl + rw [eq4] at this + have eq5 : (Subalgebra.toSubmodule (Subalgebra.center K C)).subtype = + (Subalgebra.center K C).val.toLinearMap := by rfl + rw [eq5] at this + rw [this] + +/-- Linear map from the tensor product of centers into the tensor product algebra. -/ +noncomputable def centerTensorCenter (B C : Type v) [Ring B] [Algebra K B] [Ring C] [Algebra K C] : + (Subalgebra.center K B ⊗[K] Subalgebra.center K C) →ₗ[K] (B ⊗[K] C) := + TensorProduct.map (Subalgebra.val _).toLinearMap (Subalgebra.val _).toLinearMap +lemma centerTensorCenter_injective (B C : Type v) [Ring B] [Algebra K B] [Ring C] [Algebra K C] : + Function.Injective (centerTensorCenter K B C) := by + have : centerTensorCenter K B C = + ((Subalgebra.center K B).val.toLinearMap.rTensor _) ∘ₗ + ((Subalgebra.center K C).val.toLinearMap.lTensor _) := by + ext; simp [centerTensorCenter] + rw [this] + apply Function.Injective.comp (g := (Subalgebra.center K B).val.toLinearMap.rTensor _) + · apply Module.Flat.rTensor_preserves_injective_linearMap + exact Subtype.val_injective + · apply Module.Flat.lTensor_preserves_injective_linearMap + exact Subtype.val_injective + +/-- Linear equivalence identifying the tensor product of centers with the center of a tensor +product. -/ +noncomputable def centerTensor + (B C : Type u) [Ring B] [Algebra K B] [Ring C] [Algebra K C] : + Subalgebra.center K B ⊗[K] Subalgebra.center K C ≃ₗ[K] + Subalgebra.center K (B ⊗[K] C) := + LinearEquiv.ofInjective (centerTensorCenter K B C) (centerTensorCenter_injective K B C) ≪≫ₗ + (show _ ≃ₗ[K] Subalgebra.toSubmodule (Subalgebra.center K (B ⊗[K] C)) from LinearEquiv.ofLinear + (Submodule.inclusion (by + rw [center_tensorProduct] + intro x hx + simp only [LinearMap.mem_range, Subalgebra.mem_toSubmodule, AlgHom.mem_range] at hx ⊢ + obtain ⟨y, rfl⟩ := hx + refine ⟨y, rfl⟩)) + (Submodule.inclusion (by + intro x hx + simp only [Subalgebra.mem_toSubmodule, LinearMap.mem_range] at hx ⊢ + rw [center_tensorProduct] at hx + simp only [AlgHom.mem_range] at hx + obtain ⟨y, rfl⟩ := hx + refine ⟨y, rfl⟩)) rfl rfl) +instance _root_.IsCentralSimple.TensorProduct.isCentral + (A B : Type u) [Ring A] [Algebra K A] [Ring B] [Algebra K B] + [isCentral_A : Algebra.IsCentral K A] [isCentral_B : Algebra.IsCentral K B] : + Algebra.IsCentral K (A ⊗[K] B) := by + constructor + intro _ H + obtain ⟨x, rfl⟩ := le_of_eq (center_tensorProduct K A B) H; clear H + induction x using TensorProduct.induction_on with + | zero => exact ⟨0, by simp⟩ + | tmul a b => + obtain ⟨a', ha⟩ := isCentral_A.1 a.2 + obtain ⟨b', hb⟩ := isCentral_B.1 b.2 + refine ⟨b' * a', ?_⟩ + simp only [AlgHom.toRingHom_eq_coe, map_mul, RingHom.coe_coe, Algebra.TensorProduct.map_tmul, + Subalgebra.coe_val, ← ha, ← hb] + rw [Algebra.ofId_apply, Algebra.ofId_apply, Algebra.TensorProduct.algebraMap_apply', + Algebra.TensorProduct.algebraMap_apply, Algebra.TensorProduct.tmul_mul_tmul] + simp only [one_mul, mul_one] + rw [← Algebra.ofId_apply, ← Algebra.ofId_apply] + | add x y hx hy => + obtain ⟨kx, hx⟩ := hx + obtain ⟨ky, hy⟩ := hy + refine ⟨kx + ky, ?_⟩ + rw [map_add, hx, hy, map_add] +instance _root_.IsCentralSimple.TensorProduct.nontrivial + (A B : Type v) [Ring A] [Algebra K A] [Ring B] [Algebra K B] + [Nontrivial A] [Nontrivial B] : + Nontrivial (A ⊗[K] B) := by + refine ⟨0, 1, fun r ↦ ?_⟩ + let f : K ⊗[K] B →ₐ[K] A ⊗[K] B := + Algebra.TensorProduct.map (Algebra.ofId _ _) (.id _ _) + have hf : Function.Injective f := Module.Flat.rTensor_preserves_injective_linearMap _ + (algebraMap K A).injective + have r' : f 0 = f 1 := by convert r; simp [f] + specialize hf r' + apply_fun Algebra.TensorProduct.lid K B at hf + simp only [map_zero, map_one] at hf + exact zero_ne_one hf +variable {K} in +/-- +a non-zero element in an ideal that can be represented as a sum of tensor products of `n`-terms. +-/ +structure is_obtainable_by_sum_tmul + {ιA A B : Type*} [Ring A] [Algebra K A] [Ring B] [Algebra K B] + (x : A ⊗[K] B) (𝒜 : Basis ιA K A) (I : TwoSidedIdeal <| A ⊗[K] B) (n : ℕ) : Prop where + mem : x ∈ I + ne_zero : x ≠ 0 + rep : ∃ (s : Finset ιA) (_ : s.card = n) (f : ιA → B), + x = ∑ i ∈ s, 𝒜 i ⊗ₜ[K] f i +variable {K} in +lemma _root_.IsCentralSimple.is_obtainable_by_sum_tmul.exists_minimal_element + {A B : Type v} [Ring A] [Algebra K A] [Ring B] [Algebra K B] + (ιA : Type*) (𝒜 : Basis ιA K A) + (I : TwoSidedIdeal (A ⊗[K] B)) (hI : I ≠ ⊥) : + ∃ (n : ℕ) (x : A ⊗[K] B), is_obtainable_by_sum_tmul x 𝒜 I n ∧ + ∀ (m : ℕ) (y : A ⊗[K] B) , is_obtainable_by_sum_tmul y 𝒜 I m → n ≤ m := by + classical + have := SetLike.ext_iff.not.mp hI + push Not at this + obtain ⟨x, ⟨hx0, hx1⟩|⟨hx0, hx1⟩⟩ := this + pick_goal 2 + · change x = 0 at hx1 + subst hx1 + exact hx0 I.zero_mem |>.elim + obtain ⟨s, rfl⟩ := TensorProduct.eq_repr_basis_left 𝒜 x + let n := @Nat.find (fun n => ∃ x : A ⊗[K] B, is_obtainable_by_sum_tmul x 𝒜 I n) _ + ⟨s.support.card, ∑ i ∈ s.support, 𝒜 i ⊗ₜ[K] s i, ⟨hx0, hx1, s.support, rfl, s, rfl⟩⟩ + obtain ⟨x, hx⟩ : ∃ x, is_obtainable_by_sum_tmul x 𝒜 I n := + @Nat.find_spec (fun n => ∃ x : A ⊗[K] B, is_obtainable_by_sum_tmul x 𝒜 I n) _ + ⟨s.support.card, ∑ i ∈ s.support, 𝒜 i ⊗ₜ[K] s i, ⟨hx0, hx1, s.support, rfl, s, rfl⟩⟩ + refine ⟨n, x, hx, fun m y hy => ?_⟩ + by_contra r + simp only [not_le] at r + have := @Nat.find_min (fun n => ∃ x : A ⊗[K] B, is_obtainable_by_sum_tmul x 𝒜 I n) _ + ⟨s.support.card, ∑ i ∈ s.support, 𝒜 i ⊗ₜ[K] s i, ⟨hx0, hx1, s.support, rfl, s, rfl⟩⟩ m r + simp only [not_exists] at this + exact this y hy +lemma _root_.IsCentralSimple.TensorProduct.map_comap_le_span_of_isSimple_isCentralSimple + {A B : Type v} [Ring A] [Algebra K A] [Ring B] [Algebra K B] + [isSimple_A : IsSimpleOrder <| TwoSidedIdeal A] + [isCentral_B : Algebra.IsCentral K B] + [isSimple_B : IsSimpleRing B] + (I : TwoSidedIdeal (A ⊗[K] B)) : + I ≤ TwoSidedIdeal.span + (Set.image (Algebra.TensorProduct.includeLeft : A →ₐ[K] A ⊗[K] B) <| + I.comap (Algebra.TensorProduct.includeLeft : A →ₐ[K] A ⊗[K] B)) := by + classical + if I_ne_bot : I = ⊥ + then subst I_ne_bot; exact bot_le + else + let f : A →ₐ[K] A ⊗[K] B := Algebra.TensorProduct.includeLeft + change I ≤ TwoSidedIdeal.span (Set.image f <| I.comap f) + let 𝒜 := Basis.ofVectorSpace K A + obtain ⟨n, x, ⟨x_mem, x_ne_zero, ⟨s, card_s, b, rfl⟩⟩, H⟩ := + is_obtainable_by_sum_tmul.exists_minimal_element _ 𝒜 I I_ne_bot + have b_ne_zero : ∀ i ∈ s, b i ≠ 0 := by + by_contra! h + rcases h with ⟨i, h1, h2⟩ + specialize H (n - 1) (∑ i ∈ s, 𝒜 i ⊗ₜ[K] b i) ⟨x_mem, x_ne_zero, ⟨s.erase i, + by rw [Finset.card_erase_of_mem, card_s]; exact h1, b, by + symm + fapply Finset.sum_subset + · exact Finset.erase_subset i s + · intro x hx1 hx2 + simp only [Finset.mem_erase, ne_eq, not_and] at hx2 + rw [show x = i by tauto, h2, TensorProduct.tmul_zero]⟩⟩ + have ineq1 : 0 < n := by + rw [← card_s, Finset.card_pos] + exact ⟨i, h1⟩ + omega + if s_ne_empty : s = ∅ + then + subst s_ne_empty + simp only [Finset.card_empty, Finset.sum_empty, ne_eq, not_true_eq_false] at * + else + obtain ⟨i₀, hi₀⟩ := Finset.nonempty_iff_ne_empty.mpr s_ne_empty + have ineq1 : 0 < n := by + rw [← card_s, Finset.card_pos] + exact ⟨i₀, hi₀⟩ + have x_eq' : + ∑ i ∈ s, 𝒜 i ⊗ₜ[K] b i = + 𝒜 i₀ ⊗ₜ[K] b i₀ + + ∑ i ∈ s.erase i₀, 𝒜 i ⊗ₜ[K] b i := by + rw [show 𝒜 i₀ ⊗ₜ[K] b i₀ = ∑ i ∈ {i₀}, 𝒜 i ⊗ₜ[K] b i by rw [Finset.sum_singleton], + ← Finset.sum_disjUnion] + pick_goal 2 + · rw [← Finset.disjoint_erase_comm] + simp only [Finset.erase_singleton, Finset.disjoint_empty_left] + refine Finset.sum_congr ?_ fun _ _ => rfl + ext x + simp only [Finset.disjUnion_eq_union, Finset.mem_union, Finset.mem_singleton, + Finset.mem_erase, ne_eq] + constructor + · intro hx + if hx' : x = i₀ then left; exact hx' + else right; exact ⟨hx', hx⟩ + · rintro (rfl|⟨_, hx2⟩) <;> assumption + have span_bi₀ : TwoSidedIdeal.span {b i₀} = ⊤ := isSimple_B.1.2 _ |>.resolve_left fun r ↦ by + have mem : b i₀ ∈ (⊥ : TwoSidedIdeal B) := by + rw [← r] + apply TwoSidedIdeal.subset_span + simp only [Set.mem_singleton_iff] + exact b_ne_zero i₀ hi₀ mem + have one_mem : (1 : B) ∈ TwoSidedIdeal.span {b i₀} := by rw [span_bi₀]; trivial + rw [TwoSidedIdeal.mem_span_iff_exists_fin] at one_mem + obtain ⟨ℐ, inst1, xL, xR, y, one_eq⟩ := one_mem + replace one_eq : 1 = ∑ i : ℐ, xL i * b i₀ * xR i := by + rw [one_eq] + refine Finset.sum_congr rfl fun i _ => ?_ + congr + simpa only [Set.mem_singleton_iff] using (y i).2 + let ω := ∑ i ∈ s, 𝒜 i ⊗ₜ[K] b i + let Ω := ∑ i : ℐ, (1 ⊗ₜ[K] xL i) * ω * (1 ⊗ₜ[K] xR i) + have Ω_in_I : Ω ∈ I := TwoSidedIdeal.finsetSum_mem _ _ _ fun i _ => I.mul_mem_right _ _ <| + I.mul_mem_left _ _ x_mem + have Ω_eq : + Ω = + 𝒜 i₀ ⊗ₜ[K] (∑ i : ℐ, xL i * b i₀ * xR i) + + ∑ i ∈ s.erase i₀, 𝒜 i ⊗ₜ[K] (∑ j : ℐ, xL j * b i * xR j) := by + dsimp only [Ω, ω] + simp only [x_eq', mul_add, Algebra.TensorProduct.tmul_mul_tmul, one_mul, Finset.mul_sum, + add_mul, mul_one, Finset.sum_mul, Finset.sum_add_distrib, TensorProduct.tmul_sum, + add_right_inj] + rw [Finset.sum_comm] + rw [← one_eq] at Ω_eq + have Ω_prop_1 (b : B) : (1 ⊗ₜ b) * Ω - Ω * (1 ⊗ₜ b) ∈ I := + I.sub_mem (I.mul_mem_left _ _ Ω_in_I) (I.mul_mem_right _ _ Ω_in_I) + have Ω_prop_2 (x : B) : ((1 : A) ⊗ₜ[K] x) * Ω - Ω * ((1 : A) ⊗ₜ[K] x) = + ∑ i ∈ s.erase i₀, 𝒜 i ⊗ₜ[K] + (∑ j : ℐ, (x * (xL j * b i * xR j) - (xL j * b i * xR j) * x)) := by + rw [Ω_eq] + simp only [TensorProduct.tmul_sum, mul_add, Algebra.TensorProduct.tmul_mul_tmul, one_mul, + mul_one, Finset.mul_sum, add_mul, Finset.sum_mul, add_sub_add_left_eq_sub, + Finset.sum_sub_distrib, TensorProduct.tmul_sub] + have Ω_prop_3 (x : B) : ((1 : A) ⊗ₜ[K] x) * Ω - Ω * ((1 : A) ⊗ₜ[K] x) = 0 := by + by_contra rid + specialize H (n - 1) (((1 : A) ⊗ₜ[K] x) * Ω - Ω * ((1 : A) ⊗ₜ[K] x)) + ⟨Ω_prop_1 x, rid, ⟨s.erase i₀, by rw [Finset.card_erase_of_mem, card_s]; exact hi₀, _, + Ω_prop_2 x⟩⟩ + omega + simp_rw [Ω_prop_2] at Ω_prop_3 + have Ω_prop_4 : ∀ i ∈ s.erase i₀, + ∑ j : ℐ, (xL j * b i * xR j) ∈ Subalgebra.center K B := by + intro i hi + rw [Subalgebra.mem_center_iff] + intro x + specialize Ω_prop_3 x + simp only [Finset.mul_sum, Finset.sum_mul, ← sub_eq_zero, sub_zero] + rw [← Finset.sum_sub_distrib, sub_zero] + simpa using TensorProduct.sum_tmul_basis_left_eq_zero' _ _ _ 𝒜 (s.erase i₀) _ Ω_prop_3 i hi + simp_rw [Algebra.IsCentral.center_eq_bot, Algebra.mem_bot, Set.mem_range] at Ω_prop_4 + choose k hk using Ω_prop_4 + have Ω_eq2 := calc Ω + _ = 𝒜 i₀ ⊗ₜ[K] 1 + ∑ i ∈ s.erase i₀, 𝒜 i ⊗ₜ[K] ∑ j : ℐ, xL j * b i * xR j := Ω_eq + _ = 𝒜 i₀ ⊗ₜ[K] 1 + ∑ i ∈ (s.erase i₀).attach, 𝒜 i ⊗ₜ[K] ∑ j : ℐ, xL j * b i * xR j := by + congr 1 + exact Finset.sum_attach _ _ |>.symm + _ = 𝒜 i₀ ⊗ₜ[K] 1 + ∑ i ∈ (s.erase i₀).attach, 𝒜 i ⊗ₜ[K] algebraMap _ _ (k i.1 i.2) := by + congr 1 + refine Finset.sum_congr rfl fun i _ => ?_ + rw [hk i.1 i.2] + _ = 𝒜 i₀ ⊗ₜ[K] 1 + ∑ i ∈ (s.erase i₀).attach, 𝒜 i ⊗ₜ[K] (k i.1 i.2 • (1 : B) : B) := by + congr 1 + refine Finset.sum_congr rfl fun i _ => ?_ + rw [Algebra.algebraMap_eq_smul_one] + _ = 𝒜 i₀ ⊗ₜ[K] 1 + ∑ i ∈ (s.erase i₀).attach, (k i.1 i.2 • 𝒜 i) ⊗ₜ[K] (1 : B) := by + congr 1 + refine Finset.sum_congr rfl fun i _ => ?_ + rw [TensorProduct.smul_tmul] + _ = 𝒜 i₀ ⊗ₜ[K] 1 + (∑ i ∈ (s.erase i₀).attach, (k i.1 i.2 • 𝒜 i)) ⊗ₜ[K] (1 : B) := by + rw [TensorProduct.sum_tmul] + _ = (𝒜 i₀ + (∑ i ∈ (s.erase i₀).attach, (k i.1 i.2 • 𝒜 i))) ⊗ₜ[K] 1 := by + rw [TensorProduct.add_tmul] + rw [Ω_eq2] at Ω_in_I + have hI : I.comap f = ⊤ := isSimple_A.2 _ |>.resolve_left fun r ↦ by + have mem : 𝒜 i₀ + (∑ i ∈ (s.erase i₀).attach, (k i.1 i.2 • 𝒜 i)) ∈ I.comap f := by + rw [TwoSidedIdeal.mem_comap] + exact Ω_in_I + rw [r] at mem + change _ = 0 at mem + rw [mem, TensorProduct.zero_tmul] at Ω_eq2 + have LI := 𝒜.linearIndependent + rw [linearIndependent_iff'] at LI + specialize LI s (fun i => + if i = i₀ then 1 + else if h : i ∈ s.erase i₀ then k i h else 0) (by + dsimp only + simp_rw [ite_smul, one_smul, dite_smul, zero_smul] + rw [Finset.sum_ite, + show ∑ x ∈ Finset.filter (fun x ↦ x = i₀) s, 𝒜 x = ∑ x ∈ {i₀}, 𝒜 x by + refine Finset.sum_congr ?_ fun _ _ => rfl + ext + simp only [Finset.mem_filter, Finset.mem_singleton, and_iff_right_iff_imp] + rintro rfl + exact hi₀, Finset.sum_singleton, + show Finset.filter (fun x ↦ ¬x = i₀) s = s.erase i₀ by + ext + simp only [Finset.mem_filter, Finset.mem_erase, ne_eq] + rw [and_comm], ← Finset.sum_attach] + conv_rhs => rw [← mem] + congr 1 + refine Finset.sum_congr rfl fun i _ => ?_ + rw [dif_pos i.2]) i₀ hi₀ + rw [if_pos rfl] at LI + exact zero_ne_one LI.symm + rw [hI, TwoSidedIdeal.coe_top_set, TwoSidedIdeal.le_iff] + rintro x - + rw [SetLike.mem_coe] + induction x using TensorProduct.induction_on with + | zero => simp + | tmul a b => + rw [show a ⊗ₜ[K] b = (a ⊗ₜ 1) * (1 ⊗ₜ b) by simp] + exact TwoSidedIdeal.mul_mem_right _ _ _ <| TwoSidedIdeal.subset_span ⟨a, ⟨⟩, rfl⟩ + | add x y hx hy => exact TwoSidedIdeal.add_mem _ hx hy +lemma _root_.IsCentralSimple.TensorProduct.map_comap_eq_of_isSimple_isCentralSimple + {A B : Type v} [Ring A] [Algebra K A] [Ring B] [Algebra K B] + [isSimple_A : IsSimpleOrder <| TwoSidedIdeal A] + [isCentral_B : Algebra.IsCentral K B] + [isSimple_B : IsSimpleRing B] + (I : TwoSidedIdeal (A ⊗[K] B)) : + I = TwoSidedIdeal.span + (Set.image (Algebra.TensorProduct.includeLeft : A →ₐ[K] A ⊗[K] B) <| + I.comap (Algebra.TensorProduct.includeLeft : A →ₐ[K] A ⊗[K] B)) := by + refine le_antisymm (TensorProduct.map_comap_le_span_of_isSimple_isCentralSimple (K := K) I) ?_ + rw [TwoSidedIdeal.span_le] + rintro _ ⟨x, hx, rfl⟩ + rw [SetLike.mem_coe, TwoSidedIdeal.mem_comap] at hx + exact hx +instance _root_.IsCentralSimple.TensorProduct.simple + (A B : Type v) [Ring A] [Algebra K A] [Ring B] [Algebra K B] + [isSimple_A : IsSimpleRing A] + [isCentral_B : Algebra.IsCentral K B] + [isSimple_B : IsSimpleRing B] : + IsSimpleRing (A ⊗[K] B) := by + let f : A →ₐ[K] A ⊗[K] B := Algebra.TensorProduct.includeLeft + suffices eq1 : ∀ (I : TwoSidedIdeal (A ⊗[K] B)), + I = TwoSidedIdeal.span (Set.image f <| I.comap f) by + refine ⟨⟨fun I => ?_⟩⟩ + specialize eq1 I + rcases isSimple_A.1.2 (I.comap f) with h|h + · left + rw [h, TwoSidedIdeal.coe_bot_set, Set.image_singleton, map_zero] at eq1 + rw [eq1, eq_bot_iff, TwoSidedIdeal.le_iff] + rintro x hx + rw [SetLike.mem_coe, TwoSidedIdeal.mem_span_iff_exists_fin] at hx + obtain ⟨ι, inst, xL, xR, y, rfl⟩ := hx + rw [SetLike.mem_coe] + refine TwoSidedIdeal.finsetSum_mem _ _ _ fun i _ => ?_ + have := (y i).2 + simp only [Set.mem_singleton_iff] at this + rw [this, mul_zero, zero_mul] + rfl + · right + rw [h, TwoSidedIdeal.coe_top_set] at eq1 + rw [eq1, eq_top_iff, TwoSidedIdeal.le_iff] + rintro x - + rw [SetLike.mem_coe] + induction x using TensorProduct.induction_on with + | zero => simp + | tmul a b => + rw [show a ⊗ₜ[K] b = (a ⊗ₜ 1) * (1 ⊗ₜ b) by simp] + exact TwoSidedIdeal.mul_mem_right _ _ _ <| TwoSidedIdeal.subset_span ⟨a, ⟨⟩, rfl⟩ + | add x y hx hy => exact TwoSidedIdeal.add_mem _ hx hy + apply TensorProduct.map_comap_eq_of_isSimple_isCentralSimple +-- We can't have `L` to have different universe level of `D` in this proof, again due that we used +-- `flatness` +-- FIXME: Get rid of the raised heartbeats +instance baseChange + (D L : Type u) [Ring D] [Algebra K D] + [Field L] [Algebra K L] + [h : Algebra.IsCentral K D] [IsSimpleRing D] : + Algebra.IsCentral L (L ⊗[K] D) where + out:= by + intro _ H + obtain ⟨x, rfl⟩ := le_of_eq (center_tensorProduct K L D) H; clear H + induction x using TensorProduct.induction_on with + | zero => exact ⟨0, by simp⟩ + | tmul l d => + obtain ⟨k, hk⟩ := h.out d.2 + refine ⟨k • l, ?_⟩ + simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe, Algebra.TensorProduct.map_tmul, + Subalgebra.coe_val, ← hk] + simp only [Algebra.ofId_apply, Algebra.TensorProduct.algebraMap_apply, + Algebra.algebraMap_self, RingHom.id_apply] + rw [TensorProduct.smul_tmul, Algebra.algebraMap_eq_smul_one] + | add x y hx hy => + obtain ⟨kx, (hkx : kx ⊗ₜ 1 = _)⟩ := hx + obtain ⟨ky, (hky : ky ⊗ₜ 1 = _)⟩ := hy + exact ⟨kx + ky, by simp only [AlgHom.toRingHom_eq_coe, map_add, RingHom.coe_coe, + Algebra.ofId_apply, Algebra.TensorProduct.algebraMap_apply, Algebra.algebraMap_self, + RingHom.id_apply, hkx, hky]⟩ +end IsCentralSimple +section CSA_implies_CSA +variable (K : Type u) [Field K] +variable (B : Type*) [Ring B] +lemma top_eq_ring (R : Type*) [Ring R] : (⊤ : TwoSidedIdeal R) = (⊤ : Set R) := by + aesop +lemma _root_.AlgEquiv.isCentral {K B C : Type*} + [Field K] [Ring B] [Algebra K B] + [hc : Algebra.IsCentral K B] + [Ring C] [Algebra K C] (e : B ≃ₐ[K] C) : + Algebra.IsCentral K C where + out z hz := by + obtain ⟨k, hk⟩ := hc.out (show e.symm z ∈ _ by + simp only [Subalgebra.mem_center_iff] at hz ⊢ + exact fun x ↦ by simpa using congr(e.symm $(hz (e x)))) + exact ⟨k, by simpa [Algebra.ofId_apply] using congr(e $hk)⟩ +theorem CSA_implies_CSA (K : Type*) (B : Type*) [Field K] [Ring B] [Algebra K B] + (n : ℕ) (D : Type*) [NeZero n] (h : DivisionRing D) [Algebra K D] + (Wdb : B ≃ₐ[K] (Matrix (Fin n) (Fin n) D)) [Algebra.IsCentral K B] [IsSimpleRing B] : + Algebra.IsCentral K D := by + refine ⟨fun d hd => ?_⟩ + obtain ⟨k, hk⟩ := Wdb.isCentral.1 + (show (Matrix.diagonal fun _ ↦ d) ∈ _ by + rw [Matrix.mem_center_iff'] + refine ⟨⟨d, hd⟩, ?_⟩ + ext i j + simp only [Matrix.diagonal_apply, Matrix.smul_apply, Matrix.one_apply, smul_ite, smul_zero] + split_ifs + · change _ = d • (1 : D) + simp only [smul_eq_mul, mul_one] + · rfl) + refine ⟨k, ?_⟩ + apply_fun (· 0 0) at hk + simpa using hk +end CSA_implies_CSA diff --git a/LeanPool/BrauerGroupNew/Centralizer.lean b/LeanPool/BrauerGroupNew/Centralizer.lean new file mode 100644 index 0000000000..e23d805f9c --- /dev/null +++ b/LeanPool/BrauerGroupNew/Centralizer.lean @@ -0,0 +1,170 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +/- +Copyright (c) 2024 Jujian Zhang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jujian Zhang +-/ +import Mathlib.Algebra.Algebra.Subalgebra.Basic +import Mathlib.RingTheory.Adjoin.Basic +import Mathlib.RingTheory.TensorProduct.Maps +import Mathlib.LinearAlgebra.TensorProduct.Basis +import Mathlib.LinearAlgebra.FreeModule.Basic + +/-! +# Properties of centers and centralizers + +This file contains theorems about the center and centralizer of a subalgebra. + +## Main results + +Let `R` be a commutative ring and `A` and `B` two `R`-algebras. +- `Subalgebra.centralizer_sup`: if `S` and `T` are subalgebras of `A`, then the centralizer of + `S ⊔ T` is the intersection of the centralizer of `S` and the centralizer of `T`. +- `Subalgebra.centralizer_range_includeLeft_eq_center_tensorProduct`: if `B` is free as a module, + then the centralizer of `A` in `A ⊗ B` is `C(A) ⊗ B` where `C(A)` is the center of `A`. +- `Subalgebra.centralizer_range_includeRight_eq_center_tensorProduct`: if `A` is free as a module, + then the centralizer of `B` in `A ⊗ B` is `A ⊗ C(B)` where `C(B)` is the center of `B`. +-/ + +namespace Subalgebra + +section CommSemiring + +variable {R : Type*} [CommSemiring R] +variable {A : Type*} [Semiring A] [Algebra R A] + +lemma centralizer_sup (S T : Subalgebra R A) : + centralizer R ((S ⊔ T : Subalgebra R A) : Set A) = centralizer R S ⊓ centralizer R T := by + ext x + simp only [Subalgebra.mem_centralizer_iff, SetLike.mem_coe, Algebra.mem_inf] + constructor + · intro h + exact ⟨fun g hg => h g <| (le_sup_left : S ≤ S ⊔ T) hg, + fun g hg => h g <| (le_sup_right : T ≤ S ⊔ T) hg⟩ + · rintro ⟨h1, h2⟩ g hg + induction hg using Algebra.adjoin_induction with + | mem y hy => exact hy.recOn (fun hy => h1 y hy) (fun hy => h2 y hy) + | algebraMap r => exact Algebra.commutes r x + | add _ _ _ _ h h' => simp [add_mul, h, h', mul_add] + | mul _ _ _ _ h h' => rw [mul_assoc, h', ← mul_assoc, h, mul_assoc] + +end CommSemiring + +section Free + +variable (R : Type*) [CommSemiring R] +variable (A : Type*) [Semiring A] [Algebra R A] +variable (B : Type*) [Semiring B] [Algebra R B] + +open Finsupp TensorProduct + +/-- +Let `R` be a commutative ring and `A, B` be `R`-algebras where `B` is free as `R`-module. +Then the centralizer of `A ⊆ A ⊗ B` is `C(A) ⊗ B` where `C(A)` is the center of `A`. +-/ +lemma _root_.Subalgebra.centralizer_range_includeLeft_eq_center_tensorProduct [Module.Free R B] : + Subalgebra.centralizer R + (Algebra.TensorProduct.includeLeft : A →ₐ[R] A ⊗[R] B).range = + (Algebra.TensorProduct.map (Subalgebra.center R A).val (AlgHom.id R B)).range := by + classical + ext w + constructor + · intro hw + rw [Subalgebra.mem_centralizer_iff] at hw + let ℬ := Module.Free.chooseBasis R B + obtain ⟨b, rfl⟩ := TensorProduct.eq_repr_basis_right ℬ w + refine Subalgebra.sum_mem _ fun j hj => ⟨⟨b j, ?_⟩ ⊗ₜ[R] ℬ j, by simp⟩ + rw [Subalgebra.mem_center_iff] + intro x + suffices x • b = b.mapRange (fun a ↦ a * x) (by simp) from Finsupp.ext_iff.1 this j + specialize hw (x ⊗ₜ[R] 1) ⟨x, rfl⟩ + simp only [Finsupp.sum, Finset.mul_sum, Algebra.TensorProduct.tmul_mul_tmul, one_mul, + Finset.sum_mul, mul_one] at hw + refine TensorProduct.sum_tmul_basis_right_injective ℬ ?_ + simp only [Finsupp.coe_lsum] + rw [sum_of_support_subset (s := b.support) (hs := Finsupp.support_smul) (h := by aesop), + sum_of_support_subset (s := b.support) (hs := support_mapRange) (h := by aesop)] + simpa only [Finsupp.coe_smul, Pi.smul_apply, smul_eq_mul, LinearMap.flip_apply, + TensorProduct.mk_apply, Finsupp.mapRange_apply] using hw + · rintro ⟨w, rfl⟩ + rw [Subalgebra.mem_centralizer_iff] + rintro _ ⟨x, rfl⟩ + induction w using TensorProduct.induction_on with + | zero => simp + | tmul b c => + simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe, Algebra.TensorProduct.includeLeft_apply, + Algebra.TensorProduct.map_tmul, coe_val, AlgHom.coe_id, id_eq, + Algebra.TensorProduct.tmul_mul_tmul, one_mul, mul_one, Subalgebra.mem_center_iff.1 b.2 x] + | add y z hy hz => rw [map_add, mul_add, hy, hz, add_mul] + +/-- +Let `R` be a commutative ring and `A, B` be `R`-algebras where `A` is free as `R`-module. +Then the centralizer of `B ⊆ A ⊗ B` is `A ⊗ C(B)` where `C(B)` is the center of `B`. +-/ +lemma _root_.Subalgebra.centralizer_range_includeRight_eq_center_tensorProduct [Module.Free R A] : + Subalgebra.centralizer R + (Algebra.TensorProduct.includeRight : B →ₐ[R] A ⊗[R] B).range = + (Algebra.TensorProduct.map (AlgHom.id R A) (center R B).val).range := by + have eq1 := centralizer_range_includeLeft_eq_center_tensorProduct R B A + apply_fun Subalgebra.comap (Algebra.TensorProduct.comm R A B).toAlgHom at eq1 + convert eq1 + · ext x + simpa only [AlgHom.coe_range, mem_centralizer_iff, Set.mem_range, + Algebra.TensorProduct.includeRight_apply, forall_exists_index, forall_apply_eq_imp_iff, + AlgEquiv.toAlgHom_eq_coe, mem_comap, AlgHom.coe_coe, + Algebra.TensorProduct.includeLeft_apply] using + ⟨fun h b ↦ (Algebra.TensorProduct.comm R A B).symm.injective <| by simpa using h b, + fun h b ↦ (Algebra.TensorProduct.comm R A B).injective <| by simpa using h b⟩ + ext x + simp only [AlgHom.mem_range, AlgEquiv.toAlgHom_eq_coe, mem_comap, AlgHom.coe_coe] + constructor + · rintro ⟨x, rfl⟩ + refine ⟨(Algebra.TensorProduct.comm R _ _) x, ?_⟩ + change AlgHom.comp ((Algebra.TensorProduct.map (center R B).val (AlgHom.id R A))) + ((Algebra.TensorProduct.comm R A ↥(center R B))).toAlgHom x = + (Algebra.TensorProduct.comm R A B).toAlgHom.comp + ((Algebra.TensorProduct.map (AlgHom.id R A) (center R B).val)) x + congr 1 + ext + · rfl + · rfl + · rintro ⟨y, hy⟩ + refine ⟨(Algebra.TensorProduct.comm R _ _) y, (Algebra.TensorProduct.comm R A B).injective ?_⟩ + rw [← hy] + change + ((Algebra.TensorProduct.comm R A B).toAlgHom.comp + (Algebra.TensorProduct.map (AlgHom.id R A) (center R B).val)).comp + (Algebra.TensorProduct.comm R (↥(center R B)) A) y = + ((Algebra.TensorProduct.map _ _)) y + congr 1 + ext + · rfl + · rfl + +lemma _root_.Subalgebra.centralizer_tensorProduct_eq_center_tensorProduct_left [Module.Free R B] : + Subalgebra.centralizer R + (Algebra.TensorProduct.map (AlgHom.id R A) (Algebra.ofId R B)).range = + (Algebra.TensorProduct.map (Subalgebra.center R A).val (AlgHom.id R B)).range := by + rw [← centralizer_range_includeLeft_eq_center_tensorProduct] + simp [Algebra.TensorProduct.map_range, + show (Algebra.TensorProduct.includeRight.comp (Algebra.ofId R B)) = Algebra.ofId R _ by ext, + show (Algebra.ofId R (A ⊗[R] B)).range = ⊥ by rfl] + +lemma _root_.Subalgebra.centralizer_tensorProduct_eq_center_tensorProduct_right [Module.Free R A] : + Subalgebra.centralizer R + (Algebra.TensorProduct.map (Algebra.ofId R A) (AlgHom.id R B)).range = + (Algebra.TensorProduct.map (AlgHom.id R A) (center R B).val).range := by + rw [← centralizer_range_includeRight_eq_center_tensorProduct] + simp [Algebra.TensorProduct.map_range, + show (Algebra.TensorProduct.includeLeft.comp (Algebra.ofId R A)) = Algebra.ofId R (A ⊗[R] B) by + ext, + show (Algebra.ofId R (A ⊗[R] B)).range = ⊥ by rfl] + +end Free + +end Subalgebra diff --git a/LeanPool/BrauerGroupNew/ExtendScalar.lean b/LeanPool/BrauerGroupNew/ExtendScalar.lean new file mode 100644 index 0000000000..7225e181f8 --- /dev/null +++ b/LeanPool/BrauerGroupNew/ExtendScalar.lean @@ -0,0 +1,179 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.RingTheory.TensorProduct.Basic + +open scoped TensorProduct + +universe u +variable (k K L A : Type u) [Field k] [Field K] [Field L] [Algebra k K] [Algebra K L] + [Algebra k L] [Ring A] [Algebra k A] [IsScalarTower k K L] + +/-- Additive map sending `l ⊗ a` to `l ⊗ (1 ⊗ a)` after releasing scalars through `K`. -/ +def releaseAddHom : L ⊗[k] A →+ L ⊗[K] (K ⊗[k] A) := + TensorProduct.liftAddHom + { + toFun l := { + toFun a := l ⊗ₜ[K] (1 ⊗ₜ[k] a) + map_zero' := by simp only [TensorProduct.tmul_zero] + map_add' _ _ := by simp_rw [TensorProduct.tmul_add] + } + map_zero' := by simp only [TensorProduct.zero_tmul]; rfl + map_add' x y := by + ext a' + simp only [AddMonoidHom.coe_mk, ZeroHom.coe_mk, AddMonoidHom.add_apply] + repeat rw [TensorProduct.add_tmul] + } fun r l a ↦ by simp only [AddMonoidHom.coe_mk, ZeroHom.coe_mk, TensorProduct.tmul_smul]; rfl +/-- Algebra homomorphism releasing an `L ⊗[k] A` tensor through `K`. -/ +def release : L ⊗[k] A →ₐ[L] L ⊗[K] (K ⊗[k] A) where + __ := releaseAddHom k K L A + map_one' := by simp only [releaseAddHom, Algebra.TensorProduct.one_def, ZeroHom.toFun_eq_coe, + AddMonoidHom.toZeroHom_coe, TensorProduct.liftAddHom_tmul, AddMonoidHom.coe_mk, + ZeroHom.coe_mk] + map_mul' x y := by + induction x using TensorProduct.induction_on with + | zero => simp only [zero_mul, ZeroHom.toFun_eq_coe, map_zero, AddMonoidHom.toZeroHom_coe] + | tmul l a => + induction y using TensorProduct.induction_on with + | zero => simp only [mul_zero, ZeroHom.toFun_eq_coe, map_zero, AddMonoidHom.toZeroHom_coe] + | tmul l' a' => + simp only [Algebra.TensorProduct.tmul_mul_tmul, ZeroHom.toFun_eq_coe, + AddMonoidHom.toZeroHom_coe] + change (l * l') ⊗ₜ[K] (1 ⊗ₜ[k] (a * a')) = (l ⊗ₜ[K] (1 ⊗ₜ[k] a)) * (l' ⊗ₜ[K] (1 ⊗ₜ[k] a')) + rw [Algebra.TensorProduct.tmul_mul_tmul, Algebra.TensorProduct.tmul_mul_tmul, mul_one] + | add x y hx hy => + simp only [mul_add, ZeroHom.toFun_eq_coe, AddMonoidHom.toZeroHom_coe, map_add] + change releaseAddHom k K L A _ = releaseAddHom k K L A _ * releaseAddHom k K L A _ at hx + change releaseAddHom k K L A _ = releaseAddHom k K L A _ * releaseAddHom k K L A _ at hy + rw [hx, hy] + | add z w hz hw => + simp only [add_mul, ZeroHom.toFun_eq_coe, AddMonoidHom.toZeroHom_coe, map_add] + simp only [ZeroHom.toFun_eq_coe, AddMonoidHom.toZeroHom_coe] at hw hz ⊢ + rw [hz, hw] + commutes' := fun l ↦ by + simp only [Algebra.TensorProduct.algebraMap_apply, ZeroHom.toFun_eq_coe, + AddMonoidHom.toZeroHom_coe, Algebra.TensorProduct.one_def]; rfl + +/-- Linear map sending `m ⊗ a` to `(m • l) ⊗ a`. -/ +def absorbMap (l : L) : K ⊗[k] A →ₗ[k] L ⊗[k] A := + TensorProduct.lift { + toFun := fun m ↦ { + toFun := fun a ↦ (m • l) ⊗ₜ[k] a + map_add' := fun _ _ ↦ by simp only [TensorProduct.tmul_add] + map_smul' := fun _ _ ↦ by simp [TensorProduct.tmul_smul, RingHom.id_apply] + } + map_add' := fun _ _ ↦ by ext; simp only [add_smul, TensorProduct.add_tmul, + LinearMap.coe_mk, AddHom.coe_mk, LinearMap.add_apply] + map_smul' := fun _ _ ↦ by ext; simp only [smul_assoc, ← TensorProduct.smul_tmul', + LinearMap.coe_mk, AddHom.coe_mk, RingHom.id_apply, LinearMap.smul_apply] + } + +/-- Additive map absorbing the intermediate `K` tensor factor into `L`. -/ +def absorbAddHom : L ⊗[K] (K ⊗[k] A) →+ L ⊗[k] A := + TensorProduct.liftAddHom + { + toFun l := absorbMap k K L A l + map_zero' := by + ext x + induction x using TensorProduct.induction_on with + | zero => simp only [map_zero] + | tmul x a => + change (x • 0) ⊗ₜ a = 0 + simp only [smul_zero, TensorProduct.zero_tmul] + | add x y hx hy => + simp_all only [AddMonoidHom.zero_apply, map_add, add_zero] + map_add' := fun x y ↦ by + ext z + induction z using TensorProduct.induction_on with + | zero => simp only [map_zero] + | tmul m a => + change (m • (x + y)) ⊗ₜ a = (m • x) ⊗ₜ a + (m • y) ⊗ₜ a + simp only [smul_add, TensorProduct.add_tmul] + | add z w hz hw => + simp only [AddMonoidHom.add_apply] at hz hw + simp only [map_add, AddMonoidHom.add_apply, hz, hw] + } (fun r l a ↦ by + induction a using TensorProduct.induction_on with + | zero => simp only [AddMonoidHom.coe_mk, ZeroHom.coe_mk, map_zero, smul_zero] + | tmul m a => + simp only [AddMonoidHom.coe_mk, ZeroHom.coe_mk, TensorProduct.smul_tmul'] + change (m • (r • l)) ⊗ₜ a = ((r • m) • l) ⊗ₜ a + rw [← smul_assoc, smul_eq_mul, mul_comm, ← smul_eq_mul] + | add x y hx hy => + simp only [AddMonoidHom.coe_mk, ZeroHom.coe_mk] at hx hy + simp only [AddMonoidHom.coe_mk, ZeroHom.coe_mk, map_add, hx, hy, smul_add] + ) + +/-- Algebra homomorphism inverse to `release`, absorbing the intermediate `K` tensor factor. -/ +def absorb : L ⊗[K] (K ⊗[k] A) →ₐ[L] L ⊗[k] A where + __ := absorbAddHom k K L A + map_one' := by + simp only [Algebra.TensorProduct.one_def, ZeroHom.toFun_eq_coe, AddMonoidHom.toZeroHom_coe] + change (1 • 1) ⊗ₜ (1 : A) = _ + rw [one_smul] + map_mul' := fun x y ↦ by + simp only [ZeroHom.toFun_eq_coe, AddMonoidHom.toZeroHom_coe] + induction x using TensorProduct.induction_on with + | zero => simp only [zero_mul, map_zero] + | add x' y' hx hy => simp only [add_mul, map_add, hx, hy] + | tmul l ka => + induction y using TensorProduct.induction_on with + | zero => simp only [mul_zero, map_zero] + | add x y hx hy => simp only [mul_add, map_add, hx, hy] + | tmul l' ka' => + simp only [Algebra.TensorProduct.tmul_mul_tmul] + induction ka' using TensorProduct.induction_on with + | zero => simp only [mul_zero, TensorProduct.tmul_zero, map_zero] + | add x y hx hy => simp only [mul_add, TensorProduct.tmul_add, map_add, hx, hy] + | tmul k' a => + induction ka using TensorProduct.induction_on with + | zero => simp only [zero_mul, TensorProduct.tmul_zero, map_zero] + | add x y hx hy => simp only [add_mul, TensorProduct.tmul_add, map_add, hx, hy] + | tmul k1 a1 => + simp only [Algebra.TensorProduct.tmul_mul_tmul] + change ((k1 * k') • (l * l')) ⊗ₜ (a1 * a) = (k1 • l) ⊗ₜ a1 * (k' • l') ⊗ₜ a + simp only [Algebra.TensorProduct.tmul_mul_tmul, Algebra.mul_smul_comm, + Algebra.smul_mul_assoc] + rw [← smul_assoc, smul_eq_mul, mul_comm] + commutes' := fun l ↦ by + simp only [Algebra.TensorProduct.algebraMap_apply, Algebra.TensorProduct.one_def] + change (1 • l) ⊗ₜ (1 : A) = l ⊗ₜ 1 + rw [one_smul] + +/-- Algebra equivalence between direct scalar extension and extension through the intermediate +field. -/ +def absorb_eqv : L ⊗[k] A ≃ₐ[L] L ⊗[K] (K ⊗[k] A) where + toFun := release k K L A + invFun := absorb k K L A + left_inv := fun x ↦ by + induction x using TensorProduct.induction_on with + | zero => simp only [map_zero] + | tmul l a => + change (absorb k K L A) (l ⊗ₜ[K] (1 ⊗ₜ a)) = _ + change (1 • l) ⊗ₜ _ = _ + rw [one_smul] + | add x y hx hy => + simp only [map_add, hx, hy] + right_inv := fun x ↦ by + induction x using TensorProduct.induction_on with + | zero => simp only [map_zero] + | tmul l ka => + induction ka using TensorProduct.induction_on with + | zero => simp only [TensorProduct.tmul_zero, map_zero] + | tmul k' a => + change (release k K L A) ((k' • l) ⊗ₜ a) = _ + change (k' • l) ⊗ₜ[K] (1 ⊗ₜ a) = _ + rw [TensorProduct.smul_tmul, TensorProduct.smul_tmul', smul_eq_mul, mul_one] + | add x y hx hy => + simp only [TensorProduct.tmul_add, map_add, hx, hy] + | add x y hx hy => + simp only [map_add, hx, hy] + map_mul' := map_mul _ + map_add' := map_add _ + commutes' := release k K L A|>.commutes + +theorem absorb_eqv_apply (l : L) (a : A) : absorb_eqv k K L A (l ⊗ₜ a) = l ⊗ₜ[K] (1 ⊗ₜ a) := + rfl diff --git a/LeanPool/BrauerGroupNew/FieldCat.lean b/LeanPool/BrauerGroupNew/FieldCat.lean new file mode 100644 index 0000000000..5194a8ad9c --- /dev/null +++ b/LeanPool/BrauerGroupNew/FieldCat.lean @@ -0,0 +1,317 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +/- +Copyright (c) 2024 Yunzhou Xie. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie +-/ +import Mathlib.Algebra.Category.Ring.Basic +import Mathlib.Algebra.EuclideanDomain.Field +import Mathlib.Algebra.Ring.CompTypeclasses +import Mathlib.Combinatorics.Quiver.ReflQuiver + +/-! +# Category instances for `Field`. +-/ + +universe u v + +open CategoryTheory + +/-- The category of fields. -/ +structure FieldCat where + private mk :: + /-- The underlying type. -/ + carrier : Type u + [field : Field carrier] + +attribute [instance] FieldCat.field + +initialize_simps_projections FieldCat (-field) + +namespace FieldCat + +instance : CoeSort (FieldCat) (Type u) := + ⟨FieldCat.carrier⟩ + +attribute [coe] FieldCat.carrier + +/-- The object in the category of R-algebras associated to a type equipped with the appropriate +typeclasses. This is the preferred way to construct a term of `FieldCat`. -/ +abbrev of (R : Type u) [Field R] : FieldCat := ⟨R⟩ + +lemma coe_of (R : Type u) [Field R] : (of R : Type u) = R := rfl + +lemma of_carrier (R : FieldCat.{u}) : of R = R := rfl + +variable {R} in +/-- The type of morphisms in `FieldCat`. -/ +@[ext] +structure Hom (R S : FieldCat) where + private mk :: + /-- The underlying ring hom. -/ + hom : R →+* S + +instance : Category FieldCat where + Hom R S := Hom R S + id R := ⟨RingHom.id R⟩ + comp f g := ⟨g.hom.comp f.hom⟩ + +instance {R S : FieldCat.{u}} : CoeFun (R ⟶ S) (fun _ ↦ R → S) where + coe f := f.hom + +@[simp] +lemma hom_id {R : FieldCat} : (𝟙 R : R ⟶ R).hom = RingHom.id R := rfl + +/- Provided for rewriting. -/ +lemma id_apply (R : FieldCat) (r : R) : + (𝟙 R : R ⟶ R) r = r := by simp + +@[simp] +lemma hom_comp {R S T : FieldCat} (f : R ⟶ S) (g : S ⟶ T) : + (f ≫ g).hom = g.hom.comp f.hom := rfl + +/- Provided for rewriting. -/ +lemma comp_apply {R S T : FieldCat} (f : R ⟶ S) (g : S ⟶ T) (r : R) : + (f ≫ g) r = g (f r) := by simp + +@[ext] +lemma hom_ext {R S : FieldCat} {f g : R ⟶ S} (hf : f.hom = g.hom) : f = g := + Hom.ext hf + +/-- Typecheck a `RingHom` as a morphism in `FieldCat`. -/ +abbrev ofHom {R S : Type u} [Field R] [Field S] (f : R →+* S) : of R ⟶ of S := + ⟨f⟩ + +lemma hom_ofHom {R S : Type u} [Field R] [Field S] (f : R →+* S) : (ofHom f).hom = f := rfl + +@[simp] +lemma ofHom_hom {R S : FieldCat} (f : R ⟶ S) : + ofHom (Hom.hom f) = f := rfl + +@[simp] +lemma ofHom_id {R : Type u} [Field R] : ofHom (RingHom.id R) = 𝟙 (of R) := rfl + +@[simp] +lemma ofHom_comp {R S T : Type u} [Field R] [Field S] [Field T] + (f : R →+* S) (g : S →+* T) : + ofHom (g.comp f) = ofHom f ≫ ofHom g := + rfl + +lemma ofHom_apply {R S : Type u} [Field R] [Field S] + (f : R →+* S) (r : R) : ofHom f r = f r := rfl + +@[simp] +lemma inv_hom_apply {R S : FieldCat} (e : R ≅ S) (r : R) : e.inv (e.hom r) = r := by + rw [← comp_apply] + simp + +@[simp] +lemma hom_inv_apply {R S : FieldCat} (e : R ≅ S) (s : S) : e.hom (e.inv s) = s := by + rw [← comp_apply] + simp + +-- instance : Inhabited FieldCat := +-- ⟨of PUnit⟩ + +instance : ConcreteCategory.{u} FieldCat (fun R S ↦ R →+* S) where + hom := Hom.hom + ofHom := ofHom + +/-- This unification hint helps with problems of the form `(forget ?C).obj R =?= carrier R'`. + +An example where this is needed is in applying +`PresheafOfModules.Sheafify.app_eq_of_isLocallyInjective`. +-/ +unif_hint forget_obj_eq_coe (R R' : FieldCat) where + R ≟ R' ⊢ + (forget FieldCat).obj R ≟ FieldCat.carrier R' + +lemma forget_obj {R : FieldCat} : (forget FieldCat).obj R = R := rfl + +lemma forget_map {R S : FieldCat} (f : R ⟶ S) : + (forget FieldCat).map f = (f.hom : R → S) := + rfl + +instance {R : FieldCat} : Field ((forget FieldCat).obj R) := + (inferInstance : Field R.carrier) + +instance hasForgetToSemiRingCat : HasForget₂ FieldCat CommRingCat where + forget₂ := + { obj := fun R ↦ CommRingCat.of R + map := fun f ↦ CommRingCat.ofHom f.hom } + +instance hasForgetToAddCommGrp : HasForget₂ FieldCat RingCat where + forget₂ := + { obj := fun R ↦ RingCat.of R + map := fun f ↦ RingCat.ofHom f.hom } + +/-- Field equivalence are isomorphisms in category of semirings -/ +@[simps] +def RingEquiv.toRingCatIso {R S : Type u} [Field R] [Field S] (e : R ≃+* S) : + of R ≅ of S where + hom := ⟨e⟩ + inv := ⟨e.symm⟩ + +instance forgetReflectIsos : (forget FieldCat).ReflectsIsomorphisms where + reflects {X Y} f _ := by + let i := asIso ((forget FieldCat).map f) + let ff : X →+* Y := f.hom + let e : X ≃+* Y := { ff, i.toEquiv with } + exact FieldCat.RingEquiv.toRingCatIso e|>.isIso_hom + +-- instance : BundledHom.ParentProjection @Field.toCommRing := +-- ⟨⟩ + +-- instance (X : FieldCat) : Field X.1 := X.field + +-- instance : Category FieldCat := inferInstance + +-- instance : HasForget FieldCat where +-- forget := { +-- obj X := X +-- map f := f.1 +-- map_id X := by simp [RingHom.id_apply]; rfl +-- map_comp := _ +-- } +-- forget_faithful := _ + +-- -- Porting note: Hinting to Lean that `forget R` and `R` are the same +-- unif_hint forget_obj_eq_coe (R : FieldCat) where ⊢ +-- (forget FieldCat).obj R ≟ R + +-- instance instField (X : FieldCat) : Field X := X.str + +-- instance instFunLike {X Y : FieldCat} : FunLike (X ⟶ Y) X Y := +-- -- Note: this is apparently _not_ defeq to FieldHom.instFunLike with reducible transparency +-- ConcreteCategory.instFunLike + +-- -- Porting note (#10754) : added instance +-- instance instFieldHomClass {X Y : FieldCat} : RingHomClass (X ⟶ Y) X Y := +-- RingHom.instRingHomClass + +-- lemma coe_id {X : FieldCat} : (𝟙 X : X → X) = id := rfl + +-- lemma coe_comp {X Y Z : FieldCat} {f : X ⟶ Y} {g : Y ⟶ Z} : (f ≫ g : X → Z) = g ∘ f := rfl + +-- lemma ext {X Y : FieldCat} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g := +-- RingHom.ext w + +-- /-- Construct a bundled `FieldCat` from the underlying type and typeclass. -/ +-- def of (R : Type u) [Field R] : FieldCat := +-- Bundled.of R + +-- /-- Typecheck a `RingHom` as a morphism in `FieldCat`. -/ +-- def ofHom {R S : Type u} [Field R] [Field S] (f : R →+* S) : of R ⟶ of S := +-- f + +-- instance : Inhabited FieldCat := +-- ⟨of ℚ⟩ + +-- instance (R : FieldCat) : Field R := +-- R.str + +-- @[simp] +-- theorem coe_of (R : Type u) [Field R] : (FieldCat.of R : Type u) = R := +-- rfl + +-- -- Coercing the identity morphism, as a Field homomorphism, gives the identity function. +-- @[simp] theorem coe_FieldHom_id {X : FieldCat} : +-- @DFunLike.coe (X →+* X) X (fun _ ↦ X) _ (𝟙 X) = id := +-- rfl + +-- -- Coercing `𝟙 (of X)` to a function should be expressed as the coercion of `RingHom.id X`. +-- @[simp] theorem coe_id_of {X : Type u} [Field X] : +-- @DFunLike.coe no_index (FieldCat.of X ⟶ FieldCat.of X) X +-- (fun _ ↦ X) _ +-- (𝟙 (of X)) = +-- @DFunLike.coe (X →+* X) X (fun _ ↦ X) _ (RingHom.id X) := +-- rfl + +-- -- Coercing `f ≫ g`, where `f : of X ⟶ of Y` and `g : of Y ⟶ of Z`, to a function should be +-- -- expressed in terms of the coercion of `g.comp f`. +-- @[simp] theorem coe_comp_of {X Y Z : Type u} [Field X] [Field Y] [Field Z] +-- (f : X →+* Y) (g : Y →+* Z) : +-- @DFunLike.coe no_index (FieldCat.of X ⟶ FieldCat.of Z) X +-- (fun _ ↦ Z) _ +-- (CategoryStruct.comp (X := FieldCat.of X) (Y := FieldCat.of Y) (Z := FieldCat.of Z) +-- f g) = +-- @DFunLike.coe (X →+* Z) X (fun _ ↦ Z) _ (RingHom.comp g f) := +-- rfl + +-- -- Sometimes neither the `ext` lemma for `FieldCat` nor for `RingHom` is applicable, +-- -- because of incomplete unfolding of `FieldCat.of X ⟶ FieldCat.of Y := X →+* Y`, +-- -- but this one will fire. +-- @[ext] theorem ext_of {X Y : Type u} [Field X] [Field Y] (f g : X →+* Y) +-- (h : ∀ x, f x = g x) : +-- @Eq (FieldCat.of X ⟶ FieldCat.of Y) f g := +-- RingHom.ext h + +-- @[simp] +-- lemma FieldEquiv_coe_eq {X Y : Type _} [Field X] [Field Y] (e : X ≃+* Y) : +-- (@DFunLike.coe (FieldCat.of X ⟶ FieldCat.of Y) _ (fun _ => (forget FieldCat).obj _) +-- ConcreteCategory.instFunLike (e : X →+* Y) : X → Y) = ↑e := +-- rfl + +-- instance hasForgetToCommFieldCat : HasForget₂ FieldCat CommFieldCat := +-- BundledHom.forget₂ _ _ + +-- -- instance hasForgetToFieldCat : HasForget₂ FieldCat FieldCat := +-- -- BundledHom.forget₂ _ Field.toCommRing |>.tran _ + +-- instance hasForgetToAddCommGrp : HasForget₂ FieldCat AddCommGrp where +-- -- can't use BundledHom.mkHasForget₂, since AddCommGroup is an induced category +-- forget₂ := +-- { obj R := AddCommGrp.of R +-- -- Porting note: use `(_ := _)` similar to above. +-- map := fun {R₁ R₂} f => RingHom.toAddMonoidHom (α := R₁) (β := R₂) f } + +-- end FieldCat + +-- namespace FieldEquiv + +-- variable {X Y : Type u} + +-- /-- Build an isomorphism in the category `FieldCat` from a `FieldEquiv` between `FieldCat`s. -/ +-- @[simps] +-- def toFieldCatIso [Field X] [Field Y] (e : X ≃+* Y) : FieldCat.of X ≅ FieldCat.of Y where +-- hom := e.toRingHom +-- inv := e.symm.toRingHom + +-- end FieldEquiv + +-- namespace CategoryTheory.Iso + +-- /-- Build a `FieldEquiv` from an isomorphism in the category `FieldCat`. -/ +-- def FieldCatIsoToRingEquiv {X Y : FieldCat} (i : X ≅ Y) : X ≃+* Y := +-- RingEquiv.ofHomInv i.hom i.inv i.hom_inv_id i.inv_hom_id + +-- end CategoryTheory.Iso + +-- /-- Field equivalences between `FieldCat`s are the same as (isomorphic to) isomorphisms in +-- `FieldCat`. -/ +-- def fieldEquivIsoRingIso {X Y : Type u} [Field X] [Field Y] : +-- X ≃+* Y ≅ FieldCat.of X ≅ FieldCat.of Y where +-- hom e := FieldEquiv.toFieldCatIso e +-- inv i := i.FieldCatIsoToRingEquiv + +-- instance FieldCat.forget_reflects_isos : (forget FieldCat.{u}).ReflectsIsomorphisms where +-- reflects {X Y} f _ := by +-- let i := asIso ((forget FieldCat).map f) +-- let ff : X →+* Y := f +-- let e : X ≃+* Y := { ff, i.toEquiv with } +-- exact (FieldEquiv.toFieldCatIso e).isIso_hom + +-- -- It would be nice if we could have the following, +-- -- but it requires making `reflectsIsomorphisms_forget₂` an instance, +-- -- which can cause typeclass loops: +-- -- Porting note: This was the case in mathlib3, perhaps it is different now? +-- attribute [local instance] reflectsIsomorphisms_forget₂ + +-- example : (forget₂ FieldCat AddCommGrp).ReflectsIsomorphisms := by infer_instance + +end FieldCat diff --git a/LeanPool/BrauerGroupNew/LemmasAboutSimpleRing.lean b/LeanPool/BrauerGroupNew/LemmasAboutSimpleRing.lean new file mode 100644 index 0000000000..34c3cfac25 --- /dev/null +++ b/LeanPool/BrauerGroupNew/LemmasAboutSimpleRing.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ +import LeanPool.BrauerGroupNew.CentralSimple +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Operations +import Mathlib.RingTheory.Flat.FaithfullyFlat.Basic +universe u +variable (K : Type u) [Field K] +open TensorProduct in +lemma IsSimpleRing.left_of_tensor (B C : Type u) + [Ring B] [Ring C] [Algebra K C] [Algebra K B] + [hbc : IsSimpleRing (B ⊗[K] C)] : + IsSimpleRing B := by + have hB : Subsingleton B ∨ Nontrivial B := subsingleton_or_nontrivial B + have hC : Subsingleton C ∨ Nontrivial C := subsingleton_or_nontrivial C + rcases hB with hB|hB + · have : Subsingleton (B ⊗[K] C) := by + rw [← subsingleton_iff_zero_eq_one, show (0 : B ⊗[K] C) = 0 ⊗ₜ 0 by simp, + show (1 : B ⊗[K] C) = 1 ⊗ₜ 1 by rfl, show (1 : B) = 0 from Subsingleton.elim _ _] + simp only [tmul_zero, zero_tmul] + have : Subsingleton (TwoSidedIdeal (B ⊗[K] C)) := by + constructor + intro I J + refine SetLike.ext fun x ↦ ?_ + rw [show x = 0 from Subsingleton.elim _ _] + refine ⟨fun _ => TwoSidedIdeal.zero_mem _, fun _ ↦ TwoSidedIdeal.zero_mem _⟩ + have H := hbc.1.1 + rw [← not_subsingleton_iff_nontrivial] at H + contradiction + rcases hC with hC|hC + · have : Subsingleton (B ⊗[K] C) := by + rw [← subsingleton_iff_zero_eq_one, show (0 : B ⊗[K] C) = 0 ⊗ₜ 0 by simp, + show (1 : B ⊗[K] C) = 1 ⊗ₜ 1 by rfl, show (1 : C) = 0 from Subsingleton.elim _ _] + simp only [tmul_zero] + have : Subsingleton (TwoSidedIdeal (B ⊗[K] C)) := by + constructor + intro I J + refine SetLike.ext fun x ↦ ?_ + rw [show x = 0 from Subsingleton.elim _ _] + refine ⟨fun _ => TwoSidedIdeal.zero_mem _, fun _ ↦ TwoSidedIdeal.zero_mem _⟩ + have H := hbc.1.1 + rw [← not_subsingleton_iff_nontrivial] at H + contradiction + by_contra h + rw [IsSimpleRing.iff_eq_zero_or_injective' (k := K) (A := B)] at h + push Not at h + obtain ⟨B', _, _, f, h1, h2⟩ := h + have : Nontrivial B' := by + contrapose! h1 + refine SetLike.ext ?_ + intro b + simp only [TwoSidedIdeal.mem_ker] + refine ⟨fun _ => trivial, fun _ ↦ Subsingleton.elim _ _⟩ + let F : B ⊗[K] C →ₐ[K] (B' ⊗[K] C) := Algebra.TensorProduct.map f (AlgHom.id _ _) + have hF := IsSimpleRing.iff_eq_zero_or_injective' (B ⊗[K] C) K |>.1 inferInstance F + rcases hF with hF|hF + · have : Nontrivial (B' ⊗[K] C) := by + rw [← rank_pos_iff_nontrivial (R := K), rank_tensorProduct] + simp only [CanonicallyOrderedAdd.mul_pos, Cardinal.zero_lt_lift_iff] + rw [rank_pos_iff_nontrivial, rank_pos_iff_nontrivial] + aesop + have : 1 ∈ TwoSidedIdeal.ker F := by rw [hF]; trivial + simp only [TwoSidedIdeal.mem_ker, _root_.map_one, one_ne_zero] at this + · have h : Module.FaithfullyFlat K C := inferInstance + have : Function.Exact (0 : PUnit.{u + 1} →ₗ[K] _) F := by + intro x + simp only [Set.mem_range, LinearMap.zero_apply, exists_const] + rw [← show F 0 = 0 by simp, @Eq.comm _ 0 x] + constructor + · apply hF + · rintro rfl; simp + have : Function.Exact (0 : PUnit.{u + 1} →ₗ[K] _) f := + Module.FaithfullyFlat.iff_exact_iff_rTensor_exact K C|>.1 inferInstance + (l12 := (0 : PUnit →ₗ[K] _) ) (l23 := f.toLinearMap) |>.2 + fun x ↦ show F x = 0 ↔ _ by aesop + refine h2 fun x y hxy => ?_ + specialize this (x - y) + simp only [map_sub, sub_eq_zero, Set.mem_range, LinearMap.zero_apply, exists_const] at this + simpa [Eq.comm, sub_eq_zero] using this.1 hxy +open TensorProduct in +lemma IsSimpleRing.right_of_tensor (B C : Type u) + [Ring B] [Ring C] [Algebra K C] [Algebra K B] + [hbc : IsSimpleRing (B ⊗[K] C)] : + IsSimpleRing C := by + haveI : IsSimpleRing (C ⊗[K] B) := by + let e : C ⊗[K] B ≃ₐ[K] (B ⊗[K] C) := Algebra.TensorProduct.comm _ _ _ + have := TwoSidedIdeal.orderIsoOfRingEquiv e.toRingEquiv + exact ⟨(OrderIso.isSimpleOrder_iff this).mpr hbc.1⟩ + apply IsSimpleRing.left_of_tensor (K := K) (B := C) (C := B) diff --git a/LeanPool/BrauerGroupNew/Mathlib.lean b/LeanPool/BrauerGroupNew/Mathlib.lean new file mode 100644 index 0000000000..3021f0f57a --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib.lean @@ -0,0 +1,14 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.Algebra +import LeanPool.BrauerGroupNew.Mathlib.RingTheory + +/-! +# Brauer Group New Mathlib + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/Algebra.lean b/LeanPool/BrauerGroupNew/Mathlib/Algebra.lean new file mode 100644 index 0000000000..8c7f718080 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/Algebra.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra + +/-! +# Brauer Group New Mathlib Algebra + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra.lean b/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra.lean new file mode 100644 index 0000000000..83c7190d2c --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Subalgebra + +/-! +# Brauer Group New Mathlib Algebra Algebra + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Subalgebra.lean b/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Subalgebra.lean new file mode 100644 index 0000000000..c31c55f5da --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Subalgebra.lean @@ -0,0 +1,15 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Subalgebra.Basic +import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Subalgebra.Directed +import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Subalgebra.Lattice + +/-! +# Brauer Group New Mathlib Algebra Algebra Subalgebra + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Subalgebra/Basic.lean b/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Subalgebra/Basic.lean new file mode 100644 index 0000000000..2599c7ef26 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Subalgebra/Basic.lean @@ -0,0 +1,18 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.Algebra.Algebra.Subalgebra.Basic + +namespace Subalgebra +variable {R A : Type*} [CommSemiring R] [Semiring A] [Algebra R A] {L S T U : Subalgebra R A} + +lemma le_centralizer_self : L ≤ centralizer R L ↔ ∀ x ∈ L, ∀ y ∈ L, x * y = y * x := forall₂_comm +variable {R A : Type*} [CommSemiring R] [Semiring A] [Algebra R A] {S T U : Subalgebra R A} + +@[simp] lemma inclusion_comp_inclusion (hST : S ≤ T) (hTU : T ≤ U) : + (inclusion hTU).comp (inclusion hST) = inclusion (hST.trans hTU) := rfl + +end Subalgebra diff --git a/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Subalgebra/Directed.lean b/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Subalgebra/Directed.lean new file mode 100644 index 0000000000..db7967f638 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Subalgebra/Directed.lean @@ -0,0 +1,19 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.Algebra.Algebra.Subalgebra.Directed + +namespace Subalgebra +variable {R A ι : Type*} [CommSemiring R] [Semiring A] [Algebra R A] {K : ι → Subalgebra R A} + {s : Set ι} + +lemma coe_biSup_of_directedOn (hs : s.Nonempty) (dir : DirectedOn (K · ≤ K ·) s) : + ↑(⨆ i ∈ s, K i) = ⨆ i ∈ s, (K i : Set A) := by + have := hs.to_subtype + rw [← iSup_subtype'', ← iSup_subtype'', coe_iSup_of_directed, Set.iSup_eq_iUnion] + rwa [← Function.comp_def, directed_comp, ← directedOn_iff_directed] + +end Subalgebra diff --git a/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Subalgebra/Lattice.lean b/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Subalgebra/Lattice.lean new file mode 100644 index 0000000000..97b303cf7b --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Subalgebra/Lattice.lean @@ -0,0 +1,15 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.Algebra.Algebra.Subalgebra.Lattice + +variable {R A B : Type*} [CommSemiring R] [Semiring A] [Semiring B] [Algebra R A] [Algebra R B] + +lemma Subalgebra.map_centralizer_le_centralizer_image (s : Set A) (f : A →ₐ[R] B) : + (centralizer _ s).map f ≤ centralizer _ (f '' s) := by + rintro - ⟨g, hg, rfl⟩ - ⟨h, hh, rfl⟩ + dsimp only [RingHom.coe_coe] + rw [← map_mul, ← map_mul, hg h hh] diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory.lean new file mode 100644 index 0000000000..71aa77513b --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal + +/-! +# Brauer Group New Mathlib RingTheory + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal.lean new file mode 100644 index 0000000000..69664bfd3a --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal.lean @@ -0,0 +1,14 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Kernel +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Operations + +/-! +# Brauer Group New Mathlib RingTheory TwoSidedIdeal + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal/Kernel.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal/Kernel.lean new file mode 100644 index 0000000000..cae4697774 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal/Kernel.lean @@ -0,0 +1,27 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.RingTheory.TwoSidedIdeal.Kernel + +variable {R S : Type*} [Ring R] [Ring S] + +namespace TwoSidedIdeal + +lemma injective_iff_ker_eq_bot {F : Type*} [FunLike F R S] [RingHomClass F R S] (f : F) : + Function.Injective f ↔ TwoSidedIdeal.ker f = ⊥ := by + rw [Function.Injective, eq_bot_iff, le_iff] + change _ ↔ ∀ _, _ + simp only [SetLike.mem_coe, mem_ker] + constructor + · intro h x hx + specialize @h x 0 (by simpa using hx) + rw [h]; rfl + · intro h a b hab + specialize h (a - b) (by rwa [map_sub, sub_eq_zero]) + rw [← sub_eq_zero] + exact h + +end TwoSidedIdeal diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal/Operations.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal/Operations.lean new file mode 100644 index 0000000000..0f80d77f84 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal/Operations.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.RingTheory.TwoSidedIdeal.Operations + +open Function + +namespace TwoSidedIdeal +variable {F R S : Type*} [Ring R] [Ring S] [FunLike F R S] [RingHomClass F R S] + +attribute [simp] mem_comap + +lemma comap_injective (f : F) (hf : Surjective f) : Injective (comap f) := by + simp [Function.Injective, SetLike.ext_iff, hf.forall] + +/-- The order isomorphism on two-sided ideals induced by a ring equivalence. -/ +@[simp] +def orderIsoOfRingEquiv {F : Type*} [EquivLike F R S] [RingEquivClass F R S] (f : F) : + TwoSidedIdeal R ≃o TwoSidedIdeal S where + toFun := comap (RingEquivClass.toRingEquiv f).symm + invFun := comap (RingEquivClass.toRingEquiv f) + left_inv I := by + have := TwoSidedIdeal.comap_comap (R := R) (S := S) I + (RingEquivClass.toRingEquiv f) (RingEquivClass.toRingEquiv f).symm + simp at this + erw [TwoSidedIdeal.comap_comap _ (RingEquivClass.toRingEquiv f).toRingHom + (RingEquivClass.toRingEquiv f).symm.toRingHom] + simp only [RingEquiv.toRingHom_eq_coe, RingEquiv.symm_comp] + rfl + right_inv I := SetLike.ext fun x ↦ by simp only [mem_comap, RingEquiv.apply_symm_apply] + map_rel_iff' := by + intro I J + rw [le_iff, le_iff] + constructor + · rintro h x hx + specialize @h (RingEquivClass.toRingEquiv f x) (by simpa [TwoSidedIdeal.mem_comap]) + simpa [TwoSidedIdeal.mem_comap] using h + · intro h x hx + simp only [Equiv.coe_fn_mk, SetLike.mem_coe, mem_comap] at hx ⊢ + exact h hx +end TwoSidedIdeal diff --git a/LeanPool/BrauerGroupNew/MatrixCenterEquiv.lean b/LeanPool/BrauerGroupNew/MatrixCenterEquiv.lean new file mode 100644 index 0000000000..785cc0247a --- /dev/null +++ b/LeanPool/BrauerGroupNew/MatrixCenterEquiv.lean @@ -0,0 +1,126 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.Algebra.Algebra.Subalgebra.Basic +import Mathlib.LinearAlgebra.Matrix.IsDiag + +local notation "M[" ι "," R "]" => Matrix ι ι R + +universe u v w + +section RingEquiv + +lemma Matrix.mem_center_iff (R : Type*) [Ring R] (n : ℕ) (M) : + M ∈ Subring.center M[Fin n, R] ↔ ∃ α : (Subring.center R), M = α • 1 := by + constructor + · if h : n = 0 then subst h; exact fun _ ↦ ⟨0, Subsingleton.elim _ _⟩ + else + intro h + rw [Subring.mem_center_iff] at h + have diag : Matrix.IsDiag M := fun i j hij => by + simpa only [single_mul_apply_same, one_mul, + mul_single_apply_of_ne (hbj := hij.symm)] using + Matrix.ext_iff.2 (h (single i i 1)) i j + have (i j : Fin n) : M i i = M j j := by + simpa [Eq.comm] using Matrix.ext_iff.2 (h (single i j 1)) i j + obtain ⟨b, hb⟩ : ∃ (b : R), M = b • 1 := by + refine ⟨M ⟨0, by omega⟩ ⟨0, by omega⟩, Matrix.ext fun i j => ?_⟩ + if heq : i = j then subst heq; rw [this i ⟨0, by omega⟩]; simp + else simp [diag heq, Matrix.one_apply_ne heq] + suffices b ∈ Subring.center R by aesop + refine Subring.mem_center_iff.mpr fun g ↦ ?_ + simpa [hb] using Matrix.ext_iff.2 (h (Matrix.diagonal fun _ ↦ g)) ⟨0, by omega⟩ ⟨0, by omega⟩ + · rintro ⟨α, ha⟩; rw [Subring.mem_center_iff]; aesop + +/-- The center of a nonempty square matrix ring is ring-equivalent to the center of the +base ring. -/ +def Matrix.centerEquivBase (n : ℕ) (hn : 0 < n) (R : Type*) [Ring R] : + Subring.center (M[Fin n, R]) ≃+* (Subring.center R) where + toFun A := ⟨(A.1 ⟨0, by omega⟩ ⟨0, by omega⟩), by + obtain ⟨a, ha⟩ := (Matrix.mem_center_iff R n A.1).1 A.2 + simpa only [ha, smul_apply, one_apply_eq] using Subring.mul_mem _ a.2 <| Subring.one_mem _⟩ + invFun a := ⟨a • 1, Subring.mem_center_iff.2 fun A ↦ Matrix.ext <| by simp⟩ + left_inv := by + if hn : n = 0 + then subst hn; exact fun _ ↦ Subsingleton.elim _ _ + else + rintro ⟨A, hA⟩; obtain ⟨⟨α, hα⟩, rfl⟩ := Matrix.mem_center_iff _ _ _ |>.1 hA + simp only [smul_apply, one_apply_eq, Subtype.mk.injEq] + change (α • (1 : R)) • (1 : Matrix (Fin n) (Fin n) R) = α • (1 : _) + simp only [smul_eq_mul, mul_one] + right_inv := by + intro ⟨r, hr⟩; simp only [smul_apply, one_apply_eq, Subtype.mk.injEq] + change r • (1 : R) = _ + simp only [smul_eq_mul, mul_one] + map_mul' := by + rintro ⟨A, hA⟩ ⟨B, hB⟩ + rw [Matrix.mem_center_iff] at hA hB + obtain ⟨a, rfl⟩ := hA + obtain ⟨b, rfl⟩ := hB + apply Subtype.ext + simp only [smul_apply, one_apply_eq] + have ha_center : a • (1 : R) ∈ Subring.center R := by + change (a : R) * 1 ∈ Subring.center R + rw [mul_one] + exact a.2 + have hb_center : b • (1 : R) ∈ Subring.center R := by + change (b : R) * 1 ∈ Subring.center R + rw [mul_one] + exact b.2 + rw [show ((⟨a • 1, hA⟩ * ⟨b • 1, hB⟩ : + Subring.center (Matrix (Fin n) (Fin n) R)) : Matrix (Fin n) (Fin n) R) = + (a • 1 : Matrix (Fin n) (Fin n) R) * + (b • 1 : Matrix (Fin n) (Fin n) R) from rfl] + rw [show ((⟨a • (1 : R), ha_center⟩ * ⟨b • (1 : R), hb_center⟩ : + Subring.center R) : R) = (a • (1 : R)) * (b • (1 : R)) from rfl] + change (((a : R) • (1 : Matrix (Fin n) (Fin n) R)) * + ((b : R) • (1 : Matrix (Fin n) (Fin n) R))) ⟨0, hn⟩ ⟨0, hn⟩ = + (a • (1 : R)) * (b • (1 : R)) + rw [Matrix.mul_apply] + rw [Fintype.sum_eq_single ⟨0, hn⟩] + · rfl + · intro x hx + simp [show (⟨0, hn⟩ : Fin n) ≠ x from fun h => hx h.symm] + map_add' := by + rintro ⟨A, hA⟩ ⟨B, hB⟩ + rw [Matrix.mem_center_iff] at hA hB + obtain ⟨a, rfl⟩ := hA + obtain ⟨b, rfl⟩ := hB + apply Subtype.ext + simp only [smul_apply, one_apply_eq] + have ha_center : a • (1 : R) ∈ Subring.center R := by + change (a : R) * 1 ∈ Subring.center R + rw [mul_one] + exact a.2 + have hb_center : b • (1 : R) ∈ Subring.center R := by + change (b : R) * 1 ∈ Subring.center R + rw [mul_one] + exact b.2 + rw [show ((⟨a • 1, hA⟩ + ⟨b • 1, hB⟩ : + Subring.center (Matrix (Fin n) (Fin n) R)) : Matrix (Fin n) (Fin n) R) = + (a • 1 : Matrix (Fin n) (Fin n) R) + + (b • 1 : Matrix (Fin n) (Fin n) R) from rfl] + rw [show ((⟨a • (1 : R), ha_center⟩ + ⟨b • (1 : R), hb_center⟩ : + Subring.center R) : R) = (a • (1 : R)) + (b • (1 : R)) from rfl] + change (((a : R) • (1 : Matrix (Fin n) (Fin n) R)) + + ((b : R) • (1 : Matrix (Fin n) (Fin n) R))) ⟨0, hn⟩ ⟨0, hn⟩ = + (a • (1 : R)) + (b • (1 : R)) + change ((a : R) * 1) + ((b : R) * 1) = (a • (1 : R)) + (b • (1 : R)) + rfl + +end RingEquiv + +section AlgEquiv + +variable (R A : Type u) [CommSemiring R] [Ring A] [Algebra R A] + +/-- The center of a nonempty matrix algebra is algebra-equivalent to the center of the algebra. -/ +def Matrix.centerAlgEquiv (n : ℕ) (hn : 0 < n) : + Subalgebra.center R M[Fin n, A] ≃ₐ[R] Subalgebra.center R A := { + __ := Matrix.centerEquivBase n hn A + commutes' := fun _ ↦ rfl } + +end AlgEquiv diff --git a/LeanPool/BrauerGroupNew/MatrixEquivTensor.lean b/LeanPool/BrauerGroupNew/MatrixEquivTensor.lean new file mode 100644 index 0000000000..6af4321de1 --- /dev/null +++ b/LeanPool/BrauerGroupNew/MatrixEquivTensor.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.Data.Matrix.Basis +import Mathlib.RingTheory.TensorProduct.Basic + +open scoped TensorProduct + +variable (K F : Type*) [CommSemiring K] [CommSemiring F] [Algebra F K] + (A : Type*) (n : Type*) [Ring A] [Algebra F A] [DecidableEq n] [Fintype n] + +open Matrix + +/-- Bilinear map sending a scalar and a matrix to the matrix obtained by tensoring entries. -/ +def toTensorMartrix_toFun_bilinear : K →ₗ[F] Matrix n n A →ₗ[F] Matrix n n (K ⊗[F] A) where + toFun k := { + toFun M := k • Algebra.TensorProduct.includeRight.mapMatrix M + map_add' _ _ := by simp [← smul_add, map_add] + map_smul' r M := by simpa using smul_comm _ _ _ + } + map_add' k1 k2 := by ext; simp [add_smul] + map_smul' r k := by ext; simp + +@[simp] +lemma toTensorMartrix_toFun_bilinear_apply (k : K) (M : Matrix n n A) : + toTensorMartrix_toFun_bilinear K F A n k M = + k • Algebra.TensorProduct.includeRight.mapMatrix M := rfl + +/-- The `F`-linear map induced from `toTensorMartrix_toFun_bilinear`. -/ +abbrev toTensorMatrix_toFun_Flinear : K ⊗[F] Matrix n n A →ₗ[F] Matrix n n (K ⊗[F] A) := + TensorProduct.lift <| toTensorMartrix_toFun_bilinear K F A n + +/-- The `K`-linear map from a tensor of matrices to matrices over a tensor product. -/ +abbrev toTensorMatrix_toFun_Klinear : K ⊗[F] Matrix n n A →ₗ[K] Matrix n n (K ⊗[F] A) := + {__ := toTensorMatrix_toFun_Flinear K F A n, + map_smul' k tensor := by + induction tensor with + | zero => simp + | tmul k0 M => simp [TensorProduct.smul_tmul', SemigroupAction.mul_smul] + | add _ _ h1 h2 => simp_all} + +/-- Algebra homomorphism from a tensor of matrices to matrices over the tensor product. -/ +abbrev toTensorMatrix : K ⊗[F] Matrix n n A →ₐ[K] Matrix n n (K ⊗[F] A) := + .ofLinearMap (toTensorMatrix_toFun_Klinear K F A n) (by simp [Algebra.TensorProduct.one_def]) + fun t1 t2 ↦ by + induction t1 with + | zero => simp + | tmul x y => + induction t2 with + | zero => simp + | tmul x0 y0 => + simp [mul_comm x x0, SemigroupAction.mul_smul, Matrix.map_mul] + | add _ _ h1 h2 => simp_all [mul_add] + | add _ _ h1 h2 => simp_all [add_mul] + +open TensorProduct + +/-- Bilinear map placing a tensor entry into the `(i,j)` matrix coefficient. -/ +def invFun_toFun_bilinear (i j : n) : K →ₗ[F] A →ₗ[F] K ⊗[F] Matrix n n A where + toFun k := { + toFun a := k ⊗ₜ single i j a + map_add' _ _ := by simp [single_add, tmul_add] + map_smul' _ _ := by simp [← smul_single] + } + map_add' _ _ := by ext; simp [add_tmul] + map_smul' _ _ := by ext; simp [smul_tmul'] + +omit [Fintype n] in +@[simp] +lemma invFun_toFun_bilinear_apply (i j : n) (k : K) (a : A) : + invFun_toFun_bilinear K F A n i j k a = k ⊗ₜ single i j a := rfl + +/-- The `F`-linear map induced by `invFun_toFun_bilinear`. -/ +abbrev invFun_toFun (i j : n) : K ⊗[F] A →ₗ[F] K ⊗[F] Matrix n n A := + TensorProduct.lift <| invFun_toFun_bilinear K F A n i j + +/-- The `K`-linear map placing a tensor entry into the `(i,j)` matrix coefficient. -/ +abbrev invFun_Klinear (i j : n) : K ⊗[F] A →ₗ[K] K ⊗[F] Matrix n n A := + {__ := invFun_toFun K F A n i j, + map_smul' k tensor := by + induction tensor with + | zero => simp + | tmul k0 a => simp [smul_tmul'] + | add _ _ h1 h2 => simp_all} + +/-- Linear inverse map from matrices over the tensor product to a tensor of matrices. -/ +abbrev invFun_linearMap : Matrix n n (K ⊗[F] A) →ₗ[K] K ⊗[F] Matrix n n A where + toFun M := ∑ p : n × n, invFun_Klinear K F A n p.1 p.2 (M p.1 p.2) + map_add' _ _ := by simp [Finset.sum_add_distrib] + map_smul' _ _ := by simp [Finset.smul_sum] + +lemma matrixTensor_left_inv (M : K ⊗[F] Matrix n n A) : + invFun_linearMap K F A n (toTensorMatrix K F A n M) = M := by + induction M with + | zero => simp + | tmul k M => + simp [← tmul_sum, smul_tmul', Fintype.sum_prod_type, ← matrix_eq_sum_single] + | add koxa1 koxa2 h1 h2 => rw [map_add, map_add, h1, h2] + +lemma matrixTensor_right_inv (M : Matrix n n (K ⊗[F] A)) : + toTensorMatrix K F A n (invFun_linearMap K F A n M) = M := by + simp only [LinearMap.coe_mk, LinearMap.coe_toAddHom, AddHom.coe_mk, map_sum, + AlgHom.ofLinearMap_apply, Fintype.sum_prod_type] + conv_rhs => rw [matrix_eq_sum_single M] + refine Finset.sum_congr rfl fun p _ => Finset.sum_congr rfl fun q _ => ?_ + induction M p q with + | zero => simp + | tmul x y => simp [smul_tmul'] + | add _ _ h1 h2 => simp [single_add, h1, h2] + +/-- Equivalence underlying the tensor-matrix algebra equivalence. -/ +def equivTensor' : K ⊗[F] Matrix n n A ≃ Matrix n n (K ⊗[F] A) where + toFun := toTensorMatrix K F A n + invFun := invFun_linearMap K F A n + left_inv := matrixTensor_left_inv K F A n + right_inv := matrixTensor_right_inv K F A n + +/-- Algebra equivalence between tensoring a matrix algebra and matrices over a tensor product. -/ +def matrixTensorEquivTensor : K ⊗[F] Matrix n n A ≃ₐ[K] Matrix n n (K ⊗[F] A) := + {toTensorMatrix K F A n, equivTensor' K F A n with} + +@[simp] +lemma matrixTensorEquivTensor_apply (M : K ⊗[F] Matrix n n A) : + matrixTensorEquivTensor K F A n M = toTensorMatrix K F A n M := rfl + +@[simp] +lemma matrixTensorEquivTensor_symm_apply (M : Matrix n n (K ⊗[F] A)) : + (matrixTensorEquivTensor K F A n).symm M = invFun_linearMap K F A n M := rfl diff --git a/LeanPool/BrauerGroupNew/Subfield.lean b/LeanPool/BrauerGroupNew/Subfield.lean new file mode 100644 index 0000000000..60d5bcd57f --- /dev/null +++ b/LeanPool/BrauerGroupNew/Subfield.lean @@ -0,0 +1,14 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Subfield.Defs +import LeanPool.BrauerGroupNew.Subfield.FiniteDimensional + +/-! +# Brauer Group New Subfield + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Subfield/Defs.lean b/LeanPool/BrauerGroupNew/Subfield/Defs.lean new file mode 100644 index 0000000000..19e492a1de --- /dev/null +++ b/LeanPool/BrauerGroupNew/Subfield/Defs.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Subalgebra.Directed + +open Function TensorProduct MulOpposite + +/-- A subalgebra whose carrier is commutative and contains inverses of all nonzero elements. -/ +structure SubField (K A : Type*) [CommSemiring K] [Semiring A] [Algebra K A] + extends Subalgebra K A where + protected mul_comm ⦃x : A⦄ (hx : x ∈ carrier) ⦃y : A⦄ (hy : y ∈ carrier) : x * y = y * x + exists_inverse ⦃x : A⦄ : x ∈ carrier → x ≠ 0 → ∃ y ∈ carrier, x * y = 1 + +/-- Reinterpret SubFields as `Subalgebras` -/ +add_decl_doc SubField.toSubalgebra + +namespace SubField +variable {R K A : Type*} + +section CommSemiring +variable [CommSemiring R] [Semiring A] [Algebra R A] {L L₁ L₂ : SubField R A} {a : A} + +lemma toSubalgebra_injective : Injective (toSubalgebra : SubField R A → Subalgebra R A) := by + rintro ⟨L⟩; congr! + +@[simp] lemma toSubalgebra_inj : L₁.toSubalgebra = L₂.toSubalgebra ↔ L₁ = L₂ := + toSubalgebra_injective.eq_iff + +instance : SetLike (SubField R A) A where + coe L := L.1 + coe_injective' := SetLike.coe_injective.comp toSubalgebra_injective + +instance : PartialOrder (SubField R A) := .ofSetLike (SubField R A) A + +lemma mem_carrier : a ∈ L.carrier ↔ a ∈ L := .rfl +@[simp] lemma mem_toSubalgebra : a ∈ L.toSubalgebra ↔ a ∈ L := .rfl + +@[simp] lemma coe_toSubalgebra (L : SubField R A) : (L.toSubalgebra : Set A) = L := rfl + +@[ext] lemma ext (h : ∀ x, x ∈ L₁ ↔ x ∈ L₂) : L₁ = L₂ := SetLike.ext h + +@[simp] lemma toSubalgebra_le_toSubalgebra : L₁.toSubalgebra ≤ L₂.toSubalgebra ↔ L₁ ≤ L₂ := .rfl +@[simp] lemma toSubalgebra_lt_toSubalgebra : L₁.toSubalgebra < L₂.toSubalgebra ↔ L₁ < L₂ := .rfl + +instance : SubsemiringClass (SubField R A) A where + mul_mem {s} := mul_mem (s := s.1) + one_mem {s} := one_mem (s := s.1) + add_mem {s} := add_mem (s := s.1) + zero_mem {s} := zero_mem (s := s.1) + +instance (priority := low) algebra' {K' : Type*} [CommSemiring K'] [SMul K' R] [Algebra K' A] + [IsScalarTower K' R A] (S : SubField R A) : Algebra K' S := S.toSubalgebra.algebra' + +open scoped Classical in +noncomputable instance _root_.SubField.carrier.instSemifield [Nontrivial A] : Semifield L.1 where + __ := L + mul_comm := fun ⟨a, ha⟩ ⟨b, hb⟩ ↦ Subtype.ext_iff.2 <| L.2 ha hb + inv := fun ⟨x, hx⟩ ↦ if h0 : x = 0 then 0 else ⟨L.3 hx h0|>.choose, + L.3 hx h0|>.choose_spec.1⟩ + exists_pair_ne := ⟨⟨0, Subalgebra.zero_mem L.1⟩, ⟨1, Subalgebra.one_mem L.1⟩, by simp⟩ + mul_inv_cancel a ha := by ext; simpa [ha] using (L.3 a.2 <| mod_cast ha).choose_spec.2 + inv_zero := by simp only [↓reduceDIte] + nnqsmul := _ + +/-- The directed supremum of a set of subfields. -/ +@[simps toSubalgebra] +def dSup (s : Set (SubField R A)) (hs : s.Nonempty) (hsdir : DirectedOn (· ≤ ·) s) : + SubField R A where + toSubalgebra := ⨆ L ∈ s, L.1 + mul_comm := by + simp only [Subsemiring.coe_carrier_toSubmonoid, Subalgebra.coe_toSubsemiring, + Subalgebra.coe_biSup_of_directedOn hs hsdir, coe_toSubalgebra, Set.iSup_eq_iUnion, + Set.mem_iUnion, SetLike.mem_coe, exists_prop, forall_exists_index, and_imp] + rintro x L₁ hL₁ hx y L₂ hL₂ hy + obtain ⟨L, hL, hLL₁, hLL₂⟩ := hsdir _ hL₁ _ hL₂ + exact L.mul_comm (hLL₁ hx) (hLL₂ hy) + exists_inverse := by + simp only [Subsemiring.coe_carrier_toSubmonoid, Subalgebra.coe_toSubsemiring, + Subalgebra.coe_biSup_of_directedOn hs hsdir, coe_toSubalgebra, Set.iSup_eq_iUnion, + Set.mem_iUnion, SetLike.mem_coe, exists_prop, ne_eq, forall_exists_index, and_imp] + rintro x L hL hx hx₀ + obtain ⟨y, hy, hxy⟩ := L.exists_inverse hx hx₀ + exact ⟨y, ⟨L, hL, hy⟩, hxy⟩ + +lemma isLUB_dSup (s : Set (SubField R A)) (hs hsdir) : IsLUB s (dSup s hs hsdir) := by + simpa [IsLUB, IsLeast, lowerBounds, upperBounds, ← toSubalgebra_le_toSubalgebra] + using isLUB_biSup (s := s) (f := toSubalgebra) + +end CommSemiring + +section CommRing +variable [CommRing R] [Ring A] [Algebra R A] {L : SubField R A} {a : A} + +instance : SubringClass (SubField R A) A where + mul_mem {s} := mul_mem (s := s.1) + one_mem {s} := one_mem (s := s.1) + add_mem {s} := add_mem (s := s.1) + zero_mem {s} := zero_mem (s := s.1) + neg_mem {s} := neg_mem (s := s.1) + +lemma _root_.SubField.mem_toSubring : a ∈ L.toSubring ↔ a ∈ L := .rfl +@[simp] lemma _root_.SubField.coe_toSubring (L : SubField R A) : + (L.toSubring : Set A) = L := rfl + +noncomputable instance _root_.SubField.carrier.instField [Nontrivial A] : Field L where + __ : Ring L := inferInstance + __ := carrier.instSemifield + qsmul := _ + +end CommRing + +section Semifield +variable [Semifield K] [Semiring A] [Algebra K A] + +instance : Bot (SubField K A) where + bot.toSubalgebra := ⊥ + bot.mul_comm := by simp [← map_mul, _root_.mul_comm] + bot.exists_inverse := by + simp only [Subsemiring.coe_carrier_toSubmonoid, Subalgebra.coe_toSubsemiring, Algebra.coe_bot, + Set.mem_range, ne_eq, exists_exists_eq_and, forall_exists_index, forall_apply_eq_imp_iff] + exact fun x hx ↦ ⟨x⁻¹, by rw [← map_mul, mul_inv_cancel₀ (by aesop), map_one]⟩ + +instance : Nonempty (SubField K A) := ⟨⊥⟩ + +variable (K A) in +lemma _root_.SubField.exists_isMax : ∃ L : SubField K A, IsMax L := + zorn_le_nonempty fun s hschain hs ↦ ⟨dSup s hs hschain.directedOn, (isLUB_dSup ..).1⟩ + +end Semifield +end SubField diff --git a/LeanPool/BrauerGroupNew/Subfield/FiniteDimensional.lean b/LeanPool/BrauerGroupNew/Subfield/FiniteDimensional.lean new file mode 100644 index 0000000000..63753e1027 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Subfield/FiniteDimensional.lean @@ -0,0 +1,15 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Subfield.Defs +import Mathlib.LinearAlgebra.FiniteDimensional.Basic + +namespace SubField +variable {K A : Type*} [Field K] [Ring A] [Algebra K A] {L : SubField K A} + +instance [FiniteDimensional K A] : FiniteDimensional K L := .finiteDimensional_subalgebra L.1 + +end SubField diff --git a/LeanPool/BrauerGroupNew/TwoSidedIdeal.lean b/LeanPool/BrauerGroupNew/TwoSidedIdeal.lean new file mode 100644 index 0000000000..0be3c29425 --- /dev/null +++ b/LeanPool/BrauerGroupNew/TwoSidedIdeal.lean @@ -0,0 +1,179 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Kernel +import Mathlib.Algebra.Algebra.Hom +import Mathlib.Algebra.BigOperators.Ring.Finset +import Mathlib.Data.Fintype.BigOperators +import Mathlib.RingTheory.SimpleRing.Defs +import Mathlib.RingTheory.TwoSidedIdeal.BigOperators +import Mathlib.RingTheory.TwoSidedIdeal.Operations + +variable {M : Type*} [AddCommMonoid M] (r : AddCon M) {ι : Type*} (s : Finset ι) +variable {R : Type*} [Ring R] (t : TwoSidedIdeal R) + +open MulOpposite + +namespace TwoSidedIdeal + +variable {s} + +variable (I : TwoSidedIdeal R) + +variable {R' : Type*} [Ring R'] + +-- def span (s : Set R) : TwoSidedIdeal R := +-- .mk <| ringConGen (fun a b ↦ a - b ∈ s) + + +/-- The two-sided ideal generated by finite sums `xL * y * xR` with `y ∈ s`. -/ +def span' (s : Set R) : TwoSidedIdeal R := .mk' + {x | ∃ (ι : Type) (fin : Fintype ι) (xL : ι → R) (xR : ι → R) (y : ι → s), + x = ∑ i : ι, xL i * y i * xR i} + ⟨Empty, Fintype.instEmpty, Empty.elim, Empty.elim, Empty.elim, by simp⟩ + (by + rintro _ _ ⟨na, fina, xLa, xRa, ya, rfl⟩ ⟨nb, finb, xLb, xRb, yb, rfl⟩ + refine ⟨na ⊕ nb, inferInstance, Sum.elim xLa xLb, Sum.elim xRa xRb, Sum.elim ya yb, by + simp⟩) + (by + rintro _ ⟨n, finn, xL, xR, y, rfl⟩ + exact ⟨n, finn, -xL, xR, y, by simp⟩) + (by + rintro a _ ⟨n, finn, xL, xR, y, rfl⟩ + exact ⟨n, finn, a • xL, xR, y, by + rw [Finset.mul_sum]; simp only [mul_assoc, Pi.smul_apply, smul_eq_mul]⟩) + (by + rintro _ b ⟨n, finn, xL, xR, y, rfl⟩ + exact ⟨n, finn, xL, fun x ↦ xR x * b, y, by simp [Finset.sum_mul, mul_assoc]⟩) + +lemma mem_span'_iff_exists_fin (s : Set R) (x : R) : + x ∈ span' s ↔ + ∃ (ι : Type) (_ : Fintype ι) (xL : ι → R) (xR : ι → R) (y : ι → s), + x = ∑ i : ι, xL i * (y i : R) * xR i := by + simp only [span', mem_mk', Set.mem_setOf_eq] + +lemma mem_span_iff_exists_fin (s : Set R) (x : R) : + x ∈ span s ↔ + ∃ (ι : Type) (_ : Fintype ι) (xL : ι → R) (xR : ι → R) (y : ι → s), + x = ∑ i : ι, xL i * (y i : R) * xR i := by + suffices eq1 : span s = span' s by + rw [eq1] + simp only [span'] + generalize_proofs h1 h2 h3 h4 h5 + simp_all only [mem_mk', Set.mem_setOf_eq] + rw [span, RingCon.ringConGen_eq] + apply ringCon_injective + refine sInf_eq_of_forall_ge_of_forall_gt_exists_lt ?_ ?_ + · rintro I (hI : ∀ a b, _ → _) + suffices span' s ≤ .mk I by + rw [ringCon_le_iff] at this + exact this + intro x h + rw [mem_span'_iff_exists_fin] at h + obtain ⟨n, finn, xL, xR, y, rfl⟩ := h + rw [mem_iff] + refine TwoSidedIdeal.finsetSum_mem _ _ _ fun i _ ↦ TwoSidedIdeal.mul_mem_right _ _ _ + (TwoSidedIdeal.mul_mem_left _ _ _ <| hI (y i) 0 (by simp)) + · rintro I hI + exact ⟨(span' s).ringCon, fun a b H ↦ ⟨PUnit, inferInstance, fun _ ↦ 1, fun _ ↦ 1, + fun _ ↦ ⟨a - b, by simp [H]⟩, by simp⟩, hI⟩ + +lemma mem_span_ideal_iff_exists_fin (s : Ideal R) (x : R) : + x ∈ span s ↔ + ∃ (ι : Type) (_ : Fintype ι) (xR : ι → R) (y : ι → s), + x = ∑ i : ι, (y i : R) * xR i := by + rw [mem_span_iff_exists_fin] + fconstructor + · rintro ⟨n, fin, xL, xR, y, rfl⟩ + exact ⟨n, fin, xR, fun i ↦ ⟨xL i * y i, s.mul_mem_left _ (y i).2⟩, by simp⟩ + · rintro ⟨n, fin, xR, y, rfl⟩ + exact ⟨n, fin, 1, xR, y, by simp⟩ + +lemma coe_bot_set : ((⊥ : TwoSidedIdeal R) : Set R) = {0} := by + ext x + simp only [SetLike.mem_coe, Set.mem_singleton_iff] + rfl + +lemma coe_top_set : ((⊤ : TwoSidedIdeal R) : Set R) = Set.univ := by + ext x + simp only [SetLike.mem_coe, Set.mem_univ] + rfl + +section IsSimpleOrder + +universe u + +variable (A : Type u) [Ring A] + +instance [Nontrivial A] : Nontrivial (TwoSidedIdeal A) := +⟨⊥, ⊤, by + apply_fun (fun I => I.ringCon 0 1) + convert false_ne_true + -- Change after https://github.com/leanprover-community/mathlib4/pull/12860 + simp only [iff_false] + exact zero_ne_one⟩ + +lemma _root_.IsSimpleRing.iff_eq_zero_or_injective' + (k : Type*) [CommRing k] [Algebra k A] [Nontrivial A] : + IsSimpleRing A ↔ + ∀ ⦃B : Type u⦄ [Ring B] [Algebra k B] (f : A →ₐ[k] B), + TwoSidedIdeal.ker f = ⊤ ∨ Function.Injective f := by + classical + constructor + · intro so B _ _ f + if hker : TwoSidedIdeal.ker f.toRingHom = ⊤ + then exact Or.inl hker + else + replace hker := so.1.2 (TwoSidedIdeal.ker f) |>.resolve_right hker + rw [injective_iff_ker_eq_bot] + exact Or.inr hker + · intro h + refine ⟨⟨fun I => ?_⟩⟩ + letI : Algebra k I.ringCon.Quotient := + { algebraMap := I.ringCon.mk'.comp (algebraMap k A) + smul a := Quotient.map' (fun b => a • b) fun x y (h : I.ringCon x y) => + show I.ringCon _ _ by + simp only + rw [Algebra.smul_def, Algebra.smul_def] + exact I.ringCon.mul (I.ringCon.refl (algebraMap k A a)) h + commutes' := by + simp only [RingHom.coe_comp, Function.comp_apply] + intro a b + induction b using Quotient.inductionOn' with + | h b => + change _ * I.ringCon.mk' b = I.ringCon.mk' b * _ + simp only [← map_mul, Algebra.commutes a b] + + smul_def' := fun a b => by + simp only [RingHom.coe_comp, Function.comp_apply] + change Quotient.map' _ _ _ = _ + induction b using Quotient.inductionOn' with + | h b => + change _ = _ * I.ringCon.mk' _ + simp only [Quotient.map'_mk'', ← map_mul, Algebra.smul_def] + rfl } + rcases @h I.ringCon.Quotient _ _ {I.ringCon.mk' with commutes' a := rfl } with h|h + · right + rw [eq_top_iff, le_iff] + rintro x - + simp only at h + have mem : x ∈ TwoSidedIdeal.ker I.ringCon.mk' := by erw [h]; trivial + rw [mem_ker] at mem + change _ = I.ringCon.mk' 0 at mem + exact I.ringCon.eq.mp mem + · left + rw [injective_iff_ker_eq_bot] at h + rw [eq_bot_iff, le_iff] + intro x hx + have mem : x ∈ TwoSidedIdeal.ker I.ringCon.mk' := by + rw [mem_ker] + exact I.ringCon.eq.mpr hx + erw [h] at mem + exact mem + +end IsSimpleOrder + +end TwoSidedIdeal diff --git a/LeanPool/BrauerGroupNew/Wedderburn.lean b/LeanPool/BrauerGroupNew/Wedderburn.lean new file mode 100644 index 0000000000..719023b673 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Wedderburn.lean @@ -0,0 +1,625 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.MatrixCenterEquiv +import LeanPool.BrauerGroupNew.TwoSidedIdeal +import Mathlib.Algebra.Azumaya.Basic +import Mathlib.Algebra.Central.Defs +import Mathlib.FieldTheory.IsAlgClosed.Basic +import Mathlib.RingTheory.HopkinsLevitzki + +variable (A : Type*) [Ring A] + +open Matrix MulOpposite + +local notation "M[" ι ", " R "]" => Matrix ι ι R + +section two_two_one + +variable (ι : Type) [Fintype ι] + +/-- +If `I` is a two-sided-ideal of `A`, then `Mₙ(I) := {(xᵢⱼ) | ∀ i j, xᵢⱼ ∈ I}` is a two-sided-ideal of +`Mₙ(A)`. +-/ +@[simps] +def TwoSidedIdeal.mapMatrix (I : TwoSidedIdeal A) : TwoSidedIdeal M[ι, A] := .mk +{ + r := fun X Y => ∀ i j, I.ringCon (X i j) (Y i j) + iseqv := + { refl := fun X i j ↦ I.ringCon.refl (X i j) + symm := fun h i j ↦ I.ringCon.symm (h i j) + trans := fun h1 h2 i j ↦ I.ringCon.trans (h1 i j) (h2 i j) } + mul' := by + intro _ _ _ _ h h' i j + rw [Matrix.mul_apply, Matrix.mul_apply] + rw [TwoSidedIdeal.rel_iff, ← Finset.sum_sub_distrib] + apply I.finsetSum_mem + rintro k - + rw [← TwoSidedIdeal.rel_iff] + apply I.ringCon.mul (h _ _) (h' _ _) + add' := fun {X X' Y Y'} h h' i j ↦ by + simpa only [Matrix.add_apply] using I.ringCon.add (h _ _) (h' _ _) +} + +@[simp] lemma TwoSidedIdeal.mem_mapMatrix (I : TwoSidedIdeal A) (x) : x ∈ I.mapMatrix A ι ↔ + ∀ i j, x i j ∈ I := + Iff.rfl + +/-- +The two-sided-ideals of `A` corresponds bijectively to that of `Mₙ(A)`. +Given an ideal `I ≤ A`, we send it to `Mₙ(I)`. +Given an ideal `J ≤ Mₙ(A)`, we send it to `{x₀₀ | x ∈ J}`. +-/ +@[simps] +def TwoSidedIdeal.equivRingConMatrix (oo : ι) : TwoSidedIdeal A ≃ TwoSidedIdeal M[ι, A] where + toFun I := I.mapMatrix A ι + invFun J := TwoSidedIdeal.mk' + ((fun (x : M[ι, A]) => x oo oo) '' J) + ⟨0, J.zero_mem, rfl⟩ + (by rintro _ _ ⟨x, hx, rfl⟩ ⟨y, hy, rfl⟩; exact ⟨x + y, J.add_mem hx hy, rfl⟩) + (by rintro _ ⟨x, hx, rfl⟩; exact ⟨-x, J.neg_mem hx, rfl⟩) + (by + classical + rintro x _ ⟨y, hy, rfl⟩ + exact ⟨Matrix.diagonal (fun _ ↦ x) * y, J.mul_mem_left _ _ hy, by simp⟩) + (by + classical + rintro _ y ⟨x, hx, rfl⟩ + exact ⟨x * Matrix.diagonal (fun _ ↦ y), J.mul_mem_right _ _ hx, by simp⟩) + right_inv J := SetLike.ext fun x ↦ by + classical + simp only [mem_mapMatrix] + generalize_proofs h1 h2 h3 h4 h5 + -- rw [TwoSidedIdeal.mem_mk'] + -- simp only [mem_fromIdeal, Set.mem_image, SetLike.mem_coe, mem_mapMatrix] + constructor + · intro h + choose y hy1 hy2 using h + rw [Matrix.matrix_eq_sum_single x] + refine J.finsetSum_mem _ _ fun i _ ↦ J.finsetSum_mem _ _ fun j _ ↦ ?_ + suffices + single i j (x i j) = + single i oo 1 * y i j * single oo j 1 by + rw [this] + exact J.mul_mem_right _ _ (J.mul_mem_left _ _ <| hy1 _ _) + ext a b + by_cases hab : a = i ∧ b = j + · rcases hab with ⟨ha, hb⟩ + subst ha hb + simp only [single_apply_same, mul_single_apply_same, + single_mul_apply_same, one_mul, mul_one] + specialize hy2 a b + simp only [sub_zero] at hy2 + exact hy2.symm + · conv_lhs => + dsimp [single] + rw [if_neg (by tauto)] + rw [not_and_or] at hab + rcases hab with ha | hb + · rw [mul_assoc, Matrix.single_mul_apply_of_ne (h := ha)] + · rw [Matrix.mul_single_apply_of_ne (hbj := hb)] + · intro hx i j + refine ⟨single oo i 1 * x * single j oo 1, + J.mul_mem_right _ _ (J.mul_mem_left _ _ hx), ?_⟩ + simp only [mul_single_apply_same, single_mul_apply_same, one_mul, + mul_one, sub_zero] + left_inv I := SetLike.ext fun x ↦ by + simp only + constructor + · intro h + choose y hy1 hy2 using h + simp only [sub_zero] at hy2 + exact hy2 ▸ hy1 _ _ + · intro h + exact ⟨of fun _ _ => x, by simp [h], by simp⟩ + +/-- +The two-sided-ideals of `A` corresponds bijectively to that of `Mₙ(A)`. +Given an ideal `I ≤ A`, we send it to `Mₙ(I)`. +Given an ideal `J ≤ Mₙ(A)`, we send it to `{x₀₀ | x ∈ J}`. +-/ +@[simps!] +def TwoSidedIdeal.equivRingConMatrix' (oo : ι) : TwoSidedIdeal A ≃o TwoSidedIdeal M[ι, A] where +__ := TwoSidedIdeal.equivRingConMatrix A _ oo +map_rel_iff' {I J} := by + simp only [equivRingConMatrix_apply, TwoSidedIdeal.le_iff] + constructor + · intro h x hx + specialize @h (of fun _ _ => x) + (by simp only [SetLike.mem_coe, mem_mapMatrix, of_apply]; intros; exact hx) + simp only [SetLike.mem_coe, mem_mapMatrix, of_apply] at h + exact h oo oo + · intro h X hX i j + exact h <| hX i j + +end two_two_one + +section simple_ring + +open MulOpposite + +variable (K D : Type*) [Field K] [IsSimpleRing A] [Algebra K A] [DivisionRing D] + +-- /-- +-- Division rings are a simple ring +-- -/ +-- instance : IsSimpleOrder (TwoSidedIdeal D) where +-- eq_bot_or_eq_top r := by +-- obtain h | h := _root_.forall_or_exists_not (fun x ↦ x ∈ r ↔ x = 0) +-- · left +-- exact SetLike.ext fun x ↦ (h x).trans (by rfl) +-- · right +-- obtain ⟨x, hx⟩ := h +-- refine SetLike.ext fun y ↦ ⟨fun _ ↦ trivial, fun _ ↦ ?_⟩ +-- have hx' : x ≠ 0 := by rintro rfl; simp [r.zero_mem] at hx +-- rw [show y = y * x * x⁻¹ by field_simp] +-- refine r.mul_mem_right _ _ <| r.mul_mem_left _ _ (by tauto) + +instance op_simple : IsSimpleRing Aᵐᵒᵖ := + ⟨TwoSidedIdeal.opOrderIso.symm.isSimpleOrder⟩ + +/-- +The canonical map from `Aᵒᵖ` to `Hom(A, A)` +-/ +@[simps] +def mopToEnd : Aᵐᵒᵖ →+* Module.End A A where + toFun a := + { toFun := fun x ↦ x * a.unop + map_add' := by simp [add_mul] + map_smul' := by simp [mul_assoc] } + map_zero' := by aesop + map_one' := by aesop + map_add' := by aesop + map_mul' := by aesop + +/-- +The canonical map from `A` to `Hom(A, A)ᵒᵖ` +-/ +@[simps] +def toEndMop : A →+* (Module.End A A)ᵐᵒᵖ where + toFun a := op + { toFun := fun x ↦ x * a + map_add' := by simp [add_mul] + map_smul' := by intros; simp [mul_assoc] } + map_zero' := by aesop + map_one' := by aesop + map_add' := by intros; apply_fun MulOpposite.unop using unop_injective; ext; simp + map_mul' := by intros; apply_fun MulOpposite.unop using unop_injective; ext; simp + +/-- +the map `Aᵒᵖ → Hom(A, A)` is bijective +-/ +noncomputable def mopEquivEnd : Aᵐᵒᵖ ≃+* Module.End A A := + .ofBijective (mopToEnd A) ⟨RingHom.injective_iff_ker_eq_bot _ |>.mpr <| + SetLike.ext fun α => ⟨by rintro (ha : mopToEnd A α = 0); simpa using (DFunLike.ext_iff.mp ha) 1, + by rintro rfl; ext; simp⟩, fun φ => ⟨op (φ 1), by ext; simp⟩⟩ + +/-- +the map `Aᵒᵖ → Hom(A, A)` is bijective +-/ +@[simps!] +noncomputable def equivEndMop : A ≃+* (Module.End A A)ᵐᵒᵖ := + .ofBijective (toEndMop A) ⟨RingHom.injective_iff_ker_eq_bot _ |>.mpr <| SetLike.ext + fun α => ⟨fun ha => by + simp only [RingHom.mem_ker, toEndMop_apply, op_eq_zero_iff, DFunLike.ext_iff, + LinearMap.coe_mk, AddHom.coe_mk, LinearMap.zero_apply] at ha + simpa using ha 1, fun (ha : α = 0) => by simp [ha]⟩, + fun φ => ⟨φ.unop 1, unop_injective <| by ext; simp⟩⟩ + +/-- +For any ring `D`, `Mₙ(D) ≅ Mₙ(D)ᵒᵖ`. +-/ +@[simps] +def matrixEquivMatrixMop (n : ℕ) (D : Type*) [Ring D] : + Matrix (Fin n) (Fin n) Dᵐᵒᵖ ≃+* (Matrix (Fin n) (Fin n) D)ᵐᵒᵖ where + toFun M := MulOpposite.op (M.transpose.map (fun d => MulOpposite.unop d)) + invFun M := (MulOpposite.unop M).transpose.map (fun d => MulOpposite.op d) + left_inv a := by aesop + right_inv a := by aesop + map_mul' x y := unop_injective <| by ext; simp [transpose_map, transpose_apply, mul_apply] + map_add' x y := by aesop + +-- instance matrix_simple_ring (ι : Type) [ne : Nonempty ι] [Fintype ι] [DecidableEq ι] +-- (R : Type*) [Ring R] [IsSimpleOrder (TwoSidedIdeal R)] : +-- IsSimpleOrder (TwoSidedIdeal M[ι, R]) := +-- TwoSidedIdeal.equivRingConMatrix' _ ι (ne.some) |>.symm.isSimpleOrder + +universe u + +lemma Ideal.eq_of_le_of_isSimpleModule {A : Type u} [Ring A] + (I : Ideal A) [IsSimpleModule A I] + (J : Ideal A) (ineq : J ≤ I) (a : A) (ne_zero : a ≠ 0) (mem : a ∈ J) : J = I := by + obtain eq | eq : Submodule.comap I.subtype J = ⊥ ∨ Submodule.comap I.subtype J = ⊤ := + eq_bot_or_eq_top _ + · rw [Submodule.eq_bot_iff] at eq + specialize eq ⟨a, ineq mem⟩ (by simpa [Subtype.ext_iff]) + rw [Subtype.ext_iff] at eq + exact ne_zero eq |>.elim + · simp only [Submodule.comap_subtype_eq_top] at eq + exact le_antisymm ineq eq + +lemma minimal_ideal_isSimpleModule {A : Type u} [Ring A] + (I : Ideal A) (I_nontrivial : I ≠ ⊥) + (I_minimal : ∀ J : Ideal A, J ≠ ⊥ → ¬ J < I) : + IsSimpleModule A I := by + letI ins1 : Nontrivial I := by + obtain ⟨y, hy⟩ := Submodule.nonzero_mem_of_bot_lt (bot_lt_iff_ne_bot.mpr I_nontrivial) + exact ⟨0, y, hy.symm⟩ + rw [isSimpleModule_iff] + refine ⟨fun J ↦ ?_⟩ + rw [or_iff_not_imp_left] + intro hJ + specialize I_minimal (J.map I.subtype : Ideal A) (by + contrapose! hJ + apply_fun Submodule.comap (f := I.subtype) at hJ + rw [Submodule.comap_map_eq_of_injective (hf := Submodule.injective_subtype _)] at hJ + rw [hJ, Submodule.comap_bot] + rw [LinearMap.ker_eq_bot] + exact Submodule.injective_subtype _) + apply_fun Submodule.map (f := I.subtype) using Submodule.map_injective_of_injective + (hf := Submodule.injective_subtype I) + simp only [Submodule.map_top, Submodule.range_subtype] + contrapose! I_minimal + refine lt_of_le_of_ne (fun x hx ↦ ?_) I_minimal + simp only [Submodule.mem_map, Submodule.coe_subtype, Subtype.exists, exists_and_right, + exists_eq_right] at hx + exact hx.1 + +lemma Wedderburn_Artin.aux.one_eq + {A : Type u} [Ring A] [simple : IsSimpleRing A] + (I : Ideal A) (I_nontrivial : I ≠ ⊥) : + ∃ (n : ℕ) (x : Fin n → A) (i : Fin n → I), ∑ j : Fin n, i j * x j = 1 := by + letI I' : TwoSidedIdeal A := TwoSidedIdeal.span I + have I'_is_everything : I' = ⊤ := simple.1.2 I' |>.resolve_left (fun r ↦ by + obtain ⟨y, hy⟩ := Submodule.nonzero_mem_of_bot_lt (bot_lt_iff_ne_bot.mpr I_nontrivial) + have hy' : y.1 ∈ I' := by + change I'.ringCon y 0 + exact .of _ _ <| by simp + rw [r] at hy' + change _ = _ at hy' + aesop) + have one_mem_I' : 1 ∈ I' := by rw [I'_is_everything]; trivial + rw [TwoSidedIdeal.mem_span_ideal_iff_exists_fin] at one_mem_I' + obtain ⟨n, finn, x, y, hy⟩ := one_mem_I' + exact ⟨Fintype.card n, x ∘ (Fintype.equivFin _).symm, y ∘ (Fintype.equivFin _).symm, hy ▸ + Fintype.sum_bijective (Fintype.equivFin _).symm (Equiv.bijective _) _ _ fun k ↦ rfl⟩ + +/-- The minimal number of summands representing `1` from a nontrivial ideal in the +Wedderburn-Artin proof. -/ +noncomputable abbrev Wedderburn_Artin.aux.n + {A : Type u} [Ring A] [simple : IsSimpleRing A] + (I : Ideal A) (I_nontrivial : I ≠ ⊥) : ℕ := by + classical + exact Nat.find <| Wedderburn_Artin.aux.one_eq I I_nontrivial + +/-- The right factors in the chosen minimal representation of `1`. -/ +noncomputable abbrev Wedderburn_Artin.aux.x + {A : Type u} [Ring A] [simple : IsSimpleRing A] + (I : Ideal A) (I_nontrivial : I ≠ ⊥) : + Fin (Wedderburn_Artin.aux.n I I_nontrivial) → A := by + classical + exact (Nat.find_spec <| Wedderburn_Artin.aux.one_eq I I_nontrivial).choose + +/-- The ideal-valued left factors in the chosen minimal representation of `1`. -/ +noncomputable abbrev Wedderburn_Artin.aux.i + {A : Type u} [Ring A] [simple : IsSimpleRing A] + (I : Ideal A) (I_nontrivial : I ≠ ⊥) : + Fin (Wedderburn_Artin.aux.n I I_nontrivial) → I := by + classical + exact (Nat.find_spec <| Wedderburn_Artin.aux.one_eq I I_nontrivial).choose_spec.choose + +open Wedderburn_Artin.aux in +/-- The chosen representation of `1` by the auxiliary Wedderburn-Artin data. -/ +lemma Wedderburn_Artin.aux.nxi_spec + {A : Type u} [Ring A] [simple : IsSimpleRing A] + (I : Ideal A) (I_nontrivial : I ≠ ⊥) : + ∑ j : Fin (n I I_nontrivial), (i I I_nontrivial j) * (x I I_nontrivial j) = 1 := by + classical + exact (Nat.find_spec <| Wedderburn_Artin.aux.one_eq I I_nontrivial).choose_spec.choose_spec + +lemma Wedderburn_Artin.aux.n_ne_zero + {A : Type u} [Ring A] [simple : IsSimpleRing A] + (I : Ideal A) (I_nontrivial : I ≠ ⊥) : + Wedderburn_Artin.aux.n I I_nontrivial ≠ 0 := by + rintro hn + let n : ℕ := Wedderburn_Artin.aux.n I I_nontrivial + let x : Fin n → A := Wedderburn_Artin.aux.x I I_nontrivial + let i : Fin n → I := Wedderburn_Artin.aux.i I I_nontrivial + have one_eq : ∑ j : Fin n, (i j) * (x j) = 1 := + Wedderburn_Artin.aux.nxi_spec I I_nontrivial + let e : Fin n ≃ Fin 0 := Fin.castOrderIso hn + simpa using calc 1 + _ = _ := one_eq.symm + _ = ∑ j : Fin 0, i (e.symm j) * x (e.symm j) := + Fintype.sum_bijective e e.bijective _ _ (fun _ ↦ rfl) + _ = 0 := by simp + +open Wedderburn_Artin.aux in +lemma Wedderburn_Artin.aux.nxi_ne_zero {A : Type u} [Ring A] [simple : IsSimpleRing A] + (I : Ideal A) (I_nontrivial : I ≠ ⊥) : + ∀ j, x I I_nontrivial j ≠ 0 ∧ i I I_nontrivial j ≠ 0 := by + classical + let n : ℕ := Wedderburn_Artin.aux.n I I_nontrivial + have n_ne : n ≠ 0 := Wedderburn_Artin.aux.n_ne_zero I I_nontrivial + let x : Fin n → A := Wedderburn_Artin.aux.x I I_nontrivial + let i : Fin n → I := Wedderburn_Artin.aux.i I I_nontrivial + have one_eq : ∑ j : Fin n, i j * x j = 1 := Wedderburn_Artin.aux.nxi_spec I I_nontrivial + by_contra! H + obtain ⟨j, (hj : x j ≠ 0 → i j = 0)⟩ := H + refine Nat.find_min (aux.one_eq I I_nontrivial) (m := n - 1) + (show n - 1 < n by omega) ?_ + let e : Fin n ≃ Option (Fin (n - 1)) := + (Fin.castOrderIso <| by omega).toEquiv.trans (finSuccEquiv' (j.cast <| by omega)) + have one_eq := calc 1 + _ = _ := one_eq.symm + _ = ∑ j : Option (Fin (n - 1)), i (e.symm j) * x (e.symm j) := + Fintype.sum_bijective e (Equiv.bijective _) _ _ (fun _ ↦ by simp) + simp only [Equiv.symm_trans_apply, OrderIso.coe_symm_toEquiv, Fin.symm_castOrderIso, + Fin.castOrderIso_apply, Fintype.sum_option, finSuccEquiv'_symm_none, Fin.cast_cast, + Fin.cast_eq_self, finSuccEquiv'_symm_some, e] at one_eq + if xj_eq : x j = 0 + then rw [xj_eq, mul_zero, zero_add] at one_eq; exact ⟨_, _, one_eq.symm⟩ + else erw [hj xj_eq, Submodule.coe_zero, zero_mul, zero_add] at one_eq; exact ⟨_, _, one_eq.symm⟩ + +lemma Wedderburn_Artin.aux.equivIdeal + {A : Type u} [Ring A] [simple : IsSimpleRing A] + (I : Ideal A) (I_nontrivial : I ≠ ⊥) (I_minimal : ∀ J : Ideal A, J ≠ ⊥ → ¬ J < I) : + ∃ n ≠ 0, Nonempty ((Fin n → I) ≃ₗ[A] A) := by + classical + letI n : ℕ := Wedderburn_Artin.aux.n I I_nontrivial + have n_ne : n ≠ 0 := Wedderburn_Artin.aux.n_ne_zero I I_nontrivial + letI x : Fin n → A := Wedderburn_Artin.aux.x I I_nontrivial + letI i : Fin n → I := Wedderburn_Artin.aux.i I I_nontrivial + have one_eq : ∑ j : Fin n, (i j) * (x j) = 1 := + Wedderburn_Artin.aux.nxi_spec I I_nontrivial + haveI : IsSimpleModule A I := minimal_ideal_isSimpleModule I I_nontrivial I_minimal + letI g : (Fin n → I) →ₗ[A] A := + { toFun := fun v ↦ ∑ j : Fin n, v j * x j + map_add' := fun v1 v2 => by simp [add_mul, Finset.sum_add_distrib] + map_smul' := fun a v => by simp [Finset.mul_sum, mul_assoc] } + have g_surj : Function.Surjective g := fun a ↦ + ⟨fun j ↦ ⟨a * (i j), I.mul_mem_left _ (i j).2⟩, + by simp [g, mul_assoc, ← Finset.mul_sum, one_eq]⟩ + have g_inj : Function.Injective g := by + rw [← LinearMap.ker_eq_bot] + by_contra! + obtain ⟨⟨y, (hy1 : ∑ j : Fin n, _ = 0)⟩, hy2⟩ := + Submodule.nonzero_mem_of_bot_lt (bot_lt_iff_ne_bot.mpr this) + replace hy2 : y ≠ 0 := by contrapose! hy2; subst hy2; rfl + obtain ⟨j, hj⟩ : ∃ (j : Fin n), y j ≠ 0 := by contrapose! hy2; ext; rw [hy2]; rfl + have eq1 : Ideal.span {(y j).1} = I := + Ideal.eq_of_le_of_isSimpleModule (A := A) I (Ideal.span {(y j).1}) + (by simp only [Ideal.span_le, Set.singleton_subset_iff, Subtype.coe_prop]) (y j).1 + (by contrapose! hj; rwa [Subtype.ext_iff]) <| Ideal.subset_span + (by simp only [Set.mem_singleton_iff]) + have mem : (i j).1 ∈ Ideal.span {(y j).1} := eq1.symm ▸ (i j).2 + rw [Ideal.mem_span_singleton'] at mem + obtain ⟨r, hr⟩ := mem + have hr' : (i j).1 - r * (y j).1 = 0 := by rw [hr, sub_self] + apply_fun (r * ·) at hy1 + simp only [Finset.mul_sum, ← mul_assoc, mul_zero] at hy1 + have one_eq' : ∑ j : Fin n, ↑(i j) * x j - ∑ _, _ = 1 - 0 := congr_arg₂ (· - ·) one_eq hy1 + rw [← Finset.sum_sub_distrib, sub_zero] at one_eq' + let e : Fin n ≃ Option (Fin (n - 1)) := + (Fin.castOrderIso <| by omega).toEquiv.trans (finSuccEquiv' (j.cast <| by omega)) + have one_eq' := calc 1 + _ = _ := one_eq'.symm + _ = ∑ k : Option (Fin (n - 1)), + (i (e.symm k) * x (e.symm k) - r * y (e.symm k) * x (e.symm k)) := + Fintype.sum_bijective e (Equiv.bijective _) _ _ (fun _ ↦ by simp) + _ = ∑ k : Option (Fin (n - 1)), + ((i (e.symm k) - r * y (e.symm k)) * x (e.symm k)) := + Finset.sum_congr rfl (fun _ _ ↦ by simp only [sub_mul, mul_assoc]) + simp only [Equiv.symm_trans_apply, OrderIso.coe_symm_toEquiv, Fin.symm_castOrderIso, + Fin.castOrderIso_apply, Fintype.sum_option, finSuccEquiv'_symm_none, Fin.cast_cast, + Fin.cast_eq_self, hr', zero_mul, finSuccEquiv'_symm_some, zero_add, e] at one_eq' + set f := _ + change 1 = ∑ k : Fin (n - 1), (i ∘ f - (r • y) ∘ f) k * (x ∘ f) k at one_eq' + exact Nat.find_min (Wedderburn_Artin.aux.one_eq I I_nontrivial) (m := n - 1) + (show n - 1 < n by omega) ⟨_, _, one_eq'.symm⟩ + exact ⟨n, n_ne, ⟨LinearEquiv.ofBijective g ⟨g_inj, g_surj⟩⟩⟩ + +/-- Endomorphisms of a finite product are equivalent to matrices over endomorphisms of one +factor. -/ +def endPowEquivMatrix (A : Type*) [Ring A] + (M : Type*) [AddCommGroup M] [Module A M] (n : ℕ) : + Module.End A (Fin n → M) ≃+* Matrix (Fin n) (Fin n) (Module.End A M) := + endVecAlgEquivMatrixEnd (Fin n) ℤ A M + +theorem Wedderburn_Artin_ideal_version + (A : Type u) [Ring A] [IsArtinianRing A] [simple : IsSimpleRing A] : + ∃ n ≠ 0, ∃ (I : Ideal A) (_ : IsSimpleModule A I), Nonempty ((Fin n → I) ≃ₗ[A] A) := by + classical + obtain ⟨(I : Ideal A), (I_nontrivial : I ≠ ⊥), (I_minimal : ∀ J : Ideal A, J ≠ ⊥ → ¬ J < I)⟩ := + IsArtinian.set_has_minimal (R := A) (M := A) {I | I ≠ ⊥} + ⟨⊤, show ⊤ ≠ ⊥ by aesop⟩ + haveI : IsSimpleModule A I := minimal_ideal_isSimpleModule I I_nontrivial I_minimal + obtain ⟨n, hn, ⟨e⟩⟩ := Wedderburn_Artin.aux.equivIdeal I I_nontrivial I_minimal + exact ⟨n, hn, I, inferInstance, ⟨e⟩⟩ + +theorem Wedderburn_Artin (A : Type u) [Ring A] [IsArtinianRing A] [simple : IsSimpleRing A] : + ∃ n ≠ 0, ∃ (I : Ideal A) (_ : IsSimpleModule A I), + Nonempty (A ≃+* M[Fin n, (Module.End A I)ᵐᵒᵖ]) := by + classical + obtain ⟨(I : Ideal A), (I_nontrivial : I ≠ ⊥), (I_minimal : ∀ J : Ideal A, J ≠ ⊥ → ¬ J < I)⟩ := + IsArtinian.set_has_minimal (R := A) (M := A) {I | I ≠ ⊥} + ⟨⊤, show ⊤ ≠ ⊥ by aesop⟩ + haveI : IsSimpleModule A I := minimal_ideal_isSimpleModule I I_nontrivial I_minimal + obtain ⟨n, hn, ⟨e⟩⟩ := Wedderburn_Artin.aux.equivIdeal I I_nontrivial I_minimal + let endEquiv : Module.End A A ≃+* Module.End A (Fin n → I) := + { toFun := fun f ↦ e.symm ∘ₗ f ∘ₗ e + invFun := fun f ↦ e ∘ₗ f ∘ₗ e.symm + left_inv := by intro f; ext; simp + right_inv := by intro f; ext; simp + map_add' := by intros f g; ext; simp + map_mul' := by intros f g; ext; simp } + refine ⟨n, hn, I, inferInstance, ⟨(equivEndMop A).trans <| endEquiv.op.trans <| + (endPowEquivMatrix A I n).op.trans <| (matrixEquivMatrixMop n (Module.End A ↥I)).symm⟩⟩ + +theorem Wedderburn_Artin' (A : Type u) [Ring A] [IsArtinianRing A] [simple : IsSimpleRing A] : + ∃ n ≠ 0, ∃ (S : Type u) (_ : DivisionRing S), Nonempty (A ≃+* (M[Fin n, S])) := by + classical + obtain ⟨n, hn, I, inst, e⟩ := Wedderburn_Artin A + exact ⟨n, hn, (Module.End A I)ᵐᵒᵖ, inferInstance, e⟩ + +-- theorem Wedderburn_Artin_divisionRing_unique +-- (D E : Type u) [DivisionRing D] [DivisionRing E] (m n : ℕ) [hm : NeZero m] [hn : NeZero n] +-- (iso : M[Fin m, D] ≃+* M[Fin n, E]) : Nonempty <| D ≃+* E := by +-- classical +-- have i1 : IsMoritaEquivalent D E := @IsMoritaEquivalent.trans _ _ _ _ _ _ +-- (@IsMoritaEquivalent.trans _ _ _ _ _ _ (.matrix' D m) (.ofIso _ _ iso)) +-- (IsMoritaEquivalent.matrix' E n).symm +-- exact ⟨i1.ringEquivOfDivisionRing⟩ + +end simple_ring + +universe u v w +section central_simple + +variable (K : Type u) (B : Type v) [Field K] [Ring B] [Algebra K B] [FiniteDimensional K B] + +lemma Matrix.mem_center_iff' (K R : Type*) [Field K] [Ring R] [Algebra K R] (n : ℕ) (M) : + M ∈ Subalgebra.center K M[Fin n, R] ↔ + ∃ α : (Subalgebra.center K R), M = α • 1 := + Matrix.mem_center_iff R n M + +theorem RingEquiv.mem_center_iff {R1 R2 : Type*} [Ring R1] [Ring R2] (e : R1 ≃+* R2) : + ∀ x, x ∈ Subring.center R1 ↔ e x ∈ Subring.center R2 := fun x ↦ by + simpa only [Subring.mem_center_iff] using + ⟨fun h r => e.symm.injective <| by simp [h], fun h r => e.injective <| by simpa using h (e r)⟩ + +variable {B} in +/-- +For a `K`-algebra B, there is a map from `I : Ideal B` to `End(I)ᵒᵖ` defined by `k ↦ x ↦ k • x`. +-/ +@[simps] +def algebraMapEndIdealMop (I : Ideal B) : K →+* (Module.End B I)ᵐᵒᵖ where + toFun k := .op { + toFun x := k • x + map_add' := fun x y => by simp + map_smul' := fun k' x => by ext; simp + } + map_one' := unop_injective <| by ext; simp + map_mul' _ _ := unop_injective <| by ext; simp [SemigroupAction.mul_smul] + map_zero' := unop_injective <| by ext; simp + map_add' _ _ := unop_injective <| by ext; simp [add_smul] + +instance (I : Ideal B) : Algebra K (Module.End B I)ᵐᵒᵖ where + algebraMap := algebraMapEndIdealMop K I + commutes' := fun r ⟨x⟩ => MulOpposite.unop_injective <| DFunLike.ext _ _ fun ⟨i, hi⟩ => + Subtype.ext <| show (x (r • ⟨i, hi⟩)).1 = r • (x ⟨i, hi⟩).1 by + convert Subtype.ext_iff.mp (x.map_smul (algebraMap K B r) ⟨i, hi⟩) using 1 <;> aesop + smul k x := .op <| (algebraMapEndIdealMop K I k).unop * x.unop + smul_def' := fun r ⟨x⟩ => MulOpposite.unop_injective <| DFunLike.ext _ _ fun ⟨i, hi⟩ => + Subtype.ext <| by + convert Subtype.ext_iff.mp (x.map_smul (algebraMap K B r) ⟨i, hi⟩) |>.symm using 1 <;> aesop + +omit [FiniteDimensional K B] in +lemma algebraEndIdealMop.algebraMap_eq (I : Ideal B) : + algebraMap K (Module.End B I)ᵐᵒᵖ = algebraMapEndIdealMop K I := rfl + +lemma Wedderburn_Artin_algebra_version' (R : Type u) (A : Type v) [CommRing R] [Ring A] + [sim : IsSimpleRing A] [Algebra R A] [hA : IsArtinianRing A] : + ∃ n ≠ 0, ∃ (S : Type v) (_ : DivisionRing S) (_ : Algebra R S), + Nonempty (A ≃ₐ[R] (M[Fin n, S])) := by + classical + obtain ⟨n, hn, I, inst_I, ⟨e⟩⟩ := Wedderburn_Artin_ideal_version A + let endEquiv : Module.End A A ≃+* Module.End A (Fin n → I) := + { toFun := fun f ↦ e.symm ∘ₗ f ∘ₗ e + invFun := fun f ↦ e ∘ₗ f ∘ₗ e.symm + left_inv := by intro f; ext; simp + right_inv := by intro f; ext; simp + map_add' := by intros f g; ext; simp + map_mul' := by intros f g; ext; simp } + refine ⟨n, hn, (Module.End A I)ᵐᵒᵖ, inferInstance, inferInstance, ⟨AlgEquiv.ofRingEquiv + (f := equivEndMop A |>.trans <| endEquiv.op.trans <| (endPowEquivMatrix A I n).op.trans + (matrixEquivMatrixMop n (Module.End A I)).symm) ?_⟩⟩ + intro r + rw [Matrix.algebraMap_eq_diagonal] + ext i j + apply MulOpposite.unop_injective + simp only [endPowEquivMatrix, RingEquiv.coe_trans, Function.comp_apply, equivEndMop_apply, + RingEquiv.op_apply_apply, unop_op, RingEquiv.coe_mk, Equiv.coe_fn_mk, + matrixEquivMatrixMop_symm_apply, map_apply, transpose_apply, diagonal, Pi.algebraMap_apply, + MulOpposite.algebraMap_apply, of_apply, endEquiv] + split_ifs with h + · subst h + ext x : 1 + simp only [unop_op, Module.algebraMap_end_apply] + rw [show r • x = Function.update (0 : Fin n → I) i (r • x) i by simp] + refine congr_fun (e.injective ?_) i + rw [show Function.update (0 : Fin n → I) i (r • x) = r • Function.update (0 : Fin n → I) i x + by ext : 1; simp [Function.update]] + simp only [LinearEquiv.invFun_eq_symm, LinearMap.coe_comp, LinearMap.coe_mk, + AddHom.coe_mk, LinearEquiv.coe_coe, Function.comp_apply, LinearEquiv.apply_symm_apply] + rw [← Algebra.commutes, ← smul_eq_mul, ← e.map_smul] + exact congr_arg e <| by ext; simp [Pi.single] + · ext x : 1 + simp only [MulOpposite.unop_zero, LinearMap.zero_apply] + rw [show (0 : I) = Function.update (0 : Fin n → I) i (r • x) j + by simp [Function.update, if_neg (Ne.symm h)]] + refine congr_fun (e.injective ?_) j + simp only [LinearMap.coe_comp, LinearEquiv.coe_coe, LinearMap.coe_mk, AddHom.coe_mk, + Function.comp_apply] + rw [show Function.update (0 : Fin n → I) i (r • x) = r • Function.update (0 : Fin n → I) i x + by ext : 1; simp [Function.update]] + simp only [LinearEquiv.invFun_eq_symm, LinearEquiv.apply_symm_apply] + rw [← Algebra.commutes, ← smul_eq_mul, ← e.map_smul] + exact congr_arg e <| by ext; simp [Pi.single] + +lemma Wedderburn_Artin_algebra_version + [sim : IsSimpleRing B] : + ∃ n ≠ 0, ∃ (S : Type v) (_ : DivisionRing S) (_ : Algebra K S), + Nonempty (B ≃ₐ[K] (M[Fin n, S])) := by + classical + have hB : IsArtinianRing B := .of_finite K B + exact Wedderburn_Artin_algebra_version' K B + +omit [FiniteDimensional K B] in +theorem is_central_of_wdb [hctr : Algebra.IsCentral K B] + (n : ℕ) (S : Type*) (hn : n ≠ 0) [h : DivisionRing S] + [Algebra K S] (Wdb : B ≃ₐ[K] M[Fin n, S]) : + Algebra.IsCentral K S := by + have : NeZero n := ⟨hn⟩ + constructor + intro x hx + have hx' : (Matrix.diagonal fun _ ↦ x) ∈ Subalgebra.center K M[Fin n, S] := + Matrix.mem_center_iff' _ _ _ _ |>.2 <| + ⟨⟨x, hx⟩, by + ext; simp only [diagonal, of_apply]; split_ifs + · simp_all only [smul_apply, one_apply_eq] + change _ = x • (1 : S) + simp only [smul_eq_mul, mul_one] + · simp_all only [smul_apply, ne_eq, not_false_eq_true, one_apply_ne, smul_zero]⟩ + have hx'' : Wdb.symm (Matrix.diagonal fun _ ↦ x) ∈ Subalgebra.center K B := by + rw [Subalgebra.mem_center_iff] at hx' ⊢ + exact fun b ↦ Wdb.injective <| by simpa using hx' (Wdb b) + obtain ⟨s, (hs : algebraMap _ _ s = _)⟩ := hctr.out hx'' + exact ⟨s, show algebraMap _ _ _ = _ by + simpa using Matrix.ext_iff.2 congr(Wdb $hs) 0 0⟩ + +theorem is_fin_dim_of_wdb {n : ℕ} (hn : n ≠ 0) (S : Type*) [h : DivisionRing S] [Algebra K S] + (Wdb : B ≃ₐ[K] M[Fin n, S]) : FiniteDimensional K S := by + classical + have : NeZero n := ⟨hn⟩ + have := FiniteDimensional.of_injective Wdb.symm.toLinearEquiv.toLinearMap Wdb.symm.injective + exact Module.Finite.of_injective + ({ + toFun s := Matrix.diagonal (fun _ => s) + map_add' := by + intros; ext i j; by_cases i = j <;> aesop + map_smul' := by intros; ext i j; by_cases i = j <;> aesop + } : S →ₗ[K] Matrix (Fin n) (Fin n) S) fun x y h => Matrix.ext_iff.2 h 0 0 + +theorem simple_eq_matrix_algClosed [IsAlgClosed K] [IsSimpleRing B] : + ∃ n ≠ 0, Nonempty (B ≃ₐ[K] M[Fin n, K]) := by + rcases Wedderburn_Artin_algebra_version K B with ⟨n, hn, S, ins1, ins2, ⟨e⟩⟩ + have := is_fin_dim_of_wdb K B hn S e + exact ⟨n, hn, ⟨e.trans <| .mapMatrix <| .symm <| + .ofBijective (Algebra.ofId _ _) IsAlgClosed.algebraMap_bijective_of_isIntegral⟩⟩ + +end central_simple diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index 8d2bc9c42b..fdef88c5ec 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -444,3 +444,41 @@ projects: msc: - "11E25" - "11H06" + - slug: brauergroup_new + title: Brauer Group Core + summary: Formalizes central simple algebra infrastructure and Wedderburn-Artin structure theorems toward Brauer groups. + branch: ring theory + entry_module: LeanPool.BrauerGroupNew + authors: + - Yunzhou Xie + - Yichen Feng + - Jujian Zhang + - Yael Dillies + source: + url: https://github.com/Whysoserioushah/BrauerGroup_new + github_repo: Whysoserioushah/BrauerGroup_new + status: verified + main_declarations: + - Wedderburn_Artin + - IsCentralSimple.TensorProduct.simple + - CSA_implies_CSA + main_results: + - declaration: Wedderburn_Artin + informal: Proves a Wedderburn-Artin decomposition for simple Artinian rings as matrix algebras over division rings. + - declaration: Wedderburn_Artin_algebra_version + informal: Gives an algebra equivalence form of Wedderburn-Artin for finite-dimensional central simple algebras. + - declaration: IsCentralSimple.TensorProduct.simple + informal: Proves simplicity of tensor products of central simple algebras over a field. + - declaration: IsCentralSimple.TensorProduct.isCentral + informal: Proves centrality of tensor products of central algebras over a field. + - declaration: CSA_implies_CSA + informal: Shows that base change preserves central simple algebra structure under the imported hypotheses. + tags: + - algebra + - ring-theory + - central-simple-algebras + - brauer-groups + msc: + - "16K20" + - "16K50" + - "16S35" From 971b78b67963160fd2ee689b241d41fe91faa435 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 18 May 2026 19:59:35 +0900 Subject: [PATCH 02/34] Add Brauer group source citation --- LeanPool/BrauerGroupNew.lean | 6 +++++- LeanPool/projects.yml | 6 +++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index b0979514fb..0d887841f0 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -19,7 +19,11 @@ import LeanPool.BrauerGroupNew.Subfield /-! # Brauer Group Core -Source: url:https://github.com/Whysoserioushah/BrauerGroup_new +Source: Philippe Gille and Tamás Szamuely, "Central Simple Algebras and + Galois Cohomology", 2nd ed., Cambridge Studies in Advanced Mathematics 165, + Cambridge University Press, 2017, for central simple algebras and Brauer + group structure; formalization source: + url:https://github.com/Whysoserioushah/BrauerGroup_new Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies Status: verified Main declarations: `Wedderburn_Artin`, `IsCentralSimple.TensorProduct.simple`, `CSA_implies_CSA` diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index fdef88c5ec..40bf9e5a27 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -455,7 +455,11 @@ projects: - Jujian Zhang - Yael Dillies source: - url: https://github.com/Whysoserioushah/BrauerGroup_new + title: Central Simple Algebras and Galois Cohomology + authors: + - Philippe Gille + - Tamás Szamuely + url: https://doi.org/10.1017/9781107359419 github_repo: Whysoserioushah/BrauerGroup_new status: verified main_declarations: From a56d88f879853ecd589befbd10aa9b3a44eb8745 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 18 May 2026 20:16:26 +0900 Subject: [PATCH 03/34] Regenerate project card --- LeanPool/BrauerGroupNew.lean | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index 0d887841f0..ba48f8e046 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -19,11 +19,7 @@ import LeanPool.BrauerGroupNew.Subfield /-! # Brauer Group Core -Source: Philippe Gille and Tamás Szamuely, "Central Simple Algebras and - Galois Cohomology", 2nd ed., Cambridge Studies in Advanced Mathematics 165, - Cambridge University Press, 2017, for central simple algebras and Brauer - group structure; formalization source: - url:https://github.com/Whysoserioushah/BrauerGroup_new +Source: url:https://doi.org/10.1017/9781107359419 Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies Status: verified Main declarations: `Wedderburn_Artin`, `IsCentralSimple.TensorProduct.simple`, `CSA_implies_CSA` From 14c2b52dc15bebc1280646a79870a41450d75469 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 19 May 2026 14:38:19 +0900 Subject: [PATCH 04/34] Add Brauer group core --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew.lean | 3 +- LeanPool/BrauerGroupNew/BrauerGroup.lean | 809 +++++++++++++++++++++++ LeanPool/projects.yml | 10 +- 4 files changed, 819 insertions(+), 4 deletions(-) create mode 100644 LeanPool/BrauerGroupNew/BrauerGroup.lean diff --git a/LeanPool.lean b/LeanPool.lean index 19895d6ae8..d695524765 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -30,6 +30,7 @@ import LeanPool.ArchonFirstProofResults.FirstProof6.Auxiliary.ResolventBound import LeanPool.ArchonFirstProofResults.FirstProof6.Problem6 import LeanPool.Basic import LeanPool.BrauerGroupNew +import LeanPool.BrauerGroupNew.BrauerGroup import LeanPool.BrauerGroupNew.CentralSimple import LeanPool.BrauerGroupNew.Centralizer import LeanPool.BrauerGroupNew.ExtendScalar diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index ba48f8e046..ea0880790d 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -8,6 +8,7 @@ import LeanPool.BrauerGroupNew.CentralSimple import LeanPool.BrauerGroupNew.Centralizer import LeanPool.BrauerGroupNew.ExtendScalar import LeanPool.BrauerGroupNew.FieldCat +import LeanPool.BrauerGroupNew.BrauerGroup import LeanPool.BrauerGroupNew.LemmasAboutSimpleRing import LeanPool.BrauerGroupNew.MatrixCenterEquiv import LeanPool.BrauerGroupNew.MatrixEquivTensor @@ -22,7 +23,7 @@ import LeanPool.BrauerGroupNew.Subfield Source: url:https://doi.org/10.1017/9781107359419 Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies Status: verified -Main declarations: `Wedderburn_Artin`, `IsCentralSimple.TensorProduct.simple`, `CSA_implies_CSA` +Main declarations: `BrauerGroup.Bruaer_Group`, `BrauerGroupHom.Br`, `Wedderburn_Artin` Tags: algebra, ring-theory, central-simple-algebras, brauer-groups MSC: 16K20, 16K50, 16S35 -/ diff --git a/LeanPool/BrauerGroupNew/BrauerGroup.lean b/LeanPool/BrauerGroupNew/BrauerGroup.lean new file mode 100644 index 0000000000..4fc5365697 --- /dev/null +++ b/LeanPool/BrauerGroupNew/BrauerGroup.lean @@ -0,0 +1,809 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ +import LeanPool.BrauerGroupNew.CentralSimple +import LeanPool.BrauerGroupNew.FieldCat +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Operations +import Mathlib.Algebra.BrauerGroup.Defs +import Mathlib.Algebra.Central.Matrix +import Mathlib.Analysis.Complex.Polynomial.Basic +import Mathlib.LinearAlgebra.FreeModule.PID +import Mathlib.LinearAlgebra.Matrix.FiniteDimensional +import Mathlib.RingTheory.SimpleRing.Matrix + +suppress_compilation +universe u v v₁ v₂ w + +variable (K : Type u) [Field K] +variable (A B : Type u) [Ring A] [Ring B] [Algebra K A] [Algebra K B] + +open scoped TensorProduct + +lemma bijective_of_dim_eq_of_isCentralSimple + [csa_source : IsSimpleRing A] + [fin_source : FiniteDimensional K A] + [fin_target : FiniteDimensional K B] + (f : A →ₐ[K] B) (h : Module.finrank K A = Module.finrank K B) : + Function.Bijective f := by + obtain hA|hA := subsingleton_or_nontrivial A + · have eq1 : Module.finrank K A = 0 := by + rw [finrank_zero_iff_forall_zero] + intro x + apply Subsingleton.elim + rw [eq1] at h + replace h : Subsingleton B := by + constructor + symm at h + rw [finrank_zero_iff_forall_zero] at h + intro a b + rw [h a, h b] + rw [Function.bijective_iff_existsUnique] + intro b + refine ⟨0, Subsingleton.elim _ _, fun _ _ => Subsingleton.elim _ _⟩ + · have := IsSimpleRing.iff_injective_ringHom_or_subsingleton_codomain A |>.1 csa_source + f.toRingHom + rcases this with (H|H) + · refine ⟨H, ?_⟩ + change Function.Surjective f.toLinearMap + have := f.toLinearMap.finrank_range_add_finrank_ker + rw [show Module.finrank K (LinearMap.ker f.toLinearMap) = 0 by + rw [finrank_zero_iff_forall_zero] + rintro ⟨x, hx⟩ + rw [LinearMap.ker_eq_bot (f := f.toLinearMap) |>.2 H] at hx + ext + exact hx, add_zero, h] at this + rw [← LinearMap.range_eq_top] + apply Submodule.eq_top_of_finrank_eq + exact this + · have : (1 : A) ∈ TwoSidedIdeal.ker f.toRingHom := by + simp only [AlgHom.toRingHom_eq_coe, TwoSidedIdeal.mem_ker, map_one] + exact Subsingleton.elim _ _ + simp only [AlgHom.toRingHom_eq_coe, TwoSidedIdeal.mem_ker, map_one] at this + have hmm : Nontrivial B := by + let e := LinearEquiv.ofFinrankEq _ _ h + exact Equiv.nontrivial e.symm.toEquiv + exact one_ne_zero this |>.elim + +lemma bijective_of_surj_of_isCentralSimple + [csa_source : IsSimpleRing A] + (f : A →ₐ[K] B) [Nontrivial B] (h : Function.Surjective f) : + Function.Bijective f := + ⟨IsSimpleRing.iff_injective_ringHom A |>.1 inferInstance f.toRingHom, h⟩ +-- instance tensor_CSA_is_CSA +-- [Algebra.IsCentral K A] [hA : IsSimpleRing A] +-- [Algebra.IsCentral K B] [hB: IsSimpleRing B] : +-- IsSimpleRing (A ⊗[K] B) := inferInstance + -- is_central := IsCentralSimple.TensorProduct.isCentral K A B hA.is_central hB.is_central + -- simple := IsCentralSimple.TensorProduct.simple K A B + +instance CSA_op_is_CSA [hA : Algebra.IsCentral K A] : Algebra.IsCentral K Aᵐᵒᵖ where + out z hz:= by + let z': A := z.unop + have hz' : ∀ (x : A), x * z' = z' * x := by + rw [Subalgebra.mem_center_iff] at hz + intro x; specialize hz (MulOpposite.op x) + have z'_eq : MulOpposite.op z'= z := rfl + rw [← z'_eq, ← MulOpposite.op_mul, ← MulOpposite.op_mul] at hz + have : (MulOpposite.op (z' * x)).unop = z' * x := rfl + simp_all only [MulOpposite.op_mul, MulOpposite.op_unop, MulOpposite.unop_mul, + MulOpposite.unop_op, z'] + obtain ⟨k, hk⟩ := hA.out <| Subalgebra.mem_center_iff.mpr hz' + exact ⟨k, MulOpposite.unop_inj.mp hk⟩ + -- is_simple := @op_simple A _ hA.is_simple + +-- instance [IsSimpleRing A] : IsSimpleRing Aᵐᵒᵖ := @op_simple A _ _ + +namespace tensor_self_op + +variable [Algebra.IsCentral K A] [hA : IsSimpleRing A] [FiniteDimensional K A] + +instance st : IsScalarTower K K (Module.End K A) where + smul_assoc k₁ k₂ f := DFunLike.ext _ _ fun a ↦ by + change (k₁ * k₂) • f a = k₁ • (k₂ • f a) + rw [mul_smul] +/-- The action map from `A ⊗ Aᵐᵒᵖ` to endomorphisms of `A`. -/ +def toEnd : A ⊗[K] Aᵐᵒᵖ →ₐ[K] Module.End K A := + Algebra.TensorProduct.lift + { toFun a := + { toFun x := a * x + map_add' := mul_add _ + map_smul' := by simp } + map_one' := by aesop + map_mul' := by intros; ext; simp [mul_assoc] + map_zero' := by aesop + map_add' := by intros; ext; simp [add_mul] + commutes' k := DFunLike.ext _ _ fun a ↦ show (algebraMap K A) k * a = k • _ from + (Algebra.smul_def _ _).symm } + { toFun a := + { toFun x := x * a.unop + map_add' := fun x y => by simp [add_mul] + map_smul' := by simp } + map_one' := by aesop + map_mul' := by intros; ext; simp [mul_assoc] + map_zero' := by aesop + map_add' := by intros; ext; simp [mul_add] + commutes' k := DFunLike.ext _ _ fun a ↦ + show a * (algebraMap K A) k = k • _ by + rw [Algebra.smul_def, Algebra.commutes] + rfl } + fun a a' => show _ = _ from DFunLike.ext _ _ fun x ↦ show a * (x * a'.unop) = a * x * a'.unop + from mul_assoc _ _ _ |>.symm + +-- instance : Algebra.IsCentral K Aᵐᵒᵖ := inferInstance -- CSA_op_is_CSA K A inferInstance +instance : FiniteDimensional K Aᵐᵒᵖ := LinearEquiv.finiteDimensional + (MulOpposite.opLinearEquiv K : A ≃ₗ[K] Aᵐᵒᵖ) + +instance fin_end : FiniteDimensional K (Module.End K A) := + LinearMap.finiteDimensional + +omit [Algebra.IsCentral K A] hA in +lemma dim_eq : + Module.finrank K (A ⊗[K] Aᵐᵒᵖ) = Module.finrank K (Module.End K A) := by + rw [Module.finrank_tensorProduct] + rw [show Module.finrank K (Module.End K A) = + Module.finrank K (Matrix (Fin <| Module.finrank K A) (Fin <| Module.finrank K A) K) from + (algEquivMatrix <| Module.finBasis _ _).toLinearEquiv.finrank_eq] + rw [Module.finrank_matrix, Fintype.card_fin] + rw [show Module.finrank K Aᵐᵒᵖ = Module.finrank K A from + (MulOpposite.opLinearEquiv K : A ≃ₗ[K] Aᵐᵒᵖ).symm.finrank_eq] + simp only [Module.finrank_self, mul_one] + +/-- The central simple algebra isomorphism `A ⊗ Aᵐᵒᵖ ≃ End_K(A)`. -/ +def equivEnd : A ⊗[K] Aᵐᵒᵖ ≃ₐ[K] Module.End K A := + AlgEquiv.ofBijective (toEnd K A) <| bijective_of_dim_eq_of_isCentralSimple _ _ _ _ <| + dim_eq K A + +end tensor_self_op + +open tensor_self_op in +/-- Identifies `A ⊗ Aᵐᵒᵖ` with a full matrix algebra over the base field. -/ +def tensor_self_op + [Algebra.IsCentral K A] [hA : IsSimpleRing A] [FiniteDimensional K A] : + A ⊗[K] Aᵐᵒᵖ ≃ₐ[K] + (Matrix (Fin <| Module.finrank K A) (Fin <| Module.finrank K A) K) := + equivEnd K A |>.trans <| algEquivMatrix <| Module.finBasis _ _ + +/-- Identifies `Aᵐᵒᵖ ⊗ A` with a full matrix algebra over the base field. -/ +def tensor_op_self + [Algebra.IsCentral K A] [hA : IsSimpleRing A] [FiniteDimensional K A] : + Aᵐᵒᵖ ⊗[K] A ≃ₐ[K] + (Matrix (Fin <| Module.finrank K A) (Fin <| Module.finrank K A) K) := + (Algebra.TensorProduct.comm _ _ _).trans <| tensor_self_op _ _ + +/- +## TODO: + 1. Define a Brauer equivalence relation on the set of All Central Simple + K-Algebras, namely A ~ B if A ≃ₐ[K] Mₙ(D) and B ≃ₐ[K] Mₘ(D) for some + m,n ∈ ℕ and D a division algebra over K. + 2. Prove the set of All Central Simple K-Algebras under this equivalence relation + forms a group with mul := ⊗[K] and inv A := Aᵒᵖ. + +-/ + +variable {K : Type u} [Field K] + +namespace IsBrauerEquivalent + +/-- Reindexes matrices over `Fin n × Fin m` as matrices over `Fin (n * m)`. -/ +def matrix_eqv' (n m : ℕ) (A : Type*) [Ring A] [Algebra K A] : + (Matrix (Fin n × Fin m) (Fin n × Fin m) A) ≃ₐ[K] Matrix (Fin (n * m)) (Fin (n * m)) A := +{ Matrix.reindexLinearEquiv K A finProdFinEquiv finProdFinEquiv with + toFun := Matrix.reindex finProdFinEquiv finProdFinEquiv + map_mul' := fun m n ↦ by simp only [Matrix.reindex_apply, Matrix.submatrix_mul_equiv] + commutes' := fun k ↦ by + ext i j + simp only [Matrix.reindex_apply, Matrix.submatrix_apply, finProdFinEquiv_symm_apply, + Matrix.algebraMap_matrix_apply, Prod.mk.injEq] + if h : i = j then aesop + else + simp only [h, ↓reduceIte, ite_eq_right_iff, and_imp] + intro h1 h2 + have : i = j := by + have : (⟨i.divNat, i.modNat⟩ : Fin n × Fin m) = ⟨j.divNat, j.modNat⟩ := Prod.ext h1 h2 + apply_fun finProdFinEquiv at this + rw [show ⟨i.divNat, i.modNat⟩ = finProdFinEquiv.symm i by rfl, + show ⟨j.divNat, _⟩ = finProdFinEquiv.symm j by rfl, + finProdFinEquiv.apply_symm_apply, finProdFinEquiv.apply_symm_apply] at this + exact this + tauto +} + +lemma iso_to_eqv (A B : CSA K) (h : A ≃ₐ[K] B) : IsBrauerEquivalent A B := + ⟨1, 1, one_ne_zero, one_ne_zero, ⟨h.mapMatrix (m := (Fin 1))⟩⟩ + +theorem Braur_is_eqv : Equivalence (IsBrauerEquivalent (K := K)) where + refl := refl + symm := symm + trans := trans + +end IsBrauerEquivalent + +namespace BrauerGroup + +/-- The setoid on central simple algebras generated by Brauer equivalence. -/ +@[implicit_reducible] +def CSA_Setoid : Setoid (CSA K) where + r := IsBrauerEquivalent + iseqv := IsBrauerEquivalent.Braur_is_eqv + +/-- Tensor-product multiplication on representatives of the Brauer group. -/ +def mul (A B : CSA K) : CSA K where + toAlgCat := .of K (A ⊗[K] B) + fin_dim := Module.Finite.tensorProduct K A B + +/-- Finite-dimensionality is preserved by passing to the opposite algebra. -/ +@[implicit_reducible] +def is_fin_dim_of_mop (A : Type*) [Ring A] [Algebra K A] [FiniteDimensional K A] : + FiniteDimensional K Aᵐᵒᵖ := by + have f:= MulOpposite.opLinearEquiv K (M:= A) + exact Module.Finite.equiv f + -- Module.Finite.of_surjective f (LinearEquiv.surjective _) + +/-- The opposite algebra representative used for inversion in the Brauer group. -/ +def inv (A : CSA K) : CSA K := { + __ := AlgCat.of K Aᵐᵒᵖ + fin_dim := is_fin_dim_of_mop A } + +/-- The matrix algebra representative of the identity Brauer class. -/ +def one_in (n : ℕ) [hn : NeZero n] : CSA K := ⟨.of K (Matrix (Fin n) (Fin n) K)⟩ + +/-- The base field representative of the identity Brauer class. -/ +def one_in' : CSA K := ⟨.of K K⟩ + +/-- Right tensoring by an identity matrix algebra representative. -/ +def one_mul_in (n : ℕ) [hn : NeZero n] (A : CSA K) : CSA K := + ⟨.of K (A ⊗[K] (Matrix (Fin n) (Fin n) K))⟩ + +/-- Left tensoring by an identity matrix algebra representative. -/ +def mul_one_in (n : ℕ) [hn : NeZero n] (A : CSA K) : CSA K := + ⟨.of K ((Matrix (Fin n) (Fin n) K) ⊗[K] A)⟩ + +/-- Transports a central simple algebra structure across an algebra equivalence. -/ +def eqv_in (A : CSA K) (A' : Type*) [Ring A'] [Algebra K A'] (e : A ≃ₐ[K] A') : CSA K where + toAlgCat := .of K A' + isCentral := AlgEquiv.isCentral e + isSimple := ⟨TwoSidedIdeal.orderIsoOfRingEquiv e.toRingEquiv.symm |>.isSimpleOrder⟩ + fin_dim := LinearEquiv.finiteDimensional e.toLinearEquiv + +/-- The representative obtained by replacing `A ⊗ Mₙ(K)` with `Mₙ(A)`. -/ +def matrix_A (n : ℕ) [hn : NeZero n] (A : CSA K) : CSA K := + eqv_in (one_mul_in n A) (Matrix (Fin n) (Fin n) A) <| + by unfold one_mul_in; exact matrixEquivTensor _ K A |>.symm + +/-- The standard scalar action on `1 × 1` matrices. -/ +@[implicit_reducible] +def dim_1 (R : Type*) [Ring R] [Algebra K R] : Algebra K (Matrix (Fin 1) (Fin 1) R) where + algebraMap.toFun k := Matrix.diagonal fun _ => Algebra.ofId K R k + algebraMap.map_one' := by simp only [map_one, Matrix.diagonal_one] + algebraMap.map_mul' := by simp only [map_mul, Matrix.diagonal_mul_diagonal, implies_true] + algebraMap.map_zero' := by simp only [map_zero, Matrix.diagonal_zero] + algebraMap.map_add' := by simp only [map_add, Matrix.diagonal_add, implies_true] + commutes' r m := by ext i j; fin_cases i; fin_cases j; simp only [RingHom.coe_mk, + MonoidHom.coe_mk, OneHom.coe_mk, Fin.zero_eta, Fin.isValue, Matrix.diagonal_mul, + Matrix.mul_diagonal]; exact Algebra.commutes r (m 0 0) + smul_def' r m := by ext i j; fin_cases i; fin_cases j; simp only [Fin.zero_eta, Fin.isValue, + Matrix.smul_apply, RingHom.coe_mk, MonoidHom.coe_mk, OneHom.coe_mk, Matrix.diagonal_mul, + Algebra.smul_def]; rfl + +/-- The algebra equivalence between `1 × 1` matrices and the coefficient algebra. -/ +def dim_one_iso (R : Type*) [Ring R] [Algebra K R] : (Matrix (Fin 1) (Fin 1) R) ≃ₐ[K] R where + toFun m := m 0 0 + invFun r := Matrix.diagonal fun _ => r + left_inv m := by ext i j; fin_cases i; fin_cases j; simp only [Fin.isValue, Fin.zero_eta, + Matrix.diagonal_apply_eq] + right_inv r := by simp only [Fin.isValue, Matrix.diagonal_apply_eq] + map_mul' m n := by + simp only [Fin.isValue, Matrix.mul_apply] + exact Fin.sum_univ_one fun i ↦ m 0 i * n i 0 + map_add' m n := by simp only [Fin.isValue, Matrix.add_apply] + commutes' r := by + simp only [Fin.isValue, Algebra.algebraMap_eq_smul_one'] + rw [Matrix.smul_apply]; rfl + +open IsBrauerEquivalent + +theorem eqv_mat (A : CSA K) (n : ℕ) [hn : NeZero n] : IsBrauerEquivalent A (matrix_A n A) := by + refine ⟨n, 1, hn.1, one_ne_zero, ?_⟩ + unfold matrix_A one_mul_in eqv_in + exact ⟨dim_one_iso _ |>.symm⟩ + +/-- The Kronecker product algebra homomorphism on square matrices. -/ +def matrixEquivForward (m n : Type*) [Fintype m] [Fintype n] [DecidableEq m] [DecidableEq n] : + Matrix m m K ⊗[K] Matrix n n K →ₐ[K] Matrix (m × n) (m × n) K := + Algebra.TensorProduct.algHomOfLinearMapTensorProduct + (TensorProduct.lift Matrix.kroneckerBilinear) + (fun _ _ _ _ => Matrix.mul_kronecker_mul _ _ _ _) + (Matrix.one_kronecker_one (α := K)) + +open scoped Kronecker in +lemma matrixEquivForward_tmul (m n : Type*) [Fintype m] [Fintype n] [DecidableEq m] [DecidableEq n] + (M : Matrix m m K) (N : Matrix n n K) : matrixEquivForward m n (M ⊗ₜ N) = M ⊗ₖ N := rfl + +lemma matrixEquivForward_surjective + (n m : Type*) [Fintype m] [Fintype n] [DecidableEq m] [DecidableEq n] : + Function.Surjective <| matrixEquivForward (K := K) m n := by + intro x + rw [Matrix.matrix_eq_sum_single x] + suffices H : + ∀ (i j : m × n), ∃ a, (matrixEquivForward m n) a = Matrix.single i j (x i j) by + choose a ha using H + use ∑ i : m × n, ∑ j : m × n, a i j + rw [map_sum] + simp_rw [map_sum] + simp_rw [ha] + intro i j + rw [show Matrix.single i j (x i j) = (x i j) • Matrix.single i j 1 by + rw [Matrix.smul_single, Algebra.smul_def, mul_one] + rfl] + use (x i j) • ((Matrix.single i.1 j.1 1) ⊗ₜ (Matrix.single i.2 j.2 1)) + rw [_root_.map_smul (f := (matrixEquivForward (K := K) m n)) (x i j)] + congr 1 + simp only [matrixEquivForward, Algebra.TensorProduct.algHomOfLinearMapTensorProduct_apply, + TensorProduct.lift.tmul] + ext a b + erw [Matrix.kroneckerMapBilinear_apply_apply] + erw [Matrix.kroneckerMap_apply] + erw [Algebra.coe_lmul_eq_mul] + rw [LinearMap.mul] + simp only [LinearMap.mk₂_apply] + simp only [Matrix.single, Matrix.of_apply, mul_ite, mul_one, mul_zero] + split_ifs with h1 h2 h3 h4 h5 + · rfl + · simp only [not_and, ne_eq] at h3 + refine h3 ?_ ?_ |>.elim <;> ext <;> aesop + · simp only [not_and] at h2 + refine h2 ?_ ?_ |>.elim <;> aesop + · rfl + · simp only [not_and] at h1 + refine h1 ?_ ?_ |>.elim <;> aesop + · rfl + +/-- The tensor product of matrix algebras is a matrix algebra on the product index type. -/ +def matrix_eqv (m n : ℕ) : (Matrix (Fin m) (Fin m) K) ⊗[K] (Matrix (Fin n) (Fin n) K) ≃ₐ[K] + Matrix (Fin m × Fin n) (Fin m × Fin n) K := + .ofBijective (matrixEquivForward (Fin m) (Fin n)) <| by + if h : n = 0 ∨ m = 0 + then + rcases h with h|h <;> + subst h <;> + refine ⟨?_, matrixEquivForward_surjective _ _⟩ <;> + intro x y _ <;> + apply Subsingleton.elim + else + have : Nonempty (Fin n) := ⟨0, by omega⟩ + have : Nonempty (Fin m) := ⟨0, by omega⟩ + apply bijective_of_surj_of_isCentralSimple + apply matrixEquivForward_surjective + +lemma one_mul (n : ℕ) [hn : NeZero n] (A : CSA K) : + IsBrauerEquivalent A (one_mul_in n A) := + ⟨n, 1, hn.1, one_ne_zero, ⟨.symm <| (dim_one_iso _).trans <| matrixEquivTensor _ _ _ |>.symm⟩⟩ + +lemma mul_one (n : ℕ) [hn : NeZero n] (A : CSA K) : + IsBrauerEquivalent A (mul_one_in n A) := + ⟨n, 1, hn.1, one_ne_zero, ⟨.symm <| (dim_one_iso _).trans <| .symm <| + matrixEquivTensor _ _ _ |>.trans <| Algebra.TensorProduct.comm _ _ _⟩⟩ + +lemma mul_assoc (A B C : CSA K) : + IsBrauerEquivalent (mul (mul A B) C) (mul A (mul B C)) := + IsBrauerEquivalent.iso_to_eqv (K := K) _ _ <| Algebra.TensorProduct.assoc .. + +/-- Kronecker-style equivalence for tensor products of matrix algebras over two algebras. -/ +def kroneckerMatrixTensor' (A B : Type*) [Ring A] [Ring B] [Algebra K A] [Algebra K B] (n m : ℕ) : + (Matrix (Fin n) (Fin n) A) ⊗[K] (Matrix (Fin m) (Fin m) B) ≃ₐ[K] + (Matrix (Fin (n*m)) (Fin (n*m)) (A ⊗[K] B)) := + .trans (Algebra.TensorProduct.congr (matrixEquivTensor (Fin n) K A) <| + matrixEquivTensor (Fin m) K B) <| (Algebra.TensorProduct.tensorTensorTensorComm ..).trans <| + .trans + (Algebra.TensorProduct.congr .refl <| (matrix_eqv ..).trans <| matrix_eqv' ..) + (matrixEquivTensor ..).symm + +theorem eqv_tensor_eqv + (A B C D : CSA K) (hAB : IsBrauerEquivalent A B) (hCD : IsBrauerEquivalent C D) : + IsBrauerEquivalent (mul A C) (mul B D) := by + obtain ⟨n, m, hn, hm, ⟨e1⟩⟩ := hAB + obtain ⟨p, q, hp, hq, ⟨e2⟩⟩ := hCD + exact ⟨n * p, m * q, by simp_all, by simp_all, ⟨ + (kroneckerMatrixTensor' (K := K) A C n p).symm.trans <| + (Algebra.TensorProduct.congr e1 e2).trans <| + kroneckerMatrixTensor' (K := K) B D m q⟩⟩ + +instance Mul : Mul <| BrauerGroup (K := K) := + ⟨Quotient.lift₂ (fun A B ↦ Quotient.mk (CSA_Setoid) <| BrauerGroup.mul A B) + (by + simp only [Quotient.eq] + intro A B C D hAB hCD + simpa [CSA_Setoid] using (eqv_tensor_eqv A C B D hAB hCD))⟩ + +instance One : One (BrauerGroup (K := K)) := ⟨Quotient.mk (CSA_Setoid) one_in'⟩ + +theorem mul_assoc' (A B C : BrauerGroup (K := K)) : A * B * C = A * (B * C) := by + induction A using Quotient.inductionOn' with | h A + induction B using Quotient.inductionOn' with | h B + induction C using Quotient.inductionOn' with | h C + apply Quotient.sound; exact mul_assoc _ _ _ + +lemma mul_inv (A : CSA.{u, u} K) : IsBrauerEquivalent (mul A (inv (K := K) A)) one_in' := by + unfold mul inv one_in' + let n := Module.finrank K A + have hn : NeZero n := by + constructor + by_contra! hn + simp only [n] at hn + have := Module.finrank_pos_iff (R := K) (M := A) |>.2 inferInstance + omega + have := tensor_self_op K A + exact ⟨1, n, one_ne_zero, hn.1, ⟨dim_one_iso _|>.trans this⟩⟩ + +lemma inv_mul (A : CSA.{u, u} K) : IsBrauerEquivalent (mul (inv (K := K) A) A) one_in' := by + unfold mul inv one_in' + let n := Module.finrank K A + have hn : NeZero n := by + constructor + by_contra! hn + simp only [n] at hn + have := Module.finrank_pos_iff (R := K) (M := A) |>.2 inferInstance + omega + have := tensor_op_self K A + exact ⟨1, n, one_ne_zero, hn.1, ⟨dim_one_iso _|>.trans this⟩⟩ + +variable (K R : Type*) [CommSemiring K] [Semiring R] [Algebra K R] in +open Matrix MulOpposite in +/-- Mn(Rᵒᵖ) ≃ₐ[K] Mₙ(R)ᵒᵖ -/ +def matrixEquivMatrixMop_algebra (n : ℕ) : + Matrix (Fin n) (Fin n) Rᵐᵒᵖ ≃ₐ[K] (Matrix (Fin n) (Fin n) R)ᵐᵒᵖ where + toFun M := op (M.transpose.map (fun d => d.unop)) + invFun M := M.unop.transpose.map (fun d => op d) + left_inv a := by aesop + right_inv a := by aesop + map_mul' x y := unop_injective <| by ext; simp [transpose_map, transpose_apply, mul_apply] + map_add' x y := by aesop + commutes' k := by + simp only [MulOpposite.algebraMap_apply, op_inj]; ext i j + simp only [map_apply, transpose_apply, algebraMap_matrix_apply] + if h : i = j then simp only [h, ↓reduceIte, MulOpposite.algebraMap_apply, unop_op] + else simp only [MulOpposite.algebraMap_apply, h, ↓reduceIte, unop_eq_zero_iff, ite_eq_right_iff, + op_eq_zero_iff]; tauto + +lemma inv_eqv (A B : CSA K) (hAB : IsBrauerEquivalent A B) : + IsBrauerEquivalent (inv (K := K) A) (inv (K := K) B) := by + unfold inv + obtain ⟨n, m, hn, hm, ⟨iso⟩⟩ := hAB + refine ⟨n, m, hn, hm, ⟨(matrixEquivMatrixMop_algebra _ _ _).trans <| + (AlgEquiv.op iso).trans (matrixEquivMatrixMop_algebra _ _ _).symm⟩⟩ + +instance Inv : Inv (BrauerGroup (K := K)) where + inv := Quotient.lift (fun A ↦ Quotient.mk (CSA_Setoid) <| inv A) fun A B hAB ↦ by + change IsBrauerEquivalent _ _ at hAB + exact Quotient.sound (inv_eqv (K := K) A B hAB) + +theorem mul_left_inv' (A : BrauerGroup (K := K)) : A⁻¹ * A = 1 := by + induction A using Quotient.inductionOn' with | h A + change _ = Quotient.mk'' one_in' + apply Quotient.sound; exact inv_mul A + +theorem one_mul' (A : BrauerGroup (K := K)) : 1 * A = A := by + induction A using Quotient.inductionOn' with | h A + change Quotient.mk'' one_in' * _ = _; apply Quotient.sound + exact iso_to_eqv _ _ (Algebra.TensorProduct.lid K A) + +theorem mul_one' (A : BrauerGroup (K := K)) : A * 1 = A := by + induction A using Quotient.inductionOn' with | h A + change _ * Quotient.mk'' one_in' = _; apply Quotient.sound + exact iso_to_eqv _ _ (Algebra.TensorProduct.rid K K A) + +instance Bruaer_Group : Group (BrauerGroup (K := K)) where + mul_assoc := mul_assoc' + one_mul := one_mul' + mul_one := mul_one' + inv_mul_cancel := mul_left_inv' + +lemma Alg_closed_equiv_one [IsAlgClosed K] : ∀(A : CSA K), IsBrauerEquivalent A one_in' := by + intro A + obtain ⟨n, hn, ⟨iso⟩⟩ := simple_eq_matrix_algClosed K A + exact ⟨1, n, one_ne_zero, hn, ⟨dim_one_iso A|>.trans iso⟩⟩ + +lemma Alg_closed_eq_one [IsAlgClosed K] : ∀(A : BrauerGroup (K := K)), A = 1 := by + intro A; induction A using Quotient.inductionOn' with | h A + change _ = Quotient.mk'' one_in'; apply Quotient.sound + change IsBrauerEquivalent _ _; exact Alg_closed_equiv_one A + +instance [IsAlgClosed K] : Unique (BrauerGroup (K := K)) where + default := 1 + uniq := Alg_closed_eq_one + +theorem Alg_closed_Brauer_trivial [IsAlgClosed K] : (⊤ : Subgroup (BrauerGroup K)) = + (⊥ : Subgroup <| BrauerGroup (K := K)) := + Subgroup.ext fun _ ↦ ⟨fun _ ↦ Alg_closed_eq_one _, fun _ ↦ ⟨⟩⟩ + +end BrauerGroup + +namespace BrauerGroupHom + +open BrauerGroup +variable {E : Type u} [Field E] [Algebra K E] + +namespace someEquivs + +variable (A B : Type u) [Ring A] [Algebra K A] [Ring B] [Algebra K B] +variable (m : ℕ) + +/-- The linear equivalence underlying compatibility of scalar extension with tensor products. -/ +def baseChangeTensorLinear : + (E ⊗[K] A) ⊗[E] (E ⊗[K] B) ≃ₗ[E] E ⊗[K] (A ⊗[K] B) := + TensorProduct.AlgebraTensorModule.cancelBaseChange K E E (E ⊗[K] A) B ≪≫ₗ + (Algebra.TensorProduct.assoc K K E E A B).toLinearEquiv + +/-- Evaluates the scalar-extension tensor compatibility equivalence on pure tensors. -/ +theorem baseChangeTensorLinear_tmul (e e' : E) (a : A) (b : B) : + baseChangeTensorLinear (K := K) (E := E) A B ((e ⊗ₜ[K] a) ⊗ₜ[E] (e' ⊗ₜ[K] b)) = + (e * e') ⊗ₜ[K] (a ⊗ₜ[K] b) := by + simp [baseChangeTensorLinear, Algebra.smul_def, mul_comm] + +/-- Scalar extension is compatible with tensor products of algebras. -/ +def baseChangeTensorEquiv : + (E ⊗[K] A) ⊗[E] (E ⊗[K] B) ≃ₐ[E] E ⊗[K] (A ⊗[K] B) := + AlgEquiv.ofLinearEquiv (baseChangeTensorLinear (K := K) (E := E) A B) + (by simp [baseChangeTensorLinear, Algebra.TensorProduct.one_def]) + (by + let f := baseChangeTensorLinear (K := K) (E := E) A B + apply LinearMap.map_mul_of_map_mul_tmul + intro x1 x2 y1 y2 + change f ((x1 * x2) ⊗ₜ[E] (y1 * y2)) = f (x1 ⊗ₜ[E] y1) * f (x2 ⊗ₜ[E] y2) + induction x1 using TensorProduct.induction_on with + | zero => + simp only [zero_mul, TensorProduct.zero_tmul, f.map_zero] + | add x1 x1' hx hx' => + simp only [add_mul, TensorProduct.add_tmul, f.map_add, hx, hx', add_mul] + | tmul e1 a1 => + induction x2 using TensorProduct.induction_on with + | zero => + simp only [mul_zero, TensorProduct.zero_tmul, f.map_zero] + | add x2 x2' hx hx' => + simp only [mul_add, TensorProduct.add_tmul, f.map_add, hx, hx', mul_add] + | tmul e2 a2 => + induction y1 using TensorProduct.induction_on with + | zero => + simp only [zero_mul, TensorProduct.tmul_zero, f.map_zero] + | add y1 y1' hy hy' => + simp only [add_mul, TensorProduct.tmul_add, f.map_add, hy, hy', add_mul] + | tmul e3 b1 => + induction y2 using TensorProduct.induction_on with + | zero => + simp only [mul_zero, TensorProduct.tmul_zero, f.map_zero] + | add y2 y2' hy hy' => + simp only [mul_add, TensorProduct.tmul_add, f.map_add, hy, hy', mul_add] + | tmul e4 b2 => + rw [Algebra.TensorProduct.tmul_mul_tmul, Algebra.TensorProduct.tmul_mul_tmul] + rw [show f (((e1 * e2) ⊗ₜ[K] (a1 * a2)) ⊗ₜ[E] + ((e3 * e4) ⊗ₜ[K] (b1 * b2))) = + ((e1 * e2) * (e3 * e4)) ⊗ₜ[K] ((a1 * a2) ⊗ₜ[K] (b1 * b2)) from + baseChangeTensorLinear_tmul (K := K) (E := E) A B (e1 * e2) (e3 * e4) + (a1 * a2) (b1 * b2)] + rw [show f ((e1 ⊗ₜ[K] a1) ⊗ₜ[E] (e3 ⊗ₜ[K] b1)) = + (e1 * e3) ⊗ₜ[K] (a1 ⊗ₜ[K] b1) from + baseChangeTensorLinear_tmul (K := K) (E := E) A B e1 e3 a1 b1] + rw [show f ((e2 ⊗ₜ[K] a2) ⊗ₜ[E] (e4 ⊗ₜ[K] b2)) = + (e2 * e4) ⊗ₜ[K] (a2 ⊗ₜ[K] b2) from + baseChangeTensorLinear_tmul (K := K) (E := E) A B e2 e4 a2 b2] + rw [Algebra.TensorProduct.tmul_mul_tmul, Algebra.TensorProduct.tmul_mul_tmul] + ring_nf) + +/-- Rewrites matrices over a scalar extension as a tensor product with matrices over the +extension. -/ +def e1 : Matrix (Fin m) (Fin m) (E ⊗[K] A) ≃ₐ[E] (E ⊗[K] A) ⊗[E] Matrix (Fin m) (Fin m) E := + matrixEquivTensor (Fin m) E (E ⊗[K] A) + +/-- Replaces matrices over the extension field by scalar extension of matrices over `K`. -/ +def e2 : + (E ⊗[K] A) ⊗[E] Matrix (Fin m) (Fin m) E ≃ₐ[E] + (E ⊗[K] A) ⊗[E] (E ⊗[K] Matrix (Fin m) (Fin m) K) := + Algebra.TensorProduct.congr .refl <| + { __ := matrixEquivTensor (Fin m) K E + commutes' e := by + simp only [AlgEquiv.toEquiv_eq_coe, Equiv.toFun_as_coe, EquivLike.coe_coe, + matrixEquivTensor_apply, Fintype.sum_prod_type, + Algebra.TensorProduct.algebraMap_apply, Algebra.algebraMap_self, RingHom.id_apply] + simp_rw [Matrix.algebraMap_eq_diagonal] + simp_rw [Matrix.diagonal_apply] + simp only [Pi.algebraMap_apply, Algebra.algebraMap_self, RingHom.id_apply] + rw [show + ∑ x : Fin m, ∑ y : Fin m, + (if x = y then e else 0) ⊗ₜ[K] Matrix.single x y (1 : K) = + ∑ x : Fin m, e ⊗ₜ[K] Matrix.single x x 1 by + refine Finset.sum_congr rfl fun x _ => ?_ + rw [show e ⊗ₜ[K] Matrix.single x x (1 : K) = + (if x = x then e else 0) ⊗ₜ Matrix.single x x (1 : K) by aesop] + apply Finset.sum_eq_single + · aesop + · aesop] + rw [← TensorProduct.tmul_sum] + congr 1 + ext i j + rw [Matrix.sum_apply] + by_cases h : i = j + · subst h; simp [Matrix.single] + · rw [Matrix.one_apply_ne h] + apply Finset.sum_eq_zero + intros k + simp only [Finset.mem_univ, Matrix.single, Matrix.of_apply, ite_eq_right_iff, + one_ne_zero, imp_false, not_and, forall_const] + rintro rfl + exact h } + +/-- Reassociates a tensor product after base change along `K → E`. -/ +def e3 : + (E ⊗[K] A) ⊗[E] (E ⊗[K] Matrix (Fin m) (Fin m) K) ≃ₐ[E] + E ⊗[K] (A ⊗[K] Matrix (Fin m) (Fin m) K) := + baseChangeTensorEquiv A (Matrix (Fin m) (Fin m) K) + +/-- Applies the matrix-tensor equivalence inside a scalar extension. -/ +def e4 : + E ⊗[K] (A ⊗[K] Matrix (Fin m) (Fin m) K) ≃ₐ[E] + E ⊗[K] (Matrix (Fin m) (Fin m) A) := + Algebra.TensorProduct.congr AlgEquiv.refl <| (matrixEquivTensor (Fin m) K A).symm + +/-- Extends an algebra equivalence by scalars from `K` to `E`. -/ +def e5 (e : A ≃ₐ[K] B) : (E ⊗[K] A) ≃ₐ[E] (E ⊗[K] B) := + Algebra.TensorProduct.congr AlgEquiv.refl e + +/-- Scalar extension is compatible with tensor products of algebras. -/ +def e6 : + (E ⊗[K] A) ⊗[E] (E ⊗[K] B) ≃ₐ[E] E ⊗[K] (A ⊗[K] B) := + baseChangeTensorEquiv A B + +/-- The base field scalar extension `E ⊗[K] K` is equivalent to `E`. -/ +def e7 : E ≃ₐ[E] (E ⊗[K] K) := .symm <| Algebra.TensorProduct.rid _ _ _ + +end someEquivs + +section Q_to_C + +/-- The Brauer group homomorphism induced by scalar extension from `K` to `E`. -/ +abbrev BaseChange : BrauerGroup (K := K) →* BrauerGroup (K := E) where + toFun := + Quotient.map' + (fun A => + { __ := AlgCat.of E (E ⊗[K] A) + fin_dim := inferInstance }) fun A B ⟨m, n, hm, hn, ⟨e⟩⟩ => + ⟨m, n, hm, hn, ⟨(someEquivs.e1 A m).trans <| (someEquivs.e2 A m).trans <| + (someEquivs.e3 A m).trans <| (someEquivs.e4 A m).trans <| AlgEquiv.symm <| + (someEquivs.e1 B n).trans <| (someEquivs.e2 B n).trans <| + (someEquivs.e3 B n).trans <| (someEquivs.e4 B n).trans <| someEquivs.e5 _ _ e.symm⟩⟩ + map_one' := by + erw [Quotient.eq''] + exact ⟨1, 1, one_ne_zero, one_ne_zero, + ⟨(dim_one_iso (K := E) (E ⊗[K] K)).trans <| + (someEquivs.e7 (K := K) (E := E)).symm.trans <| + (dim_one_iso (K := E) E).symm⟩⟩ + map_mul' := by + intro x y + induction x using Quotient.inductionOn' with | h A + induction y using Quotient.inductionOn' with | h B + simp only [Quotient.map'_mk''] + erw [Quotient.map'_mk''] + erw [Quotient.eq''] + change IsBrauerEquivalent ⟨.of E (E ⊗[K] (A ⊗[K] B))⟩ _ + exact ⟨1, 1, one_ne_zero, one_ne_zero, + ⟨(dim_one_iso _).trans <| .symm <| (dim_one_iso _).trans <| someEquivs.e6 A B⟩⟩ + +/-- The scalar extension homomorphism from the rational Brauer group to the complex Brauer group. -/ +abbrev BaseChange_Q_to_C := BaseChange (K := ℚ) (E := ℂ) + +lemma BaseChange_Q_to_C_eq_one : BaseChange_Q_to_C = 1 := by + haveI : IsAlgClosed ℂ := Complex.isAlgClosed + ext A; simp only [MonoidHom.coe_mk, OneHom.coe_mk, MonoidHom.one_apply] + induction A using Quotient.inductionOn' with | h A; + simp only [Quotient.map'_mk'']; apply Quotient.sound + exact BrauerGroup.Alg_closed_equiv_one _ + +instance IsAbelBrauer : CommGroup (BrauerGroup (K := K)) where + __ := BrauerGroup.Bruaer_Group + mul_comm A B := by + induction A using Quotient.inductionOn' with | h A + induction B using Quotient.inductionOn' with | h B + apply Quotient.sound' + exact ⟨1, 1, one_ne_zero, one_ne_zero, ⟨.mapMatrix <| Algebra.TensorProduct.comm ..⟩⟩ + +open CategoryTheory + +namespace baseChange_idem + +/-- The linear equivalence comparing two-step and one-step scalar extension. -/ +@[simps!] +def Aux (F K E : Type u) [Field F] [Field K] [Field E] + [Algebra F K] [Algebra F E] [Algebra K E] [IsScalarTower F K E] (A : CSA F) : + E ⊗[K] (K ⊗[F] A) ≃ₗ[E] (E ⊗[F] A.carrier) := + have : SMulCommClass F K E := + { smul_comm := fun a b c => by + rw [Algebra.smul_def, Algebra.smul_def, ← _root_.mul_assoc, mul_comm (algebraMap _ _ a), + Algebra.smul_def, Algebra.smul_def, _root_.mul_assoc] } + (TensorProduct.AlgebraTensorModule.assoc F K E E K A).symm ≪≫ₗ + TensorProduct.AlgebraTensorModule.congr + (TensorProduct.AlgebraTensorModule.rid _ _ _) (LinearEquiv.refl _ _) + +/-- The algebra equivalence comparing two-step and one-step scalar extension. -/ +def Aux' (F K E : Type u) [Field F] [Field K] [Field E] + [Algebra F K] [Algebra F E] [Algebra K E] [IsScalarTower F K E] (A : CSA F) : + E ⊗[K] (K ⊗[F] A) ≃ₐ[E] (E ⊗[F] A.carrier) := by + have : SMulCommClass F K E := + { smul_comm := fun a b c => by + rw [Algebra.smul_def, Algebra.smul_def, ← _root_.mul_assoc, mul_comm (algebraMap _ _ a), + Algebra.smul_def, Algebra.smul_def, _root_.mul_assoc] } + refine .ofLinearEquiv (Aux F K E A) ?_ fun x y ↦ ?_ + · simp [Algebra.TensorProduct.one_def] + induction x using TensorProduct.induction_on with + | zero => rw [zero_mul, (baseChange_idem.Aux F K E A).map_zero, zero_mul] + | add => simp only [add_mul, (Aux F K E A).map_add, *] + | tmul => + induction y using TensorProduct.induction_on with + | zero => rw [mul_zero, (baseChange_idem.Aux F K E A).map_zero, mul_zero] + | add => simp only [mul_add, (Aux F K E A).map_add, *] + | tmul => + rename_i x1 y1 x2 y2 + simp only [Aux, Algebra.TensorProduct.tmul_mul_tmul, LinearEquiv.trans_apply] + set f := (TensorProduct.AlgebraTensorModule.congr + (TensorProduct.AlgebraTensorModule.rid K E E) (LinearEquiv.refl F A)) + set g := (TensorProduct.AlgebraTensorModule.assoc F K E E K A.carrier).symm + change f (g _) = _ + induction y1 using TensorProduct.induction_on with + | zero => + rw [zero_mul, TensorProduct.tmul_zero, g.map_zero, f.map_zero, TensorProduct.tmul_zero, + g.map_zero, f.map_zero, zero_mul] + | add => simp only [add_mul, TensorProduct.tmul_add, g.map_add, f.map_add, *] + | tmul k1 a1 => + induction y2 using TensorProduct.induction_on with + | zero => + rw [mul_zero, TensorProduct.tmul_zero, TensorProduct.tmul_zero, g.map_zero, f.map_zero, + mul_zero] + | add => simp only [mul_add, TensorProduct.tmul_add, g.map_add, f.map_add, *] + | tmul k2 a2 => + simp only [Algebra.TensorProduct.tmul_mul_tmul, *] + -- rw [mul_comm] + simp only [TensorProduct.AlgebraTensorModule.assoc_symm_tmul, + TensorProduct.AlgebraTensorModule.congr_tmul, TensorProduct.AlgebraTensorModule.rid_tmul, + LinearEquiv.refl_apply, Algebra.TensorProduct.tmul_mul_tmul, Algebra.mul_smul_comm, + Algebra.smul_mul_assoc, f, g] + congr 1 + rw [mul_comm k1 k2] + exact mul_smul k2 k1 (x1 * x2) + +end baseChange_idem + +lemma baseChange_idem (F K E : Type u) [Field F] [Field K] [Field E] + [Algebra F K] [Algebra F E] [Algebra K E] [IsScalarTower F K E] : + BrauerGroupHom.BaseChange (K := F) (E := E) = + (BrauerGroupHom.BaseChange (K := K) (E := E)).comp + BrauerGroupHom.BaseChange := by + ext A + simp only [MonoidHom.coe_mk, OneHom.coe_mk, MonoidHom.coe_comp, Function.comp_apply] + induction A using Quotient.inductionOn' with | h A + simp only [Quotient.map'_mk'', Quotient.eq''] + exact ⟨1, 1, one_ne_zero, one_ne_zero, ⟨.mapMatrix <| .symm <| baseChange_idem.Aux' ..⟩⟩ + +/-- The Brauer group functor from fields to commutative groups. -/ +def Br : FieldCat ⥤ CommGrpCat where + obj F := .of <| BrauerGroup F + map {F K} f := CommGrpCat.ofHom <| @BrauerGroupHom.BaseChange F _ K _ (RingHom.toAlgebra f.hom) + map_id F := by + ext A + simp only [CommGrpCat.coe_of] + induction A using Quotient.inductionOn' with | h A + simp only [CommGrpCat.hom_ofHom, MonoidHom.coe_mk, OneHom.coe_mk, + Quotient.map'_mk'', CommGrpCat.hom_id, MonoidHom.id_apply, Quotient.eq] + change IsBrauerEquivalent _ _ + exact ⟨1, 1, one_ne_zero, one_ne_zero, ⟨AlgEquiv.mapMatrix <| Algebra.TensorProduct.lid _ _⟩⟩ + map_comp {F K E} f g := by + simp only [← CommGrpCat.ofHom_comp] + congr 1 + apply (config := { allowSynthFailures := true }) baseChange_idem + letI : Algebra F E := RingHom.toAlgebra (f ≫ g).hom + letI : Algebra F K := RingHom.toAlgebra f.hom + letI : Algebra K E := RingHom.toAlgebra g.hom + exact IsScalarTower.of_algebraMap_smul (R := F) (A := K) (M := E) fun r ↦ congrFun rfl + +end Q_to_C + +end BrauerGroupHom diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index 40bf9e5a27..1a0904445c 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -463,10 +463,14 @@ projects: github_repo: Whysoserioushah/BrauerGroup_new status: verified main_declarations: + - BrauerGroup.Bruaer_Group + - BrauerGroupHom.Br - Wedderburn_Artin - - IsCentralSimple.TensorProduct.simple - - CSA_implies_CSA main_results: + - declaration: BrauerGroup.Bruaer_Group + informal: Constructs the Brauer group of a field from Brauer equivalence classes of central simple algebras. + - declaration: BrauerGroupHom.Br + informal: Constructs the Brauer group functor from fields to commutative groups via scalar extension. - declaration: Wedderburn_Artin informal: Proves a Wedderburn-Artin decomposition for simple Artinian rings as matrix algebras over division rings. - declaration: Wedderburn_Artin_algebra_version @@ -476,7 +480,7 @@ projects: - declaration: IsCentralSimple.TensorProduct.isCentral informal: Proves centrality of tensor products of central algebras over a field. - declaration: CSA_implies_CSA - informal: Shows that base change preserves central simple algebra structure under the imported hypotheses. + informal: Shows that the division algebra factor in a matrix presentation of a central simple algebra is central over the base field. tags: - algebra - ring-theory From 020f677e3330951011fcd1cb9ca2f6e4a413dbc6 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 19 May 2026 23:54:14 +0900 Subject: [PATCH 05/34] Narrow Brauer group source scope --- LeanPool/projects.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index 1a0904445c..1d7de7db6e 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -460,7 +460,6 @@ projects: - Philippe Gille - Tamás Szamuely url: https://doi.org/10.1017/9781107359419 - github_repo: Whysoserioushah/BrauerGroup_new status: verified main_declarations: - BrauerGroup.Bruaer_Group From 68df6f3101aacb7c07e3010d1328e4e7fbaa276e Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Wed, 20 May 2026 09:56:55 +0900 Subject: [PATCH 06/34] Restore BrauerGroup finite-field theorem --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew.lean | 1 + LeanPool/BrauerGroupNew/FiniteField.lean | 43 ++++++++++++++++++++++++ LeanPool/projects.yml | 4 ++- 4 files changed, 48 insertions(+), 1 deletion(-) create mode 100644 LeanPool/BrauerGroupNew/FiniteField.lean diff --git a/LeanPool.lean b/LeanPool.lean index 7e0eaa1734..e71bd8763a 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -59,6 +59,7 @@ import LeanPool.BrauerGroupNew.CentralSimple import LeanPool.BrauerGroupNew.Centralizer import LeanPool.BrauerGroupNew.ExtendScalar import LeanPool.BrauerGroupNew.FieldCat +import LeanPool.BrauerGroupNew.FiniteField import LeanPool.BrauerGroupNew.LemmasAboutSimpleRing import LeanPool.BrauerGroupNew.Mathlib import LeanPool.BrauerGroupNew.Mathlib.Algebra diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index ea0880790d..034b07c432 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -8,6 +8,7 @@ import LeanPool.BrauerGroupNew.CentralSimple import LeanPool.BrauerGroupNew.Centralizer import LeanPool.BrauerGroupNew.ExtendScalar import LeanPool.BrauerGroupNew.FieldCat +import LeanPool.BrauerGroupNew.FiniteField import LeanPool.BrauerGroupNew.BrauerGroup import LeanPool.BrauerGroupNew.LemmasAboutSimpleRing import LeanPool.BrauerGroupNew.MatrixCenterEquiv diff --git a/LeanPool/BrauerGroupNew/FiniteField.lean b/LeanPool/BrauerGroupNew/FiniteField.lean new file mode 100644 index 0000000000..7fe3c86af4 --- /dev/null +++ b/LeanPool/BrauerGroupNew/FiniteField.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ +import LeanPool.BrauerGroupNew.BrauerGroup +import Mathlib.RingTheory.LittleWedderburn + +/-! +# Brauer groups over finite fields + +This file proves that the Brauer group of a finite field is trivial. +-/ + +variable (K : Type*) [Field K] [Finite K] + +suppress_compilation + +lemma BrauerTrivial (A : CSA K) : ∃ n ≠ 0, Nonempty (A ≃ₐ[K] Matrix (Fin n) (Fin n) K) := by + obtain ⟨n, hn, D, hD1, hD2, ⟨iso⟩⟩ := Wedderburn_Artin_algebra_version K A + have : Finite D := Module.finite_iff_finite.1 <| is_fin_dim_of_wdb K A hn D iso + let _ := littleWedderburn D + have eq1 := is_central_of_wdb K A n D hn iso |>.center_eq_bot + have eq2 : Subalgebra.center K D = ⊤ := SetLike.ext fun x ↦ + ⟨fun _ ↦ by trivial, fun _ ↦ by + rw [Subalgebra.mem_center_iff] + simp [mul_comm]⟩ + have e : D ≃ₐ[K] K := Subalgebra.topEquiv.symm.trans <| Subalgebra.equivOfEq ⊤ ⊥ + (eq2.symm.trans eq1) |>.trans <| Algebra.botEquiv K D + exact ⟨n, hn, ⟨iso.trans e.mapMatrix⟩⟩ + +theorem trivialBrauer : ∀ a : BrauerGroup K, a = 1 := fun a ↦ by + induction a using Quotient.inductionOn with + | h A => + change _ = Quotient.mk (Brauer.CSA_Setoid K) _ + simp only [Quotient.eq] + change IsBrauerEquivalent _ ⟨.of K K⟩ + obtain ⟨n, hn, ⟨iso⟩⟩ := BrauerTrivial K A + exact ⟨1, n, one_ne_zero, hn, ⟨BrauerGroup.dim_one_iso A |>.trans iso⟩⟩ + +instance BrauerOverFinite : Unique (BrauerGroup K) where + default := 1 + uniq := trivialBrauer K diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index 510713d25e..80d5eb1bed 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -1,7 +1,7 @@ projects: - slug: brauergroup_new title: Brauer Group Core - summary: Formalizes central simple algebra infrastructure and Wedderburn-Artin structure theorems toward Brauer groups. + summary: Formalizes central simple algebra infrastructure, Wedderburn-Artin structure theorems, and finite-field triviality for Brauer groups. branch: ring theory entry_module: LeanPool.BrauerGroupNew authors: @@ -27,6 +27,8 @@ projects: informal: Constructs the Brauer group functor from fields to commutative groups via scalar extension. - declaration: Wedderburn_Artin informal: Proves a Wedderburn-Artin decomposition for simple Artinian rings as matrix algebras over division rings. + - declaration: trivialBrauer + informal: Proves that every element of the Brauer group of a finite field is trivial. - declaration: Wedderburn_Artin_algebra_version informal: Gives an algebra equivalence form of Wedderburn-Artin for finite-dimensional central simple algebras. - declaration: IsCentralSimple.TensorProduct.simple From e471ca798b14c4071c1d19405d6835678a542627 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 03:36:36 -0700 Subject: [PATCH 07/34] Add BrauerGroup upstream repository metadata --- LeanPool/projects.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index 593a8bc13b..c2e9a8d227 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -1269,6 +1269,7 @@ projects: - Philippe Gille - Tamás Szamuely url: https://doi.org/10.1017/9781107359419 + github_repo: Whysoserioushah/BrauerGroup_new status: verified main_declarations: - BrauerGroup.Bruaer_Group From 615ae54c7fc31f94a959e55c7e7a7cde6d987156 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 10:52:46 -0700 Subject: [PATCH 08/34] Restore BrauerGroup upstream helper files --- LeanPool.lean | 16 + LeanPool/BrauerGroupNew.lean | 1 + LeanPool/BrauerGroupNew/AlgClosedUnion.lean | 413 ++++++++++++++++++ LeanPool/BrauerGroupNew/Mathlib.lean | 2 + .../Mathlib/Algebra/Algebra.lean | 1 + .../Mathlib/Algebra/Algebra/Equiv.lean | 9 + LeanPool/BrauerGroupNew/Mathlib/Data.lean | 13 + .../BrauerGroupNew/Mathlib/Data/DFinsupp.lean | 13 + .../Mathlib/Data/DFinsupp/Submonoid.lean | 16 + .../BrauerGroupNew/Mathlib/LinearAlgebra.lean | 14 + .../LinearAlgebra/LinearIndependent.lean | 13 + .../LinearAlgebra/LinearIndependent/Defs.lean | 13 + .../Mathlib/LinearAlgebra/Span.lean | 13 + .../Mathlib/LinearAlgebra/Span/Basic.lean | 16 + .../BrauerGroupNew/Mathlib/RingTheory.lean | 2 + .../Mathlib/RingTheory/NonUnitalSubring.lean | 13 + .../RingTheory/NonUnitalSubring/Defs.lean | 10 + .../RingTheory/NonUnitalSubsemiring.lean | 14 + .../NonUnitalSubsemiring/Basic.lean | 8 + .../RingTheory/NonUnitalSubsemiring/Defs.lean | 11 + .../Mathlib/RingTheory/TwoSidedIdeal.lean | 1 + .../RingTheory/TwoSidedIdeal/Lattice.lean | 15 + 22 files changed, 627 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/AlgClosedUnion.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Equiv.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/Data.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/Data/DFinsupp.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/Data/DFinsupp/Submonoid.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/LinearIndependent.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/LinearIndependent/Defs.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Span.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Span/Basic.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubring.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubring/Defs.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubsemiring.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubsemiring/Basic.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubsemiring/Defs.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal/Lattice.lean diff --git a/LeanPool.lean b/LeanPool.lean index b5d0c772de..a9aa0cc235 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -54,6 +54,7 @@ import LeanPool.ArtinWedderburn.PrimeRing import LeanPool.ArtinWedderburn.SetProd import LeanPool.Basic import LeanPool.BrauerGroupNew +import LeanPool.BrauerGroupNew.AlgClosedUnion import LeanPool.BrauerGroupNew.BrauerGroup import LeanPool.BrauerGroupNew.CentralSimple import LeanPool.BrauerGroupNew.Centralizer @@ -64,13 +65,28 @@ import LeanPool.BrauerGroupNew.LemmasAboutSimpleRing import LeanPool.BrauerGroupNew.Mathlib import LeanPool.BrauerGroupNew.Mathlib.Algebra import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra +import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Equiv import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Subalgebra import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Subalgebra.Basic import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Subalgebra.Directed import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Subalgebra.Lattice +import LeanPool.BrauerGroupNew.Mathlib.Data +import LeanPool.BrauerGroupNew.Mathlib.Data.DFinsupp +import LeanPool.BrauerGroupNew.Mathlib.Data.DFinsupp.Submonoid +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.LinearIndependent +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.LinearIndependent.Defs +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Span +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Span.Basic import LeanPool.BrauerGroupNew.Mathlib.RingTheory +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubring +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubring.Defs +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubsemiring +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubsemiring.Basic +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubsemiring.Defs import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Kernel +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Lattice import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Operations import LeanPool.BrauerGroupNew.MatrixCenterEquiv import LeanPool.BrauerGroupNew.MatrixEquivTensor diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index 034b07c432..90c1efda75 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -8,6 +8,7 @@ import LeanPool.BrauerGroupNew.CentralSimple import LeanPool.BrauerGroupNew.Centralizer import LeanPool.BrauerGroupNew.ExtendScalar import LeanPool.BrauerGroupNew.FieldCat +import LeanPool.BrauerGroupNew.AlgClosedUnion import LeanPool.BrauerGroupNew.FiniteField import LeanPool.BrauerGroupNew.BrauerGroup import LeanPool.BrauerGroupNew.LemmasAboutSimpleRing diff --git a/LeanPool/BrauerGroupNew/AlgClosedUnion.lean b/LeanPool/BrauerGroupNew/AlgClosedUnion.lean new file mode 100644 index 0000000000..8b459f9b6c --- /dev/null +++ b/LeanPool/BrauerGroupNew/AlgClosedUnion.lean @@ -0,0 +1,413 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ +import Mathlib.FieldTheory.IsAlgClosed.Basic +import Mathlib.RingTheory.Flat.Basic +import Mathlib.RingTheory.TensorProduct.Free + +/-! +# Tensor products over algebraic closures + +This file ports auxiliary results about finite intermediate fields inside an algebraic +closure and tensor products over their directed union. +-/ + +suppress_compilation + +open Module TensorProduct + +universe u + +section + +variable (K L : Type u) [Field K] [Field L] [Algebra K L] + (V : Type u) [AddCommGroup V] [Module K V] [Module.Finite K V] + +lemma dim_eq : Module.finrank K V = Module.finrank L (L ⊗[K] V) := by + let b := Module.finBasis K V + let b' := Algebra.TensorProduct.basis L b + rw [Module.finrank_eq_card_basis b, Module.finrank_eq_card_basis b'] + +end + +section +variable (K K_bar : Type u) [Field K] [Field K_bar] [Algebra K K_bar] [IsAlgClosure K K_bar] + +variable (A : Type u) [AddCommGroup A] [Module K A] + +open scoped IntermediateField + +/-- The image of scalar extension from an intermediate field tensor product. -/ +def intermediateTensor (L : IntermediateField K K_bar) : Submodule K (K_bar ⊗[K] A) := + LinearMap.range (LinearMap.rTensor _ (L.val.toLinearMap) : L ⊗[K] A →ₗ[K] K_bar ⊗[K] A) + +/-- The same image as `intermediateTensor`, regarded as a module over the intermediate field. -/ +def intermediateTensor' (L : IntermediateField K K_bar) : Submodule L (K_bar ⊗[K] A) := + LinearMap.range ({LinearMap.rTensor _ (L.val.toLinearMap) with + map_smul' l x := by + simp only [AddHom.toFun_eq_coe, LinearMap.coe_toAddHom, RingHom.id_apply] + induction x using TensorProduct.induction_on with + | zero => simp + | tmul x a => + simp only [smul_tmul', smul_eq_mul, LinearMap.rTensor_tmul, AlgHom.toLinearMap_apply, + _root_.map_mul, IntermediateField.coe_val]; rfl + | add x y hx hy => simp only [smul_add, map_add, hx, hy] } : L ⊗[K] A →ₗ[L] K_bar ⊗[K] A) +/-- The range-restricted tensor map identifies an intermediate tensor with `L ⊗[K] A`. -/ +def intermediateTensorEquiv (L : IntermediateField K K_bar) : + intermediateTensor K K_bar A L ≃ₗ[K] L ⊗[K] A := + .symm <| .ofBijective (LinearMap.rangeRestrict _) ⟨by + intro x y hxy + simp only [LinearMap.rangeRestrict, Subtype.ext_iff, LinearMap.codRestrict_apply] at hxy + exact Module.Flat.rTensor_preserves_injective_linearMap _ (fun x y h => by simpa using h) hxy, + LinearMap.surjective_rangeRestrict _⟩ + +omit [IsAlgClosure K K_bar] in +@[simp] +lemma intermediateTensorEquiv_apply_tmul (L : IntermediateField K K_bar) + (x : L) (a : A) (h : x.1 ⊗ₜ[K] a ∈ intermediateTensor K K_bar A L) : + intermediateTensorEquiv K K_bar A L ⟨_, h⟩ = + x ⊗ₜ a := by + simp only [intermediateTensorEquiv] + convert LinearEquiv.ofBijective_symm_apply_apply _ _ + rfl +/-- The `L`-linear version of `intermediateTensorEquiv`. -/ +def intermediateTensorEquiv' (L : IntermediateField K K_bar) : + intermediateTensor' K K_bar A L ≃ₗ[L] L ⊗[K] A where + toFun := intermediateTensorEquiv K K_bar A L + map_add' := map_add _ + map_smul' := by + rintro x ⟨-, ⟨y, rfl⟩⟩ + simp only [RingHom.id_apply] + induction y using TensorProduct.induction_on with + | zero => + simp only [map_zero, SetLike.mk_smul_mk, smul_zero] + erw [map_zero] + rw [smul_zero] + | tmul y a => + change (intermediateTensorEquiv K K_bar A L) ⟨↑(x * y) ⊗ₜ[K] a, _⟩ = + x • (intermediateTensorEquiv K K_bar A L) ⟨↑y ⊗ₜ[K] a, _⟩ + rw [intermediateTensorEquiv_apply_tmul] + rw [intermediateTensorEquiv_apply_tmul] + rfl + | add y z hy hz => + simp only [LinearMap.coe_mk, LinearMap.coe_toAddHom, SetLike.mk_smul_mk, map_add, + smul_add] at hy hz ⊢ + convert congr($hy + $hz) using 1 + · rw [← (intermediateTensorEquiv K K_bar A L).map_add]; rfl + · erw [← smul_add, ← (intermediateTensorEquiv K K_bar A L).map_add]; rfl + invFun := (intermediateTensorEquiv K K_bar A L).symm + left_inv := (intermediateTensorEquiv K K_bar A L).left_inv + right_inv := (intermediateTensorEquiv K K_bar A L).right_inv + +omit [IsAlgClosure K K_bar] in +lemma mem_intermediateTensor_iff_mem_intermediateTensor' + {L : IntermediateField K K_bar} {x : K_bar ⊗[K] A} : + x ∈ intermediateTensor K K_bar A L ↔ x ∈ intermediateTensor' K K_bar A L := by + simp only [intermediateTensor, LinearMap.mem_range, intermediateTensor', LinearMap.coe_mk, + LinearMap.coe_toAddHom] + +omit [IsAlgClosure K K_bar] in +lemma intermediateTensor_mono {L1 L2 : IntermediateField K K_bar} (h : L1 ≤ L2) : + intermediateTensor K K_bar A L1 ≤ intermediateTensor K K_bar A L2 := by + have e1 : (LinearMap.rTensor _ (L1.val.toLinearMap) : L1 ⊗[K] A →ₗ[K] K_bar ⊗[K] A) = + (LinearMap.rTensor _ (L2.val.toLinearMap) : L2 ⊗[K] A →ₗ[K] K_bar ⊗[K] A) ∘ₗ + (LinearMap.rTensor A (L1.inclusion h).toLinearMap : L1 ⊗[K] A →ₗ[K] L2 ⊗[K] A) := by + rw [← LinearMap.rTensor_comp]; rfl + delta intermediateTensor + rw [e1, LinearMap.range_comp, Submodule.map_le_iff_le_comap] + rintro _ ⟨x, rfl⟩ + simp only [Submodule.mem_comap, LinearMap.mem_range, exists_apply_eq_apply] + +/-- Finite-dimensional intermediate fields of the algebraic closure. -/ +abbrev SetOfFinite : Set (IntermediateField K K_bar) := + {M | FiniteDimensional K M} + +omit [IsAlgClosure K K_bar] in +lemma is_direct : DirectedOn (fun x x_1 ↦ x ≤ x_1) + (Set.range fun (L : SetOfFinite K K_bar) ↦ intermediateTensor K K_bar A L) := by + rintro _ ⟨⟨L1, (hL1 : FiniteDimensional _ _)⟩, rfl⟩ _ ⟨⟨L2, (hL2 : FiniteDimensional _ _)⟩, rfl⟩ + refine ⟨intermediateTensor K K_bar A (L1 ⊔ L2), ⟨⟨L1 ⊔ L2, show FiniteDimensional _ _ from + ?_⟩, rfl⟩, ⟨intermediateTensor_mono K K_bar A le_sup_left, + intermediateTensor_mono K K_bar A le_sup_right⟩⟩ + · apply (config := { allowSynthFailures := true }) IntermediateField.finiteDimensional_sup + +omit [IsAlgClosure K K_bar] in +lemma SetOfFinite_nonempty : (Set.range fun (L : SetOfFinite K K_bar) ↦ + intermediateTensor K K_bar A L).Nonempty := by + refine ⟨intermediateTensor K K_bar A ⊥, ⟨⟨⊥, ?_⟩, rfl⟩⟩ + simp only [SetOfFinite, Set.mem_setOf_eq] + infer_instance + +/-- K_bar ⊗[K] A = union of all finite subextension of K ⊗ A -/ +theorem inter_tensor_union : + ⨆ (L : SetOfFinite K K_bar), + (intermediateTensor K K_bar A L) = ⊤ := by + rw [eq_top_iff] + rintro x - + induction x using TensorProduct.induction_on with + |zero => simp + |tmul x a => + have fin0: FiniteDimensional K K⟮x⟯ := IntermediateField.adjoin.finiteDimensional (by + observe : IsAlgebraic K x + exact Algebra.IsIntegral.isIntegral x) + exact Submodule.mem_sSup_of_directed (SetOfFinite_nonempty K K_bar A) (is_direct K K_bar A) |>.2 + ⟨intermediateTensor K K_bar A K⟮x⟯, ⟨⟨⟨K⟮x⟯, fin0⟩, rfl⟩, + ⟨(⟨x, IntermediateField.mem_adjoin_simple_self K x⟩ ⊗ₜ a), by simp⟩⟩⟩ + |add x y hx hy => + apply AddMemClass.add_mem <;> assumption + +theorem algclosure_element_in (x : K_bar ⊗[K] A) : ∃(F : IntermediateField K K_bar), + FiniteDimensional K F ∧ x ∈ intermediateTensor K K_bar A F := by + have mem : x ∈ (⊤ : Submodule K _) := ⟨⟩ + rw [← inter_tensor_union K K_bar A] at mem + obtain ⟨_, ⟨⟨L, hL1⟩, rfl⟩, hL⟩ := Submodule.mem_sSup_of_directed (SetOfFinite_nonempty K K_bar A) + (is_direct K K_bar A)|>.1 mem + refine ⟨L, ⟨hL1, hL⟩⟩ + +/-- A finite intermediate field whose tensor image contains a chosen tensor element. -/ +def subfieldOf (x : K_bar ⊗[K] A) : IntermediateField K K_bar := + algclosure_element_in K K_bar A x|>.choose + +instance (x : K_bar ⊗[K] A) : FiniteDimensional K (subfieldOf K K_bar A x) := + (algclosure_element_in K K_bar A _).choose_spec.1 + +theorem mem_subfieldOf (x : K_bar ⊗[K] A) : x ∈ intermediateTensor K K_bar A + (subfieldOf K K_bar A x) := (algclosure_element_in K K_bar A _).choose_spec.2 + +theorem mem_subfieldOf' (x : K_bar ⊗[K] A) : x ∈ intermediateTensor' K K_bar A + (subfieldOf K K_bar A x) := by + rw [← mem_intermediateTensor_iff_mem_intermediateTensor'] + exact mem_subfieldOf K K_bar A x + +end + +namespace lemma_tto + +variable (n : ℕ) [NeZero n] (k k_bar A : Type u) [Field k] [Field k_bar] [Algebra k k_bar] + [IsAlgClosure k k_bar] [Ring A] [Algebra k A] [FiniteDimensional k A] + (iso : k_bar ⊗[k] A ≃ₐ[k_bar] Matrix (Fin n) (Fin n) k_bar) + +/-- The basis of `k_bar ⊗[k] A` pulled back from the standard matrix basis. -/ +def ee : Basis (Fin n × Fin n) k_bar (k_bar ⊗[k] A) := + Basis.map (Matrix.stdBasis k_bar _ _) iso.symm + +local notation "e" => ee n k k_bar A iso + +omit [NeZero n] [IsAlgClosure k k_bar] [FiniteDimensional k A] in +@[simp] +lemma ee_apply (i : Fin n × Fin n) : iso (e i) = Matrix.stdBasis k_bar (Fin n) (Fin n) i := by + apply_fun iso.symm + simp only [AlgEquiv.symm_apply_apply] + have := Basis.map_apply (Matrix.stdBasis k_bar (Fin n) (Fin n)) iso.symm.toLinearEquiv i + erw [← this] + +/-- The finite intermediate field generated by all basis coordinates. -/ +def ℒℒ : IntermediateField k k_bar := + ⨆ (i : Fin n × Fin n), subfieldOf k k_bar A (e i) + +local notation "ℒ" => ℒℒ n k k_bar A iso + +instance : FiniteDimensional k ℒ := + IntermediateField.finiteDimensional_iSup_of_finite + +/-- Inclusion of the coordinate field of a basis vector into the generated field `ℒ`. -/ +def f (i : Fin n × Fin n) : subfieldOf k k_bar A (e i) →ₐ[k] ℒ := + subfieldOf k k_bar A (e i)|>.inclusion (le_sSup ⟨i, rfl⟩) + +/-- The pulled-back basis vector, regarded in the `ℒ`-linear intermediate tensor submodule. -/ +def e_hat' (i : Fin n × Fin n) : intermediateTensor' k k_bar A ℒ := + ⟨e i, by + rw [← mem_intermediateTensor_iff_mem_intermediateTensor'] + exact intermediateTensor_mono k k_bar A (le_sSup (by simp)) <| mem_subfieldOf k k_bar A (e i)⟩ + +local notation "e^'" => e_hat' n k k_bar A iso +local notation "k⁻" => k_bar + +omit [NeZero n] [FiniteDimensional k A] in +theorem e_hat_linear_independent : LinearIndependent ℒ e^' := by + rw [linearIndependent_iff'] + intro s g h + have h' : ∑ i ∈ s, algebraMap ℒ k⁻ (g i) • e i = 0 := by + apply_fun Submodule.subtype _ at h + simpa only [IntermediateField.algebraMap_apply, map_sum, map_smul, Submodule.coe_subtype, + map_zero] using h + have H := (linearIndependent_iff'.1 <| e |>.linearIndependent) s (algebraMap ℒ k⁻ ∘ g) h' + intro i hi + simpa using H i hi + +-- shortcut instance search +instance : Module ℒ (ℒ ⊗[k] A) := TensorProduct.leftModule + +instance : FiniteDimensional ℒ (intermediateTensor' k k⁻ A ℒ) := + Module.Finite.equiv (intermediateTensorEquiv' k k_bar A ℒ).symm + +omit [NeZero n] in +theorem dim_ℒ_eq : Module.finrank ℒ (intermediateTensor' k k⁻ A ℒ) = n^2 := by + have eq1 := dim_eq k k⁻ A |>.trans iso.toLinearEquiv.finrank_eq + simp only [Module.finrank_matrix, Fintype.card_fin, Module.finrank_self, mul_one] at eq1 + rw [pow_two, ← eq1, dim_eq k ℒ A] + exact LinearEquiv.finrank_eq (intermediateTensorEquiv' k k_bar A ℒ) + +/-- The basis of the intermediate tensor submodule over `ℒ`. -/ +def e_hat : Basis (Fin n × Fin n) ℒ (intermediateTensor' k k_bar A ℒ) := + basisOfLinearIndependentOfCardEqFinrank (e_hat_linear_independent n k k_bar A iso) <| by + simp only [Fintype.card_prod, Fintype.card_fin, dim_ℒ_eq, pow_two] + +local notation "e^" => e_hat n k k_bar A iso + +/-- The restricted linear equivalence over the finite intermediate field `ℒ`. -/ +def isoRestrict' : ℒ ⊗[k] A ≃ₗ[ℒ] Matrix (Fin n) (Fin n) ℒ := + (intermediateTensorEquiv' k k_bar A ℒ).symm ≪≫ₗ + Basis.equiv (e^) (Matrix.stdBasis ℒ (Fin n) (Fin n)) (Equiv.refl _) + +instance : SMulCommClass k ℒ ℒ := inferInstance +-- instance : Algebra ℒ (ℒ ⊗[k] A) := Algebra.TensorProduct.leftAlgebra + +/-- Scalar-extension inclusion from the restricted tensor product into the algebraic closure. -/ +def inclusion : ℒ ⊗[k] A →ₐ[ℒ] k⁻ ⊗[k] A := + Algebra.TensorProduct.map (Algebra.ofId ℒ k⁻) (AlgHom.id k A) + +/-- Entrywise matrix inclusion from `ℒ` to the algebraic closure. -/ +def inclusion' : Matrix (Fin n) (Fin n) ℒ →ₐ[ℒ] Matrix (Fin n) (Fin n) k⁻ := + AlgHom.mapMatrix (Algebra.ofId ℒ _) + +omit [NeZero n] [FiniteDimensional k A] in +lemma inclusion'_injective : Function.Injective (inclusion' n k k_bar A iso) := by + intro x y h + ext i j + rw [← Matrix.ext_iff] at h + specialize h i j + simp only [inclusion', Algebra.ofId] at h + exact h + +omit [NeZero n] [FiniteDimensional k A] in +/-- +ℒ ⊗_k A ------> intermidateTensor + | / + | inclusion / + v / +k⁻ ⊗_k A <- +-/ +lemma comm_triangle : + (intermediateTensor' k k_bar A ℒ).subtype ∘ₗ + (intermediateTensorEquiv' k k_bar A ℒ).symm.toLinearMap = + (inclusion n k k_bar A iso).toLinearMap := by + ext a + simp only [AlgebraTensorModule.curry_apply, curry_apply, LinearMap.coe_restrictScalars, + LinearMap.coe_comp, Submodule.coe_subtype, LinearEquiv.coe_coe, Function.comp_apply, inclusion, + AlgHom.toLinearMap_apply] + simp only [intermediateTensorEquiv', intermediateTensorEquiv, LinearEquiv.symm_symm, + LinearEquiv.coe_symm_mk] + rfl + +/-- +intermidateTensor ----> M_n(ℒ) + | val | inclusion' + v v +k⁻ ⊗_k A ----------> M_n(k⁻) + iso +-/ +lemma comm_square' : + iso.toLinearEquiv.toLinearMap.restrictScalars ℒ ∘ₗ + (intermediateTensor' k k_bar A ℒ).subtype = + (inclusion' n k k_bar A iso).toLinearMap ∘ₗ + Basis.equiv (e^) (Matrix.stdBasis ℒ (Fin n) (Fin n)) (Equiv.refl _) := by + apply Basis.ext (e^) + intro i + conv_lhs => simp only [AlgEquiv.toLinearEquiv_toLinearMap, e_hat, + basisOfLinearIndependentOfCardEqFinrank, + Basis.coe_mk, e_hat', LinearMap.coe_comp, LinearMap.coe_restrictScalars, Submodule.coe_subtype, + Function.comp_apply, AlgEquiv.toLinearMap_apply, LinearEquiv.coe_coe, AlgHom.toLinearMap_apply] + simp only [ee_apply, LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, + Basis.equiv_apply, Equiv.refl_apply, AlgHom.toLinearMap_apply] + ext a b + simp only [inclusion'] + simp only [Algebra.ofId] + rw [Matrix.stdBasis_eq_single] + erw [Matrix.stdBasis_eq_single] + simp only [Matrix.single] + change (if i.1 = a ∧ i.2 = b then 1 else 0) = + algebraMap ℒ k_bar ((if i.1 = a ∧ i.2 = b then 1 else 0) : ℒ) + simp + +/-- This shows the following diagram commutes: + isoRestrict + ℒ ⊗_k A -----> M_n(ℒ) + | inclusion | inclusion' + v v + k⁻ ⊗_k A -----> M_n(k⁻) + iso +-/ +lemma comm_square : + (inclusion' n k k_bar A iso).toLinearMap ∘ₗ + (isoRestrict' n k k_bar A iso).toLinearMap = + iso.toLinearEquiv.toLinearMap.restrictScalars ℒ ∘ₗ + (inclusion n k k_bar A iso).toLinearMap := by + rw [← comm_triangle n k k_bar A iso, ← LinearMap.comp_assoc, comm_square' n k k_bar A iso] + rfl + +lemma isoRestrict_map_one : isoRestrict' n k k⁻ A iso 1 = 1 := by + /- + isoRestrict + ℒ ⊗_k A -----> M_n(ℒ) + | inclusion | inclusion' + v v + k⁻ ⊗_k A -----> M_n(k⁻) + iso + + Want to show isoRestrict 1 = 1 + inclusion' ∘ isoRestrict = iso ∘ inclusion + inclusion' (isoRestrict 1) = iso (inclusion 1) = 1 = inclusion' 1 + since inclusion' is injective, isoRestrict 1 = 1 + -/ + have eq := congr($(comm_square n k k_bar A iso) 1) + -- have : (inclusion n k k_bar A iso) 1 = 1 := by + -- erw [_root_.map_one (f := inclusion n k k_bar A iso)] + conv_rhs at eq => + rw [LinearMap.comp_apply] + change (LinearMap.restrictScalars (@Subtype k_bar fun x ↦ x ∈ ℒ)) iso.toLinearEquiv.toLinearMap + (inclusion n k k_bar A iso 1) + erw [show (inclusion n k k_bar A iso 1) = 1 from rfl, map_one iso] + refine inclusion'_injective n k k_bar A iso (eq.trans ?_) + rw [_root_.map_one] + +lemma isoRestrict_map_mul (x y : ℒ ⊗[k] A) : + isoRestrict' n k k⁻ A iso (x * y) = + isoRestrict' n k k⁻ A iso x * isoRestrict' n k k⁻ A iso y := by + /- + isoRestrict + ℒ ⊗_k A -----> M_n(ℒ) + | inclusion | inclusion' + v v + k⁻ ⊗_k A -----> M_n(k⁻) + iso + + Want to show isoRestrict (x * y) = isoRestrict x * isoRestrict y + inclusion' ∘ isoRestrict = iso ∘ inclusion + inclusion' (isoRestrict (x * y)) = iso (inclusion (x * y)) = iso (inclusion x) * iso (inclusion y) + = inclusion' (isoRestrict x) * inclusion' (isoRestrict y) + = inclusion' (isoRestrict x * isoRestrict y) + since inclusion' is injective, isoRestrict (x * y) = isoRestrict x * isoRestrict y + + -/ + have eq := congr($(comm_square n k k_bar A iso) (x * y)) + conv_rhs at eq => + rw [LinearMap.comp_apply] + erw [_root_.map_mul (f := inclusion n k k_bar A iso), _root_.map_mul (f := iso)] + have eq₁ := congr($(comm_square n k k_bar A iso) x) + have eq₂ := congr($(comm_square n k k_bar A iso) y) + simp only [LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, AlgHom.toLinearMap_apply, + AlgEquiv.toLinearEquiv_toLinearMap, LinearMap.coe_restrictScalars, + AlgEquiv.toLinearMap_apply] at eq₁ eq₂ + rw [← eq₁, ← eq₂, ← _root_.map_mul] at eq + refine inclusion'_injective n k k_bar A iso (eq.trans ?_) + rw [_root_.map_mul] + +/-- The restricted algebra equivalence over the finite intermediate field `ℒ`. -/ +def isoRestrict : ℒ ⊗[k] A ≃ₐ[ℒ] Matrix (Fin n) (Fin n) ℒ := + AlgEquiv.ofLinearEquiv (isoRestrict' n k k⁻ A iso) + (isoRestrict_map_one n k k⁻ A iso) (isoRestrict_map_mul n k k⁻ A iso) + +end lemma_tto diff --git a/LeanPool/BrauerGroupNew/Mathlib.lean b/LeanPool/BrauerGroupNew/Mathlib.lean index 3021f0f57a..96787184e5 100644 --- a/LeanPool/BrauerGroupNew/Mathlib.lean +++ b/LeanPool/BrauerGroupNew/Mathlib.lean @@ -5,6 +5,8 @@ Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies -/ import LeanPool.BrauerGroupNew.Mathlib.Algebra +import LeanPool.BrauerGroupNew.Mathlib.Data +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra import LeanPool.BrauerGroupNew.Mathlib.RingTheory /-! diff --git a/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra.lean b/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra.lean index 83c7190d2c..00dc49e86d 100644 --- a/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra.lean +++ b/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies -/ +import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Equiv import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Subalgebra /-! diff --git a/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Equiv.lean b/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Equiv.lean new file mode 100644 index 0000000000..b6efd6e867 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/Algebra/Algebra/Equiv.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ +import Mathlib.Algebra.Algebra.Equiv + +/-- Galois-group notation as algebra equivalences. -/ +notation "Gal("K ", "F")" => K ≃ₐ[F] K diff --git a/LeanPool/BrauerGroupNew/Mathlib/Data.lean b/LeanPool/BrauerGroupNew/Mathlib/Data.lean new file mode 100644 index 0000000000..0d8ba21a73 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/Data.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.Data.DFinsupp + +/-! +# Brauer Group New Mathlib Data + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/Data/DFinsupp.lean b/LeanPool/BrauerGroupNew/Mathlib/Data/DFinsupp.lean new file mode 100644 index 0000000000..702547cd5f --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/Data/DFinsupp.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.Data.DFinsupp.Submonoid + +/-! +# Brauer Group New Mathlib DFinsupp + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/Data/DFinsupp/Submonoid.lean b/LeanPool/BrauerGroupNew/Mathlib/Data/DFinsupp/Submonoid.lean new file mode 100644 index 0000000000..bc6c05711c --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/Data/DFinsupp/Submonoid.lean @@ -0,0 +1,16 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ +import Mathlib.Data.DFinsupp.Submonoid +import Mathlib.Data.Finsupp.Basic + +variable {ι γ β : Type*} + +open Finsupp + +@[to_additive] +theorem finsuppProd_mem [Zero β] [CommMonoid γ] {S : Type*} [SetLike S γ] [SubmonoidClass S γ] + {s : S} {f : ι →₀ β} {g : ι → β → γ} (h : ∀ c, f c ≠ 0 → g c (f c) ∈ s) : f.prod g ∈ s := + prod_mem fun _ hi ↦ h _ <| mem_support_iff.1 hi diff --git a/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra.lean b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra.lean new file mode 100644 index 0000000000..059da0288f --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra.lean @@ -0,0 +1,14 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.LinearIndependent +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Span + +/-! +# Brauer Group New Mathlib LinearAlgebra + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/LinearIndependent.lean b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/LinearIndependent.lean new file mode 100644 index 0000000000..ddf7db8686 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/LinearIndependent.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.LinearIndependent.Defs + +/-! +# Brauer Group New Mathlib LinearIndependent + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/LinearIndependent/Defs.lean b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/LinearIndependent/Defs.lean new file mode 100644 index 0000000000..e50025253f --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/LinearIndependent/Defs.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ +import Mathlib.LinearAlgebra.LinearIndependent.Defs + +variable {ι R M : Type*} {v : ι → M} [Semiring R] [AddCommMonoid M] [Module R M] + +-- TODO: Replace `linearIndependent_iff_finset_linearIndependent` +lemma linearIndependent_iff_linearIndepOn_finset : + LinearIndependent R v ↔ ∀ s : Finset ι, LinearIndepOn R v s := + linearIndependent_iff_finset_linearIndependent diff --git a/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Span.lean b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Span.lean new file mode 100644 index 0000000000..4426466c59 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Span.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Span.Basic + +/-! +# Brauer Group New Mathlib Span + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Span/Basic.lean b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Span/Basic.lean new file mode 100644 index 0000000000..cef230621d --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Span/Basic.lean @@ -0,0 +1,16 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ +import Mathlib.Algebra.BigOperators.GroupWithZero.Action +import Mathlib.Algebra.Module.Submodule.Basic +import Mathlib.LinearAlgebra.Span.Defs + +/-! +# Span compatibility imports + +The upstream file supplied `Submodule.mem_span_image_finset_iff_exists_fun`; +that declaration is available in the current Mathlib import graph, so this file +is kept as an import-compatible shim. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory.lean index 71aa77513b..0b76b179a3 100644 --- a/LeanPool/BrauerGroupNew/Mathlib/RingTheory.lean +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies -/ +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubring +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubsemiring import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal /-! diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubring.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubring.lean new file mode 100644 index 0000000000..0a6a2a9bd4 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubring.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubring.Defs + +/-! +# Brauer Group New Mathlib NonUnitalSubring + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubring/Defs.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubring/Defs.lean new file mode 100644 index 0000000000..2aeb92263b --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubring/Defs.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ +import Mathlib.RingTheory.NonUnitalSubring.Defs + +variable {R : Type*} [NonUnitalRing R] + +@[simp] lemma NonUnitalSubring.carrier_eq_coe (S : NonUnitalSubring R) : S.carrier = S := rfl diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubsemiring.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubsemiring.lean new file mode 100644 index 0000000000..a72a8da112 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubsemiring.lean @@ -0,0 +1,14 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubsemiring.Basic +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubsemiring.Defs + +/-! +# Brauer Group New Mathlib NonUnitalSubsemiring + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubsemiring/Basic.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubsemiring/Basic.lean new file mode 100644 index 0000000000..509e0e22cb --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubsemiring/Basic.lean @@ -0,0 +1,8 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ +import Mathlib.RingTheory.NonUnitalSubsemiring.Basic + +attribute [simp, norm_cast] NonUnitalSubsemiring.coe_center diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubsemiring/Defs.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubsemiring/Defs.lean new file mode 100644 index 0000000000..1c8dd07ac3 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/NonUnitalSubsemiring/Defs.lean @@ -0,0 +1,11 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ +import Mathlib.RingTheory.NonUnitalSubsemiring.Defs + +variable {R : Type*} [NonUnitalSemiring R] + +@[simp] +lemma NonUnitalSubsemiring.carrier_eq_coe (S : NonUnitalSubsemiring R) : S.carrier = S := rfl diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal.lean index 69664bfd3a..673d9dc72a 100644 --- a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal.lean +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal.lean @@ -5,6 +5,7 @@ Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies -/ import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Kernel +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Lattice import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Operations /-! diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal/Lattice.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal/Lattice.lean new file mode 100644 index 0000000000..ed5dc03216 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal/Lattice.lean @@ -0,0 +1,15 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ +import Mathlib.RingTheory.TwoSidedIdeal.Lattice + +namespace TwoSidedIdeal +variable {R : Type*} [NonUnitalNonAssocRing R] {I J : TwoSidedIdeal R} {x : R} + +@[simp] lemma ringCon_inj : I.ringCon = J.ringCon ↔ I = J := ringCon_injective.eq_iff + +@[simp] lemma ringCon_eq_top : I.ringCon = ⊤ ↔ I = ⊤ := by rw [← top_ringCon, ringCon_inj] + +end TwoSidedIdeal From 1c3f64b9f05beed1626c6bdda4a44b281c4de6dd Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 11:45:36 -0700 Subject: [PATCH 09/34] Restore BrauerGroup Morita equivalence --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew.lean | 1 + .../BrauerGroupNew/MoritaEquivalence.lean | 622 ++++++++++++++++++ 3 files changed, 624 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/MoritaEquivalence.lean diff --git a/LeanPool.lean b/LeanPool.lean index a9aa0cc235..b9cbcabde7 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -90,6 +90,7 @@ import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Lattice import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Operations import LeanPool.BrauerGroupNew.MatrixCenterEquiv import LeanPool.BrauerGroupNew.MatrixEquivTensor +import LeanPool.BrauerGroupNew.MoritaEquivalence import LeanPool.BrauerGroupNew.Subfield import LeanPool.BrauerGroupNew.Subfield.Defs import LeanPool.BrauerGroupNew.Subfield.FiniteDimensional diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index 90c1efda75..bbf11e40b3 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -14,6 +14,7 @@ import LeanPool.BrauerGroupNew.BrauerGroup import LeanPool.BrauerGroupNew.LemmasAboutSimpleRing import LeanPool.BrauerGroupNew.MatrixCenterEquiv import LeanPool.BrauerGroupNew.MatrixEquivTensor +import LeanPool.BrauerGroupNew.MoritaEquivalence import LeanPool.BrauerGroupNew.TwoSidedIdeal import LeanPool.BrauerGroupNew.Wedderburn import LeanPool.BrauerGroupNew.Mathlib diff --git a/LeanPool/BrauerGroupNew/MoritaEquivalence.lean b/LeanPool/BrauerGroupNew/MoritaEquivalence.lean new file mode 100644 index 0000000000..fc96cf3a24 --- /dev/null +++ b/LeanPool/BrauerGroupNew/MoritaEquivalence.lean @@ -0,0 +1,622 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.Algebra.Category.ModuleCat.EpiMono +import Mathlib.Algebra.Category.ModuleCat.Limits +import Mathlib.Algebra.Group.Subgroup.Finite +import Mathlib.Algebra.Homology.ShortComplex.Exact +import Mathlib.CategoryTheory.Limits.Shapes.Countable +import Mathlib.Data.Matrix.Basis +import Mathlib.LinearAlgebra.Basis.VectorSpace +import Mathlib.RingTheory.SimpleModule.Basic +import Mathlib.RingTheory.SimpleRing.Basic + +/-! +# Morita equivalence for matrix algebras + +This file ports the upstream BrauerGroup development proving the Morita +equivalence between modules over a ring and over a matrix ring. +-/ + +open CategoryTheory Matrix Module + +universe u u' u'' v v' v'' w + +local notation "M[" ι ", " R "]" => Matrix ι ι R + +variable (R : Type u) [Ring R] + +variable (ι : Type w) [Fintype ι] [Inhabited ι] [DecidableEq ι] + +instance (M : Type*) [AddCommGroup M] [Module R M] : Module M[ι, R] (ι → M) where + smul N v i := ∑ j : ι, N i j • v j + one_smul v := funext fun i ↦ show ∑ _, _ = _ by simp [one_apply] + mul_smul N₁ N₂ v := funext fun i ↦ show ∑ _, _ = ∑ _, _ • (∑ _, _) by + simp_rw [mul_apply, Finset.smul_sum, Finset.sum_smul, SemigroupAction.mul_smul] + rw [Finset.sum_comm] + smul_zero v := funext fun i ↦ show ∑ _, _ = _ by simp + smul_add N v₁ v₂ := funext fun i ↦ show ∑ j : ι, N i j • (v₁ + v₂) j = (∑ _, _) + (∑ _, _) by + simp [Finset.sum_add_distrib] + add_smul N₁ N₂ v := funext fun i ↦ show ∑ j : ι, (N₁ + N₂) i j • v j = (∑ _, _) + (∑ _, _) by + simp [add_smul, Finset.sum_add_distrib] + zero_smul v := funext fun i ↦ show ∑ _, _ = _ by simp + +/-- The functor sending an `R`-module to the coordinatewise module over `ι × ι` matrices. -/ +@[simps] +def toModuleCatOverMatrix : ModuleCat R ⥤ ModuleCat M[ι, R] where + obj M := ModuleCat.of M[ι, R] (ι → M) + map f := ModuleCat.ofHom { + toFun := fun v i => f <| v i + map_add' x y := funext fun i ↦ show f (x i + y i) = f (x i) + f (y i) from + f.hom.map_add _ _ + map_smul' := fun m v => funext fun i ↦ show f (∑ _, _) = ∑ _, _ by + simp only [RingHom.id_apply, map_sum, _root_.map_smul] } + map_id _ := rfl + map_comp _ _ := rfl + +/-- The additive subgroup cut out by the default diagonal idempotent. -/ +@[simps] +def fromModuleCatOverMatrix.α [Inhabited ι] (M : Type*) [AddCommGroup M] [Module M[ι, R] M] : + AddSubgroup M where + carrier := Set.range ((single (default : ι) (default : ι) (1 : R) : M[ι, R]) • ·) + add_mem' := by + rintro _ _ ⟨m, rfl⟩ ⟨n, rfl⟩ + exact ⟨m + n, by simp⟩ + zero_mem' := ⟨0, by simp⟩ + neg_mem' := by + rintro _ ⟨m, rfl⟩ + exact ⟨-m, by simp⟩ + +open fromModuleCatOverMatrix + +instance fromModuleCatOverMatrix.module_α (M : Type*) [AddCommGroup M] [Module M[ι, R] M] : + Module R <| α R ι M where + smul a x := by + refine ⟨(single default default a : M[ι, R]) • x.1, ?_⟩ + obtain ⟨y, hy⟩ := x.2 + refine ⟨(single default default a : M[ι, R]) • y, hy ▸ ?_⟩ + simp only + rw [← SemigroupAction.mul_smul, ← SemigroupAction.mul_smul] + congr 1 + ext i j + simp + one_smul := by + rintro ⟨_, x, rfl⟩ + ext + change single _ _ _ • _ = single _ _ _ • _ + rw [← SemigroupAction.mul_smul] + congr 1 + ext i j + simp + mul_smul := by + rintro a a' ⟨_, x, rfl⟩ + ext + change single _ _ _ • _ = single _ _ _ • (single _ _ _ • _) + dsimp only [id_eq, eq_mpr_eq_cast, cast_eq] + rw [← SemigroupAction.mul_smul, ← SemigroupAction.mul_smul, ← SemigroupAction.mul_smul] + congr 1 + ext i j + simp + smul_zero a := by + ext + change single _ _ _ • 0 = 0 + simp + smul_add := by + rintro a ⟨_, x, rfl⟩ ⟨_, ⟨y, rfl⟩⟩ + ext + change single _ _ _ • _ = single _ _ _ • _ + single _ _ _ • _ + dsimp only [AddSubgroup.coe_add] + rw [← SemigroupAction.mul_smul, ← SemigroupAction.mul_smul, ← smul_add, ← smul_add, + ← SemigroupAction.mul_smul] + add_smul := by + rintro a b ⟨_, x, rfl⟩ + ext + change single _ _ _ • _ = single _ _ _ • _ + single _ _ _ • _ + dsimp only + rw [← SemigroupAction.mul_smul, ← SemigroupAction.mul_smul, + ← SemigroupAction.mul_smul, ← add_smul, ← add_mul, ← single_add] + zero_smul := by + rintro ⟨_, x, rfl⟩ + ext + change single _ _ _ • _ = _ + simp only [single_zero, zero_smul, ZeroMemClass.coe_zero] + +open fromModuleCatOverMatrix + +/-- The functor sending a matrix-module to the default diagonal idempotent summand. -/ +@[simps] +def fromModuleCatOverMatrix : ModuleCat M[ι, R] ⥤ ModuleCat R where + obj M := .of _ <| α R ι M + map f := ModuleCat.ofHom { + toFun x := by + refine ⟨f x.1, ?_⟩ + obtain ⟨y, hy⟩ := x.2 + refine ⟨f y, ?_⟩ + rw [← hy, f.hom.map_smul] + map_add' := by + rintro ⟨_, x, rfl⟩ ⟨_, ⟨y, rfl⟩⟩ + refine Subtype.ext ?_ + change f ((single _ _ _ • x) + (single _ _ _ • y)) = + f (single _ _ _ • x) + f (single _ _ _ • y) + rw [map_add] + map_smul' := by + rintro r ⟨_, x, rfl⟩ + simp only [RingHom.id_apply, LinearMapClass.map_smul] + refine Subtype.ext ?_ + change f (_ • _) = _ • (_ • f _) + simp only [LinearMapClass.map_smul] } + map_id _ := by ext; rfl + map_comp _ _ := by ext; rfl + +/-- The counit of `toModuleCatOverMatrix ⋙ fromModuleCatOverMatrix`. -/ +@[simps] +def matrix.unitIsoHom : + toModuleCatOverMatrix R ι ⋙ fromModuleCatOverMatrix R ι ⟶ 𝟭 (ModuleCat R) where + app X := ModuleCat.ofHom + { toFun x := ∑ i : ι, x.1 i + map_add' := by + rintro ⟨_, x, rfl⟩ ⟨_, y, rfl⟩ + simp only [toModuleCatOverMatrix_obj_carrier, ← Finset.sum_add_distrib] + rfl + map_smul' := by + rintro r ⟨_, x, rfl⟩ + simp only [toModuleCatOverMatrix_obj_carrier, RingHom.id_apply, Finset.smul_sum] + refine Finset.sum_congr rfl fun i _ => ?_ + change ((single default default r : M[ι, R]) • (single default default 1 • x)) i = + r • (single default default 1 • x) i + rw [← SemigroupAction.mul_smul, single_mul_single_same, mul_one] + change (∑ j : ι, single default default r i j • x j) = + r • (∑ j : ι, single default default 1 i j • x j) + by_cases hi : default = i + · subst hi + rw [Finset.sum_eq_single_of_mem (a := default)] + · rw [Finset.sum_eq_single_of_mem (a := default)] + · simp + · exact Finset.mem_univ _ + · intro j _ hj + simp [single, of_apply, hj.symm] + · exact Finset.mem_univ _ + · intro j _ hj + simp [single, of_apply, hj.symm] + · have hzeroR : ∀ j : ι, single default default r i j • x j = 0 := by + intro j + simp [single, of_apply, hi] + have hzero1 : ∀ j : ι, single default default (1 : R) i j • x j = 0 := by + intro j + simp [single, of_apply, hi] + simp [hzeroR, hzero1] } + naturality {X Y} f := by + simp only [Functor.comp_obj, toModuleCatOverMatrix_obj_carrier, Functor.id_obj, + Functor.comp_map, Functor.id_map] + ext ⟨_, x, rfl⟩ + change ∑ _, _ = f _ + rw [fromModuleCatOverMatrix_map] + simp only [toModuleCatOverMatrix_map, fromModuleCatOverMatrix_obj_carrier, + toModuleCatOverMatrix_obj_carrier] + change ∑ _, (ModuleCat.Hom.hom f) _ = (ConcreteCategory.hom f) (∑ i : ι, ∑ _, _) + rw [map_sum] + refine Finset.sum_congr rfl fun i _ => ?_ + simp only [map_sum, _root_.map_smul] + change f.hom (∑ _, _) = _ + rw [map_sum] + refine Finset.sum_congr rfl fun i _ => ?_ + simp only [_root_.map_smul] + +/-- The inverse unit map for `toModuleCatOverMatrix ⋙ fromModuleCatOverMatrix`. -/ +@[simps] +def matrix.unitIsoInv : + 𝟭 (ModuleCat R) ⟶ toModuleCatOverMatrix R ι ⋙ fromModuleCatOverMatrix R ι where + app X := ModuleCat.ofHom + { toFun x := by + refine ⟨Function.update (0 : ι → X) default x, fun _ => x, ?_⟩ + dsimp + ext i + change ∑ _, _ = _ + simp only [single, of_apply, ite_smul, one_smul, zero_smul, Function.update, + eq_rec_constant, Pi.zero_apply, dite_eq_ite] + split_ifs with h + · subst h + simp only [true_and, Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte] + · apply Finset.sum_eq_zero + intro j _ + rw [if_neg] + tauto + map_add' := by + rintro (x : X) (y : X) + simp only [toModuleCatOverMatrix_obj_carrier] + refine Subtype.ext <| funext fun i ↦ ?_ + change _ = + (Function.update (0 : ι → X) default x + Function.update (0 : ι → X) default y) i + rw [← Function.update_add, zero_add] + map_smul' := by + rintro r (x : X) + simp only [toModuleCatOverMatrix_obj_carrier, RingHom.id_apply] + refine Subtype.ext <| funext fun i ↦ ?_ + change _ = ∑ _, single default default r i _ • _ + simp only [Function.update, eq_rec_constant, Pi.zero_apply, dite_eq_ite, smul_ite, + smul_zero, Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte] + split_ifs with h + · subst h + simp only [single_apply_same] + · rw [single_apply_of_row_ne, zero_smul] + exact Ne.symm h } + naturality {X Y} f := by + simp only [Functor.id_obj, Functor.comp_obj, toModuleCatOverMatrix_obj_carrier, + Functor.id_map, Functor.comp_map] + ext x + refine Subtype.ext <| funext fun i ↦ ?_ + simp only [toModuleCatOverMatrix_obj_carrier, fromModuleCatOverMatrix_obj_carrier] + change Function.update (0 : ι → Y) default (f x) i = + f (Function.update (0 : ι → X) default x i) + simp only [Function.update, eq_rec_constant, Pi.zero_apply, dite_eq_ite] + split_ifs with h + · rfl + · rw [map_zero] + +/-- The natural isomorphism from `toModuleCatOverMatrix ⋙ fromModuleCatOverMatrix` +to the identity. -/ +@[simps] +def matrix.unitIso : + toModuleCatOverMatrix R ι ⋙ fromModuleCatOverMatrix R ι ≅ + 𝟭 (ModuleCat R) where + hom := matrix.unitIsoHom R ι + inv := matrix.unitIsoInv R ι + hom_inv_id := by + ext X ⟨_, x, rfl⟩ + simp only [Functor.comp_obj, toModuleCatOverMatrix_obj_carrier, NatTrans.comp_app, + Functor.id_obj, NatTrans.id_app] + refine Subtype.ext <| funext fun i ↦ ?_ + change Function.update (0 : ι → X) default (∑ j, (single default default 1 • x) j) i = + ∑ j : ι, single default default 1 i j • x j + simp only [Function.update, eq_rec_constant, Pi.zero_apply, dite_eq_ite] + split_ifs with h + · refine Finset.sum_congr rfl fun i _ => ?_ + change ∑ _, _ = _ + subst h + simp only [single, of_apply, ite_smul, one_smul, zero_smul, true_and] + split_ifs with h + · subst h + simp only [true_and, Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte] + · apply Finset.sum_eq_zero + intro j _ + rw [if_neg] + tauto + · symm + apply Finset.sum_eq_zero + intro j _ + rw [single_apply_of_row_ne, zero_smul] + exact Ne.symm h + inv_hom_id := by + ext X (x : X) + simp only [Functor.id_obj, NatTrans.comp_app, Functor.comp_obj, NatTrans.id_app] + change (∑ i : ι, Function.update (0 : ι → X) default x i) = x + simp [Function.update] + +/-- The linear isomorphism comparing a matrix-module with its reconstructed coordinate module. -/ +noncomputable def matrix.counitIsoHomMap (M : ModuleCat M[ι, R]) : + M ≅ (fromModuleCatOverMatrix R ι ⋙ toModuleCatOverMatrix R ι).obj M := + LinearEquiv.toModuleIso <| .ofBijective + ({toFun m i := by + refine ⟨(single default i 1 : M[ι, R]) • m, (single default i 1 : M[ι, R]) • m, ?_⟩ + simp only [← SemigroupAction.mul_smul, single_mul_single_same, mul_one] + map_add' x y := funext fun i ↦ Subtype.ext <| + show (single default i 1 : M[ι, R]) • (x + y) = + (single default i 1 : M[ι, R]) • x + + (single default i 1 : M[ι, R]) • y from smul_add _ _ _ + map_smul' x m := funext fun i ↦ Subtype.ext <| by + simp only [RingHom.id_apply] + change _ = Subtype.val (∑ _, _) + simp only [AddSubmonoidClass.coe_finset_sum] + change single default i 1 • x • m = + ∑ j : ι, (single default default (x i j) : M[ι, R]) • + (single default j 1 • m) + simp_rw [← SemigroupAction.mul_smul, single_mul_single_same, mul_one, ← Finset.sum_smul] + congr 2 + conv_lhs => rw [Matrix.matrix_eq_sum_single x] + rw [Finset.mul_sum] + simp_rw [Finset.mul_sum] + rw [Finset.sum_eq_single_of_mem (a := i)] + pick_goal 2 + · exact Finset.mem_univ i + pick_goal 2 + · intro j _ hj + apply Finset.sum_eq_zero + intro k _ + rw [single_mul_single_of_ne] + exact hj.symm + simp_rw [single_mul_single_same, one_mul] } : M →ₗ[M[ι, R]] ι → (α R ι ↑M)) + ⟨by + rw [← LinearMap.ker_eq_bot, eq_bot_iff] + rintro x (hx : _ = 0) + simp only [LinearMap.coe_mk, AddHom.coe_mk] at hx + rw [show x = ∑ i : ι, (single i i 1 : M[ι, R]) • x by + rw [← Finset.sum_smul, show ∑ i : ι, (single i i 1 : M[ι, R]) = 1 by + ext + simp only [sum_apply, single, one_apply] + split_ifs with h + · subst h + simp only [of_apply, and_self, Finset.sum_ite_eq', Finset.mem_univ, + ↓reduceIte] + · apply Finset.sum_eq_zero + intro k _ + simp_all]; rw [one_smul]] + refine Submodule.sum_mem _ fun i _ => ?_ + rw [show (single i i 1 : M[ι, R]) = + single i default 1 * single default i 1 + by rw [single_mul_single_same, one_mul], SemigroupAction.mul_smul] + refine Submodule.smul_mem _ _ ?_ + rw [show _ • x = 0 from Subtype.ext_iff.1 <| congr_fun hx i] + rfl, fun v ↦ by + refine ⟨∑ k, (single k default 1 : M[ι, R]) • v k, ?_⟩ + simp only [map_sum, _root_.map_smul, LinearMap.coe_mk, AddHom.coe_mk] + conv_rhs => rw [show v = ∑ k : ι, Function.update (0 : ι → (α R ι M)) k (v k) by + ext i + simp only [Finset.sum_apply, Function.update, eq_rec_constant, Pi.zero_apply, dite_eq_ite, + Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte]] + refine Finset.sum_congr rfl fun i _ => ?_ + ext j + by_cases hij : i = j + · subst hij + change Subtype.val (∑ _, _) = _ + simp only [AddSubmonoidClass.coe_finset_sum, Function.update_self] + change ∑ j : ι, (single default default (single i default (1 : R) i j) : M[ι, R]) • + (single default j 1 • (v i : M)) = (v i : M) + simp_rw [← SemigroupAction.mul_smul, single_mul_single_same, mul_one] + rw [Finset.sum_eq_single_of_mem (a := default), single_apply_same] + pick_goal 2 + · exact Finset.mem_univ _ + pick_goal 2 + · intro j _ hj + convert zero_smul (Matrix ι ι R) (v i).val using 2 + simp [single, of_apply, hj.symm] + rfl + obtain ⟨y, hy⟩ := (v i).2 + rw [← hy] + simp only [← SemigroupAction.mul_smul, single_mul_single_same, mul_one] + · rw [Function.update_of_ne] + pick_goal 2 + · exact Ne.symm hij + change Subtype.val (∑ _, _) = 0 + simp only [AddSubmonoidClass.coe_finset_sum] + change ∑ k : ι, + (single default default (single i default (1 : R) j k) : M[ι, R]) • + (single default k 1 • (v i : M)) = 0 + apply Finset.sum_eq_zero + intro k _ + rw [single_apply_of_ne, single_zero, zero_smul] + tauto⟩ + +/-- The counit map from the reconstructed matrix-module to the original matrix-module. -/ +@[simps] +noncomputable def matrix.counitIsoHom : + fromModuleCatOverMatrix R ι ⋙ toModuleCatOverMatrix R ι ⟶ 𝟭 (ModuleCat M[ι, R]) where + app M := (matrix.counitIsoHomMap R ι M).inv + naturality X Y f := by + simp only [Functor.comp_obj, Functor.id_obj, Functor.comp_map, Functor.id_map] + rw [Iso.eq_inv_comp, ← Category.assoc, Iso.comp_inv_eq] + ext x + simp only [toModuleCatOverMatrix_obj_carrier, fromModuleCatOverMatrix_obj_carrier, + toModuleCatOverMatrix_obj_isModule, ModuleCat.hom_comp] + refine funext fun i ↦ ?_ + erw [toModuleCatOverMatrix_map, ModuleCat.hom_ofHom] + refine Subtype.ext ?_ + change f (single default i 1 • x) = single default i 1 • f x + rw [map_smul] + +/-- The inverse of the matrix-module counit map. -/ +@[simps] +noncomputable def matrix.counitIsoInv : + 𝟭 (ModuleCat M[ι, R]) ⟶ + fromModuleCatOverMatrix R ι ⋙ toModuleCatOverMatrix R ι where + app M := (matrix.counitIsoHomMap R ι M).hom + naturality X Y f := by + simp only [Functor.id_obj, Functor.comp_obj, Functor.id_map, Functor.comp_map] + ext x + simp only [Functor.comp_obj, fromModuleCatOverMatrix_obj_carrier, + toModuleCatOverMatrix_obj_carrier] + refine funext fun i ↦ Subtype.ext ?_ + change single default i 1 • f x = f (single default i 1 • x) + rw [map_smul] + +/-- The natural isomorphism from `fromModuleCatOverMatrix ⋙ toModuleCatOverMatrix` +to the identity. -/ +@[simps] +noncomputable def matrix.counitIso : + fromModuleCatOverMatrix R ι ⋙ toModuleCatOverMatrix R ι ≅ 𝟭 (ModuleCat M[ι, R]) where + hom := matrix.counitIsoHom R ι + inv := matrix.counitIsoInv R ι + hom_inv_id := by ext X x; simp + inv_hom_id := by ext; simp + +/-- The Morita equivalence between modules over `R` and modules over `Matrix ι ι R`. -/ +@[simps] +noncomputable def moritaEquivalentToMatrix : ModuleCat R ≌ ModuleCat M[ι, R] where + functor := toModuleCatOverMatrix R ι + inverse := fromModuleCatOverMatrix R ι + unitIso := matrix.unitIso R ι |>.symm + counitIso := matrix.counitIso R ι + functor_unitIso_comp X := by + simp only [Iso.symm_hom, matrix.unitIso_inv, toModuleCatOverMatrix_map, + fromModuleCatOverMatrix_obj_carrier, toModuleCatOverMatrix_obj_carrier, + matrix.counitIso_hom] + ext v + apply_fun (matrix.counitIsoHomMap R ι ((toModuleCatOverMatrix R ι).obj X)).hom using + LinearEquiv.injective _ + rw [ModuleCat.hom_id] + change _ = (ModuleCat.Hom.hom (matrix.counitIsoHomMap R ι + ((toModuleCatOverMatrix R ι).obj X)).hom) v + erw [Iso.inv_hom_id_apply] + refine funext fun i => ?_ + apply Subtype.ext + funext j + change Function.update (0 : ι → X) default (v i) j = + (∑ k : ι, single default i (1 : R) j k • v k) + by_cases h : j = default + · subst h + simp [Function.update, single] + · simp [Function.update, single, h, Ne.symm h] + +namespace IsMoritaEquivalent +namespace division_ring -- auxilaries for division rings, don't use + +variable (R : Type u) (S : Type u) [DivisionRing R] [DivisionRing S] +variable (e : ModuleCat.{u} R ≌ ModuleCat.{u} S) + +-- This is a lemma on purpose, **don't** attempt to look at its definition +lemma division_ring_exists_unique_isSimpleModule + (S : Type u) [DivisionRing S] (N : Type*) [AddCommGroup N] [Module S N] [IsSimpleModule S N] : + Nonempty (N ≃ₗ[S] S) := by + have inst4 := IsSimpleModule.nontrivial S N + have H := Module.Free.of_divisionRing S N + rw [Module.free_iff_set] at H + obtain ⟨s, ⟨b⟩⟩ := H + if hs1 : s = ∅ + then + subst hs1 + have := b.index_nonempty + simp only [nonempty_subtype, Set.mem_empty_iff_false, exists_const] at this + else + obtain ⟨i, hi⟩ := Set.nonempty_iff_ne_empty.mpr hs1 + have eq0 := IsSimpleOrder.eq_bot_or_eq_top (Submodule.span S {b ⟨i, hi⟩}) |>.resolve_left (by + intro h + simp only [Submodule.span_singleton_eq_bot] at h + exact b.ne_zero ⟨i, hi⟩ h) + have eq : s = {i} := by + refine le_antisymm ?_ (by simpa) + simp only [Set.le_eq_subset, Set.subset_singleton_iff] + intro j hj + have mem : b ⟨j, hj⟩ ∈ Submodule.span S {b ⟨i, hi⟩} := eq0 ▸ ⟨⟩ + rw [Submodule.mem_span_singleton] at mem + obtain ⟨r, hr⟩ := mem + have hr' := congr(b.repr $hr) + simp only [LinearMapClass.map_smul, Basis.repr_self, Finsupp.smul_single, smul_eq_mul, + mul_one] at hr' + by_contra rid + have hr' := congr($hr' ⟨i, hi⟩) + rw [Finsupp.single_eq_same, Finsupp.single_eq_of_ne (h := by simpa [eq_comm] using rid)] + at hr' + subst hr' + simp only [zero_smul] at hr + exact b.ne_zero _ hr.symm |>.elim + subst eq + refine ⟨b.repr ≪≫ₗ LinearEquiv.ofBijective ⟨⟨fun x => x ⟨i, by simp⟩, ?_⟩, ?_⟩ ⟨?_, ?_⟩⟩ + · intro x y; simp + · intro x y; simp + · intro x y hxy; ext; simpa using hxy + · intro x; exact ⟨Finsupp.single ⟨i, by simp⟩ x, by simp⟩ + +instance : e.functor.Additive := + Functor.additive_of_preserves_binary_products _ + +lemma isSimpleModule_iff_injective_or_eq_zero + (R : Type u) [Ring R] (M : ModuleCat R) : + IsSimpleModule R M ↔ + (Nontrivial M ∧ ∀ (N : ModuleCat R) (f : M ⟶ N), f = 0 ∨ Function.Injective f) := by + constructor + · intros inst1 + constructor + · have := inst1.1.1 + rwa [Submodule.nontrivial_iff] at this + · intro N f + refine inst1.1.2 (LinearMap.ker f.hom) |>.elim + (fun h => Or.inr <| by rwa [LinearMap.ker_eq_bot] at h) <| + fun h ↦ Or.inl <| by + simp only [LinearMap.ker_eq_top] at h + ext : 1 + rw [h]; simp + · rintro ⟨inst1, h⟩ + rw [isSimpleModule_iff] + refine ⟨fun p => ?_⟩ + refine h (.of R (M ⧸ p)) (ModuleCat.ofHom (Submodule.mkQ p)) |>.elim (fun h => Or.inr ?_) <| + fun h ↦ .inl <| eq_bot_iff.2 fun x hx => h ?_ + · rw [ModuleCat.hom_ext_iff] at h + simp only [ModuleCat.of_coe, ModuleCat.hom_zero, ModuleCat.hom_ofHom] at h + rw [← Submodule.ker_mkQ p, LinearMap.ker_eq_top, h] + · rw [map_zero] + exact Submodule.Quotient.mk_eq_zero _ |>.2 hx + +open ZeroObject + +variable {R S} in +instance _root_.CategoryTheory.Equivalence.nontrivial + {R S : Type u} [Ring R] [Ring S] (e : ModuleCat.{v} R ≌ ModuleCat.{v} S) + (M : ModuleCat.{v} R) [h : Nontrivial M] : Nontrivial (e.functor.obj M) := by + obtain ⟨m, n, h⟩ := h + by_contra inst1 + rw [not_nontrivial_iff_subsingleton] at inst1 + let iso1 : e.functor.obj M ≅ 0 := + { hom := ModuleCat.ofHom ⟨⟨fun _ => 0, by intros; simp⟩, by intros; simp⟩ + inv := ModuleCat.ofHom ⟨⟨fun _ => 0, by intros; simp⟩, by intros; simp⟩ + hom_inv_id := by ext; exact Subsingleton.elim _ _ + inv_hom_id := by ext; simp only [Limits.id_zero]; rfl } + let iso2 : M ≅ 0 := calc M + _ ≅ e.inverse.obj (e.functor.obj M) := e.unitIso.app M + _ ≅ e.inverse.obj 0 := e.inverse.mapIso iso1 + _ ≅ 0 := e.inverse.mapZeroObject + let iso3 : (0 : ModuleCat R) ≅ ModuleCat.of.{v, u} R PUnit.{v + 1} := + { hom := ModuleCat.ofHom ⟨⟨fun _ => 0, by intros; simp⟩, by intros; simp⟩ + inv := ModuleCat.ofHom ⟨⟨fun _ => 0, by intros; simp⟩, by intros; simp⟩ + hom_inv_id := by ext; simp only [Limits.id_zero]; rfl + inv_hom_id := rfl } + -- have := iso3.toLinearEquiv.injective (by + -- have : ∀ x y : ModuleCat.of R PUnit.{1}, x = y x y :↦by + -- exact rfl + -- exact this m n + -- ) + refine h <| LinearEquiv.injective iso2.toLinearEquiv <| + iso3.toLinearEquiv.injective <| Subsingleton.elim _ _ + +variable (K : Type u) [Field K] + +namespace IsSimpleModule + +lemma functor + (R S : Type u) [Ring R] [Ring S] (e : ModuleCat.{v} R ≌ ModuleCat.{v} S) + (M : ModuleCat.{v} R) [simple_module : IsSimpleModule R M] : + IsSimpleModule S (e.functor.obj M) := by + rw [isSimpleModule_iff_injective_or_eq_zero] at simple_module ⊢ + rcases simple_module with ⟨nontriv, H⟩ + refine ⟨e.nontrivial (h := nontriv), fun N f => ?_⟩ + let F := e.unit.app M ≫ e.inverse.map f + rcases H _ F with H|H + · have hzero : e.inverse.map f = 0 := by + apply (cancel_epi (e.unit.app M)).1 + simpa [F] using H + replace H : e.inverse.map f = e.inverse.map 0 := by simpa using hzero + exact .inl <| e.inverse.map_injective H + · simp only [Functor.id_obj, Functor.comp_obj, F] at H + refine Or.inr ?_ + rw [← ModuleCat.mono_iff_injective] at H ⊢ + letI : Mono (e.unit.app M ≫ e.inverse.map f) := H + have m1 : Mono (e.functor.map <| e.unit.app M ≫ e.inverse.map f) := e.functor.map_mono _ + simp only [Functor.id_obj, Functor.comp_obj, Functor.map_comp, Equivalence.fun_inv_map, + Equivalence.functor_unit_comp_assoc] at m1 + letI : Mono (f ≫ e.counitInv.app N) := m1 + exact mono_of_mono f (e.counitInv.app N) + +end IsSimpleModule + +end division_ring + +end IsMoritaEquivalent + +omit [Inhabited ι] in +lemma matrix_smul_vec_def {M : Type*} [AddCommGroup M] [Module R M] (N : M[ι, R]) + (v : ι → M) : + N • v = fun i ↦ ∑ j : ι, N i j • v j := rfl + +omit [Inhabited ι] in +lemma matrix_smul_vec_def' {M : Type*} [AddCommGroup M] [Module R M] (N : M[ι, R]) + (v : ι → M) : + N • v = ∑ j : ι, fun i ↦ N i j • v j := by + rw [matrix_smul_vec_def] + ext + simp + +omit [Inhabited ι] in +lemma matrix_smul_vec_apply {M : Type*} [AddCommGroup M] [Module R M] (N : M[ι, R]) + (v : ι → M) (i : ι) : + (N • v) i = ∑ j : ι, N i j • v j := rfl From 649db4d77ee2cd6b1ce4662d7e9cdf6cc062ffc8 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 12:21:55 -0700 Subject: [PATCH 10/34] Restore BrauerGroup splitting prerequisites --- LeanPool.lean | 4 + LeanPool/BrauerGroupNew.lean | 1 + .../BrauerGroupNew/Mathlib/RingTheory.lean | 1 + .../Mathlib/RingTheory/Congruence.lean | 14 + .../Mathlib/RingTheory/Congruence/Basic.lean | 47 +++ .../Mathlib/RingTheory/Congruence/Defs.lean | 26 ++ LeanPool/BrauerGroupNew/SplittingOfCSA.lean | 296 ++++++++++++++++++ 7 files changed, 389 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RingTheory/Congruence.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RingTheory/Congruence/Basic.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RingTheory/Congruence/Defs.lean create mode 100644 LeanPool/BrauerGroupNew/SplittingOfCSA.lean diff --git a/LeanPool.lean b/LeanPool.lean index b9cbcabde7..f181291524 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -79,6 +79,9 @@ import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.LinearIndependent.Defs import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Span import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Span.Basic import LeanPool.BrauerGroupNew.Mathlib.RingTheory +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.Congruence +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.Congruence.Basic +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.Congruence.Defs import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubring import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubring.Defs import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubsemiring @@ -91,6 +94,7 @@ import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Operations import LeanPool.BrauerGroupNew.MatrixCenterEquiv import LeanPool.BrauerGroupNew.MatrixEquivTensor import LeanPool.BrauerGroupNew.MoritaEquivalence +import LeanPool.BrauerGroupNew.SplittingOfCSA import LeanPool.BrauerGroupNew.Subfield import LeanPool.BrauerGroupNew.Subfield.Defs import LeanPool.BrauerGroupNew.Subfield.FiniteDimensional diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index bbf11e40b3..741887840f 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -15,6 +15,7 @@ import LeanPool.BrauerGroupNew.LemmasAboutSimpleRing import LeanPool.BrauerGroupNew.MatrixCenterEquiv import LeanPool.BrauerGroupNew.MatrixEquivTensor import LeanPool.BrauerGroupNew.MoritaEquivalence +import LeanPool.BrauerGroupNew.SplittingOfCSA import LeanPool.BrauerGroupNew.TwoSidedIdeal import LeanPool.BrauerGroupNew.Wedderburn import LeanPool.BrauerGroupNew.Mathlib diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory.lean index 0b76b179a3..7df286eac6 100644 --- a/LeanPool/BrauerGroupNew/Mathlib/RingTheory.lean +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory.lean @@ -6,6 +6,7 @@ Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubring import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubsemiring +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.Congruence import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal /-! diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/Congruence.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/Congruence.lean new file mode 100644 index 0000000000..34ab729a34 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/Congruence.lean @@ -0,0 +1,14 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.Congruence.Basic +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.Congruence.Defs + +/-! +# Brauer Group New Mathlib RingTheory Congruence + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/Congruence/Basic.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/Congruence/Basic.lean new file mode 100644 index 0000000000..7c53eed243 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/Congruence/Basic.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.Algebra.Algebra.Hom +import Mathlib.Algebra.RingQuot +import Mathlib.RingTheory.Congruence.Basic + +/-! +# Ring congruence quotient compatibility + +This file restores the upstream quotient-map names used by the Brauer group port. +-/ + +namespace RingCon + +variable {α R : Type*} + +instance [Semiring α] [NonAssocSemiring R] [Module α R] [IsScalarTower α R R] + (c : RingCon R) : Module α c.Quotient where + zero_smul x := by + induction x using Quotient.ind + change ⟦_⟧ = ⟦_⟧ + simp + add_smul r s x := by + induction x using Quotient.ind + change ⟦_⟧ = ⟦_⟧ + simp [add_smul] + +variable (α) in +/-- The quotient map as a linear map. -/ +def mkL [Semiring α] [NonAssocSemiring R] [Module α R] [IsScalarTower α R R] + (c : RingCon R) : R →ₗ[α] c.Quotient where + __ := c.mk' + map_smul' _ _ := rfl + +lemma algebraMap_def [CommSemiring α] [Semiring R] [Algebra α R] (c : RingCon R) : + algebraMap α c.Quotient = c.mk'.comp (algebraMap α R) := rfl + +variable (α) in +/-- The quotient map as an algebra homomorphism. -/ +def mkA [CommSemiring α] [Semiring R] [Algebra α R] (c : RingCon R) : R →ₐ[α] c.Quotient := + c.mkₐ (S := α) + +end RingCon diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/Congruence/Defs.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/Congruence/Defs.lean new file mode 100644 index 0000000000..9e64024898 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/Congruence/Defs.lean @@ -0,0 +1,26 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.RingTheory.Congruence.Defs + +/-! +# Ring congruence induction compatibility + +This file restores the upstream eliminator name used by the Brauer group port. +-/ + +namespace RingCon + +variable {R : Type*} [Ring R] + +@[elab_as_elim] +lemma quot_ind (r : RingCon R) {motive : r.Quotient → Prop} + (basic : ∀ x : R, motive (r.mk' x)) : ∀ x : r.Quotient, motive x := by + intro x + induction x using Quotient.inductionOn' with + | h x => exact basic x + +end RingCon diff --git a/LeanPool/BrauerGroupNew/SplittingOfCSA.lean b/LeanPool/BrauerGroupNew/SplittingOfCSA.lean new file mode 100644 index 0000000000..617f7388fc --- /dev/null +++ b/LeanPool/BrauerGroupNew/SplittingOfCSA.lean @@ -0,0 +1,296 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.AlgClosedUnion +import LeanPool.BrauerGroupNew.ExtendScalar +import LeanPool.BrauerGroupNew.LemmasAboutSimpleRing +import Mathlib.Algebra.BrauerGroup.Defs +import Mathlib.Algebra.Central.Matrix +import Mathlib.Analysis.Normed.Ring.Lemmas +import Mathlib.LinearAlgebra.FreeModule.PID +import Mathlib.RingTheory.SimpleRing.Matrix + +/-! +# Splitting central simple algebras + +This file ports the upstream splitting-field infrastructure for central simple algebras. +-/ + +suppress_compilation + +universe u v w +variable (k A K : Type u) [Field k] [Field K] [Algebra k K] [Ring A] [Algebra k A] + +variable (k_bar : Type u) [Field k_bar] [Algebra k k_bar] + [hk_bar : IsAlgClosure k k_bar] (k_s : Type u) [Field k_s] [Algebra k k_s] + +open scoped TensorProduct +open RingCon + +instance module_over_over (A : CSA k) (I : TwoSidedIdeal A) : + Module k I := Module.compHom I (algebraMap k A) + +theorem is_simple_A [IsSimpleRing (K ⊗[k] A)] : IsSimpleRing A := IsSimpleRing.right_of_tensor k K A + +theorem central_over_extension_iff_subsingleton + [Subsingleton A] [FiniteDimensional k A] [FiniteDimensional k K] : + Algebra.IsCentral k A ↔ Algebra.IsCentral K (K ⊗[k] A) := by + have : Subsingleton (K ⊗[k] A) := by + rw [← subsingleton_iff_zero_eq_one, show (0 : K ⊗[k] A) = 0 ⊗ₜ 0 by simp, + show (1 : K ⊗[k] A) = 1 ⊗ₜ 1 by rfl, show (1 : A) = 0 from Subsingleton.elim _ _] + simp + constructor <;> + · intro h + refine ⟨fun x hx => ?_⟩ + rw [show x = 0 from Subsingleton.elim _ _] + exact Subalgebra.zero_mem ⊥ + +theorem isSimple_over_extension_iff_subsingleton + [Subsingleton A] [FiniteDimensional k A] [FiniteDimensional k K] : + IsSimpleRing A ↔ IsSimpleRing (K ⊗[k] A) := by + have : Subsingleton (K ⊗[k] A) := by + rw [← subsingleton_iff_zero_eq_one, show (0 : K ⊗[k] A) = 0 ⊗ₜ 0 by simp, + show (1 : K ⊗[k] A) = 1 ⊗ₜ 1 by rfl, show (1 : A) = 0 from Subsingleton.elim _ _] + simp + constructor <;> + · intro h + have : Nontrivial (K ⊗[k] A) := inferInstance + rw [← not_subsingleton_iff_nontrivial] at this + contradiction + +theorem centralSimple_over_extension_iff_nontrivial + [Nontrivial A] [FiniteDimensional k A] [FiniteDimensional k K] : + (Algebra.IsCentral k A ∧ IsSimpleRing A) ↔ + (Algebra.IsCentral K (K ⊗[k] A) ∧ IsSimpleRing (K ⊗[k] A)) where + mp := fun ⟨_, _⟩ ↦ ⟨inferInstance, inferInstance⟩ + mpr := fun ⟨hAt, _⟩ ↦ ⟨by + constructor + by_contra h + simp only [le_bot_iff] at h + have : 1 < Module.finrank k (Subalgebra.center k A) := by + have eq1 := Subalgebra.finrank_bot (F := k) (E := A) + have ineq1 := Submodule.finrank_lt_finrank_of_lt + (s := Subalgebra.toSubmodule (⊥ : Subalgebra k A)) + (t := Subalgebra.toSubmodule (Subalgebra.center k A)) (by + simp only [OrderEmbedding.lt_iff_lt] + rw [bot_lt_iff_ne_bot] + exact h) + erw [eq1] at ineq1 + exact ineq1 + let e : K ⊗[k] Subalgebra.center k A ≃ₗ[k] Subalgebra.center k (K ⊗[k] A) := + (TensorProduct.congr (Submodule.topEquiv.symm ≪≫ₗ + show _ ≃ₗ[k] Subalgebra.toSubmodule (Subalgebra.center k K) from LinearEquiv.ofLinear + (Submodule.inclusion (by simp)) (Submodule.inclusion (by simp)) rfl rfl) + (LinearEquiv.refl _ _)) ≪≫ₗ + (IsCentralSimple.centerTensor k K A) + have eq1 : Module.finrank k (Subalgebra.center k (K ⊗[k] A)) = + Module.finrank k K * + Module.finrank k (Subalgebra.center k A) := by + rw [LinearEquiv.finrank_eq e.symm, Module.finrank_tensorProduct] + have eq2 : Module.finrank k (Subalgebra.center K (K ⊗[k] A)) = + Module.finrank k K * + Module.finrank k (Subalgebra.center k A) := by + rw [← eq1]; congr + have eq3 : Module.finrank k (Subalgebra.center K (K ⊗[k] A)) = + Module.finrank k K * + Module.finrank K (Subalgebra.center K (K ⊗[k] A)) := by + rw [Module.finrank_mul_finrank] + have eq4 : Module.finrank K (Subalgebra.center K (K ⊗[k] A)) = 1 := by + rw [← Subalgebra.finrank_bot (F := K) (E := K ⊗[k] A)] + have := hAt.center_eq_bot + rw [this.symm] + rw [eq4, mul_one] at eq3 + rw [eq3] at eq2 + have ineq0 : 0 < Module.finrank k K := Module.finrank_pos + have ineq1 : + Module.finrank k K < + Module.finrank k K * Module.finrank k (Subalgebra.center k A) := by + apply lt_mul_right <;> assumption + conv_lhs at ineq1 => rw [eq2] + exact Nat.lt_irrefl _ ineq1, is_simple_A k A K⟩ + +theorem centralsimple_over_extension_iff + [FiniteDimensional k A] [FiniteDimensional k K] : + (Algebra.IsCentral k A ∧ IsSimpleRing A) ↔ + (Algebra.IsCentral K (K ⊗[k] A) ∧ IsSimpleRing (K ⊗[k] A)) := by + obtain h|h := subsingleton_or_nontrivial A + · refine ⟨fun ⟨_, _⟩ ↦ ⟨?_, ?_⟩, fun ⟨_, _⟩ ↦ ⟨?_, ?_⟩⟩ + · rwa [← central_over_extension_iff_subsingleton] + · rwa [← isSimple_over_extension_iff_subsingleton] + · rwa [central_over_extension_iff_subsingleton k A K] + · rwa [isSimple_over_extension_iff_subsingleton k A K] + · apply centralSimple_over_extension_iff_nontrivial + +/-- Scalar extension of a central simple algebra is again a central simple algebra. -/ +def extension_CSA (A : CSA k) : CSA K where + toAlgCat := .of K (K ⊗[k] A) + fin_dim := Module.Finite.base_change k K A.carrier + +/-- Descend a central simple algebra structure from a finite scalar extension. -/ +def extension_inv [FiniteDimensional k A] + [Algebra.IsCentral K (K ⊗[k] A)] [IsSimpleRing (K ⊗[k] A)] + [FiniteDimensional K (K ⊗[k] A)] + [FiniteDimensional k K] : CSA k where + toAlgCat := .of k A + isCentral := centralsimple_over_extension_iff k A K |>.2 ⟨inferInstance, inferInstance⟩ |>.1 + isSimple := centralsimple_over_extension_iff k A K |>.2 ⟨inferInstance, inferInstance⟩ |>.2 + fin_dim := by + have := centralsimple_over_extension_iff k A K |>.2 ⟨inferInstance, inferInstance⟩ |>.2 + let to_ten: A →ₐ[k] K ⊗[k] A := + { + toFun := fun a ↦ 1 ⊗ₜ a + map_one' := rfl + map_mul' := by simp + map_zero' := TensorProduct.tmul_zero A 1 + map_add' := TensorProduct.tmul_add 1 + commutes' := fun _ ↦ Algebra.TensorProduct.algebraMap_apply' _|>.symm + } + have Isinj : Function.Injective to_ten := by + have := IsSimpleRing.iff_eq_zero_or_injective' A k|>.1 inferInstance (B := K ⊗[k] A) to_ten + have nezero : TwoSidedIdeal.ker to_ten ≠ ⊤ := by + intro h + have : (1 : A) ∈ (⊤ : TwoSidedIdeal A) := by simp + rw [h.symm, TwoSidedIdeal.mem_ker] at this + simp only [map_one, one_ne_zero] at this + simp only [nezero, false_or] at this + exact this + haveI : FiniteDimensional k (K ⊗[k] A) := Module.Finite.trans (R := k) K (K ⊗[k] A) + exact FiniteDimensional.of_injective (K := k) to_ten.toLinearMap Isinj + +theorem CSA_iff_exist_split (k_bar : Type u) [Field k_bar] [Algebra k k_bar] + [hk_bar : IsAlgClosure k k_bar] [hA : FiniteDimensional k A] : + Algebra.IsCentral k A ∧ IsSimpleRing A ↔ + ∃ n ≠ 0, ∃ (L : Type u) (_ : Field L) (_ : Algebra k L) (_ : FiniteDimensional k L), + Nonempty (L ⊗[k] A ≃ₐ[L] Matrix (Fin n) (Fin n) L) := by + constructor + · rintro ⟨_, _⟩ + haveI := hk_bar.1 + obtain ⟨n, hn, ⟨iso⟩⟩ := simple_eq_matrix_algClosed k_bar (k_bar ⊗[k] A) + refine ⟨n, hn, ?_⟩ + use lemma_tto.ℒℒ n k k_bar A iso + have : NeZero n := ⟨hn⟩ + exact ⟨_, _, inferInstance, ⟨lemma_tto.isoRestrict n k k_bar A iso⟩⟩ + · rintro ⟨n, hn, L, _, _, _, ⟨iso⟩⟩ + have : NeZero n := ⟨hn⟩ + refine (centralsimple_over_extension_iff k A L).mpr <| ⟨iso.symm.isCentral, ⟨?_⟩⟩ + rw [← TwoSidedIdeal.orderIsoOfRingEquiv iso.symm.toRingEquiv |>.isSimpleOrder_iff] + exact IsSimpleRing.simple + +lemma dim_is_sq (k_bar : Type u) [Field k_bar] [Algebra k k_bar] [hk_bar : IsAlgClosure k k_bar] + [Algebra.IsCentral k A] [IsSimpleRing A] [FiniteDimensional k A] : + IsSquare (Module.finrank k A) := by + haveI := hk_bar.1 + obtain ⟨n, _, ⟨iso⟩⟩ := simple_eq_matrix_algClosed k_bar (k_bar ⊗[k] A) + refine ⟨n, ?_⟩ + have := Module.finrank_matrix k_bar k_bar (Fin n) (Fin n) + simp only [Fintype.card_fin, Module.finrank_self, mul_one] at this + exact dim_eq k k_bar A|>.trans <| LinearEquiv.finrank_eq iso.toLinearEquiv|>.trans this + +/-- The degree of a central simple algebra, defined by the square root of its dimension. -/ +def deg (A : CSA k) : ℕ := dim_is_sq k A k_bar |>.choose + +lemma deg_sq_eq_dim (A : CSA k) : (deg k k_bar A) ^ 2 = Module.finrank k A := + by rw [pow_two]; exact dim_is_sq k A k_bar |>.choose_spec.symm + +instance deg_pos (A : CSA k) : NeZero (deg k k_bar A) := by + constructor + by_contra! h + apply_fun (·^2) at h + rw [deg_sq_eq_dim k k_bar A, pow_two, mul_zero] at h + have := Module.finrank_pos_iff (R := k) (M := A)|>.2 inferInstance + linarith + +/-- Data witnessing that a field extension splits a central simple algebra. -/ +structure split (A : CSA k) (K : Type*) [Field K] [Algebra k K] where + /-- The matrix size after scalar extension. -/ + (n : ℕ) [hn : NeZero n] + /-- The scalar-extended algebra is a matrix algebra over the extension field. -/ + (iso : K ⊗[k] A ≃ₐ[K] Matrix (Fin n) (Fin n) K) + +/-- A field extension splits an algebra if the scalar extension is a matrix algebra. -/ +def isSplit (L : Type u) [Field L] [Algebra k L] : Prop := + ∃ (n : ℕ) (_ : NeZero n), + Nonempty (L ⊗[k] A ≃ₐ[L] Matrix (Fin n) (Fin n) L) + +/-- Any algebraic closure splits a central simple algebra. -/ +def split_by_alg_closure (A : CSA k) : split k A k_bar where + n := deg k k_bar A + iso := by + haveI := hk_bar.1 + choose n _ iso using simple_eq_matrix_algClosed k_bar (k_bar ⊗[k] A) + have iso' := iso.some; clear iso + have e : Matrix (Fin n) (Fin n) k_bar ≃ₐ[k_bar] Matrix (Fin (deg k k_bar A)) + (Fin (deg k k_bar A)) k_bar := by + suffices n = deg k k_bar A from Matrix.reindexAlgEquiv k_bar _ (finCongr this) + have := deg_sq_eq_dim k k_bar A + rw [pow_two] at this + have e1 := LinearEquiv.finrank_eq iso'.toLinearEquiv|>.trans <| + Module.finrank_matrix k_bar _ (Fin n) (Fin n) + simp only [Module.finrank_tensorProduct, Module.finrank_self, one_mul, Fintype.card_fin, + mul_one] at e1 + have := this.trans e1 + exact Nat.mul_self_inj.mp (id this.symm) + exact iso'.trans e + +/-- Splitting is preserved after extending the splitting field. -/ +def extension_over_split (A : CSA k) (L L' : Type u) [Field L] [Field L'] [Algebra k L] + (hA : split k A L) [Algebra L L'] [Algebra k L'] [IsScalarTower k L L'] : split k A L' where + n := deg k k_bar A + iso := by + obtain ⟨n, iso⟩ := hA + let e1 : L' ⊗[k] A ≃ₐ[L] L' ⊗[L] (L ⊗[k] A) := { + __ := absorb_eqv k L L' A + commutes' _ := rfl + } + let e2 := e1.trans <| Algebra.TensorProduct.congr .refl iso + let e3 : L' ⊗[k] A ≃ₐ[L'] L' ⊗[L] Matrix (Fin n) (Fin n) L := { + __ := e2 + commutes' := fun l' => by + simp only [AlgEquiv.toEquiv_eq_coe, Algebra.TensorProduct.algebraMap_apply, + Algebra.algebraMap_self, RingHom.id_apply, Equiv.toFun_as_coe, EquivLike.coe_coe] + simp only [AlgEquiv.toEquiv_eq_coe, AlgEquiv.trans_apply, Algebra.TensorProduct.congr_apply, + AlgEquiv.refl_toAlgHom, e2, e1] + erw [absorb_eqv_apply, Algebra.TensorProduct.map_tmul] + simp only [AlgHom.coe_id, id_eq, Algebra.TensorProduct.one_def.symm, map_one] + } + let e4 : L' ⊗[L] Matrix (Fin n) (Fin n) L ≃ₐ[L'] Matrix (Fin n) (Fin n) L' := { + __ := matrixEquivTensor _ _ _|>.symm + commutes' := fun l' ↦ by + simp only [AlgEquiv.toEquiv_eq_coe, Algebra.TensorProduct.algebraMap_apply, + Algebra.algebraMap_self, RingHom.id_apply, Equiv.toFun_as_coe, EquivLike.coe_coe, + matrixEquivTensor_apply_symm, Matrix.map] + ext i j + obtain rfl | hij := eq_or_ne i j + · simp [Matrix.one_apply_eq, Algebra.algebraMap_eq_smul_one, Matrix.smul_apply] + · simp [hij, Matrix.one_apply_ne, Algebra.algebraMap_eq_smul_one] + } + let e5 : n = deg k k_bar A := by + have := deg_sq_eq_dim k k_bar A + rw [pow_two] at this + have e6 := LinearEquiv.finrank_eq (e3.trans e4).toLinearEquiv|>.trans <| + Module.finrank_matrix L' _ (Fin n) (Fin n) + simp only [Module.finrank_tensorProduct, Module.finrank_self, one_mul, Fintype.card_fin, + mul_one] at e6 + exact Nat.mul_self_inj.mp (id (this.trans e6).symm) + exact (e3.trans e4).trans <| Matrix.reindexAlgEquiv L' _ (finCongr e5) + +/-- Splitting of an algebra is preserved after extending the splitting field. -/ +theorem extension_over_split' (k_bar : Type u) [Field k_bar] [Algebra k k_bar] + [IsAlgClosure k k_bar] (A : Type u) [Ring A] [IsSimpleRing A] [Algebra k A] + [Algebra.IsCentral k A] [FiniteDimensional k A] (L L' : Type u) [Field L] [Field L'] + [Algebra k L] (hA : isSplit k A L) [Algebra L L'] [Algebra k L'] [IsScalarTower k L L'] : + isSplit k A L' := by + obtain ⟨n, hn, ⟨e⟩⟩ := hA + obtain ⟨n, e⟩ := extension_over_split k k_bar ⟨.of k A⟩ L L' ⟨n, e⟩ + let e5 : n = deg k k_bar ⟨.of k A⟩ := by + have := deg_sq_eq_dim k k_bar ⟨.of k A⟩ + rw [pow_two] at this + have e6 := LinearEquiv.finrank_eq e.toLinearEquiv|>.trans <| + Module.finrank_matrix L' _ (Fin n) (Fin n) + simp only [Module.finrank_tensorProduct, Module.finrank_self, one_mul, Fintype.card_fin, + mul_one] at e6 + exact Nat.mul_self_inj.mp (id (this.trans e6).symm) + exact ⟨n, by rw[e5]; exact deg_pos k k_bar ⟨.of k A⟩, ⟨e⟩⟩ From 50a106fa6857f36d7937b61274a878dc57a6ff69 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 12:43:38 -0700 Subject: [PATCH 11/34] Restore BrauerGroup helper compatibility modules --- LeanPool.lean | 13 ++++ LeanPool/BrauerGroupNew/Mathlib.lean | 1 + .../BrauerGroupNew/Mathlib/LinearAlgebra.lean | 1 + .../Mathlib/LinearAlgebra/Matrix.lean | 14 ++++ .../LinearAlgebra/Matrix/Charpoly.lean | 13 ++++ .../LinearAlgebra/Matrix/Charpoly/Basic.lean | 65 +++++++++++++++++++ .../Matrix/GeneralLinearGroup.lean | 13 ++++ .../Matrix/GeneralLinearGroup/Basic.lean | 28 ++++++++ .../Mathlib/RepresentationTheory.lean | 13 ++++ .../RepresentationTheory/Homological.lean | 13 ++++ .../Homological/GroupCohomology.lean | 13 ++++ .../GroupCohomology/LowDegree.lean | 27 ++++++++ .../BrauerGroupNew/Mathlib/RingTheory.lean | 2 + .../Mathlib/RingTheory/MatrixAlgebra.lean | 27 ++++++++ .../Mathlib/RingTheory/TensorProduct.lean | 13 ++++ .../RingTheory/TensorProduct/Basic.lean | 33 ++++++++++ .../Mathlib/RingTheory/TwoSidedIdeal.lean | 1 + .../RingTheory/TwoSidedIdeal/Basic.lean | 44 +++++++++++++ 18 files changed, 334 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix/Charpoly.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix/Charpoly/Basic.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix/GeneralLinearGroup.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix/GeneralLinearGroup/Basic.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RepresentationTheory.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RepresentationTheory/Homological.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RepresentationTheory/Homological/GroupCohomology.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RepresentationTheory/Homological/GroupCohomology/LowDegree.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RingTheory/MatrixAlgebra.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RingTheory/TensorProduct.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RingTheory/TensorProduct/Basic.lean create mode 100644 LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal/Basic.lean diff --git a/LeanPool.lean b/LeanPool.lean index f181291524..a5c1739c84 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -76,18 +76,31 @@ import LeanPool.BrauerGroupNew.Mathlib.Data.DFinsupp.Submonoid import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.LinearIndependent import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.LinearIndependent.Defs +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Matrix +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Matrix.Charpoly +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Matrix.Charpoly.Basic +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Matrix.GeneralLinearGroup +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Matrix.GeneralLinearGroup.Basic import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Span import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Span.Basic +import LeanPool.BrauerGroupNew.Mathlib.RepresentationTheory +import LeanPool.BrauerGroupNew.Mathlib.RepresentationTheory.Homological +import LeanPool.BrauerGroupNew.Mathlib.RepresentationTheory.Homological.GroupCohomology +import LeanPool.BrauerGroupNew.Mathlib.RepresentationTheory.Homological.GroupCohomology.LowDegree import LeanPool.BrauerGroupNew.Mathlib.RingTheory import LeanPool.BrauerGroupNew.Mathlib.RingTheory.Congruence import LeanPool.BrauerGroupNew.Mathlib.RingTheory.Congruence.Basic import LeanPool.BrauerGroupNew.Mathlib.RingTheory.Congruence.Defs +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.MatrixAlgebra import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubring import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubring.Defs import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubsemiring import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubsemiring.Basic import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubsemiring.Defs +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TensorProduct +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TensorProduct.Basic import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Basic import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Kernel import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Lattice import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Operations diff --git a/LeanPool/BrauerGroupNew/Mathlib.lean b/LeanPool/BrauerGroupNew/Mathlib.lean index 96787184e5..7c4e117282 100644 --- a/LeanPool/BrauerGroupNew/Mathlib.lean +++ b/LeanPool/BrauerGroupNew/Mathlib.lean @@ -7,6 +7,7 @@ Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies import LeanPool.BrauerGroupNew.Mathlib.Algebra import LeanPool.BrauerGroupNew.Mathlib.Data import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra +import LeanPool.BrauerGroupNew.Mathlib.RepresentationTheory import LeanPool.BrauerGroupNew.Mathlib.RingTheory /-! diff --git a/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra.lean b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra.lean index 059da0288f..257b8d4e33 100644 --- a/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra.lean +++ b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra.lean @@ -5,6 +5,7 @@ Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies -/ import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.LinearIndependent +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Matrix import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Span /-! diff --git a/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix.lean b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix.lean new file mode 100644 index 0000000000..9c88adb5e2 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix.lean @@ -0,0 +1,14 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Matrix.Charpoly +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Matrix.GeneralLinearGroup + +/-! +# Brauer Group New Mathlib LinearAlgebra Matrix + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix/Charpoly.lean b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix/Charpoly.lean new file mode 100644 index 0000000000..4025fadf96 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix/Charpoly.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Matrix.Charpoly.Basic + +/-! +# Brauer Group New Mathlib LinearAlgebra Matrix Charpoly + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix/Charpoly/Basic.lean b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix/Charpoly/Basic.lean new file mode 100644 index 0000000000..b0ea3b06e5 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix/Charpoly/Basic.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.LinearAlgebra.Matrix.Charpoly.Basic + +/-! +# Matrix characteristic polynomial helpers + +This file restores upstream helper lemmas for block diagonal characteristic polynomials. +-/ + +variable {F : Type*} [Field F] + +/-- A subtype of a product that depends only on the second component. -/ +@[simps] +def Equiv.prodSubtypeSndEquivProdSubtype {α β} {p : β → Prop} : + {s : α × β // p s.2} ≃ α × {b // p b} where + toFun x := ⟨x.1.1, x.1.2, x.2⟩ + invFun x := ⟨⟨x.1, x.2⟩, x.2.2⟩ + left_inv _ := rfl + right_inv _ := rfl + +/-- The fiber of a product projection over a fixed second coordinate. -/ +@[simps!] +def thing' {α β : Type*} (b : β) : {i : α × β // i.2 = b} ≃ α := + Equiv.prodSubtypeSndEquivProdSubtype.trans (Equiv.prodUnique α {i : β // i = b}) + +open Matrix in +theorem Matrix.blockDiagonal_toSquareBlock {r} {n : Type*} + (A : Fin r → Matrix n n F) {i} : + (blockDiagonal A).toSquareBlock Prod.snd i = (A i).reindex (thing' _).symm (thing' _).symm := by + classical + aesop (add simp toSquareBlock_def) + +theorem Matrix.blockDiagonal_charpoly_aux {r} {n : Type*} [DecidableEq n] [Fintype n] + (A : Fin r → Matrix n n F) {i} : + ((Matrix.blockDiagonal A).toSquareBlock Prod.snd i).charpoly = (A i).charpoly := by + rw [blockDiagonal_toSquareBlock, Matrix.charpoly_reindex] + +theorem Matrix.blockDiagonal_charpoly {r} {n : Type*} [DecidableEq n] [Fintype n] + (A : Fin r → Matrix n n F) : + (Matrix.blockDiagonal A).charpoly = ∏ i : Fin r, (A i).charpoly := by + have hM := Matrix.blockTriangular_blockDiagonal A + simp only [Matrix.charpoly, hM.charmatrix.det_fintype, ← Matrix.charmatrix_toSquareBlock] + congr! with i hi + exact blockDiagonal_charpoly_aux _ + +theorem Matrix.blockDiagonal_const_charpoly (r n : ℕ) + (A : Matrix (Fin n) (Fin n) F) : + (Matrix.blockDiagonal fun _ : Fin r => A).charpoly = A.charpoly ^ r := by + rw [blockDiagonal_charpoly] + simp + +lemma Matrix.reindex_diagonal_charpoly (r n m : ℕ) (eq : m = r * n) + (A : Matrix (Fin n) (Fin n) F) : + (Matrix.reindexAlgEquiv F F + (finProdFinEquiv.trans (finCongr (by rw [eq, mul_comm])) : Fin n × Fin r ≃ Fin m) + ((Matrix.blockDiagonalRingHom (Fin n) (Fin r) F) fun _ ↦ A)).charpoly = + A.charpoly ^ r := by + rw [Matrix.blockDiagonalRingHom_apply, Matrix.reindexAlgEquiv_apply, + Matrix.charpoly_reindex, blockDiagonal_charpoly] + simp diff --git a/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix/GeneralLinearGroup.lean b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix/GeneralLinearGroup.lean new file mode 100644 index 0000000000..cb6ae8fe38 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix/GeneralLinearGroup.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Matrix.GeneralLinearGroup.Basic + +/-! +# Brauer Group New Mathlib LinearAlgebra Matrix GeneralLinearGroup + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix/GeneralLinearGroup/Basic.lean b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix/GeneralLinearGroup/Basic.lean new file mode 100644 index 0000000000..c7b3becc95 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Matrix/GeneralLinearGroup/Basic.lean @@ -0,0 +1,28 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.LinearAlgebra.Matrix.Charpoly.Basic +import Mathlib.LinearAlgebra.Matrix.GeneralLinearGroup.Defs + +/-! +# General linear group characteristic polynomial helpers + +This file restores a similarity invariance lemma for matrix characteristic polynomials. +-/ + +variable {F : Type*} [Field F] + +open Matrix Polynomial in +lemma Matrix.charpoly.similar_eq (n : ℕ) (u : (Matrix (Fin n) (Fin n) F)ˣ) + (A B : Matrix (Fin n) (Fin n) F) (h : A = u * B * u⁻¹) : + A.charpoly = B.charpoly := by + have h2 : A.charmatrix = C.mapMatrix u.1 * B.charmatrix * C.mapMatrix u.1⁻¹ := by + simp only [charmatrix, h, coe_units_inv, RingHom.mapMatrix_apply, Matrix.map_mul, mul_sub, + sub_mul] + simp [(by aesop : u.1.map C * (diagonal fun x ↦ X) = (diagonal fun x ↦ X) * u.1.map C), + mul_assoc] + rw [charpoly, charpoly, h2, det_mul, det_mul, mul_comm, ← mul_assoc, ← det_mul] + simp diff --git a/LeanPool/BrauerGroupNew/Mathlib/RepresentationTheory.lean b/LeanPool/BrauerGroupNew/Mathlib/RepresentationTheory.lean new file mode 100644 index 0000000000..c2dded602b --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RepresentationTheory.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.RepresentationTheory.Homological + +/-! +# Brauer Group New Mathlib RepresentationTheory + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/RepresentationTheory/Homological.lean b/LeanPool/BrauerGroupNew/Mathlib/RepresentationTheory/Homological.lean new file mode 100644 index 0000000000..1a54efc4e7 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RepresentationTheory/Homological.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.RepresentationTheory.Homological.GroupCohomology + +/-! +# Brauer Group New Mathlib RepresentationTheory Homological + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/RepresentationTheory/Homological/GroupCohomology.lean b/LeanPool/BrauerGroupNew/Mathlib/RepresentationTheory/Homological/GroupCohomology.lean new file mode 100644 index 0000000000..39cbfebf13 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RepresentationTheory/Homological/GroupCohomology.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.RepresentationTheory.Homological.GroupCohomology.LowDegree + +/-! +# Brauer Group New Mathlib RepresentationTheory Homological GroupCohomology + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/RepresentationTheory/Homological/GroupCohomology/LowDegree.lean b/LeanPool/BrauerGroupNew/Mathlib/RepresentationTheory/Homological/GroupCohomology/LowDegree.lean new file mode 100644 index 0000000000..f5a10aafdc --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RepresentationTheory/Homological/GroupCohomology/LowDegree.lean @@ -0,0 +1,27 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.RepresentationTheory.Homological.GroupCohomology.LowDegree + +/-! +# Low-degree group cohomology compatibility + +This file restores upstream aliases and multiplicative cocycle closure lemmas. +-/ + +variable {G M : Type*} [Group G] [CommGroup M] [MulDistribMulAction G M] {f g : G × G → M} + +alias groupCohomology.IsMulCocycle₂.of_mem_cocycles₂ := + groupCohomology.isMulCocycle₂_of_mem_cocycles₂ + +lemma groupCohomology.IsMulCocycle₂.mul + (hf : groupCohomology.IsMulCocycle₂ f) (hg : groupCohomology.IsMulCocycle₂ g) : + groupCohomology.IsMulCocycle₂ (f * g) := + fun a b c ↦ by simp [hf a, hg a, smul_mul', mul_mul_mul_comm] + +instance [Fact <| groupCohomology.IsMulCocycle₂ f] [Fact <| groupCohomology.IsMulCocycle₂ g] : + Fact <| groupCohomology.IsMulCocycle₂ (f * g) := + ⟨groupCohomology.IsMulCocycle₂.mul Fact.out Fact.out⟩ diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory.lean index 7df286eac6..4f33be9d0e 100644 --- a/LeanPool/BrauerGroupNew/Mathlib/RingTheory.lean +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory.lean @@ -7,6 +7,8 @@ Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubring import LeanPool.BrauerGroupNew.Mathlib.RingTheory.NonUnitalSubsemiring import LeanPool.BrauerGroupNew.Mathlib.RingTheory.Congruence +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.MatrixAlgebra +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TensorProduct import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal /-! diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/MatrixAlgebra.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/MatrixAlgebra.lean new file mode 100644 index 0000000000..daba699c40 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/MatrixAlgebra.lean @@ -0,0 +1,27 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.RingTheory.MatrixAlgebra + +/-! +# Matrix algebra tensor compatibility + +This file restores an upstream matrix/tensor equivalence in the opposite direction. +-/ + +open scoped TensorProduct + +/-- Matrix algebras over `A` as scalar extension from matrices over `R`. -/ +def matrixEquivTensor' (n R A : Type*) [CommSemiring R] [CommSemiring A] + [Algebra R A] [Fintype n] [DecidableEq n] : + Matrix n n A ≃ₐ[A] A ⊗[R] Matrix n n R := + .symm <| .ofRingEquiv (f := (matrixEquivTensor n R A).symm) fun a ↦ by + ext i j + simp [matrixEquivTensor, Matrix.algebraMap_eq_diagonal, Matrix.diagonal_apply, Matrix.one_apply] + +@[simp] lemma matrixEquivTensor'_symm_apply (n R A : Type*) [CommSemiring R] [CommSemiring A] + [Algebra R A] [Fintype n] [DecidableEq n] (a : A) (m : Matrix n n R) : + (matrixEquivTensor' n R A).symm (a ⊗ₜ m) = a • (m.map (algebraMap R A)) := rfl diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TensorProduct.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TensorProduct.lean new file mode 100644 index 0000000000..e729ef5e10 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TensorProduct.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TensorProduct.Basic + +/-! +# Brauer Group New Mathlib RingTheory TensorProduct + +Import index for the Brauer group formalization. +-/ diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TensorProduct/Basic.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TensorProduct/Basic.lean new file mode 100644 index 0000000000..47f53c0886 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TensorProduct/Basic.lean @@ -0,0 +1,33 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.RingTheory.TensorProduct.Basic + +/-! +# Tensor product associator compatibility + +This file restores an upstream tensor-product associator over mixed scalar towers. +-/ + +open scoped TensorProduct + +/-- An algebra equivalence reassociating tensor products over two scalar towers. -/ +def Algebra.TensorProduct.assoc' (R S R' A B C : Type*) [CommSemiring R] [CommSemiring S] + [CommSemiring R'] [Semiring A] [Semiring B] [Semiring C] [Algebra R R'] [Algebra R A] + [Algebra R' A] [Algebra R B] [Algebra R' B] [Algebra R C] + [IsScalarTower R R' A] [IsScalarTower R R' B] [Algebra S A] [Algebra R S] [Algebra R' S] + [IsScalarTower R' S A] [IsScalarTower R S A] : + (A ⊗[R'] B) ⊗[R] C ≃ₐ[S] A ⊗[R'] (B ⊗[R] C) := + AlgEquiv.ofLinearEquiv (TensorProduct.AlgebraTensorModule.assoc _ _ _ _ _ _) + rfl (LinearMap.map_mul_iff _|>.2 <| by ext; simp) + +@[simp] +lemma Algebra.TensorProduct.assoc'_apply (R S R' A B C : Type*) [CommSemiring R] [CommSemiring S] + [CommSemiring R'] [Semiring A] [Semiring B] [Semiring C] [Algebra R R'] [Algebra R A] + [Algebra R' A] [Algebra R B] [Algebra R' B] [Algebra R C] + [IsScalarTower R R' A] [IsScalarTower R R' B] [Algebra S A] [Algebra R S] [Algebra R' S] + [IsScalarTower R' S A] [IsScalarTower R S A] (a : A) (b : B) (c : C) : + (Algebra.TensorProduct.assoc' R S R' A B C) ((a ⊗ₜ b) ⊗ₜ c) = a ⊗ₜ (b ⊗ₜ c) := rfl diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal.lean index 673d9dc72a..ba1da3e952 100644 --- a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal.lean +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal.lean @@ -5,6 +5,7 @@ Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies -/ import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Kernel +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Basic import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Lattice import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Operations diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal/Basic.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal/Basic.lean new file mode 100644 index 0000000000..2d34c3db0a --- /dev/null +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/TwoSidedIdeal/Basic.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.Algebra.Ring.Opposite +import Mathlib.RingTheory.TwoSidedIdeal.Basic + +/-! +# Two-sided ideal compatibility helpers + +This file restores upstream scalar-action helpers for two-sided ideals. +-/ + +namespace TwoSidedIdeal + +variable {R : Type*} + +section NonUnitalNonAssocRing + +variable [NonUnitalNonAssocRing R] {I : TwoSidedIdeal R} {x : R} + +lemma smul_mem (r : R) (hx : x ∈ I) : r • x ∈ I := by + simpa using I.ringCon.mul (I.ringCon.refl r) hx + +end NonUnitalNonAssocRing + +section Ring + +variable [Ring R] {I : TwoSidedIdeal R} + +instance : Module Rᵐᵒᵖ I where + smul r x := ⟨x.1 * r.unop, I.mul_mem_right _ _ x.2⟩ + one_smul x := by ext; simp + mul_smul x y z := by ext; simp [mul_assoc] + smul_zero x := by ext; simp + zero_smul x := by ext; simp + add_smul x y z := by ext; simp [left_distrib] + smul_add x y z := by ext; simp [right_distrib] + +end Ring + +end TwoSidedIdeal From a82b5951ac2f065a641f7e3ed5c1db658ee9a116 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 13:09:52 -0700 Subject: [PATCH 12/34] Port BrauerGroup ZeroSevenFourE --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew.lean | 1 + LeanPool/BrauerGroupNew/ZeroSevenFourE.lean | 799 ++++++++++++++++++++ 3 files changed, 801 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/ZeroSevenFourE.lean diff --git a/LeanPool.lean b/LeanPool.lean index a5c1739c84..f2e9e6af11 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -113,6 +113,7 @@ import LeanPool.BrauerGroupNew.Subfield.Defs import LeanPool.BrauerGroupNew.Subfield.FiniteDimensional import LeanPool.BrauerGroupNew.TwoSidedIdeal import LeanPool.BrauerGroupNew.Wedderburn +import LeanPool.BrauerGroupNew.ZeroSevenFourE import LeanPool.BruhatTits import LeanPool.BruhatTits.Cartan import LeanPool.BruhatTits.Cartan.Existence diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index 741887840f..7486f15f6f 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -18,6 +18,7 @@ import LeanPool.BrauerGroupNew.MoritaEquivalence import LeanPool.BrauerGroupNew.SplittingOfCSA import LeanPool.BrauerGroupNew.TwoSidedIdeal import LeanPool.BrauerGroupNew.Wedderburn +import LeanPool.BrauerGroupNew.ZeroSevenFourE import LeanPool.BrauerGroupNew.Mathlib import LeanPool.BrauerGroupNew.Subfield diff --git a/LeanPool/BrauerGroupNew/ZeroSevenFourE.lean b/LeanPool/BrauerGroupNew/ZeroSevenFourE.lean new file mode 100644 index 0000000000..440269e3f2 --- /dev/null +++ b/LeanPool/BrauerGroupNew/ZeroSevenFourE.lean @@ -0,0 +1,799 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.MoritaEquivalence +import LeanPool.BrauerGroupNew.Wedderburn +import Mathlib.Algebra.Category.ModuleCat.ChangeOfRings +import Mathlib.Algebra.Category.ModuleCat.Products +import Mathlib.RingTheory.LittleWedderburn + +/-! +# The Stacks Project tag 074E + +This file ports the upstream Wedderburn-Artin uniqueness arguments used by the Brauer group +development. +-/ + +open CategoryTheory DirectSum + +universe u v w + +section simple + +@[stacks 074E "(1)"] +lemma linearEquiv_of_isSimpleModule_over_simple_ring + (k : Type u) (A : Type v) [Field k] [Ring A] [Algebra k A] [IsSimpleRing A] + [FiniteDimensional k A] (M N : Type w) [AddCommGroup M] [AddCommGroup N] + [Module A M] [Module A N] [IsSimpleModule A M] [IsSimpleModule A N] : Nonempty (M ≃ₗ[A] N) := by + obtain ⟨n, hn, D, _, _, ⟨iso₁⟩⟩ := Wedderburn_Artin_algebra_version k A + have : NeZero n := ⟨hn⟩ + let e₁ := moritaEquivalentToMatrix.{_, _, w} D (Fin n) + let e₂ : ModuleCat.{w} A ≌ ModuleCat (Matrix (Fin n) (Fin n) D) := + ModuleCat.restrictScalarsEquivalenceOfRingEquiv iso₁.symm.toRingEquiv + let e₃ := e₂.trans e₁.symm + haveI : IsSimpleModule A (ModuleCat.of A M) := inferInstanceAs <| IsSimpleModule A M + haveI : IsSimpleModule A (ModuleCat.of A N) := inferInstanceAs <| IsSimpleModule A N + haveI := IsMoritaEquivalent.division_ring.IsSimpleModule.functor A D e₃ (ModuleCat.of A M) + haveI := IsMoritaEquivalent.division_ring.IsSimpleModule.functor A D e₃ (ModuleCat.of A N) + obtain ⟨iso₂⟩ := IsMoritaEquivalent.division_ring.division_ring_exists_unique_isSimpleModule D + (e₃.functor.obj (ModuleCat.of A M)) + obtain ⟨iso₃⟩ := IsMoritaEquivalent.division_ring.division_ring_exists_unique_isSimpleModule D + (e₃.functor.obj (ModuleCat.of A N)) + let iso₄ : e₃.functor.obj (ModuleCat.of A M) ≅ e₃.functor.obj (ModuleCat.of A N) := + LinearEquiv.toModuleIso <| iso₂ ≪≫ₗ iso₃.symm + let iso₅ : ModuleCat.of A M ≅ ModuleCat.of A N := + e₃.unitIso.app (ModuleCat.of A M) ≪≫ e₃.inverse.mapIso iso₄ ≪≫ + (e₃.unitIso.app (ModuleCat.of A N)).symm + exact ⟨iso₅.toLinearEquiv⟩ + +variable (k : Type u) (A : Type v) [Field k] [Ring A] [Algebra k A] + [IsSimpleRing A] [FiniteDimensional k A] + +lemma directSum_simple_module_over_simple_ring + (k : Type u) (A : Type v) [Field k] [Ring A] [Algebra k A] [IsSimpleRing A] + [FiniteDimensional k A] (M : Type v) [AddCommGroup M] [Module A M] : + ∃ (S : Type v) (_ : AddCommGroup S) (_ : Module A S) (_ : IsSimpleModule A S) + (ι : Type v), Nonempty (M ≃ₗ[A] (ι →₀ S)) := by + classical + obtain ⟨n, hn, D, inst1, inst2, ⟨iso₁⟩⟩ := Wedderburn_Artin_algebra_version k A + have : NeZero n := ⟨hn⟩ + let e₁ := moritaEquivalentToMatrix D (Fin n) + let e₂ : ModuleCat A ≌ ModuleCat (Matrix (Fin n) (Fin n) D) := + ModuleCat.restrictScalarsEquivalenceOfRingEquiv iso₁.symm.toRingEquiv + let e := e₂.trans e₁.symm + let S := e.inverse.obj (ModuleCat.of D D) + haveI : IsSimpleModule D (ModuleCat.of D D) := inferInstanceAs <| IsSimpleModule D D + haveI : IsSimpleModule A S := + IsMoritaEquivalent.division_ring.IsSimpleModule.functor _ _ e.symm (ModuleCat.of D D) + obtain ⟨b, hb⟩ : Module.Free D (e.functor.obj (ModuleCat.of A M)) := inferInstance + refine ⟨S, inferInstance, inferInstance, inferInstance, b, ⟨?_⟩⟩ + let iso₂ : e.functor.obj (ModuleCat.of A M) ≅ ModuleCat.of D (b →₀ D) := hb.repr.toModuleIso + let iso₃ : ModuleCat.of A M ≅ e.inverse.obj (ModuleCat.of D (b →₀ D)) := + e.unitIso.app (ModuleCat.of A M) ≪≫ (e.inverse.mapIso iso₂) + let iso₄₀ : + ModuleCat.of A (b →₀ e.inverse.obj (ModuleCat.of D D)) ≅ + ModuleCat.of A (⨁ (i : b), e.inverse.obj (ModuleCat.of D D)) := + LinearEquiv.toModuleIso (finsuppLequivDFinsupp _) + let iso₄₁ : + ModuleCat.of A (⨁ (i : b), e.inverse.obj (ModuleCat.of D D)) ≅ + ∐ fun i : b ↦ ModuleCat.of A (e.inverse.obj (ModuleCat.of D D)) := + Iso.symm (ModuleCat.coprodIsoDirectSum _) + let iso₄₂ : + (∐ fun i : b ↦ (e.inverse.obj (ModuleCat.of D D))) ≅ + e.inverse.obj (∐ fun i : b ↦ .of D D) := Limits.PreservesCoproduct.iso _ _ |>.symm + let iso₄₃ : e.inverse.obj (∐ fun i : b ↦ ModuleCat.of D D) ≅ + e.inverse.obj (ModuleCat.of D (⨁ i : b, D)) := + e.inverse.mapIso (ModuleCat.coprodIsoDirectSum _) + let iso₄₄ : e.inverse.obj (ModuleCat.of D (⨁ i : b, D)) ≅ + e.inverse.obj (ModuleCat.of D (b →₀ D)) := + e.inverse.mapIso (LinearEquiv.toModuleIso (finsuppLequivDFinsupp _).symm) + let iso₄ : + ModuleCat.of A (b →₀ e.inverse.obj (ModuleCat.of D D)) ≅ + e.inverse.obj (ModuleCat.of D (b →₀ D)) := + iso₄₀ ≪≫ iso₄₁ ≪≫ iso₄₂ ≪≫ iso₄₃ ≪≫ iso₄₄ + exact iso₃ ≪≫ iso₄.symm |>.toLinearEquiv + +lemma directSum_simple_module_over_simple_ring' + (k : Type u) (A : Type v) [Field k] [Ring A] [Algebra k A] [IsSimpleRing A] + [FiniteDimensional k A] (M : Type v) [AddCommGroup M] [Module A M] + (S : Type v) [AddCommGroup S] [Module A S] [IsSimpleModule A S] : + ∃ (ι : Type v), Nonempty (M ≃ₗ[A] (ι →₀ S)) := by + obtain ⟨T, _, _, _, ι, ⟨iso⟩⟩ := directSum_simple_module_over_simple_ring k A M + obtain ⟨iso'⟩ := linearEquiv_of_isSimpleModule_over_simple_ring k A S T + exact ⟨ι, ⟨iso ≪≫ₗ Finsupp.mapRange.linearEquiv iso'.symm⟩⟩ + +lemma linearEquiv_iff_finrank_eq_over_simple_ring + (M N : Type v) [AddCommGroup M] [Module A M] [AddCommGroup N] [Module A N] + [Module k M] [Module k N] + [IsScalarTower k A M] [IsScalarTower k A N] + [Module.Finite A M] [Module.Finite A N] : + Nonempty (M ≃ₗ[A] N) ↔ + Module.finrank k M = Module.finrank k N := by + haveI : FiniteDimensional k M := Module.Finite.trans A M + haveI : FiniteDimensional k N := Module.Finite.trans A N + fconstructor + · rintro ⟨iso⟩ + refine LinearEquiv.finrank_eq { iso with map_smul' := ?_ } + intros a m + simp only [AddHom.toFun_eq_coe, LinearMap.coe_toAddHom, LinearMap.map_smul_of_tower, + LinearEquiv.coe_coe, RingHom.id_apply] + · intro h + obtain ⟨S, _, _, _, ι, ⟨iso⟩⟩ := directSum_simple_module_over_simple_ring k A M + obtain ⟨ι', ⟨iso'⟩⟩ := directSum_simple_module_over_simple_ring' k A N S + have HS : Nontrivial S := IsSimpleModule.nontrivial A S + cases isEmpty_or_nonempty ι + · letI : Unique M := ⟨⟨0⟩, by + intros a + apply_fun iso using LinearEquiv.injective _ + apply Subsingleton.elim⟩ + have eq : Module.finrank k M = 0 := by + rw [Module.finrank_eq_zero_iff] + exact fun m ↦ ⟨1, one_ne_zero, Subsingleton.elim _ _⟩ + have eq' : Module.finrank k N = 0 := by + rw [← h, eq] + haveI : Unique N := ⟨⟨0⟩, by + rw [Module.finrank_zero_iff] at eq' + intro n + exact Subsingleton.elim _ _⟩ + refine ⟨⟨0, 0, fun x ↦ Subsingleton.elim _ _, fun x ↦ Subsingleton.elim _ _⟩⟩ + cases isEmpty_or_nonempty ι' + · letI : Unique N := ⟨⟨0⟩, by + intros a + apply_fun iso' using LinearEquiv.injective _ + apply Subsingleton.elim⟩ + have eq : Module.finrank k N = 0 := by + rw [Module.finrank_eq_zero_iff] + exact fun m ↦ ⟨1, one_ne_zero, Subsingleton.elim _ _⟩ + have eq' : Module.finrank k M = 0 := by + rw [h, eq] + haveI : Unique M := ⟨⟨0⟩, by + rw [Module.finrank_zero_iff] at eq' + intro n + exact Subsingleton.elim _ _⟩ + exact ⟨⟨0, 0, fun x ↦ Subsingleton.elim _ _, fun x ↦ Subsingleton.elim _ _⟩⟩ + letI := Module.compHom S (Algebra.ofId k A).toRingHom + let ISO : M ≃ₗ[k] ι →₀ S := + { iso with + map_smul' := by + intros a m + simp only [AddHom.toFun_eq_coe, LinearMap.coe_toAddHom, LinearEquiv.coe_coe, + RingHom.id_apply] + rw [algebra_compatible_smul A] + change iso (algebraMap k A a • _) = algebraMap k A a • _ + rw [map_smul] } + have eq := LinearEquiv.finrank_eq ISO + let ISO' : N ≃ₗ[k] ι' →₀ S := + { iso' with + map_smul' := by + intros a m + simp only [AddHom.toFun_eq_coe, LinearMap.coe_toAddHom, LinearEquiv.coe_coe, + RingHom.id_apply] + rw [algebra_compatible_smul A] + change iso' (algebraMap k A a • _) = algebraMap k A a • _ + rw [map_smul] } + have eq' := LinearEquiv.finrank_eq ISO' + have EQ : Module.finrank k (ι →₀ S) = Module.finrank k (ι' →₀ S) := by + rw [← eq, h, eq'] + haveI : Module.Finite k (ι →₀ S) := Module.Finite.equiv ISO + haveI : Module.Finite k (ι' →₀ S) := Module.Finite.equiv ISO' + haveI : Module.Finite k S := by + suffices IsNoetherian k S from inferInstance + rw [IsNoetherian.iff_rank_lt_aleph0] + apply_fun ((↑) : ℕ → Cardinal) at eq + rw [Module.finrank_eq_rank, Module.finrank_eq_rank, rank_finsupp] at eq + have ineq : Module.rank k M < Cardinal.aleph0 := by + rw [Module.rank_lt_aleph0_iff]; infer_instance + rw [eq] at ineq + simp only [Cardinal.lift_id] at ineq + have ineq2 := @Cardinal.le_mul_right (Module.rank k S) (Cardinal.mk ι) + (by rw [Cardinal.mk_ne_zero_iff]; infer_instance) + rw [mul_comm] at ineq2 + exact lt_of_le_of_lt ineq2 ineq + haveI : Fintype ι := by + refine (@Cardinal.lt_aleph0_iff_fintype ι).1 ?_ |>.some + apply_fun ((↑) : ℕ → Cardinal) at eq + rw [Module.finrank_eq_rank, Module.finrank_eq_rank, rank_finsupp] at eq + have ineq : Module.rank k M < Cardinal.aleph0 := by + rw [Module.rank_lt_aleph0_iff]; infer_instance + rw [eq] at ineq + simp only [Cardinal.lift_id] at ineq + have ineq2 := @Cardinal.le_mul_left (Cardinal.mk ι) (Module.rank k S) + (by + suffices 0 < Module.rank k S by exact Ne.symm (ne_of_lt this) + apply rank_pos) + rw [mul_comm] at ineq2 + exact lt_of_le_of_lt ineq2 ineq + haveI : Fintype ι' := by + refine (@Cardinal.lt_aleph0_iff_fintype ι').1 ?_ |>.some + apply_fun ((↑) : ℕ → Cardinal) at eq' + rw [Module.finrank_eq_rank, Module.finrank_eq_rank, rank_finsupp] at eq' + have ineq : Module.rank k N < Cardinal.aleph0 := by + rw [Module.rank_lt_aleph0_iff]; infer_instance + rw [eq'] at ineq + simp only [Cardinal.lift_id] at ineq + have ineq2 := @Cardinal.le_mul_left (Cardinal.mk ι') (Module.rank k S) + (by + suffices 0 < Module.rank k S from + Ne.symm (ne_of_lt this) + apply rank_pos) + rw [mul_comm] at ineq2 + exact lt_of_le_of_lt ineq2 ineq + rw [Module.finrank_finsupp, Module.finrank_finsupp] at EQ + simp only [mul_eq_mul_right_iff] at EQ + replace EQ := EQ.resolve_right + (by have := Module.finrank_pos (R := k) (M := S); omega) + rw [Fintype.card_eq] at EQ + obtain ⟨e⟩ := EQ + let E : (ι →₀ S) ≃ₗ[A] (ι' →₀ S) := + { Finsupp.equivCongrLeft e with + map_add' := by intros a b; ext; simp + map_smul' := by intros a b; ext; simp } + refine ⟨iso ≪≫ₗ E ≪≫ₗ iso'.symm⟩ + +omit [IsSimpleRing A] [FiniteDimensional k A] in +@[stacks 074E "(3) first part"] +lemma simple_mod_of_wedderburn {n : ℕ} (hn : n ≠ 0) + (D : Type v) [DivisionRing D] [Algebra k D] (wdb : A ≃ₐ[k] Matrix (Fin n) (Fin n) D) : + let _ : Module A (Fin n → D) := Module.compHom _ wdb.toRingEquiv.toRingHom + IsSimpleModule A (Fin n → D) := by + letI : Module A (Fin n → D) := Module.compHom _ wdb.toRingEquiv.toRingHom + have : NeZero n := ⟨hn⟩ + let e : ModuleCat.{v} A ≌ ModuleCat (Matrix (Fin n) (Fin n) D) := + ModuleCat.restrictScalarsEquivalenceOfRingEquiv wdb.toRingEquiv.symm + have inst1 : IsSimpleModule (Matrix (Fin n) (Fin n) D) (Fin n → D) := by + haveI : IsSimpleModule D (ModuleCat.of D D) := inferInstanceAs <| IsSimpleModule D D + exact IsMoritaEquivalent.division_ring.IsSimpleModule.functor D (Matrix (Fin n) (Fin n) D) + (moritaEquivalentToMatrix D (Fin n)) (ModuleCat.of D D) + have := IsMoritaEquivalent.division_ring.IsSimpleModule.functor (Matrix (Fin n) (Fin n) D) A + e.symm (ModuleCat.of (Matrix (Fin n) (Fin n) D) (Fin n → D)) + exact this + +noncomputable section wedderburn + +/-- Restricts endomorphisms along a Wedderburn equivalence with a matrix algebra. -/ +abbrev endCatEquiv (n : ℕ) + (D : Type v) [DivisionRing D] [Algebra k D] (wdb : A ≃ₐ[k] Matrix (Fin n) (Fin n) D) + [Module A (Fin n → D)] (smul_def : ∀ (a : A) (v : Fin n → D), a • v = wdb a • v) + [IsScalarTower k (Matrix (Fin n) (Fin n) D) (Fin n → D)] [IsScalarTower k A (Fin n → D)] + [SMulCommClass A k (Fin n → D)] : + Module.End A (Fin n → D) ≃ₐ[k] Module.End (Matrix (Fin n) (Fin n) D) (Fin n → D) := + .ofAlgHom { + toFun f := { + __ := f + map_smul' := fun a v => by + simp only [AddHom.toFun_eq_coe, LinearMap.coe_toAddHom, RingHom.id_apply] + rw [show a • v = wdb.symm a • v by simp [smul_def], map_smul, smul_def] + simp + } + map_one' := rfl + map_mul' _ _ := rfl + map_zero' := rfl + map_add' _ _ := rfl + commutes' := by intros; ext; simp } + { toFun f := { + toFun := f + map_add' := f.map_add + map_smul' := fun a b => by + simp only [smul_def, LinearMapClass.map_smul, RingHom.id_apply] + } + map_one' := rfl + map_mul' _ _ := rfl + map_zero' := rfl + map_add' _ _ := rfl + commutes' := by intros; ext; simp } + (by rfl) (by rfl) + +omit [IsSimpleRing A] [FiniteDimensional k A] in +private lemma matrixModuleVectorDecomp {n : ℕ} [NeZero n] + (D : Type v) [DivisionRing D] (v : Fin n → D) : + v = ∑ j : Fin n, (Matrix.single j (0 : Fin n) (v j) : Matrix (Fin n) (Fin n) D) • + Pi.single (M := fun _ : Fin n => D) (0 : Fin n) (1 : D) := by + ext t + rw [Finset.sum_apply] + rw [Finset.sum_eq_single t] + · simp [matrix_smul_vec_apply, Matrix.single, Pi.single] + · intro j _ hj + simp [matrix_smul_vec_apply, Matrix.single, Pi.single, hj] + · intro ht + simp at ht + +omit [IsSimpleRing A] [FiniteDimensional k A] in +private lemma matrixModuleEnd_apply {n : ℕ} [NeZero n] + (D : Type v) [DivisionRing D] + (f : Module.End (Matrix (Fin n) (Fin n) D) (Fin n → D)) (v : Fin n → D) (i : Fin n) : + f v i = v i * f (Pi.single (M := fun _ : Fin n => D) (0 : Fin n) (1 : D)) 0 := by + let e₀ : Fin n → D := Pi.single (M := fun _ : Fin n => D) (0 : Fin n) (1 : D) + let c : D := f e₀ 0 + have hfe₀ (j : Fin n) : f e₀ j = Pi.single (M := fun _ : Fin n => D) (0 : Fin n) c j := by + by_cases h : j = 0 + · subst h + simp [c] + · have hzero : (Matrix.single (0 : Fin n) j (1 : D) : + Matrix (Fin n) (Fin n) D) • e₀ = 0 := by + ext t + rw [matrix_smul_vec_apply] + by_cases ht : (0 : Fin n) = t + · subst ht + rw [Finset.sum_eq_single j] + · simp [Matrix.single, Pi.single, h, e₀] + · intro x _ hx + simp [Matrix.single, Pi.single, hx.symm, e₀] + · intro hj + simp at hj + · simp [Matrix.single, Pi.single, ht, e₀] + have hmap := congrFun (f.map_smul (Matrix.single (0 : Fin n) j (1 : D)) e₀) 0 + rw [hzero] at hmap + simp [matrix_smul_vec_apply, Matrix.single, Pi.single, e₀] at hmap + simpa [Pi.single, h, c] using hmap.symm + have hv := matrixModuleVectorDecomp D v + calc + f v i = f (∑ j : Fin n, + (Matrix.single j (0 : Fin n) (v j) : Matrix (Fin n) (Fin n) D) • e₀) i := by + simpa [e₀] using congrArg (fun w => f w i) hv + _ = (∑ j : Fin n, + (Matrix.single j (0 : Fin n) (v j) : Matrix (Fin n) (Fin n) D) • f e₀) i := by + simp [map_sum, f.map_smul] + _ = (∑ j : Fin n, + (Matrix.single j (0 : Fin n) (v j) : Matrix (Fin n) (Fin n) D) • + Pi.single (M := fun _ : Fin n => D) (0 : Fin n) c) i := by + refine congrArg (fun w : Fin n → D => w i) ?_ + apply Finset.sum_congr rfl + intro j _ + rw [funext hfe₀] + _ = v i * c := by + rw [Finset.sum_apply] + rw [Finset.sum_eq_single i] + · simp [matrix_smul_vec_apply, Matrix.single, Pi.single] + · intro j _ hj + simp [matrix_smul_vec_apply, Matrix.single, Pi.single, hj] + · intro hi + simp at hi + _ = v i * f (Pi.single (M := fun _ : Fin n => D) (0 : Fin n) (1 : D)) 0 := rfl + +omit [IsSimpleRing A] [FiniteDimensional k A] in +private noncomputable def matrixModuleEndAlgEquivMop {n : ℕ} [NeZero n] + (D : Type v) [DivisionRing D] [Algebra k D] + [IsScalarTower k (Matrix (Fin n) (Fin n) D) (Fin n → D)] + [SMulCommClass (Matrix (Fin n) (Fin n) D) k (Fin n → D)] : + Module.End (Matrix (Fin n) (Fin n) D) (Fin n → D) ≃ₐ[k] Dᵐᵒᵖ where + toFun f := MulOpposite.op (f (Pi.single (M := fun _ : Fin n => D) (0 : Fin n) (1 : D)) 0) + invFun c := + { toFun v := fun i => v i * c.unop + map_add' := by + intro v w + ext i + simp [add_mul] + map_smul' := by + intro M v + ext i + simp [matrix_smul_vec_apply, Finset.sum_mul, mul_assoc] } + left_inv f := by + ext v i + simp [matrixModuleEnd_apply D f v i] + right_inv c := by + apply MulOpposite.unop_injective + simp + map_mul' f g := by + apply MulOpposite.unop_injective + simp [matrixModuleEnd_apply D f (g (Pi.single (0 : Fin n) (1 : D))) 0] + map_add' f g := by + apply MulOpposite.unop_injective + simp + commutes' a := by + apply MulOpposite.unop_injective + simp [Pi.single, Algebra.smul_def] + +@[stacks 074E "(3) first part"] +def end_simple_mod_of_wedderburn (n : ℕ) (hn : n ≠ 0) (D : Type v) [DivisionRing D] [Algebra k D] + (wdb : A ≃ₐ[k] Matrix (Fin n) (Fin n) D) : + let _ : Module A (Fin n → D) := .compHom _ wdb.toRingEquiv.toRingHom + -- these should be in Morita file + have : IsScalarTower k (Matrix (Fin n) (Fin n) D) (Fin n → D) := + { smul_assoc a b x := by + ext i + simp only [matrix_smul_vec_apply, Matrix.smul_apply, smul_eq_mul, Algebra.smul_mul_assoc, + Pi.smul_apply, Finset.smul_sum] } + letI _ : IsScalarTower k A (Fin n → D) := + { smul_assoc a b x := by + change wdb (a • b) • x = _ + rw [map_smul, Algebra.smul_def, mul_smul] + rw [algebraMap_smul] + rfl } + letI _ : SMulCommClass A k (Fin n → D) := + { smul_comm a b x := by + change wdb a • b • x = b • wdb a • x + ext i + simp only [matrix_smul_vec_apply, Pi.smul_apply, smul_eq_mul, Algebra.mul_smul_comm, + Finset.smul_sum] } + Module.End A (Fin n → D) ≃ₐ[k] Dᵐᵒᵖ := by + let _ : Module A (Fin n → D) := Module.compHom _ wdb.toRingEquiv.toRingHom + have : IsScalarTower k (Matrix (Fin n) (Fin n) D) (Fin n → D) := + { smul_assoc a b x := by + ext i + simp only [matrix_smul_vec_apply, Matrix.smul_apply, smul_eq_mul, Algebra.smul_mul_assoc, + Pi.smul_apply, Finset.smul_sum] } + letI _ : IsScalarTower k A (Fin n → D) := + { smul_assoc a b x := by + change wdb (a • b) • x = _ + rw [map_smul, Algebra.smul_def, mul_smul] + rw [algebraMap_smul] + rfl } + letI _ : SMulCommClass A k (Fin n → D) := + { smul_comm a b x := by + change wdb a • b • x = b • wdb a • x + ext i + simp only [matrix_smul_vec_apply, Pi.smul_apply, smul_eq_mul, Algebra.mul_smul_comm, + Finset.smul_sum] } + have : NeZero n := ⟨hn⟩ + let e₁ : Module.End A (Fin n → D) ≃ₐ[k] Module.End (Matrix (Fin n) (Fin n) D) (Fin n → D) := + endCatEquiv k A n D wdb fun _ _ => rfl + exact e₁.trans (matrixModuleEndAlgEquivMop (k := k) (n := n) D) + +end wedderburn + +lemma end_simple_mod_of_wedderburn' (n : ℕ) (hn : n ≠ 0) (D : Type v) [DivisionRing D] [Algebra k D] + (wdb : A ≃ₐ[k] Matrix (Fin n) (Fin n) D) (M : Type v) [AddCommGroup M] + [Module A M] [IsSimpleModule A M] [Module k M] [IsScalarTower k A M] : + Nonempty <| Module.End A M ≃ₐ[k] Dᵐᵒᵖ := by + let e := end_simple_mod_of_wedderburn k A n hn D wdb + let _ : Module A (Fin n → D) := Module.compHom _ wdb.toRingEquiv.toRingHom + have : IsScalarTower k (Matrix (Fin n) (Fin n) D) (Fin n → D) := + { smul_assoc a b x := by + ext i + simp only [matrix_smul_vec_apply, Matrix.smul_apply, smul_eq_mul, Algebra.smul_mul_assoc, + Pi.smul_apply, Finset.smul_sum] } + letI _ : IsScalarTower k A (Fin n → D) := + { smul_assoc a b x := by + change wdb (a • b) • x = _ + rw [map_smul, Algebra.smul_def, mul_smul] + rw [algebraMap_smul] + rfl } + letI _ : SMulCommClass A k (Fin n → D) := + { smul_comm a b x := by + change wdb a • b • x = b • wdb a • x + ext i + simp only [matrix_smul_vec_apply, Pi.smul_apply, smul_eq_mul, Algebra.mul_smul_comm, + Finset.smul_sum] } + haveI : IsSimpleModule A (Fin n → D) := simple_mod_of_wedderburn k A hn D wdb + obtain ⟨iso⟩ := linearEquiv_of_isSimpleModule_over_simple_ring k A M (Fin n → D) + exact ⟨(iso.conjAlgEquiv k).trans e⟩ + +instance end_simple_mod_finite + (M : Type v) [AddCommGroup M] + [Module A M] [IsSimpleModule A M] [Module k M] [IsScalarTower k A M] : + FiniteDimensional k (Module.End A M) := by + obtain ⟨n, hn, D, _, _, ⟨e⟩⟩ := Wedderburn_Artin_algebra_version k A + have : NeZero n := ⟨hn⟩ + obtain ⟨iso⟩ := end_simple_mod_of_wedderburn' k A n hn D e M + let E : Dᵐᵒᵖ ≃ₗ[k] D := MulOpposite.opLinearEquiv k |>.symm + have : Module.Finite k D := by + haveI inst1 : Module.Finite k (Matrix (Fin n) (Fin n) D) := e.toLinearEquiv.finiteDimensional + rw [← Module.rank_lt_aleph0_iff] at inst1 ⊢ + have eq1 := rank_mul_rank k D (Matrix (Fin n) (Fin n) D) + simp only [rank_matrix', Cardinal.mk_fintype, Fintype.card_fin, Cardinal.lift_mul, + Cardinal.lift_natCast] at eq1 + rw [← eq1, mul_comm] at inst1 + exact lt_of_le_of_lt (Cardinal.le_mul_left (a := Module.rank k D) (b := n * n) (by + simpa only [ne_eq, mul_eq_zero, Nat.cast_eq_zero, or_self] using NeZero.ne n)) inst1 + have : FiniteDimensional k Dᵐᵒᵖ := E.symm.finiteDimensional + refine iso.symm.toLinearEquiv.finiteDimensional + +-- instance (D : Type v) [DivisionRing D] : Module.Finite Dᵐᵒᵖ D := by +-- rw [Module.finite_def] +-- refine ⟨{1}, eq_top_iff.2 fun x _ => ?_⟩ +-- simp only [Finset.coe_singleton] +-- rw [show x = (MulOpposite.op x : Dᵐᵒᵖ) • 1 by simp] +-- exact Submodule.smul_mem _ _ <| Submodule.subset_span rfl + +instance (M : Type v) [AddCommGroup M] [Module A M] [Module k M] [IsScalarTower k A M] : + Algebra k (Module.End (Module.End A M) M) where + algebraMap := { + toFun a := + { toFun m := a • m + map_add' := by simp only [smul_add, implies_true] + map_smul' := by + simp only [Module.End.smul_def, RingHom.id_apply, LinearMap.map_smul_of_tower, + implies_true] } + map_one' := by ext; simp only [one_smul, LinearMap.coe_mk, AddHom.coe_mk, Module.End.one_apply] + map_mul' := by + intros; ext + simp only [LinearMap.coe_mk, AddHom.coe_mk, Module.End.mul_apply, LinearMap.map_smul_of_tower] + rw [mul_comm, mul_smul] + map_zero' := by ext; simp + map_add' := by + intros; ext + simp only [add_smul, LinearMap.coe_mk, AddHom.coe_mk, LinearMap.add_apply] + } + commutes' := by + intros r f + ext m + simp only [RingHom.coe_mk, MonoidHom.coe_mk, OneHom.coe_mk, Module.End.mul_apply, + LinearMap.coe_mk, AddHom.coe_mk] + let s : Module.End A M := + { toFun x := r • x + map_add' := by simp + map_smul' := fun a x => by + simp only [RingHom.id_apply] + rw [algebra_compatible_smul A, ← mul_smul, algebra_compatible_smul A, ← mul_smul] + congr 1 + exact Algebra.commutes r a } + rw [show r • m = s • m by rfl, f.map_smul] + rfl + smul r f := + { toFun m := f <| r • m + map_add' := by simp + map_smul' := by + intro g m + simp only [Module.End.smul_def, RingHom.id_apply] + let s : Module.End A M := + { toFun x := r • x + map_add' := by simp + map_smul' := fun a x => by + simp only [RingHom.id_apply] + rw [algebra_compatible_smul A, ← mul_smul, algebra_compatible_smul A, ← mul_smul] + congr 1 + exact Algebra.commutes r a } + change f (s • g m) = g (f <| s • m) + rw [f.map_smul, f.map_smul] + simp only [Module.End.smul_def, LinearMap.coe_mk, AddHom.coe_mk, LinearMap.map_smul_of_tower, + s] + change r • f (g • m) = _ + rw [f.map_smul] + simp } + smul_def' := by + intro r f + ext m + simp only [RingHom.coe_mk, MonoidHom.coe_mk, OneHom.coe_mk, Module.End.mul_apply, + LinearMap.coe_mk, AddHom.coe_mk] + let s : Module.End A M := + { toFun x := r • x + map_add' := by simp + map_smul' := fun a x => by + simp only [RingHom.id_apply] + rw [algebra_compatible_smul A, ← mul_smul, algebra_compatible_smul A, ← mul_smul] + congr 1 + exact Algebra.commutes r a } + change _ = s • f m + rw [← f.map_smul] + rfl + +omit [IsSimpleRing A] in +lemma exists_gen (M : Type v) [AddCommGroup M] + [Module A M] [IsSimpleModule A M] : + ∃ m : M, m ≠ 0 ∧ ∀ m', ∃ a : A, m' = a • m := by + have i : Submodule.IsPrincipal (⊤ : Submodule A M) := inferInstance + refine ⟨i.1.choose, ?_, fun m ↦ by + classical + have : m ∈ Submodule.span A {i.1.choose} := by + rw [← i.1.choose_spec]; trivial + rw [Submodule.mem_span_singleton] at this + simpa [Eq.comm]⟩ + intro h + have := i.1.choose_spec + rw [h] at this + simp only [Submodule.span_zero_singleton, top_ne_bot] at this + +/-- A chosen nonzero generator for a simple module. -/ +noncomputable def gen (M : Type v) [AddCommGroup M] + [Module A M] [IsSimpleModule A M] : M := + (exists_gen A M).choose + +omit [IsSimpleRing A] in +lemma gen_ne_zero (M : Type v) [AddCommGroup M] [Module A M] [IsSimpleModule A M] : + gen A M ≠ 0 := (exists_gen A M).choose_spec.1 + +omit [IsSimpleRing A] in +lemma gen_spec (M : Type v) [AddCommGroup M] + [Module A M] [IsSimpleModule A M] (m' : M) : + ∃ a : A, m' = a • gen A M := (exists_gen A M).choose_spec.2 m' + +/-- The left action map into the double centralizer endomorphism algebra. -/ +@[simps] +def toEndEnd (M : Type v) [AddCommGroup M] [Module A M] : + A →ₗ[A] Module.End (Module.End A M) M where + toFun a := + { toFun m := a • m + map_add' := by simp + map_smul' := fun f m => (f.map_smul a m).symm } + map_add' := by intros; ext; simp [add_smul] + map_smul' := by intros; ext; simp [mul_smul] + +omit [IsSimpleRing A] in +@[simp] +lemma toEndEnd_apply (M : Type v) [AddCommGroup M] [Module A M] (a : A) (m : M) : + toEndEnd A M a m = a • m := rfl + +/-- The algebra homomorphism induced by the double centralizer action map. -/ +def toEndEndAlgHom (M : Type v) [AddCommGroup M] [Module A M] [Module k M] [IsScalarTower k A M] : + A →ₐ[k] Module.End (Module.End A M) M where + __ := toEndEnd A M + map_one' := by ext; simp + map_mul' a b := by ext; simp [mul_smul] + map_zero' := by ext; simp + commutes' a := by + ext m + simp only [AddHom.toFun_eq_coe, LinearMap.coe_toAddHom, toEndEnd_apply, algebraMap_smul] + rfl + +instance (M : Type v) [AddCommGroup M] [Module A M] [IsSimpleModule A M] : + Nontrivial (Module.End (Module.End A M) M) where + exists_pair_ne := ⟨0, 1, fun eq ↦ gen_ne_zero A M congr($eq (gen A M)).symm⟩ + +omit [FiniteDimensional k A] in +lemma toEndEnd_injective + (M : Type v) [AddCommGroup M] [Module A M] [IsSimpleModule A M] + [Module k M] [IsScalarTower k A M] : + Function.Injective (toEndEnd A M) := + RingHom.injective (toEndEndAlgHom k A M).toRingHom + +/-- A module is balanced when the double centralizer action map is surjective. -/ +class IsBalanced (M : Type v) [AddCommGroup M] [Module A M] : Prop where + surj : Function.Surjective (toEndEnd A M) + +instance : IsBalanced A A where + surj f := by + refine ⟨f 1, ?_⟩ + ext x + simp only [toEndEnd_apply, smul_eq_mul] + let X : Module.End A A := LinearMap.mulRight _ x + simpa [Module.End.smul_def, LinearMap.coe_mk, AddHom.coe_mk, one_mul, X] + using (f.map_smul X 1).symm + +omit [IsSimpleRing A] in +lemma IsBalanced.congr_aux (M N : Type v) [AddCommGroup M] [AddCommGroup N] [Module A M] + [Module A N] (l : M ≃ₗ[A] N) (h : IsBalanced A M) : IsBalanced A N := by + refine ⟨fun a => ?_⟩ + let a' : Module.End (Module.End A M) M := + { toFun m := l.symm <| a (l m) + map_add' := by simp + map_smul' := fun x y => by + simp only [Module.End.smul_def, RingHom.id_apply] + let L := l.toLinearMap ∘ₗ x ∘ₗ l.symm.toLinearMap + have := a.map_smul L (l y) + simp only [Module.End.smul_def, LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, + LinearEquiv.symm_apply_apply, L] at this + simp [this] } + obtain ⟨b, hb⟩ := h.1 a' + refine ⟨b, ?_⟩ + ext n + have hb' := congrArg (fun f : Module.End (Module.End A M) M => f (l.symm n)) hb + simp only [a', toEndEnd_apply_apply] at hb' + apply_fun l at hb' + simpa using hb' + +omit [IsSimpleRing A] in +lemma IsBalanced.congr {M N : Type v} [AddCommGroup M] [AddCommGroup N] [Module A M] [Module A N] + (l : M ≃ₗ[A] N) : IsBalanced A M ↔ IsBalanced A N := by + constructor + · apply IsBalanced.congr_aux; exact l + · apply IsBalanced.congr_aux; exact l.symm + +lemma isBalanced_of_simpleMod (M : Type v) [AddCommGroup M] [Module A M] [IsSimpleModule A M] + [Module k M] [IsScalarTower k A M] : IsBalanced A M := by + classical + obtain ⟨ι, ⟨e⟩⟩ := directSum_simple_module_over_simple_ring' k A A M + haveI b : IsBalanced A (ι →₀ M) := by + rw [← IsBalanced.congr A e] + infer_instance + refine ⟨fun g => ?_⟩ + let G : Module.End (Module.End A (ι →₀ M)) (ι →₀ M) := + { toFun v := Finsupp.mapRange g (by simp) v + map_add' := by intros; ext; simp + map_smul' := by + intro f v + ext i + simp only [Module.End.smul_def, Finsupp.mapRange_apply, RingHom.id_apply] + let x (i j : ι) : Module.End A M := + { toFun m := f (Finsupp.single i m) j + map_add' := by simp + map_smul' := by + intro a m + simp only [RingHom.id_apply] + rw [← Finsupp.smul_single, map_smul] + rfl } + have eq (i j k : ι) := g.map_smul (x i j) (v k) + simp only [Module.End.smul_def, LinearMap.coe_mk, AddHom.coe_mk, x] at eq + conv_lhs => rw [show v = ∑ i ∈ v.support, Finsupp.single i (v i) by + ext j + simp only [Finsupp.coe_finset_sum, Finset.sum_apply, Finsupp.single_apply, + Finset.sum_ite_eq', Finsupp.mem_support_iff, ne_eq, ite_not] + aesop] + simp only [map_sum, Finsupp.coe_finset_sum, Finset.sum_apply] + change ∑ j ∈ _, _ = _ + simp_rw [eq] + rw [show ∑ x ∈ v.support, (f (Finsupp.single x (g (v x)))) i = + (∑ x ∈ v.support, f (Finsupp.single x (g (v x)))) i by simp [Finsupp.coe_finset_sum], + ← map_sum] + congr + ext j + simp only [Finsupp.coe_finset_sum, Finset.sum_apply, Finsupp.single_apply, Finset.sum_ite_eq', + Finsupp.mem_support_iff, ne_eq, ite_not, Finsupp.mapRange_apply, ite_eq_right_iff] + aesop } + obtain ⟨a, ha⟩ := b.1 G + refine ⟨a, ?_⟩ + ext m + haveI : Nonempty ι := by + refine isEmpty_or_nonempty ι |>.resolve_left ?_ + intro H + haveI : Subsingleton (ι →₀ M) := inferInstance + haveI : Subsingleton A := Equiv.subsingleton e.toEquiv + have eq1 : (1 : A) = 0 := Subsingleton.elim _ _ + have : Nontrivial A := inferInstance + exact one_ne_zero eq1 + obtain ⟨j⟩ := this + have := congr($ha (Finsupp.single j m)) + simp only [toEndEnd_apply, Finsupp.smul_single, LinearMap.coe_mk, AddHom.coe_mk, + Finsupp.mapRange_single, G] at this ⊢ + have := congr($this j) + simp only [Finsupp.single_eq_same] at this + exact this + +/-- The double centralizer algebra equivalence for a simple module. -/ +noncomputable def end_end_iso + (M : Type v) [AddCommGroup M] + [Module A M] [IsSimpleModule A M] [Module k M] [IsScalarTower k A M] : + A ≃ₐ[k] Module.End (Module.End A M) M := + AlgEquiv.ofBijective (toEndEndAlgHom k A M) ⟨toEndEnd_injective k A M, + isBalanced_of_simpleMod k A M |>.1⟩ + +lemma Wedderburn_Artin_uniqueness₀ + (n n' : ℕ) [NeZero n] [NeZero n'] + (D : Type v) [DivisionRing D] [Algebra k D] (wdb : A ≃ₐ[k] Matrix (Fin n) (Fin n) D) + (D' : Type v) [DivisionRing D'] [Algebra k D'] (wdb' : A ≃ₐ[k] Matrix (Fin n') (Fin n') D') : + Nonempty <| D ≃ₐ[k] D' := by + let _ : Module A (Fin n → D) := Module.compHom _ wdb.toRingEquiv.toRingHom + have : IsScalarTower k (Matrix (Fin n) (Fin n) D) (Fin n → D) := + { smul_assoc a b x := by + ext i + simp only [matrix_smul_vec_apply, Matrix.smul_apply, smul_eq_mul, Algebra.smul_mul_assoc, + Pi.smul_apply, Finset.smul_sum] } + letI _ : IsScalarTower k A (Fin n → D) := + { smul_assoc a b x := by + change wdb (a • b) • x = _ + rw [map_smul, Algebra.smul_def, mul_smul] + rw [algebraMap_smul] + rfl } + letI _ : SMulCommClass A k (Fin n → D) := + { smul_comm a b x := by + change wdb a • b • x = b • wdb a • x + ext i + simp only [matrix_smul_vec_apply, Pi.smul_apply, smul_eq_mul, Algebra.mul_smul_comm, + Finset.smul_sum] } + haveI : IsSimpleModule A (Fin n → D) := simple_mod_of_wedderburn k A (NeZero.ne _) D wdb + have ⟨iso⟩ := end_simple_mod_of_wedderburn' k A n (NeZero.ne _) D wdb (Fin n → D) + have ⟨iso'⟩ := end_simple_mod_of_wedderburn' k A n' (NeZero.ne _) D' wdb' (Fin n → D) + exact ⟨AlgEquiv.op.symm (iso.symm.trans iso')⟩ + +lemma Wedderburn_Artin_uniqueness₁ + (n n' : ℕ) [NeZero n] [NeZero n'] + (D : Type v) [DivisionRing D] [Algebra k D] (wdb : A ≃ₐ[k] Matrix (Fin n) (Fin n) D) + (D' : Type v) [DivisionRing D'] [Algebra k D'] (wdb' : A ≃ₐ[k] Matrix (Fin n') (Fin n') D') : + n = n' := by + have ⟨iso⟩ := Wedderburn_Artin_uniqueness₀ k A n n' D wdb D' wdb' + let e : Matrix (Fin n) (Fin n) D ≃ₐ[k] Matrix (Fin n') (Fin n') D := + wdb.symm.trans (wdb'.trans iso.symm.mapMatrix) + haveI : Module.Finite k D := by + haveI inst1 : Module.Finite k (Matrix (Fin n) (Fin n) D) := wdb.toLinearEquiv.finiteDimensional + rw [← Module.rank_lt_aleph0_iff] at inst1 ⊢ + have eq1 := rank_mul_rank k D (Matrix (Fin n) (Fin n) D) + simp only [rank_matrix', Cardinal.mk_fintype, Fintype.card_fin, Cardinal.lift_mul, + Cardinal.lift_natCast] at eq1 + rw [← eq1, mul_comm] at inst1 + exact lt_of_le_of_lt (Cardinal.le_mul_left (a := Module.rank k D) (b := n * n) (by + simpa only [ne_eq, mul_eq_zero, Nat.cast_eq_zero, or_self] using NeZero.ne n)) inst1 + have eq1 := Module.finrank_matrix k D (Fin n) (Fin n) + have eq2 := Module.finrank_matrix k D (Fin n') (Fin n') + simp only [Fintype.card_fin] at eq1 eq2 + have eq3 : n * n * Module.finrank k D = n' * n' * Module.finrank k D := by + rw [← eq1, ← eq2] + exact LinearEquiv.finrank_eq e + simp only [mul_eq_mul_right_iff] at eq3 + replace eq3 := eq3.resolve_right (fun rid => by + rw [Module.finrank_zero_iff] at rid + simpa using rid.elim 0 1) + simpa [← pow_two] using eq3 + +end simple From e937e584b4dccbae830b19178efc3d1afc8183b7 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 13:33:22 -0700 Subject: [PATCH 13/34] Port BrauerGroup Skolem-Noether --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew.lean | 1 + LeanPool/BrauerGroupNew/SkolemNoether.lean | 364 +++++++++++++++++++++ 3 files changed, 366 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/SkolemNoether.lean diff --git a/LeanPool.lean b/LeanPool.lean index f2e9e6af11..f84783ef93 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -107,6 +107,7 @@ import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Operations import LeanPool.BrauerGroupNew.MatrixCenterEquiv import LeanPool.BrauerGroupNew.MatrixEquivTensor import LeanPool.BrauerGroupNew.MoritaEquivalence +import LeanPool.BrauerGroupNew.SkolemNoether import LeanPool.BrauerGroupNew.SplittingOfCSA import LeanPool.BrauerGroupNew.Subfield import LeanPool.BrauerGroupNew.Subfield.Defs diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index 7486f15f6f..444eda60f1 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -19,6 +19,7 @@ import LeanPool.BrauerGroupNew.SplittingOfCSA import LeanPool.BrauerGroupNew.TwoSidedIdeal import LeanPool.BrauerGroupNew.Wedderburn import LeanPool.BrauerGroupNew.ZeroSevenFourE +import LeanPool.BrauerGroupNew.SkolemNoether import LeanPool.BrauerGroupNew.Mathlib import LeanPool.BrauerGroupNew.Subfield diff --git a/LeanPool/BrauerGroupNew/SkolemNoether.lean b/LeanPool/BrauerGroupNew/SkolemNoether.lean new file mode 100644 index 0000000000..b7d2a29356 --- /dev/null +++ b/LeanPool/BrauerGroupNew/SkolemNoether.lean @@ -0,0 +1,364 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.BrauerGroup +import LeanPool.BrauerGroupNew.ZeroSevenFourE + +suppress_compilation + +universe u v w + +open MulOpposite +open scoped TensorProduct + +variable (K : Type u) [Field K] + +/-- Type synonym for viewing an `A`-module through an embedding of `B` into `A`. -/ +def module_inst (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [Ring B] [Algebra K B] (f : B →ₐ[K] A) := + (fun _ : B →ₐ[K] A => M) f + +instance (K A B M : Type u) [Field K] [Ring A] [Algebra K A] + [Ring B] [Algebra K B] (f : B →ₐ[K] A) [AddCommGroup M] : + AddCommGroup (module_inst K A B M f) := + inferInstanceAs <| AddCommGroup M + +instance inst_K_mod (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [Ring B] [Algebra K B] + [AddCommGroup M] [Module A M] (f : B →ₐ[K] A) : + Module K (module_inst K A B M f) := + Module.compHom M (algebraMap K A) + +instance (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [Ring B] [Algebra K B] + [AddCommGroup M] [Module A M] (f : B →ₐ[K] A) : + Module A (module_inst K A B M f) := + inferInstanceAs (Module A M) + +instance (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [FiniteDimensional K A] [Ring B] [Algebra K B] + [AddCommGroup M] [Module A M] (f : B →ₐ[K] A) : + IsScalarTower K A (module_inst K A B M f) := + IsScalarTower.of_algebraMap_smul fun _ ↦ congrFun rfl + +/-- The additive action map before tensor-product descent. -/ +def smul1AddHom' (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [Ring B] [Algebra K B] + [AddCommGroup M] [Module A M] (f : B →ₐ[K] A) (m : module_inst K A B M f) : + B →+ (Module.End A M) →+ (module_inst K A B M f) where + toFun b := { + toFun l := f b • l m + map_zero' := by simp only [LinearMap.zero_apply, smul_zero]; rfl + map_add' l1 l2 := by rw [LinearMap.add_apply, smul_add]; rfl + } + map_zero' := by + ext l + change f 0 • l m = 0 + simp + map_add' b1 b2 := by + ext l + simp only [map_add, AddMonoidHom.coe_mk, ZeroHom.coe_mk, AddMonoidHom.add_apply] + exact Module.add_smul (f b1) (f b2) (l m) + +/-- The tensor-product additive action on the transported module. -/ +def smul1AddHom (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [Ring B] [Algebra K B] + [AddCommGroup M] [Module K M] [Module A M] [IsScalarTower K A M] (f : B →ₐ[K] A) : + (module_inst K A B M f) → (B ⊗[K] (Module.End A M)) →+ (module_inst K A B M f) := fun m ↦ + TensorProduct.liftAddHom (smul1AddHom' K A B M f m) fun k b l ↦ by + simp only [smul1AddHom', AddMonoidHom.coe_mk, ZeroHom.coe_mk, LinearMapClass.map_smul, + smul_assoc, LinearMap.smul_apply] + rw [smul_comm] + +/-- The tensor-product linear action on the transported module. -/ +def smul1 (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [Ring B] [Algebra K B] + [AddCommGroup M] [Module K M] [Module A M] [IsScalarTower K A M] (f : B →ₐ[K] A) : + (module_inst K A B M f) → (B ⊗[K] (Module.End A M)) →ₗ[K] (module_inst K A B M f) := + fun m ↦ { + __ := smul1AddHom K A B M f m + map_smul' := fun k b ↦ by + simp only [smul1AddHom, smul1AddHom', ZeroHom.toFun_eq_coe, AddMonoidHom.toZeroHom_coe, + RingHom.id_apply] + induction b using TensorProduct.induction_on + · simp only [smul_zero, map_zero] + · rename_i b l + simp only [TensorProduct.smul_tmul', TensorProduct.liftAddHom_tmul, AddMonoidHom.coe_mk, + ZeroHom.coe_mk, LinearMapClass.map_smul, smul_assoc] + congr + ext k m + change k • m = algebraMap _ _ k • m + simp only [algebraMap_smul] + · rename_i bl1 bl2 hbl1 hbl2 + simp only [smul_add, map_add, hbl1, hbl2] + } + +lemma one_smul1 (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [FiniteDimensional K A] [Ring B] [Algebra K B] [AddCommGroup M] + [Module K M] [Module A M] [IsScalarTower K A M] (f : B →ₐ[K] A) : + ∀ (m : module_inst K A B M f), smul1 K A B M f m 1 = m := fun m ↦ by + simp [smul1, smul1AddHom, smul1AddHom', Algebra.TensorProduct.one_def] + +lemma mul_smul1 (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [FiniteDimensional K A] [Ring B] [Algebra K B] [AddCommGroup M] + [Module K M] [Module A M] [IsScalarTower K A M] (f : B →ₐ[K] A) : + ∀ (x y : (B ⊗[K] (Module.End A M))) (m : module_inst K A B M f), + smul1 K A B M f m (x * y) = smul1 K A B M f (smul1 K A B M f m y) x := fun x y m ↦ by + dsimp [smul1, smul1AddHom, smul1AddHom'] + induction x using TensorProduct.induction_on + · simp only [zero_mul, map_zero] + · rename_i b1 l1 + induction y using TensorProduct.induction_on + · simp only [mul_zero, map_zero, TensorProduct.liftAddHom_tmul, AddMonoidHom.coe_mk, + ZeroHom.coe_mk] + have h0 : l1 0 = 0 := l1.map_zero + change 0 = f b1 • l1 (0 : M) + rw [h0, smul_zero] + · rename_i b2 l2 + simp only [Algebra.TensorProduct.tmul_mul_tmul, TensorProduct.liftAddHom_tmul, + AddMonoidHom.coe_mk, ZeroHom.coe_mk, map_mul, Module.End.mul_apply, LinearMapClass.map_smul] + simp only [smul_smul] + · simp_all only [mul_add, map_add, TensorProduct.liftAddHom_tmul, AddMonoidHom.coe_mk, + ZeroHom.coe_mk] + symm + exact (congrArg (fun z => f b1 • z) (l1.map_add _ _)).trans (smul_add (f b1) _ _) + · simp_all [add_mul] + +lemma smul1_add (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [FiniteDimensional K A] + [Ring B] [Algebra K B] [AddCommGroup M] [Module K M] [Module A M] [IsScalarTower K A M] + (f : B →ₐ[K] A) : ∀ (r : (B ⊗[K] (Module.End A M))) (m1 m2 : module_inst K A B M f), + smul1 K A B M f (m1 + m2) r = smul1 K A B M f m1 r + smul1 K A B M f m2 r := fun r m1 m2 ↦ by + induction r using TensorProduct.induction_on + · simp only [map_zero, add_zero] + · rename_i b l + simp only [smul1, smul1AddHom, smul1AddHom', ZeroHom.toFun_eq_coe, + AddMonoidHom.toZeroHom_coe, LinearMap.coe_mk, AddHom.coe_mk, TensorProduct.liftAddHom_tmul, + AddMonoidHom.coe_mk, ZeroHom.coe_mk] + have hadd : l (m1 + m2) = l m1 + l m2 := l.map_add m1 m2 + rw [hadd, smul_add] + rfl + · rename_i a b ha hb + simp_all only [smul1, smul1AddHom, smul1AddHom', map_add, ZeroHom.toFun_eq_coe, + AddMonoidHom.toZeroHom_coe, LinearMap.coe_mk, AddHom.coe_mk, ← add_assoc, add_left_inj] + nth_rw 2 [add_assoc]; nth_rw 4 [add_comm] + rw [← add_assoc] + +lemma add_smul1 (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [FiniteDimensional K A] + [Ring B] [Algebra K B] [AddCommGroup M] [Module K M] [Module A M] [IsScalarTower K A M] + (f : B →ₐ[K] A) (r s : B ⊗[K] Module.End A M) (x : module_inst K A B M f) : + smul1 K A B M f x (r + s) = smul1 K A B M f x r + smul1 K A B M f x s := by + simp only [smul1, ZeroHom.toFun_eq_coe, AddMonoidHom.toZeroHom_coe, map_add, LinearMap.coe_mk, + AddHom.coe_mk] + +instance IsMod (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [FiniteDimensional K A] [Ring B] [Algebra K B] + [AddCommGroup M] [Module K M] [Module A M] [IsScalarTower K A M] (f : B →ₐ[K] A) : + Module (B ⊗[K] (Module.End A M)) (module_inst K A B M f) where + smul := fun r m => smul1 K A B M f m r + one_smul := one_smul1 K A B M f + mul_smul := mul_smul1 K A B M f + smul_zero a := by + change smul1 K A B M f 0 a = 0 + rw [smul1] + simp only [ZeroHom.toFun_eq_coe, AddMonoidHom.toZeroHom_coe, LinearMap.coe_mk, AddHom.coe_mk] + induction a using TensorProduct.induction_on + · simp only [map_zero] + · rename_i b l + simp only [smul1AddHom, smul1AddHom', TensorProduct.liftAddHom_tmul, + AddMonoidHom.coe_mk, ZeroHom.coe_mk] + have h0 : l 0 = 0 := l.map_zero + change f b • l (0 : M) = 0 + rw [h0, smul_zero] + · simp_all [map_add] + smul_add := smul1_add K A B M f + add_smul := add_smul1 K A B M f + zero_smul m := by + change smul1 K A B M f m 0 = 0 + simp only [smul1, map_zero] + +instance (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [FiniteDimensional K A] + [Ring B] [Algebra K B] + [AddCommGroup M] [Module K M] [Module A M] [IsScalarTower K A M] + [IsSimpleModule A M] (f : B →ₐ[K] A) : + IsScalarTower K (B ⊗[K] Module.End A M) (module_inst K A B M f) where + smul_assoc a x y := by + induction x with + | zero => + -- simp + change smul1 K A B M f _ _ = _ • smul1 K A B M f _ _ + rw [map_zero, smul_zero, smul_zero, map_zero] + | tmul b z => + change (smul1 K A B M f _ _) = _ • smul1 K A B M f _ _ + simp + | add x y hx hy => + rw [smul_add, add_smul, hx, hy, add_smul, smul_add] + +instance module_inst_findim (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [FiniteDimensional K A] + [Ring B] [Algebra K B] + [AddCommGroup M] [Module K M] [Module A M] [IsScalarTower K A M] + [IsSimpleModule A M] (f : B →ₐ[K] A) : + Module.Finite (B ⊗[K] Module.End A M) (module_inst K A B M f) := by + have : Module.Finite A M := ⟨⟨{gen A M}, eq_top_iff.2 fun x _ => by + obtain ⟨a, rfl⟩ := gen_spec A M x + apply Submodule.smul_mem + refine Submodule.subset_span ?_ + aesop⟩⟩ + obtain ⟨s, hs⟩ : Module.Finite K M := Module.Finite.trans A M + refine ⟨⟨s, eq_top_iff.2 ?_⟩⟩ + rintro x - + have mem : (x : M) ∈ (Submodule.span K s : Submodule K M) := hs ▸ ⟨⟩ + obtain ⟨c, hc1, rfl⟩ := Submodule.mem_span_set (R := K) (M := M) |>.1 mem + refine Submodule.sum_mem _ fun k hk => ?_ + simp only + rw [show (c k • k : module_inst K A B M f) = + ((algebraMap K (B ⊗[K] Module.End A M) (c k)) • (show module_inst K A B M f from k)) by + simp only [Algebra.TensorProduct.algebraMap_apply] + change _ = smul1 K A B M f k _ + simp only [smul1, smul1AddHom, smul1AddHom', ZeroHom.toFun_eq_coe, AddMonoidHom.toZeroHom_coe, + LinearMap.coe_mk, AddHom.coe_mk, TensorProduct.liftAddHom_tmul, AddMonoidHom.coe_mk, + ZeroHom.coe_mk, AlgHom.commutes, algebraMap_smul, Module.End.one_apply]] + refine Submodule.smul_mem _ _ ?_ + simp only + refine Submodule.subset_span ?_ + exact hc1 hk + +instance tensor_is_simple (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [FiniteDimensional K A] [Ring B] [Algebra K B] + [IsSimpleRing B] [AddCommGroup M] [Module K M] [Module A M] + [IsScalarTower K A M] [IsSimpleModule A M] + [Algebra.IsCentral K A] [csa_A : IsSimpleRing A] : + IsSimpleRing (B ⊗[K] Module.End A M) := by + obtain ⟨n, hn, D, hD1, hD2, ⟨iso⟩⟩ := Wedderburn_Artin_algebra_version K A + have : NeZero n := ⟨hn⟩ + obtain ⟨e1⟩ := end_simple_mod_of_wedderburn' K A n hn D iso M + haveI := CSA_implies_CSA K A n D _ iso + haveI : Algebra.IsCentral K (Module.End A M) := e1.symm.isCentral + classical + exact @IsCentralSimple.TensorProduct.simple K _ B (Module.End A M) _ _ _ _ _ this _ + +variable (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [FiniteDimensional K A] + [Algebra.IsCentral K A] [IsSimpleRing A] [Ring B] + [Algebra K B] [hB : IsSimpleRing B] [AddCommGroup M] [Module K M] [Module A M] + [IsScalarTower K A M] [IsSimpleModule A M] (f g : B →ₐ[K] A) + +-- set_option linter.unusedVariables false in +lemma findimB (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [FiniteDimensional K A] + [Algebra.IsCentral K A] [IsSimpleRing A] [Ring B] + [Algebra K B] [hB : IsSimpleRing B] [AddCommGroup M] [Module K M] [Module A M] + [IsScalarTower K A M] [IsSimpleModule A M] (f : B →ₐ[K] A) : + FiniteDimensional K B := FiniteDimensional.of_injective (K := K) (V₂ := A) f (by + change Function.Injective f + have H := IsSimpleRing.injective_ringHom_or_subsingleton_codomain f.toRingHom + refine H.resolve_right fun rid ↦ ?_ + have : Nontrivial A := inferInstance + rw [← not_subsingleton_iff_nontrivial] at this + contradiction) + +omit hB in +lemma iso_fg [hB1 : IsSimpleRing B] : + Nonempty <| module_inst K A B M f ≃ₗ[B ⊗[K] (Module.End A M)] module_inst K A B M g := by + haveI := findimB K A B M f + rw [linearEquiv_iff_finrank_eq_over_simple_ring K] + rfl + +/-- +End_End_A +-/ +theorem SkolemNoether (K A B M : Type u) + [Field K] [Ring A] [Algebra K A] [FiniteDimensional K A] + [Algebra.IsCentral K A] [IsSimpleRing A] [Ring B] + [Algebra K B] [hB : IsSimpleRing B] [AddCommGroup M] [Module K M] [Module A M] + [IsScalarTower K A M] [IsSimpleModule A M] (f g : B →ₐ[K] A) : + ∃(x : Aˣ), ∀(b : B), g b = x * f b * x⁻¹ := by + obtain ⟨φ⟩ := iso_fg K A B M f g + let ISO := end_end_iso K A M + let Φ : Module.End (Module.End A M) M := + { toFun m := φ m + map_add' := fun m n => φ.map_add m n + map_smul' := by + intro F (m : module_inst K A B M f) + simp only [Module.End.smul_def, RingHom.id_apply] + have : F m = smul1 K A B M f m (1 ⊗ₜ F) := by + simp only [smul1, smul1AddHom, smul1AddHom', ZeroHom.toFun_eq_coe, + AddMonoidHom.toZeroHom_coe, LinearMap.coe_mk, AddHom.coe_mk, + TensorProduct.liftAddHom_tmul, AddMonoidHom.coe_mk, ZeroHom.coe_mk, map_one, one_smul] + rw [this] + erw [φ.map_smul] + change smul1 K A B M _ _ (1 ⊗ₜ F) = _ + simp only [smul1, smul1AddHom, smul1AddHom', ZeroHom.toFun_eq_coe, + AddMonoidHom.toZeroHom_coe, LinearMap.coe_mk, AddHom.coe_mk, + TensorProduct.liftAddHom_tmul, AddMonoidHom.coe_mk, ZeroHom.coe_mk, map_one, one_smul] } + let Ψ : Module.End (Module.End A M) M := + { toFun m := φ.symm m + map_add' := fun m n => φ.symm.map_add m n + map_smul' := by + intro F m + simp only [Module.End.smul_def, RingHom.id_apply] + have : F m = smul1 K A B M g m (1 ⊗ₜ F) := by + simp only [smul1, smul1AddHom, smul1AddHom', ZeroHom.toFun_eq_coe, + AddMonoidHom.toZeroHom_coe, LinearMap.coe_mk, AddHom.coe_mk, + TensorProduct.liftAddHom_tmul, AddMonoidHom.coe_mk, ZeroHom.coe_mk, map_one, one_smul] + rw [this] + have := φ.symm.map_smul (1 ⊗ₜ F) m + change φ.symm (smul1 K A B M _ _ _) = _ at this + rw [this] + change smul1 K A B M _ _ (1 ⊗ₜ F) = _ + simp only [smul1, smul1AddHom, smul1AddHom', ZeroHom.toFun_eq_coe, + AddMonoidHom.toZeroHom_coe, LinearMap.coe_mk, AddHom.coe_mk, + TensorProduct.liftAddHom_tmul, AddMonoidHom.coe_mk, ZeroHom.coe_mk, map_one, one_smul] } + let a := ISO.symm Φ + let b := ISO.symm Ψ + refine ⟨⟨a, b, (by + apply_fun ISO using AlgEquiv.injective _ + simp only [map_mul, AlgEquiv.apply_symm_apply, map_one, a, b] + ext m + simp only [Module.End.mul_apply, LinearMap.coe_mk, AddHom.coe_mk, LinearEquiv.apply_symm_apply, + Module.End.one_apply, Φ, Ψ]), (by + apply_fun ISO using AlgEquiv.injective _ + simp only [map_mul, AlgEquiv.apply_symm_apply, map_one, b, a] + ext m + simp only [Module.End.mul_apply, LinearMap.coe_mk, AddHom.coe_mk, LinearEquiv.symm_apply_apply, + Module.End.one_apply, Ψ, Φ])⟩, ?_⟩ + intro x + simp only [Units.inv_mk, a, b] + apply_fun ISO using AlgEquiv.injective _ + simp only [end_end_iso, AlgEquiv.coe_ofBijective, map_mul, AlgEquiv.apply_symm_apply, ISO, Φ, Ψ] + ext m + simp only [toEndEndAlgHom, AddHom.toFun_eq_coe, LinearMap.coe_toAddHom, AlgHom.coe_mk, + RingHom.coe_mk, MonoidHom.coe_mk, OneHom.coe_mk, toEndEnd_apply, Module.End.mul_apply, + LinearMap.coe_mk, AddHom.coe_mk] + have := φ.map_smul (x ⊗ₜ LinearMap.id) (φ.symm m) + change φ (smul1 K A B M _ _ (x ⊗ₜ LinearMap.id)) = _ at this + simp only [smul1, smul1AddHom, smul1AddHom', ZeroHom.toFun_eq_coe, AddMonoidHom.toZeroHom_coe, + LinearMap.coe_mk, AddHom.coe_mk, TensorProduct.liftAddHom_tmul, AddMonoidHom.coe_mk, + ZeroHom.coe_mk, LinearMap.id_coe, id_eq, LinearEquiv.apply_symm_apply] at this + erw [this] + change _ = smul1 K A B M _ _ (x ⊗ₜ LinearMap.id) + simp [smul1, smul1AddHom, smul1AddHom'] + +theorem SkolemNoether' (K A B : Type u) + [Field K] [Ring A] [Algebra K A] [FiniteDimensional K A] + [Algebra.IsCentral K A] [IsSimpleRing A] [Ring B] + [Algebra K B] [hB : IsSimpleRing B] (f g : B →ₐ[K] A) : + ∃ (x : Aˣ), ∀(b : B), g b = x * f b * x⁻¹ := by + obtain ⟨n, hn, S, _, _, ⟨e⟩⟩ := Wedderburn_Artin_algebra_version K A + letI := Module.compHom (Fin n → S) e.toRingEquiv.toRingHom + have : IsSimpleModule A (Fin n → S) := simple_mod_of_wedderburn K A hn S e + haveI : IsScalarTower K A (Fin n → S) := by + constructor + intro a b c + ext i + simp only [Pi.smul_apply] + change ∑ x, e (a • b) i x * c x = a • ∑ x, e b i x * c x + rw [map_smul] + simp only [Matrix.smul_apply, Algebra.smul_mul_assoc, Finset.smul_sum] + exact SkolemNoether K A B (Fin n → S) f g From b4642f24230d7335a12004f7120746ed830b0098 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 13:53:18 -0700 Subject: [PATCH 14/34] Port BrauerGroup double centralizer --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew.lean | 1 + .../BrauerGroupNew/DoubleCentralizer.lean | 870 ++++++++++++++++++ 3 files changed, 872 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/DoubleCentralizer.lean diff --git a/LeanPool.lean b/LeanPool.lean index f84783ef93..96effe065b 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -58,6 +58,7 @@ import LeanPool.BrauerGroupNew.AlgClosedUnion import LeanPool.BrauerGroupNew.BrauerGroup import LeanPool.BrauerGroupNew.CentralSimple import LeanPool.BrauerGroupNew.Centralizer +import LeanPool.BrauerGroupNew.DoubleCentralizer import LeanPool.BrauerGroupNew.ExtendScalar import LeanPool.BrauerGroupNew.FieldCat import LeanPool.BrauerGroupNew.FiniteField diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index 444eda60f1..d36a26c3b2 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -20,6 +20,7 @@ import LeanPool.BrauerGroupNew.TwoSidedIdeal import LeanPool.BrauerGroupNew.Wedderburn import LeanPool.BrauerGroupNew.ZeroSevenFourE import LeanPool.BrauerGroupNew.SkolemNoether +import LeanPool.BrauerGroupNew.DoubleCentralizer import LeanPool.BrauerGroupNew.Mathlib import LeanPool.BrauerGroupNew.Subfield diff --git a/LeanPool/BrauerGroupNew/DoubleCentralizer.lean b/LeanPool/BrauerGroupNew/DoubleCentralizer.lean new file mode 100644 index 0000000000..3bf3227bf5 --- /dev/null +++ b/LeanPool/BrauerGroupNew/DoubleCentralizer.lean @@ -0,0 +1,870 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +/- +Copyright (c) 2024 Jujian Zhang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jujian Zhang +-/ +import LeanPool.BrauerGroupNew.LemmasAboutSimpleRing +import LeanPool.BrauerGroupNew.SkolemNoether +import Mathlib.RingTheory.SimpleRing.Field + +universe u v + +variable {F A : Type u} +variable [Field F] [Ring A] [Algebra F A] +variable [FiniteDimensional F A] [Algebra.IsCentral F A] [IsSimpleRing A] +variable (B : Subalgebra F A) [IsSimpleRing B] + +open Module TensorProduct + +section lemma1 + +variable {F A A' : Type u} +variable [Field F] [Ring A] [Algebra F A] [Ring A'] [Algebra F A'] +variable (B : Subalgebra F A) (B' : Subalgebra F A') +variable {ι ι' : Type*} (𝒜 : Basis ι F A) (𝒜' : Basis ι' F A') + +include 𝒜' in +lemma centralizer_inclusionLeft : + Subalgebra.centralizer F (A := A ⊗[F] A') + (Algebra.TensorProduct.includeLeft (R := F) (S := F) (A := A) (B := A') |>.comp + B.val).range = + (Algebra.TensorProduct.map (Subalgebra.centralizer F B).val (AlgHom.id F A')).range := by + classical + refine le_antisymm ?_ ?_ + · rintro x hx + obtain ⟨s, rfl⟩ := TensorProduct.eq_repr_basis_right 𝒜' x + refine Subalgebra.sum_mem _ fun i hi => ?_ + simp only [AlgHom.mem_range] + refine ⟨⟨s i, fun b hb => ?_⟩ ⊗ₜ 𝒜' i, by simp⟩ + have eq := hx (b ⊗ₜ 1) (by simpa using ⟨b, hb, rfl⟩) + simp only [Finsupp.sum, Finset.mul_sum, Algebra.TensorProduct.tmul_mul_tmul, one_mul, + Finset.sum_mul, mul_one] at eq + rw [← sub_eq_zero, ← Finset.sum_sub_distrib] at eq + simp_rw [← sub_tmul] at eq + have := IsCentralSimple.TensorProduct.sum_tmul_basis_right_eq_zero' (h := eq) + specialize this i hi + rw [sub_eq_zero] at this + exact this + · rintro _ ⟨x, rfl⟩ _ ⟨y, rfl⟩ + induction x using TensorProduct.induction_on with + | zero => simp + | tmul a b => + simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe, AlgHom.coe_comp, Subalgebra.coe_val, + Function.comp_apply, Algebra.TensorProduct.includeLeft_apply, + Algebra.TensorProduct.map_tmul, AlgHom.coe_id, id_eq, + Algebra.TensorProduct.tmul_mul_tmul, one_mul, mul_one] + congr 1 + exact a.2 _ y.2 + | add x y hx hy => + simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe, AlgHom.coe_comp, Subalgebra.coe_val, + Function.comp_apply, Algebra.TensorProduct.includeLeft_apply, map_add] at hx hy ⊢ + simp [mul_add, hx, hy, add_mul] + +include 𝒜 in +lemma centralizer_inclusionRight : + Subalgebra.centralizer F (A := A ⊗[F] A') + (Algebra.TensorProduct.includeRight (R := F) (A := A) (B := A') |>.comp + B'.val).range = + (Algebra.TensorProduct.map (AlgHom.id F A) (Subalgebra.centralizer F B').val).range := by + classical + refine le_antisymm ?_ ?_ + · rintro x hx + obtain ⟨s, rfl⟩ := TensorProduct.eq_repr_basis_left 𝒜 x + refine Subalgebra.sum_mem _ fun i hi => ?_ + simp only [AlgHom.mem_range] + refine ⟨𝒜 i ⊗ₜ ⟨s i, fun b hb => ?_⟩, by simp⟩ + have eq := hx (1 ⊗ₜ b) (by simpa using ⟨b, hb, rfl⟩) + simp only [Finsupp.sum, Finset.mul_sum, Algebra.TensorProduct.tmul_mul_tmul, one_mul, + Finset.sum_mul, mul_one] at eq + rw [← sub_eq_zero, ← Finset.sum_sub_distrib] at eq + simp_rw [← tmul_sub] at eq + have := IsCentralSimple.TensorProduct.sum_tmul_basis_left_eq_zero' (h := eq) + specialize this i hi + rw [sub_eq_zero] at this + exact this + · rintro _ ⟨x, rfl⟩ _ ⟨y, rfl⟩ + induction x using TensorProduct.induction_on with + | zero => simp + | tmul a b => + simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe, AlgHom.coe_comp, Subalgebra.coe_val, + Function.comp_apply, Algebra.TensorProduct.includeRight_apply, + Algebra.TensorProduct.map_tmul, AlgHom.coe_id, id_eq, + Algebra.TensorProduct.tmul_mul_tmul, one_mul, mul_one] + congr 1 + exact b.2 _ y.2 + | add x y hx hy => + simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe, AlgHom.coe_comp, Subalgebra.coe_val, + Function.comp_apply, Algebra.TensorProduct.includeRight_apply, map_add] at hx hy ⊢ + simp [mul_add, hx, hy, add_mul] + +lemma centralizer_tensor_le_inf_centralizer : + Subalgebra.centralizer F (A := A ⊗[F] A') + ((Algebra.TensorProduct.map B.val B'.val).range : + Subalgebra F (A ⊗[F] A')) ≤ + Subalgebra.centralizer F (A := A ⊗[F] A') + (Algebra.TensorProduct.includeLeft (R := F) (S := F) (A := A) (B := A') |>.comp + B.val).range ⊓ + Subalgebra.centralizer F (A := A ⊗[F] A') + (Algebra.TensorProduct.includeRight (R := F) (A := A) (B := A') |>.comp + B'.val).range := by + intro x hx + rw [← Subalgebra.centralizer_sup] + intro y hy + apply hx + rw [Algebra.TensorProduct.map_range] + exact hy + +include 𝒜 𝒜' in +lemma centralizer_tensor_centralizer : + Subalgebra.centralizer F (A := A ⊗[F] A') + ((Algebra.TensorProduct.map B.val B'.val).range : + Subalgebra F (A ⊗[F] A')) = + (Algebra.TensorProduct.map (Subalgebra.centralizer F B).val + (Subalgebra.centralizer F B').val).range := by + refine le_antisymm ?_ ?_ + · have := Algebra.TensorProduct.includeLeft (R := F) (S := F) (A := A) (B := B') |>.comp B.val + have ineq1 : + Subalgebra.centralizer F (A := A ⊗[F] A') + ((Algebra.TensorProduct.map B.val B'.val).range : + Subalgebra F (A ⊗[F] A')) ≤ + Subalgebra.centralizer F (A := A ⊗[F] A') + (Algebra.TensorProduct.includeLeft (R := F) (S := F) (A := A) (B := A') |>.comp + B.val).range ⊓ + Subalgebra.centralizer F (A := A ⊗[F] A') + (Algebra.TensorProduct.includeRight (R := F) (A := A) (B := A') |>.comp + B'.val).range := by + apply centralizer_tensor_le_inf_centralizer + have eq1 : Subalgebra.centralizer F (A := A ⊗[F] A') + (Algebra.TensorProduct.includeLeft (R := F) (S := F) (A := A) (B := A') |>.comp + B.val).range = + (Algebra.TensorProduct.map (Subalgebra.centralizer F B).val (AlgHom.id F A')).range := by + apply centralizer_inclusionLeft (𝒜' := 𝒜') + have eq2 : Subalgebra.centralizer F (A := A ⊗[F] A') + (Algebra.TensorProduct.includeRight (R := F) (A := A) (B := A') |>.comp + B'.val).range = + (Algebra.TensorProduct.map (AlgHom.id F A) (Subalgebra.centralizer F B').val).range := by + apply centralizer_inclusionRight (𝒜 := 𝒜) + refine ineq1.trans ?_ + rw [eq1, eq2] + have := IsCentralSimple.TensorProduct.submodule_tensor_inf_tensor_submodule F A A' + (Subalgebra.toSubmodule <| Subalgebra.centralizer F (B : Set A)) + (Subalgebra.toSubmodule <| Subalgebra.centralizer F (B' : Set A')) + intro x (hx : x ∈ Subalgebra.toSubmodule (_ ⊓ _)) + suffices x ∈ + (LinearMap.range <| TensorProduct.map + (Subalgebra.toSubmodule <| Subalgebra.centralizer F (B : Set A)).subtype + (Subalgebra.toSubmodule <| Subalgebra.centralizer F (B' : Set A')).subtype) by + exact this + rw [← this] + exact hx + · rintro _ ⟨x, rfl⟩ + induction x using TensorProduct.induction_on with + | zero => exact Subalgebra.zero_mem _ + | tmul a b => + simp only [AlgHom.coe_range, AlgHom.toRingHom_eq_coe, RingHom.coe_coe, + Algebra.TensorProduct.map_tmul, Subalgebra.coe_val, Subalgebra.mem_centralizer_iff, + Set.mem_range, forall_exists_index, forall_apply_eq_imp_iff] + intro x + induction x using TensorProduct.induction_on with + | zero => simp + | tmul x y => + simp only [Algebra.TensorProduct.map_tmul, Subalgebra.coe_val, + Algebra.TensorProduct.tmul_mul_tmul] + congr 1 + · exact a.2 x x.2 + · exact b.2 y y.2 + | add x y hx hy => + simp only [map_add, add_mul, hx, hy, mul_add] + | add x y hx hy => + rw [RingHom.map_add] + exact Subalgebra.add_mem _ hx hy + +end lemma1 + +section lemma2 + +section central_simple_case + +variable (F B : Type u) [Field F] [Ring B] [Algebra F B] [Algebra.IsCentral F B] [IsSimpleRing B] + [FiniteDimensional F B] + +lemma centralizer_mulLeft_le_of_isCentralSimple : + (Subalgebra.centralizer F (Set.range <| LinearMap.mulLeft F : Set <| Module.End F B) : Set _) ≤ + Set.range (LinearMap.mulRight F (A := B)) := by + intro (x : Module.End F B) hx + let eqv := tensor_self_op.equivEnd F B + have hx' : eqv.symm x ∈ Subalgebra.centralizer F + ((Algebra.TensorProduct.includeLeft (R := F) (S := F) (A := B) (B := Bᵐᵒᵖ)).range : + Set (B ⊗[F] Bᵐᵒᵖ)) := by + rintro _ ⟨y, rfl⟩ + simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe, Algebra.TensorProduct.includeLeft_apply, + eqv] + apply_fun eqv + simp only [map_mul] + rw [show eqv (y ⊗ₜ[F] 1) = LinearMap.mulLeft F y by + ext x + simp only [LinearMap.mulLeft_apply] + simp only [tensor_self_op.equivEnd, tensor_self_op.toEnd, AlgEquiv.coe_ofBijective, + Algebra.TensorProduct.lift_tmul, AlgHom.coe_mk, RingHom.coe_mk, MonoidHom.coe_mk, + OneHom.coe_mk, MulOpposite.unop_one, mul_one, Module.End.mul_apply, LinearMap.coe_mk, + AddHom.coe_mk, eqv] ] + ext b + simp only [Module.End.mul_apply, LinearMap.mulLeft_apply] + -- change y * (eqv (eqv.symm x)) b = (eqv (eqv.symm x)) (y * b) + rw [eqv.apply_symm_apply] + exact congr($(hx (LinearMap.mulLeft F y) (by simp)) b) + have eq : Subalgebra.centralizer F + ((Algebra.TensorProduct.includeLeft (R := F) (S := F) (A := B) (B := Bᵐᵒᵖ)).range : + Set (B ⊗[F] Bᵐᵒᵖ)) = + (Algebra.TensorProduct.includeRight (R := F) (A := B) (B := Bᵐᵒᵖ)).range := by + refine le_antisymm ?_ ?_ + · set ℬ := Module.finBasis F Bᵐᵒᵖ + intro z hz + obtain ⟨s, rfl⟩ := TensorProduct.eq_repr_basis_right ℬ z + refine Subalgebra.sum_mem _ fun i hi => ?_ + have : (s i) ∈ Subalgebra.center F B := by + rw [Subalgebra.mem_center_iff] + intro b' + have eq := hz (b' ⊗ₜ 1) (by simp) + simp only [Finsupp.sum, Finset.mul_sum, Algebra.TensorProduct.tmul_mul_tmul, one_mul, + Finset.sum_mul, mul_one] at eq + rw [← sub_eq_zero, ← Finset.sum_sub_distrib] at eq + simp_rw [← TensorProduct.sub_tmul] at eq + replace eq := IsCentralSimple.TensorProduct.sum_tmul_basis_right_eq_zero' (h := eq) + specialize eq i hi + rw [sub_eq_zero] at eq + exact eq + rw [Algebra.IsCentral.center_eq_bot, Algebra.mem_bot] at this + obtain ⟨x, hx⟩ := this + dsimp only + rw [← hx, Algebra.algebraMap_eq_smul_one, ← smul_tmul'] + exact Subalgebra.smul_mem _ (by simp) _ + · set ℬ := Module.finBasis F B + rintro _ ⟨z, rfl⟩ _ ⟨y, rfl⟩ + simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe, Algebra.TensorProduct.includeLeft_apply, + Algebra.TensorProduct.includeRight_apply, Algebra.TensorProduct.tmul_mul_tmul, mul_one, + one_mul] + rw [eq] at hx' + obtain ⟨y, hy⟩ := hx' + simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe, + Algebra.TensorProduct.includeRight_apply] at hy + apply_fun eqv at hy + simp only [AlgEquiv.apply_symm_apply] at hy + rw [← hy] + refine ⟨y.unop, ?_⟩ + ext c + simp only [LinearMap.mulRight_apply, tensor_self_op.equivEnd, tensor_self_op.toEnd, + AlgEquiv.coe_ofBijective, Algebra.TensorProduct.lift_tmul, AlgHom.coe_mk, RingHom.coe_mk, + MonoidHom.coe_mk, OneHom.coe_mk, one_mul, Module.End.mul_apply, LinearMap.coe_mk, AddHom.coe_mk, + eqv] + +end central_simple_case + +variable {F B : Type u} +variable [Field F] [Ring B] [Algebra F B] [IsSimpleRing B] [FiniteDimensional F B] + +variable (F B) in +/-- Identifies the centralizer of left multiplication with endomorphisms over the center. -/ +def centralizerMulLeftCopy : + (Subalgebra.centralizer F (Set.range (LinearMap.mulLeft F) : Set <| Module.End F B)) →ₗ[F] + (B →ₗ[Subalgebra.center F B] B) where + toFun a := + { toFun := a + map_add' := a.1.map_add + map_smul' := by + intro c x + simp only [RingHom.id_apply] + rw [show c • x = c.1 * x by rfl] + have eq : c.1 * a.1 x = a.1 (c.1 * x) := + congr($(a.2 (LinearMap.mulLeft F c.1) (by simp)) x) + rw [← eq]; rfl } + map_add' _ _ := rfl + map_smul' _ _ := rfl + +instance : SMulCommClass (Subalgebra.center F B) B B where + smul_comm x y z := by + change x.1 * (y * z) = y * (x.1 * z) + rw [← mul_assoc, ← Subalgebra.mem_center_iff.1 x.2 y, mul_assoc] + +noncomputable instance center_field : Field (Subalgebra.center F B) := + IsField.toField <| IsSimpleRing.isField_center _ + +instance center_algebra : Algebra (Subalgebra.center F B) B where + smul a b := a.1 • b + algebraMap := { + toFun a := a.1 + map_one' := rfl + map_mul' _ _ := rfl + map_zero' := rfl + map_add' _ _ := rfl + } + commutes' x y := by + simpa using Subalgebra.mem_center_iff.1 x.2 y |>.symm + smul_def' _ _ := rfl + +instance : FiniteDimensional (Subalgebra.center F B) B := + FiniteDimensional.right F (Subalgebra.center F B) B + +variable (F B) in +/-- The subalgebra of endomorphisms given by left multiplication. -/ +@[simps] +def Module.End.leftMul : Subalgebra F (Module.End F B) where + carrier := Set.range <| LinearMap.mulLeft F + mul_mem' := by + rintro _ _ ⟨x, rfl⟩ ⟨y, rfl⟩ + refine ⟨x * y, ?_⟩ + ext z + simp + one_mem' := by + refine ⟨1, ?_⟩ + simp only [LinearMap.mulLeft_one] + rfl + add_mem' := by + rintro _ _ ⟨x, rfl⟩ ⟨y, rfl⟩ + refine ⟨x + y, ?_⟩ + ext z + simp [add_mul] + zero_mem' := by + refine ⟨0, ?_⟩ + ext z + simp + algebraMap_mem' := by + intro c + refine ⟨algebraMap _ _ c, ?_⟩ + ext z + simp [Algebra.smul_def] + +variable (F B) in +/-- The subalgebra of endomorphisms given by right multiplication. -/ +def Module.End.rightMul : Subalgebra F (Module.End F B) where + carrier := Set.range <| LinearMap.mulRight F + one_mem' := ⟨1, by ext; simp⟩ + add_mem' := by + rintro _ _ ⟨x, rfl⟩ ⟨y, rfl⟩ + refine ⟨x + y, ?_⟩ + ext z + simp [mul_add] + zero_mem' := by + refine ⟨0, ?_⟩ + ext z + simp + mul_mem' := by + rintro _ _ ⟨x, rfl⟩ ⟨y, rfl⟩ + refine ⟨y * x, ?_⟩ + ext z + simp + algebraMap_mem' := by + intro c + refine ⟨algebraMap _ _ c, ?_⟩ + ext z + simp only [LinearMap.mulRight_apply, algebraMap_end_apply] + rw [Algebra.smul_def, Algebra.commutes c z] + +/-- Right multiplication endomorphisms are equivalent to the opposite algebra. -/ +noncomputable def Module.End.rightMulEquiv : Module.End.rightMul F B ≃ₐ[F] Bᵐᵒᵖ := +AlgEquiv.symm <| AlgEquiv.ofBijective + { toFun x := ⟨LinearMap.mulRight F x.unop, Set.mem_range_self _⟩ + map_one' := by ext; simp + map_mul' := by intros; ext; simp + map_zero' := by ext; simp + map_add' := by intros; ext; simp [mul_add] + commutes' := by + intro r + ext x + change x * algebraMap F B r = (algebraMap F (Module.End F B) r) x + simp only [algebraMap_end_apply, Algebra.smul_def, Algebra.commutes] } <| by + constructor + · intro x y hxy + have := congr($hxy.1 1) + simp only [AlgHom.coe_mk, RingHom.coe_mk, MonoidHom.coe_mk, OneHom.coe_mk, + LinearMap.mulRight_apply, one_mul, MulOpposite.unop_inj] at this + exact this + · rintro ⟨_, ⟨x, rfl⟩⟩ + use (MulOpposite.op x) + ext + simp + +lemma centralizer_mulLeft : + Subalgebra.centralizer F (Module.End.leftMul F B : Set <| Module.End F B) = + (Module.End.rightMul F B) := by + refine le_antisymm ?_ ?_ + · suffices eq : + (Subalgebra.centralizer (Subalgebra.center F B) + (Set.range <| LinearMap.mulLeft (Subalgebra.center F B) : + Set <| Module.End (Subalgebra.center F B) B) : Set _) ≤ + Set.range (LinearMap.mulRight (Subalgebra.center F B) (A := B)) by + intro a ha + set a' : B →ₗ[Subalgebra.center F B] B := + { __ := a + map_smul' := by + intro c x + simp only [AddHom.toFun_eq_coe, LinearMap.coe_toAddHom, RingHom.id_apply] + rw [show c • x = c.1 * x by rfl] + have eq : c.1 * a x = a (c.1 * x) := + congr($(ha (LinearMap.mulLeft F c.1) (by simp)) x) + rw [← eq]; rfl } + obtain ⟨b, hb⟩ := @eq a' (by + rintro _ ⟨y, rfl⟩ + ext b + simp only [Module.End.mul_apply, LinearMap.coe_mk, LinearMap.coe_toAddHom, + LinearMap.mulLeft_apply, a'] + exact congr($(ha (LinearMap.mulLeft F y) (by simp)) b)) + refine ⟨b, ?_⟩ + ext c + exact congr($hb c) + haveI : Algebra.IsCentral (Subalgebra.center F B) B := + { out := by + intro x hx + rw [Algebra.mem_bot] + exact ⟨⟨x, hx⟩, rfl⟩ } + apply centralizer_mulLeft_le_of_isCentralSimple + · rintro _ ⟨x, rfl⟩ _ ⟨y, rfl⟩ + ext z + simp only [Module.End.mul_apply, LinearMap.mulRight_apply, LinearMap.mulLeft_apply, mul_assoc] + +end lemma2 + +/-- The conjugate of a subalgebra by a unit. -/ +@[simps] +def Subalgebra.conj (B : Subalgebra F A) (x : Aˣ) : Subalgebra F A where + carrier := {y | ∃ b ∈ B, y = x * b * x⁻¹} + mul_mem' := by + rintro _ _ ⟨b, hb, rfl⟩ ⟨c, hc, rfl⟩ + exact ⟨b * c, B.mul_mem hb hc, by simp [mul_assoc]⟩ + one_mem' := by + exact ⟨1, B.one_mem, by simp⟩ + add_mem' := by + rintro _ _ ⟨b, hb, rfl⟩ ⟨c, hc, rfl⟩ + exact ⟨b + c, B.add_mem hb hc, by simp [mul_add, add_mul]⟩ + zero_mem' := by + exact ⟨0, B.zero_mem, by simp⟩ + algebraMap_mem' := by + intro c + refine ⟨algebraMap _ _ c, B.algebraMap_mem c, ?_⟩ + rw [mul_assoc, Algebra.commutes c (x⁻¹).1, ← mul_assoc] + simp + +omit [FiniteDimensional F A] [Algebra.IsCentral F A] [IsSimpleRing A] in +lemma Subalgebra.mem_conj {B : Subalgebra F A} {x : Aˣ} {y : A} : + y ∈ B.conj x ↔ ∃ b ∈ B, y = x * b * x⁻¹ := by + simp only [conj] + rfl + +/-- The algebra homomorphism from a subalgebra to its conjugate. -/ +@[simps] +def Subalgebra.toConj (B : Subalgebra F A) (x : Aˣ) : B →ₐ[F] B.conj x where + toFun b := ⟨x * b * x⁻¹, by simp [Subalgebra.mem_conj]⟩ + map_one' := by + ext + simp + map_mul' := by + intros y z + ext + simp only [MulMemClass.coe_mul, MulMemClass.mk_mul_mk, mul_assoc] + rw [← mul_assoc x⁻¹.1, Units.inv_mul, one_mul] + map_zero' := by ext; simp + map_add' := by + intros y z + ext + simp only [AddMemClass.coe_add, mul_add, add_mul, AddMemClass.mk_add_mk] + commutes' := by + intros r + ext + change (x : A) * algebraMap F A r * (↑x⁻¹ : A) = algebraMap F A r + rw [← Algebra.commutes r (x : A), mul_assoc] + simp only [Units.mul_inv, mul_one] + +/-- The algebra homomorphism from a conjugate subalgebra back to the original subalgebra. -/ +@[simps] +def Subalgebra.fromConj (B : Subalgebra F A) (x : Aˣ) : B.conj x →ₐ[F] B where + toFun b := ⟨x⁻¹ * b * x, by + rcases b with ⟨_, ⟨b, hb, rfl⟩⟩ + simpa [mul_assoc]⟩ + map_one' := by + ext + simp + map_mul' := by + intros; ext; simp only [MulMemClass.coe_mul, ← mul_assoc, MulMemClass.mk_mul_mk, + Units.mul_inv_cancel_right] + map_zero' := by ext; simp + map_add' := by intros; ext; simp [mul_add, add_mul] + commutes' := by intros; ext; simp [← Algebra.commutes] + +/-- Conjugation by a unit gives an algebra equivalence onto the conjugate subalgebra. -/ +def Subalgebra.conjEquiv (B : Subalgebra F A) (x : Aˣ) : B ≃ₐ[F] B.conj x := + AlgEquiv.ofAlgHom (B.toConj x) (B.fromConj x) + (by ext; simp [mul_assoc]) (by ext; simp [mul_assoc]) + +omit [FiniteDimensional F A] [Algebra.IsCentral F A] [IsSimpleRing A] in +lemma Subalgebra.finrank_conj (B : Subalgebra F A) (x : Aˣ) : + Module.finrank F (B.conj x) = Module.finrank F B := by + rw [LinearEquiv.finrank_eq (Subalgebra.conjEquiv B x).toLinearEquiv] + +omit [FiniteDimensional F A] [Algebra.IsCentral F A] [IsSimpleRing A] in +lemma Subalgebra.conj_simple_iff {B : Subalgebra F A} {x : Aˣ} : + IsSimpleOrder (TwoSidedIdeal <| B.conj x) ↔ + IsSimpleOrder (TwoSidedIdeal B) := by + let e : TwoSidedIdeal (B.conj x) ≃o TwoSidedIdeal B := + { toFun J := J.comap (B.toConj x) + invFun J := .mk' + (Set.image (B.toConj x) J) + (⟨0, TwoSidedIdeal.zero_mem _, by simp⟩) + (by + rintro _ _ ⟨a, ha, rfl⟩ ⟨b, hb, rfl⟩ + rw [← map_add] + refine ⟨a + b, J.add_mem ha hb, rfl⟩) + (by + rintro _ ⟨a, ha, rfl⟩ + rw [← map_neg] + refine ⟨-a, J.neg_mem ha, rfl⟩) + (by + rintro ⟨_, ⟨a, ha, rfl⟩⟩ _ ⟨b, hb, rfl⟩ + refine ⟨⟨a, ha⟩ * b, J.mul_mem_left _ _ hb, ?_⟩ + ext + simp only [toConj, AlgHom.coe_mk, RingHom.coe_mk, MonoidHom.coe_mk, OneHom.coe_mk, + MulMemClass.coe_mul, mul_assoc] + rw [← mul_assoc x⁻¹.1, Units.inv_mul, one_mul]) + (by + rintro ⟨_, ⟨a, ha, rfl⟩⟩ ⟨_, ⟨b, hb, rfl⟩⟩ ⟨c, hc1, hc2⟩ + simp only [toConj, AlgHom.coe_mk, RingHom.coe_mk, MonoidHom.coe_mk, OneHom.coe_mk, + Subtype.mk.injEq, Units.mul_left_inj, Units.mul_right_inj] at hc2 + refine ⟨⟨a, ha⟩ * ⟨b, hb⟩, J.mul_mem_right _ _ <| by + simp_rw [← hc2]; exact hc1, ?_⟩ + ext + simp only [toConj, MulMemClass.mk_mul_mk, AlgHom.coe_mk, RingHom.coe_mk, MonoidHom.coe_mk, + OneHom.coe_mk, mul_assoc] + rw [← mul_assoc x⁻¹.1, Units.inv_mul, one_mul]) + left_inv := by + intro J + ext ⟨_, ⟨a, ha, rfl⟩⟩ + simp only [toConj, AlgHom.coe_mk, RingHom.coe_mk, MonoidHom.coe_mk, OneHom.coe_mk] + generalize_proofs + rw [TwoSidedIdeal.mem_mk'] + try assumption + simp only [Set.mem_image, SetLike.mem_coe, TwoSidedIdeal.mem_comap, AlgHom.coe_mk, + RingHom.coe_mk, MonoidHom.coe_mk, OneHom.coe_mk, Subtype.mk.injEq, Units.mul_left_inj, + Units.mul_right_inj, Subtype.exists, exists_and_right, exists_eq_right, ha, + exists_true_left] + right_inv := by + intro J + ext ⟨a, ha⟩ + simp only [TwoSidedIdeal.mem_comap] + generalize_proofs + rw [TwoSidedIdeal.mem_mk'] + try assumption + simp only [toConj, AlgHom.coe_mk, RingHom.coe_mk, MonoidHom.coe_mk, OneHom.coe_mk, + Set.mem_image, SetLike.mem_coe, Subtype.mk.injEq, Units.mul_left_inj, Units.mul_right_inj, + Subtype.exists, exists_and_right, exists_eq_right, ha, exists_true_left] + map_rel_iff' := by + intro J K + simp only [Equiv.coe_fn_mk] + constructor + · rintro H ⟨_, ⟨a, ha1, rfl⟩⟩ ha2 + have := @H ⟨a, ha1⟩ (by + simp only [toConj, TwoSidedIdeal.mem_comap, AlgHom.coe_mk, RingHom.coe_mk, + MonoidHom.coe_mk, OneHom.coe_mk, ha2]) + simp only [toConj, TwoSidedIdeal.mem_comap, AlgHom.coe_mk, RingHom.coe_mk, MonoidHom.coe_mk, + OneHom.coe_mk] at this + exact this + · intro H ⟨a, ha1⟩ ha2 + simp only [toConj, TwoSidedIdeal.mem_comap, AlgHom.coe_mk, RingHom.coe_mk, MonoidHom.coe_mk, + OneHom.coe_mk] at ha2 + simp only [toConj, TwoSidedIdeal.mem_comap, AlgHom.coe_mk, RingHom.coe_mk, MonoidHom.coe_mk, + OneHom.coe_mk] + exact H ha2 } + rw [OrderIso.isSimpleOrder_iff e] + +omit [FiniteDimensional F A] [Algebra.IsCentral F A] [IsSimpleRing A] in +lemma Subalgebra.conj_centralizer (B : Subalgebra F A) {x : Aˣ} : + Subalgebra.centralizer F (B.conj x : Set A) = + (Subalgebra.centralizer F B).conj x := by + ext a + simp only [coe_conj, mem_centralizer_iff, Set.mem_setOf_eq, forall_exists_index, and_imp, + mem_conj, SetLike.mem_coe] + constructor + · intro h + refine ⟨x⁻¹ * a * x, ?_, by simp [mul_assoc]⟩ + intro b hb + have := h (x * b * x⁻¹) b hb rfl + apply_fun (x⁻¹.1 * ·) at this + apply_fun (· * x.1) at this + simp only [← mul_assoc, Units.inv_mul, one_mul, Units.inv_mul_cancel_right] at this ⊢ + exact this + · rintro ⟨b, hb, rfl⟩ + rintro _ a ha rfl + simp only [mul_assoc, Units.inv_mul_cancel_left, Units.mul_right_inj] + simp only [← mul_assoc, Units.mul_left_inj] + apply hb + exact ha + +omit [FiniteDimensional F A] [Algebra.IsCentral F A] [IsSimpleRing A] in +lemma Subalgebra.conj_centralizer' (B : Subalgebra F A) {x : Aˣ} : + Subalgebra.centralizer F (B.conj x).carrier = + (Subalgebra.centralizer F B).conj x := + Subalgebra.conj_centralizer _ + +namespace centralizer_isSimple.aux + +open FiniteDimensional + +instance : + Algebra.IsCentral F (Matrix (Fin (Module.finrank F B)) (Fin (Module.finrank F B)) F) := by + haveI : NeZero (Module.finrank F B) := by + have : 0 < Module.finrank F B := Module.finrank_pos + constructor + omega + infer_instance + +instance : Algebra.IsCentral F (Module.End F B) := + algEquivMatrix (Module.finBasis F B) |>.symm.isCentral + +instance : IsSimpleRing (Module.End F B) := by + haveI : NeZero (Module.finrank F B) := by + have : 0 < Module.finrank F B := Module.finrank_pos + constructor + omega + constructor + rw [TwoSidedIdeal.orderIsoOfRingEquiv + (algEquivMatrix (Module.finBasis F B) |>.toRingEquiv) |>.isSimpleOrder_iff] + exact IsSimpleRing.simple + +/-- The left tensor inclusion as an algebra equivalence onto its range. -/ +noncomputable def auxLeft (B : Subalgebra F A) (C : Type u) [Ring C] [Algebra F C] : + B ⊗[F] C ≃ₐ[F] (Algebra.TensorProduct.map B.val (AlgHom.id F C)).range := + AlgEquiv.ofLinearEquiv + (LinearEquiv.ofInjective _ <| by + change Function.Injective <| LinearMap.rTensor _ _ + apply Module.Flat.rTensor_preserves_injective_linearMap + exact Subtype.val_injective) + (by + ext + erw [LinearEquiv.ofInjective_apply]) + (by + intro x y + ext + erw [LinearEquiv.ofInjective_apply] + change Algebra.TensorProduct.map _ _ _ = _ + rw [map_mul] + rfl) + +/-- The right tensor inclusion as an algebra equivalence onto its range. -/ +noncomputable def auxRight (B : Subalgebra F A) (C : Type u) [Ring C] [Algebra F C] : + C ⊗[F] B ≃ₐ[F] (Algebra.TensorProduct.map (AlgHom.id F C) B.val).range := + AlgEquiv.ofLinearEquiv + (LinearEquiv.ofInjective _ <| by + change Function.Injective <| LinearMap.lTensor _ _ + apply Module.Flat.lTensor_preserves_injective_linearMap + exact Subtype.val_injective) + (by + ext + erw [LinearEquiv.ofInjective_apply]) + (by + intro x y + ext + erw [LinearEquiv.ofInjective_apply] + change Algebra.TensorProduct.map _ _ _ = _ + rw [map_mul] + rfl) + +instance : IsSimpleRing (A ⊗[F] Module.End.rightMul F B) := by + constructor + let eqv : (A ⊗[F] Module.End.rightMul F B) ≃ₐ[F] (Bᵐᵒᵖ ⊗[F] A) := + AlgEquiv.trans (Algebra.TensorProduct.congr AlgEquiv.refl Module.End.rightMulEquiv) + (Algebra.TensorProduct.comm F A Bᵐᵒᵖ) + have := TwoSidedIdeal.orderIsoOfRingEquiv eqv.toRingEquiv + rw [OrderIso.isSimpleOrder_iff this] + haveI : IsSimpleRing Bᵐᵒᵖ := by + constructor + rw [← TwoSidedIdeal.opOrderIso.isSimpleOrder_iff] + exact IsSimpleRing.simple + apply (IsCentralSimple.TensorProduct.simple F _ _).simple + +lemma step1 {ι : Type*} (ℬ : Basis ι F <| Module.End F B) : + ∃ (x : (A ⊗[F] Module.End F B)ˣ), + Nonempty <| + ((Subalgebra.centralizer F (B : Set A)) ⊗[F] (Module.End F B)) ≃ₐ[F] + Subalgebra.conj + (Algebra.TensorProduct.map (AlgHom.id F A) + (Module.End.rightMul F B).val).range x:= by + haveI : Algebra.IsCentral F (A ⊗[F] Module.End F B) := inferInstance + let f : B →ₐ[F] A ⊗[F] Module.End F B := + { toFun b := b.1 ⊗ₜ LinearMap.id + map_one' := by rfl + map_mul' := by + intro b₁ b₂ + simp only [MulMemClass.coe_mul, Algebra.TensorProduct.tmul_mul_tmul, Module.End.mul_eq_comp, + LinearMap.comp_id] + map_zero' := by simp only [ZeroMemClass.coe_zero, zero_tmul] + map_add' := by + intro a b + simp only [AddMemClass.coe_add, add_tmul] + commutes' := by + intro a + simp only [Algebra.TensorProduct.algebraMap_apply] + rfl } + let g : B →ₐ[F] A ⊗[F] Module.End F B := + { toFun :=fun b => 1 ⊗ₜ LinearMap.mulLeft F b + map_one' := by + simp only [LinearMap.mulLeft_one] + rfl + map_mul' x y := by + simp only [LinearMap.mulLeft_mul, Algebra.TensorProduct.tmul_mul_tmul, mul_one, + Module.End.mul_eq_comp] + map_zero' := by + simp only [LinearMap.mulLeft_zero_eq_zero, tmul_zero] + map_add' b₁ b₂ := by + rw [← tmul_add] + congr + ext + simp only [LinearMap.mulLeft_apply, add_mul, AddMemClass.coe_add, MulMemClass.coe_mul, + LinearMap.add_apply] + commutes' := by + intro a + simp only [Algebra.algebraMap_eq_smul_one] + rw [Algebra.TensorProduct.one_def, smul_tmul', smul_tmul] + congr + ext + simp only [LinearMap.mulLeft_apply, Algebra.smul_mul_assoc, one_mul, SetLike.val_smul, + LinearMap.smul_apply, Module.End.one_apply] } + obtain ⟨x, hx⟩ := SkolemNoether' F (A ⊗[F] Module.End F B) B g f + use x + have eq1 : + ((Algebra.TensorProduct.includeLeft (R := F) (S := F) (A := A) (B := Module.End F B)).comp + B.val).range = + Subalgebra.conj + (Algebra.TensorProduct.includeRight (R := F) (A := A) (B := Module.End F B) |>.comp + (Module.End.leftMul F B).val).range x := by + ext z + constructor + · rintro ⟨⟨z, hz⟩, rfl⟩ + simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe, AlgHom.coe_comp, Subalgebra.coe_val, + Function.comp_apply, Algebra.TensorProduct.includeLeft_apply] + specialize hx ⟨z, hz⟩ + rw [Subalgebra.mem_conj] + refine ⟨g ⟨z, hz⟩, ?_⟩ + simp only [AlgHom.mem_range, AlgHom.coe_comp, Subalgebra.coe_val, Function.comp_apply, + Algebra.TensorProduct.includeRight_apply, Subtype.exists, exists_prop', nonempty_prop] + rw [← hx] + simp only [AlgHom.coe_mk, RingHom.coe_mk, f] + refine ⟨⟨LinearMap.mulLeft F ⟨z, hz⟩, Set.mem_range_self _, rfl⟩, rfl⟩ + · rw [Subalgebra.mem_conj] + simp only [AlgHom.mem_range, AlgHom.coe_comp, Subalgebra.coe_val, Function.comp_apply, + Algebra.TensorProduct.includeRight_apply, Subtype.exists, exists_prop', nonempty_prop, + exists_exists_and_eq_and, Algebra.TensorProduct.includeLeft_apply, forall_exists_index, + and_imp] + rintro _ ⟨⟨z, hz⟩, _, rfl⟩ rfl + refine ⟨z, hz, ?_⟩ + exact hx ⟨z, hz⟩ + have eq2 := congr(Subalgebra.centralizer F $(eq1).carrier) + erw [centralizer_inclusionLeft (𝒜' := ℬ)] at eq2 + have temp := Subalgebra.conj_centralizer' (F := F) (A := A ⊗[F] Module.End F B) + (B := (Algebra.TensorProduct.includeRight (R := F) (A := A) (B := Module.End F B) |>.comp + (Module.End.leftMul F B).val).range) (x := x) + rw [temp] at eq2; clear temp + rw [centralizer_inclusionRight (𝒜 := Module.finBasis F A)] at eq2 + rw [centralizer_mulLeft] at eq2 + rw [← eq2] + refine ⟨?_⟩ + apply auxLeft + +lemma finrank_mop (B : Type*) [Ring B] [Algebra F B] : Module.finrank F Bᵐᵒᵖ = + Module.finrank F B := by + refine LinearEquiv.finrank_eq + { toFun := MulOpposite.unop + map_add' := by intros; rfl + map_smul' := by intros; rfl + invFun := MulOpposite.op + left_inv := by intros x; simp + right_inv := by intros x; simp } + +end centralizer_isSimple.aux + +open centralizer_isSimple.aux in +lemma centralizer_isSimple {ι : Type*} (ℬ : Basis ι F <| Module.End F B) : + IsSimpleRing (Subalgebra.centralizer F (B : Set A)) := by + letI (X : Subalgebra F (A ⊗[F] Module.End F B)) : Ring X := + Subalgebra.toRing (R := F) (A := A ⊗[F] Module.End F B) X + obtain ⟨x, ⟨eqv⟩⟩ := step1 B ℬ + have : IsSimpleRing (Subalgebra.centralizer F (B : Set A) ⊗[F] Module.End F B) := by + have := TwoSidedIdeal.orderIsoOfRingEquiv eqv + constructor + rw [OrderIso.isSimpleOrder_iff this] + rw [Subalgebra.conj_simple_iff] + let eqv'' := auxRight (Module.End.rightMul F B) A + have := TwoSidedIdeal.orderIsoOfRingEquiv eqv''.toRingEquiv + rw [← OrderIso.isSimpleOrder_iff this] + infer_instance + exact IsSimpleRing.left_of_tensor (K := F) + (B := Subalgebra.centralizer F (B : Set A)) + (C := Module.End F B) + +open centralizer_isSimple.aux in +variable (F) in +lemma dim_centralizer : + Module.finrank F (Subalgebra.centralizer F (B : Set A)) * + Module.finrank F B = Module.finrank F A := by + letI (X : Subalgebra F (A ⊗[F] Module.End F B)) : Ring X := + Subalgebra.toRing (R := F) (A := A ⊗[F] Module.End F B) X + haveI : Module.Free F (Module.End.rightMul F B) := Module.Free.of_divisionRing F + ↥(Module.End.rightMul F ↥B) + obtain ⟨x, ⟨eqv⟩⟩ := step1 B (Module.finBasis _ _) + let leqv := eqv.toLinearEquiv + have : Module.finrank F (Subalgebra.centralizer F (B : Set A) ⊗[F] Module.End F B) = + Module.finrank F _ := LinearEquiv.finrank_eq leqv + simp only [Module.finrank_tensorProduct] at this + rw [Module.finrank_linearMap, Subalgebra.finrank_conj] at this + have eq' := auxRight (Module.End.rightMul F B) A |>.toLinearEquiv.finrank_eq + rw [← eq'] at this + have eq' := + Module.finrank_tensorProduct (R := F) (S := F) (M := A) (M' := Module.End.rightMul F B) + rw [eq'] at this + have eq' : Module.finrank F (Module.End.rightMul F B) = Module.finrank F Bᵐᵒᵖ := + Module.End.rightMulEquiv (F := F) (B := B) |>.toLinearEquiv.finrank_eq + rw [eq'] at this + rw [show Module.finrank F Bᵐᵒᵖ = Module.finrank F B by rw [finrank_mop], ← mul_assoc] at this + rw [Nat.mul_left_inj] at this + · exact this + rw [← pos_iff_ne_zero] + exact Module.finrank_pos + +lemma double_centralizer : + Subalgebra.centralizer F (Subalgebra.centralizer F (B : Set A) : Set A) = B := by + symm + apply Subalgebra.eq_of_le_of_finrank_eq + · intro x hx y hy + exact hy x hx |>.symm + · haveI := centralizer_isSimple B (Module.finBasis F _) + have eq1 := dim_centralizer F B + have eq2 := dim_centralizer F (A := A) (Subalgebra.centralizer F B) + have eq3 := eq1.trans eq2.symm + rw [mul_comm] at eq3 + have eq4 := Nat.mul_left_inj (by + suffices 0 < Module.finrank F (Subalgebra.centralizer F (B : Set A)) by omega + apply Module.finrank_pos) |>.1 eq3 + exact eq4 + +/- +074U +-/ +/-- The double-centralizer tensor-product decomposition. -/ +noncomputable def writeAsTensorProduct + [Algebra.IsCentral F B] [IsSimpleRing B] : + A ≃ₐ[F] B ⊗[F] Subalgebra.centralizer F (B : Set A) := + haveI s1 : IsSimpleRing (Subalgebra.centralizer F (B : Set A)) := + centralizer_isSimple B (Module.Free.chooseBasis _ _) + haveI s2 : IsSimpleRing (B ⊗[F] Subalgebra.centralizer F (B : Set A)) := + ⟨TwoSidedIdeal.orderIsoOfRingEquiv + (Algebra.TensorProduct.comm F B (Subalgebra.centralizer F (B : Set A))).toRingEquiv + |>.isSimpleOrder⟩ + AlgEquiv.symm <| AlgEquiv.ofBijective (Algebra.TensorProduct.lift B.val (Subalgebra.val _) + fun x y => show _ = _ by simpa using y.2 x x.2) <| + bijective_of_dim_eq_of_isCentralSimple F (B ⊗[F] Subalgebra.centralizer F (B : Set A)) A + _ <| by + rw [Module.finrank_tensorProduct] + rw [← dim_centralizer (B := B), mul_comm] From 8910b167ea8f2168780e5f3818f413ea599ada72 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 14:00:35 -0700 Subject: [PATCH 15/34] Port BrauerGroup maximal subfields --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew/Subfield.lean | 1 + .../BrauerGroupNew/Subfield/Subfield.lean | 190 ++++++++++++++++++ 3 files changed, 192 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/Subfield/Subfield.lean diff --git a/LeanPool.lean b/LeanPool.lean index 96effe065b..5024445418 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -113,6 +113,7 @@ import LeanPool.BrauerGroupNew.SplittingOfCSA import LeanPool.BrauerGroupNew.Subfield import LeanPool.BrauerGroupNew.Subfield.Defs import LeanPool.BrauerGroupNew.Subfield.FiniteDimensional +import LeanPool.BrauerGroupNew.Subfield.Subfield import LeanPool.BrauerGroupNew.TwoSidedIdeal import LeanPool.BrauerGroupNew.Wedderburn import LeanPool.BrauerGroupNew.ZeroSevenFourE diff --git a/LeanPool/BrauerGroupNew/Subfield.lean b/LeanPool/BrauerGroupNew/Subfield.lean index 60d5bcd57f..6605c3c8aa 100644 --- a/LeanPool/BrauerGroupNew/Subfield.lean +++ b/LeanPool/BrauerGroupNew/Subfield.lean @@ -6,6 +6,7 @@ Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies import LeanPool.BrauerGroupNew.Subfield.Defs import LeanPool.BrauerGroupNew.Subfield.FiniteDimensional +import LeanPool.BrauerGroupNew.Subfield.Subfield /-! # Brauer Group New Subfield diff --git a/LeanPool/BrauerGroupNew/Subfield/Subfield.lean b/LeanPool/BrauerGroupNew/Subfield/Subfield.lean new file mode 100644 index 0000000000..ccfc7dc78c --- /dev/null +++ b/LeanPool/BrauerGroupNew/Subfield/Subfield.lean @@ -0,0 +1,190 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.DoubleCentralizer +import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Subalgebra.Basic +import LeanPool.BrauerGroupNew.Subfield.Defs + +universe u + +section cors_of_DC + +variable (K D : Type u) [Field K] [DivisionRing D] [Algebra K D] [FiniteDimensional K D] + [Algebra.IsCentral K D] + +/-- A maximal subfield of a finite-dimensional central division algebra has square dimension. -/ +theorem dim_max_subfield (k : SubField K D) (hk : IsMax k) : + Module.finrank K D = Module.finrank K k * Module.finrank K k := by + letI : Field k.1 := inferInstanceAs <| Field k + have dimdim := dim_centralizer K (A := D) k.1 |>.symm + have := Subalgebra.le_centralizer_self.2 k.2 + have eq : k.1 = Subalgebra.centralizer K (A := D) k.1 := by + by_contra! hneq + have lt := LE.le.lt_iff_ne this |>.2 hneq + obtain ⟨a, ha1, ha2⟩ : ∃ a ∈ Subalgebra.centralizer K (A := D) k.1, a ∉ k.1 := + Set.ssubset_iff_of_subset this |>.1 <| Set.lt_iff_ssubset.1 lt + letI : CommRing (Algebra.adjoin K (insert a k.1) : Subalgebra K D) := + { mul_comm := by + rintro ⟨x, hx⟩ ⟨y, hy⟩ + simp only [MulMemClass.mk_mul_mk, Subtype.mk.injEq] + refine Algebra.adjoin_induction₂ ?_ ?_ ?_ + ?_ ?_ ?_ ?_ ?_ hx hy + · intro α β hα hβ + simp only [Set.mem_insert_iff, SetLike.mem_coe] at hα hβ + rcases hα with rfl | hα <;> rcases hβ with rfl | hβ + · rfl + · rw [Subalgebra.mem_centralizer_iff] at ha1 + refine ha1 _ hβ |>.symm + · rw [Subalgebra.mem_centralizer_iff] at ha1 + apply ha1 + exact hα + · apply k.mul_comm hα hβ + · intros + rw [Algebra.commutes] + · intros + rw [Algebra.commutes] + · intros + rw [Algebra.commutes] + · intro _ _ _ _ _ _ h1 h2 + simp only [add_mul, h1, h2, mul_add] + · intro _ _ _ _ _ _ h1 h2 + simp only [add_mul, h1, h2, mul_add] + · intro _ _ _ _ _ _ h1 h2 + rw [mul_assoc, h2, ← mul_assoc, h1, mul_assoc] + · intro _ _ _ _ _ _ h1 h2 + rw [← mul_assoc, h1, mul_assoc, h2, mul_assoc] } + have : IsField (Algebra.adjoin K (insert a k) : Subalgebra K D) := by + rw [← Algebra.IsIntegral.isField_iff_isField (R := K)] + · exact Semifield.toIsField K + · exact FaithfulSMul.algebraMap_injective K _ + let L : SubField K D := { + __ := Algebra.adjoin K (insert a k.1) + mul_comm x hx y hy := by + have := this.2 ⟨x, hx⟩ ⟨y, hy⟩ + change (⟨x * y, Subalgebra.mul_mem _ hx hy⟩ : + (Algebra.adjoin K (insert a k.1) : Subalgebra K D)) = ⟨_, _⟩ at this + simp only [Subtype.mk.injEq] at this ⊢ + exact this + exists_inverse x hx hx0 := by + have := this.3 (Subtype.coe_ne_coe.1 hx0 : (⟨x, hx⟩ : + (Algebra.adjoin K (insert a k.1) : Subalgebra K D)) ≠ 0) + use this.choose.1 + exact ⟨this.choose.2, by + have eq := this.choose_spec + change ⟨x * this.choose.1, _⟩ = (1 : Algebra.adjoin K (insert a k.1)) at eq + exact Subtype.ext_iff.1 eq⟩ + } + refine ha2 <| hk (b := L) ?_ ?_ + · change k.1 ≤ Algebra.adjoin K (insert a k.1) + nth_rw 1 [← Algebra.adjoin_eq k.1] + refine Algebra.adjoin_mono ?_ + exact Set.subset_insert _ _ + · change _ ∈ Algebra.adjoin K _ + have adjoin_le : Algebra.adjoin K {a} ≤ Algebra.adjoin K (insert a k.1) := + Algebra.adjoin_mono (s := {a}) (Set.singleton_subset_iff.mpr (Set.mem_insert a k.1)) + have := Algebra.adjoin_le_iff |>.1 adjoin_le + exact this rfl + rw [← eq] at dimdim + exact dimdim + +/-- The centralizer condition for a subfield is equivalent to having square dimension. -/ +lemma cor_two_1to2 (A : Type u) [Ring A] [Algebra K A] [FiniteDimensional K A] + [Algebra.IsCentral K A] [IsSimpleRing A] (L : SubField K A) : + Subalgebra.centralizer K L.1 = L.1 ↔ + Module.finrank K A = Module.finrank K L * Module.finrank K L where + mp h := by + letI : Field L.1 := inferInstanceAs <| Field L + have := dim_centralizer K (A := A) L.1 + rw [h] at this + exact this.symm + mpr h := by + letI : Field L.1 := inferInstanceAs <| Field L + have := dim_centralizer K (A := A) L.1 + rw [h] at this + erw [mul_eq_mul_right_iff] at this + obtain h1 | h2 := this + · exact Subalgebra.eq_of_le_of_finrank_eq (Subalgebra.le_centralizer_self.2 L.2) + h1.symm |>.symm + · have := Module.finrank_pos (R := K) (M := L.1) + simp_all only [lt_self_iff_false] + +/-- The square-dimension condition implies maximality among commutative subalgebras. -/ +lemma cor_two_2to3 (A : Type u) [Ring A] [Algebra K A] [FiniteDimensional K A] + [Algebra.IsCentral K A] [IsSimpleRing A] (L : SubField K A) : + Module.finrank K A = Module.finrank K L * Module.finrank K L → + (∀ (L' : Subalgebra K A) (_ : ∀ x ∈ L', ∀ y ∈ L', x * y = y * x), L.1 ≤ L' → + L.1 = L') := + fun hrank L' hL' hLL ↦ by + letI : Field L.1 := inferInstanceAs <| Field L + have := dim_centralizer K (A := A) L.1 |>.symm + simp only [this, SubField.coe_toSubalgebra] at hrank + erw [mul_eq_mul_right_iff] at hrank + obtain h1 | h2 := hrank + · have := Subalgebra.eq_of_le_of_finrank_eq (Subalgebra.le_centralizer_self.2 L.2) h1.symm + exact le_antisymm hLL fun x hx => this.symm ▸ Subalgebra.mem_centralizer_iff _ |>.2 + fun y hy => hL' _ hx _ (hLL hy) |>.symm + · have := Module.finrank_pos (R := K) (M := L.1) + simp_all only [mul_zero, lt_self_iff_false] + +/-- Maximality among commutative subalgebras implies that the centralizer is the subfield itself. -/ +lemma cor_two_3to1 (A : Type u) [Ring A] [Algebra K A] [FiniteDimensional K A] + [Algebra.IsCentral K A] [IsSimpleRing A] (L : SubField K A) : + (∀ (L' : Subalgebra K A) (_ : ∀ x ∈ L', ∀ y ∈ L', x * y = y * x), L.1 ≤ L' → + L.1 = L') → + Subalgebra.centralizer K L = L.1 := by + intro H + refine le_antisymm ?_ ?_ + · by_contra! hL' + have := Subalgebra.le_centralizer_self.2 L.2 + have Llt := lt_of_le_not_ge this hL' + have exist_ele : ∃ a ∈ Subalgebra.centralizer K L.1, a ∉ L.1 := + Set.ssubset_iff_of_subset this |>.1 <| Set.lt_iff_ssubset.1 Llt + obtain ⟨a, ⟨ha1, ha2⟩⟩ := exist_ele + specialize H (Algebra.adjoin K (insert a L.1)) (fun x hx y hy ↦ by + refine Algebra.adjoin_induction₂ (fun x y hx hy ↦ by + simp only [Set.mem_insert_iff, SetLike.mem_coe] at hx hy + rcases hx with rfl | hx <;> rcases hy with rfl | hy + · rfl + · rw [Subalgebra.mem_centralizer_iff] at ha1 + exact ha1 _ hy |>.symm + · rw [Subalgebra.mem_centralizer_iff] at ha1 + rename_i hxx + exact ha1 _ hxx + · exact L.2 hx hy) + (fun k1 k2 ↦ Algebra.commutes _ _) (fun k x _ ↦ Algebra.commutes _ _) + (fun k x _ ↦ Algebra.commutes _ _ |>.symm) + (fun x y z _ _ _ hxz hyz ↦ by rw [mul_add, add_mul, hxz, hyz]) + (fun x y z _ _ _ hxz hyz ↦ by rw [mul_add, add_mul, hxz, hyz]) + (fun x y z _ _ _ hxz hyz ↦ by rw [mul_assoc, hyz, ← mul_assoc, hxz, mul_assoc]) + (fun x y z _ _ _ hxy hxz ↦ by rw [← mul_assoc, hxy, mul_assoc, hxz, ← mul_assoc]) + hx hy) + (by + nth_rw 1 [← Algebra.adjoin_eq L.1] + exact Algebra.adjoin_mono (Set.subset_insert _ _)) + have : L.1 ≠ Algebra.adjoin K (insert a L.1) := ne_of_mem_of_not_mem' (a := a) + (by + exact (Algebra.adjoin_le_iff |>.1 (Algebra.adjoin_mono (R := K) (s := {a}) + (Set.singleton_subset_iff.mpr (Set.mem_insert a L.1)))) rfl) ha2 |>.symm + tauto + · exact Subalgebra.le_centralizer_self.2 L.2 + +/-- Maximal subfields of a division algebra are exactly maximal commutative subalgebras. -/ +lemma maxsubfield_of_div_iff (L : SubField K D) : (∀ (L' : Subalgebra K D) + (_ : ∀ x ∈ L', ∀ y ∈ L', x * y = y * x), L.1 ≤ L' → L.1 = L') ↔ + IsMax L := + ⟨fun h ↦ fun L' hL' ↦ le_of_eq <| SubField.toSubalgebra_inj.1 <| + h L'.1 (fun _ a _ a_1 ↦ L'.2 a a_1) hL' |>.symm, + fun h ↦ cor_two_2to3 K D L <| dim_max_subfield K D L h⟩ + +/-- Algebra equivalences preserve maximality of subfields. -/ +lemma IsMaxSubfield.ofAlgEquiv (L1 L2 : SubField K D) (e : L1 ≃ₐ[K] L2) + (hL1 : IsMax L1) : IsMax L2 := by + have hL11 := dim_max_subfield K D L1 hL1 + have dim_eq := e.toLinearEquiv.finrank_eq + rw [dim_eq] at hL11 + exact maxsubfield_of_div_iff K D L2 |>.1 <| cor_two_2to3 K D L2 hL11 + +end cors_of_DC From 23158bc91196acbf14346915c067ee5261568eba Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 14:07:30 -0700 Subject: [PATCH 16/34] Port relative Brauer group --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew.lean | 1 + LeanPool/BrauerGroupNew/RelativeBrauer.lean | 138 ++++++++++++++++++++ 3 files changed, 140 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/RelativeBrauer.lean diff --git a/LeanPool.lean b/LeanPool.lean index 5024445418..c6f357ce6c 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -108,6 +108,7 @@ import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Operations import LeanPool.BrauerGroupNew.MatrixCenterEquiv import LeanPool.BrauerGroupNew.MatrixEquivTensor import LeanPool.BrauerGroupNew.MoritaEquivalence +import LeanPool.BrauerGroupNew.RelativeBrauer import LeanPool.BrauerGroupNew.SkolemNoether import LeanPool.BrauerGroupNew.SplittingOfCSA import LeanPool.BrauerGroupNew.Subfield diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index d36a26c3b2..420a7c49a4 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -19,6 +19,7 @@ import LeanPool.BrauerGroupNew.SplittingOfCSA import LeanPool.BrauerGroupNew.TwoSidedIdeal import LeanPool.BrauerGroupNew.Wedderburn import LeanPool.BrauerGroupNew.ZeroSevenFourE +import LeanPool.BrauerGroupNew.RelativeBrauer import LeanPool.BrauerGroupNew.SkolemNoether import LeanPool.BrauerGroupNew.DoubleCentralizer import LeanPool.BrauerGroupNew.Mathlib diff --git a/LeanPool/BrauerGroupNew/RelativeBrauer.lean b/LeanPool/BrauerGroupNew/RelativeBrauer.lean new file mode 100644 index 0000000000..a0dac888bd --- /dev/null +++ b/LeanPool/BrauerGroupNew/RelativeBrauer.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2024 Yunzhou Xie. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Jujian Zhang +-/ + +import LeanPool.BrauerGroupNew.BrauerGroup +import LeanPool.BrauerGroupNew.SplittingOfCSA +import LeanPool.BrauerGroupNew.ZeroSevenFourE + +/-! +# Relative Brauer Group + +# Main results + +* `BrauerGroup.split_iff`: Let `A` be a CSA over F, then `⟦A⟧ ∈ Br(K/F)` if and only if K + splits A. +* `isSplit_iff_dimension`: Let `A` be a CSA over F, then `⟦A⟧ ∈ Br(K/F)` if and only if + there exists another `F`-CSA `B` such that `⟦A⟧ = ⟦B⟧`, `K ⊆ B`, and + `dim_F B = (dim_F K)^2`. +-/ + +suppress_compilation + +universe u + +open TensorProduct BrauerGroup + +section Defs + +variable (K F : Type u) [Field K] [Field F] [Algebra F K] + +/-- The relative Brauer group `Br(K/F)` is the kernel of the base-change map `Br F → Br K`. -/ +abbrev RelativeBrGroup := (BrauerGroupHom.BaseChange (K := F) (E := K)).ker + +/-- A central simple algebra is split by `K` iff its Brauer class base-changes to `1`. -/ +lemma BrauerGroup.split_iff (A : CSA F) : isSplit F A K ↔ + BrauerGroupHom.BaseChange (K := F) (Quotient.mk'' A) = (1 : BrauerGroup K) := + ⟨by + rintro ⟨n, hn, ⟨iso⟩⟩ + simp only [MonoidHom.coe_mk, OneHom.coe_mk, Quotient.map'_mk''] + change _ = Quotient.mk'' _ + simp only [Quotient.eq'', one_in'] + exact ⟨1, n, one_ne_zero, hn.1, ⟨dim_one_iso (K ⊗[F] A) |>.trans iso⟩⟩, + fun hA ↦ by + simp only [MonoidHom.coe_mk, OneHom.coe_mk, Quotient.map'_mk''] at hA + change _ = Quotient.mk'' _ at hA + simp only [Quotient.eq'', one_in'] at hA + change IsBrauerEquivalent _ _ at hA + obtain ⟨n, m, hn, hm, ⟨iso⟩⟩ := hA + let p : ℕ := Wedderburn_Artin_algebra_version K (K ⊗[F] A) |>.choose + let hp := Wedderburn_Artin_algebra_version K (K ⊗[F] A) |>.choose_spec.1 + let D := Wedderburn_Artin_algebra_version K (K ⊗[F] A) |>.choose_spec.2.choose + letI := Wedderburn_Artin_algebra_version K (K ⊗[F] A) |>.choose_spec.2.choose_spec.choose + letI := Wedderburn_Artin_algebra_version K (K ⊗[F] A) |>.choose_spec.2.choose_spec + |>.choose_spec.choose + let iso' := Wedderburn_Artin_algebra_version K (K ⊗[F] A) |>.choose_spec + |>.2.choose_spec.choose_spec.choose_spec.some + change K ⊗[F] A ≃ₐ[K] Matrix (Fin p) (Fin p) D at iso' + have e := Matrix.reindexAlgEquiv K _ (finProdFinEquiv.symm) |>.trans <| + Matrix.compAlgEquiv _ _ _ _ |>.symm.trans <| + iso.mapMatrix (m := (Fin p)) |>.symm.trans <| + (Matrix.compAlgEquiv (Fin p) (Fin n) D K |>.trans <| Matrix.reindexAlgEquiv K D + (Equiv.prodComm (Fin p) (Fin n)) |>.trans <| Matrix.compAlgEquiv (Fin n) (Fin p) D K + |>.symm.trans <| iso'.mapMatrix.symm).symm.mapMatrix |>.trans <| + Matrix.compAlgEquiv (Fin p) (Fin p) _ K |>.trans <| Matrix.reindexAlgEquiv K _ + (finProdFinEquiv) |>.trans <| Matrix.compAlgEquiv _ _ D K |>.trans <| + Matrix.reindexAlgEquiv K _ (finProdFinEquiv) + have D_findim := is_fin_dim_of_wdb K (K ⊗[F] A) hp D iso' + haveI : NeZero (p * p * n) := ⟨by simpa [hn]⟩ + haveI : NeZero (p * m) := ⟨by simpa [hm]⟩ + have := Wedderburn_Artin_uniqueness₀ K (Matrix (Fin (p * p * n)) (Fin (p * p * n)) D) + (p * p * n) (p * m) D AlgEquiv.refl K e.symm + exact ⟨p, ⟨hp⟩, ⟨iso'.trans <| Wedderburn_Artin_uniqueness₀ K + (Matrix (Fin (p * p * n)) (Fin (p * p * n)) D) + (p * p * n) (p * m) D .refl K e.symm |>.some.mapMatrix⟩⟩⟩ + +/-- Membership in the relative Brauer group is equivalent to being split by `K`. -/ +lemma mem_relativeBrGroup (A : CSA F) : + Quotient.mk'' A ∈ RelativeBrGroup K F ↔ + isSplit F A K := + BrauerGroup.split_iff K F A |>.symm + +/-- Brauer-equivalent central simple algebras have the same splitting fields. -/ +lemma split_sound (A B : CSA F) (h0 : IsBrauerEquivalent A B) (h : isSplit F A K) : + isSplit F B K := by + rw [split_iff] at h ⊢ + rw [show (Quotient.mk'' B : BrauerGroup F) = Quotient.mk'' A from Eq.symm <| + Quotient.sound h0, h] + +/-- Brauer-equivalent central simple algebras are split by `K` simultaneously. -/ +lemma split_sound' (A B : CSA F) (h0 : IsBrauerEquivalent A B) : + isSplit F A K ↔ isSplit F B K := + ⟨split_sound K F A B h0, split_sound K F B A <| h0.symm⟩ + +end Defs + +namespace IsBrauerEquivalent + +open BrauerGroup + +variable (K : Type u) [Field K] + +/-- Brauer-equivalent central simple algebras have matrix forms over a common division algebra. -/ +lemma exists_common_division_algebra (A B : CSA.{u, u} K) (h : IsBrauerEquivalent A B) : + ∃ (D : Type u) (_ : DivisionRing D) (_ : Algebra K D) + (m n : ℕ) (_ : NeZero m) (_ : NeZero n), + Nonempty (A ≃ₐ[K] Matrix (Fin m) (Fin m) D) ∧ + Nonempty (B ≃ₐ[K] Matrix (Fin n) (Fin n) D) := by + obtain ⟨n, hn, SA, _, _, ⟨isoA⟩⟩ := Wedderburn_Artin_algebra_version K A + haveI : Algebra.IsCentral K (Matrix (Fin n) (Fin n) SA) := isoA.isCentral + haveI : Algebra.IsCentral K SA := is_central_of_wdb _ _ _ _ hn isoA + have : FiniteDimensional K (Matrix (Fin n) (Fin n) SA) := + Module.Finite.of_injective isoA.symm.toLinearMap isoA.symm.injective + have : FiniteDimensional K SA := is_fin_dim_of_wdb _ _ hn _ isoA + have eq1 : IsBrauerEquivalent ⟨.of K SA⟩ A := + ⟨n, 1, hn, one_ne_zero, ⟨AlgEquiv.symm <| AlgEquiv.trans (dim_one_iso A) isoA⟩⟩ + obtain ⟨m, hm, SB, _, _, ⟨isoB⟩⟩ := Wedderburn_Artin_algebra_version K B + haveI : Algebra.IsCentral K (Matrix (Fin m) (Fin m) SB) := isoB.isCentral + haveI : Algebra.IsCentral K SB := is_central_of_wdb _ _ _ _ hm isoB + have : FiniteDimensional K (Matrix (Fin m) (Fin m) SB) := + .of_injective isoB.symm.toLinearMap isoB.symm.injective + have : FiniteDimensional K SB := is_fin_dim_of_wdb _ _ hm _ isoB + have eq2 : IsBrauerEquivalent ⟨.of K SA⟩ B := .trans eq1 h + obtain ⟨a, a', ha, ha', ⟨e⟩⟩ := eq2 + haveI : FiniteDimensional K (Matrix (Fin a') (Fin a') B) := + LinearEquiv.finiteDimensional (matrixEquivTensor (Fin a') K B).toLinearEquiv.symm + haveI : NeZero a' := ⟨ha'⟩ + haveI : NeZero a := ⟨ha⟩ + have : NeZero m := ⟨hm⟩ + obtain ⟨isoAB⟩ := Wedderburn_Artin_uniqueness₀ K (Matrix (Fin a') (Fin a') B) a (a' * m) + SA e.symm SB <| + (AlgEquiv.mapMatrix ‹_›).trans <| (Matrix.compAlgEquiv _ _ _ _).trans <| + IsBrauerEquivalent.matrix_eqv' _ _ _ + exact ⟨SA, inferInstance, inferInstance, n, m, ⟨hn⟩, ⟨hm⟩, ⟨isoA⟩, + ⟨isoB.trans isoAB.symm.mapMatrix⟩⟩ + +end IsBrauerEquivalent From 06f9aab6ee7b66bdf0f5c39e807996dea476d2ed Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 14:18:11 -0700 Subject: [PATCH 17/34] Port BrauerGroup subfield splitting --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew/Subfield.lean | 1 + .../BrauerGroupNew/Subfield/Splitting.lean | 358 ++++++++++++++++++ 3 files changed, 360 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/Subfield/Splitting.lean diff --git a/LeanPool.lean b/LeanPool.lean index c6f357ce6c..f40ae5ebfa 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -114,6 +114,7 @@ import LeanPool.BrauerGroupNew.SplittingOfCSA import LeanPool.BrauerGroupNew.Subfield import LeanPool.BrauerGroupNew.Subfield.Defs import LeanPool.BrauerGroupNew.Subfield.FiniteDimensional +import LeanPool.BrauerGroupNew.Subfield.Splitting import LeanPool.BrauerGroupNew.Subfield.Subfield import LeanPool.BrauerGroupNew.TwoSidedIdeal import LeanPool.BrauerGroupNew.Wedderburn diff --git a/LeanPool/BrauerGroupNew/Subfield.lean b/LeanPool/BrauerGroupNew/Subfield.lean index 6605c3c8aa..cb8b7b5efd 100644 --- a/LeanPool/BrauerGroupNew/Subfield.lean +++ b/LeanPool/BrauerGroupNew/Subfield.lean @@ -6,6 +6,7 @@ Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies import LeanPool.BrauerGroupNew.Subfield.Defs import LeanPool.BrauerGroupNew.Subfield.FiniteDimensional +import LeanPool.BrauerGroupNew.Subfield.Splitting import LeanPool.BrauerGroupNew.Subfield.Subfield /-! diff --git a/LeanPool/BrauerGroupNew/Subfield/Splitting.lean b/LeanPool/BrauerGroupNew/Subfield/Splitting.lean new file mode 100644 index 0000000000..fb3c6a7a7d --- /dev/null +++ b/LeanPool/BrauerGroupNew/Subfield/Splitting.lean @@ -0,0 +1,358 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.MatrixEquivTensor +import LeanPool.BrauerGroupNew.RelativeBrauer +import LeanPool.BrauerGroupNew.Subfield.FiniteDimensional +import LeanPool.BrauerGroupNew.Subfield.Subfield + +universe u + +variable (K F : Type u) [Field K] [Field F] [Algebra F K] + +open FiniteDimensional MulOpposite BrauerGroup TensorProduct + +section CSA + +/-- A splitting field embeds into a Brauer-equivalent central simple algebra of square dimension. -/ +lemma exists_embedding_of_isSplit [FiniteDimensional F K] (A : CSA F) (split : isSplit F A K) : + ∃ (B : CSA F), (Quotient.mk'' A : BrauerGroup F) * (Quotient.mk'' B) = 1 ∧ + ∃ (_ : K →ₐ[F] B), (Module.finrank F K) ^ 2 = Module.finrank F B := by + obtain ⟨n, hn, ⟨iso⟩⟩ := split + let iso' := iso.trans (algEquivMatrix' (R := K) (n := Fin n)).symm + let emb : A →ₐ[F] Module.End F (Fin n → K) := + AlgHom.comp (AlgHom.comp + { toFun f := f.restrictScalars F + map_one' := by + ext + rfl + map_mul' := by + intros + ext + rfl + map_zero' := by + ext + rfl + map_add' := by + intros + ext + rfl + commutes' := by + intros + ext + rfl } <| iso'.toAlgHom.restrictScalars F) <| + Algebra.TensorProduct.includeRight (R := F) (A := K) (B := A) + let B := Subalgebra.centralizer F (AlgHom.range emb : Set (Module.End F (Fin n → K))) + let e : A ≃ₐ[F] (AlgHom.range emb) := + AlgEquiv.ofInjective _ (IsSimpleRing.iff_injective_ringHom A |>.1 inferInstance emb.toRingHom) + haveI : Algebra.IsCentral F (AlgHom.range emb) := e.isCentral + haveI : IsSimpleRing (AlgHom.range emb) := by + constructor + rw [← TwoSidedIdeal.orderIsoOfRingEquiv e.toRingEquiv |>.isSimpleOrder_iff] + exact IsSimpleRing.simple + haveI : NeZero (Module.finrank F (Fin n → K)) := by + constructor + have : 0 < Module.finrank F (Fin n → K) := Module.finrank_pos + omega + haveI : Algebra.IsCentral F (Module.End F (Fin n → K)) := by + have f := algEquivMatrix (R := F) (M := Fin n → K) (Module.finBasis _ _) + refine f.symm.isCentral + haveI : IsSimpleRing (Module.End F (Fin n → K)) := by + have f := algEquivMatrix (R := F) (M := Fin n → K) (Module.finBasis _ _) + constructor + rw [TwoSidedIdeal.orderIsoOfRingEquiv f.toRingEquiv |>.isSimpleOrder_iff] + exact IsSimpleRing.simple + haveI : Algebra.IsCentral F B := + { out := fun x hx => by + rw [Algebra.mem_bot] + rw [Subalgebra.mem_center_iff] at hx + have hx' : ⟨x, by + rw [← double_centralizer (B := emb.range)] + intro y hy + specialize hx ⟨y, hy⟩ + simpa [Subtype.ext_iff] using hx⟩ ∈ Subalgebra.center F emb.range := by + rw [Subalgebra.mem_center_iff] + rintro ⟨_, ⟨y, rfl⟩⟩ + rw [Subtype.ext_iff] + exact x.2 (emb y) ⟨y, rfl⟩ + rw [Algebra.IsCentral.center_eq_bot, Algebra.mem_bot] at hx' + obtain ⟨r, hr⟩ := hx' + simp only [Subtype.ext_iff] at hr + use r + rw [Subtype.ext_iff, ← hr] + rfl } + haveI : IsSimpleRing B := centralizer_isSimple _ (Module.Free.chooseBasis _ _) + refine ⟨⟨.of F B⟩, ?_, + { toFun r := + ⟨{ + toFun a := r • a + map_add' := by simp + map_smul' := by + intro r v + ext i + simp only [Pi.smul_apply, smul_eq_mul, Algebra.mul_smul_comm, RingHom.id_apply] + }, by + rintro _ ⟨x, rfl⟩ + refine LinearMap.ext fun v ↦ ?_ + simp only [AlgEquiv.toAlgHom_eq_coe, AlgHom.toRingHom_eq_coe, RingHom.coe_coe, + AlgHom.coe_comp, AlgHom.coe_mk, RingHom.coe_mk, MonoidHom.coe_mk, OneHom.coe_mk, + AlgHom.coe_restrictScalars', AlgHom.coe_coe, Function.comp_apply, + Algebra.TensorProduct.includeRight_apply, Module.End.mul_apply, LinearMap.coe_mk, + AddHom.coe_mk, LinearMap.coe_restrictScalars, map_smul, emb]⟩ + map_one' := by + ext + simp only [one_smul, LinearMap.coe_comp, LinearMap.coe_mk, AddHom.coe_mk, + LinearMap.coe_single, Function.comp_apply, OneMemClass.coe_one, Module.End.one_apply] + map_mul' := by + intros + ext + simp only [LinearMap.coe_comp, LinearMap.coe_mk, AddHom.coe_mk, LinearMap.coe_single, + Function.comp_apply, Pi.smul_apply, smul_eq_mul, _root_.mul_assoc, MulMemClass.coe_mul, + Module.End.mul_apply] + map_zero' := by + ext + simp only [zero_smul, LinearMap.coe_comp, LinearMap.coe_mk, AddHom.coe_mk, + LinearMap.coe_single, Function.comp_apply, Pi.zero_apply, ZeroMemClass.coe_zero, + LinearMap.zero_comp, LinearMap.zero_apply] + map_add' := by + intros + ext + simp only [LinearMap.coe_comp, LinearMap.coe_mk, AddHom.coe_mk, LinearMap.coe_single, + Function.comp_apply, Pi.smul_apply, smul_eq_mul, add_mul, AddMemClass.coe_add, + LinearMap.add_apply, Pi.add_apply] + commutes' := by + intro r + ext i a x + simp only [algebraMap_smul, LinearMap.coe_comp, LinearMap.coe_mk, AddHom.coe_mk, + LinearMap.coe_single, Function.comp_apply, Pi.smul_apply] + rfl }, ?_⟩ + · change Quotient.mk'' _ = Quotient.mk'' (⟨AlgCat.of F F⟩ : CSA F) + have := writeAsTensorProduct (B := emb.range) + have iso : A ⊗[F] B ≃ₐ[F] Matrix (Fin (Module.finrank F (Fin n → K))) + (Fin (Module.finrank F (Fin n → K))) F := + AlgEquiv.symm <| + AlgEquiv.trans (algEquivMatrix (R := F) (M := Fin n → K) (Module.finBasis _ _)).symm + (writeAsTensorProduct (B := emb.range) |>.trans <| + Algebra.TensorProduct.congr e.symm AlgEquiv.refl) + apply Quotient.sound' + exact ⟨1, Module.finrank F (Fin n → K), one_ne_zero, by aesop, ⟨(dim_one_iso _).trans iso⟩⟩ + · change Module.finrank F K ^ 2 = Module.finrank F B + have dim_eq1 : Module.finrank F B * _ = _ := dim_centralizer F emb.range + rw [Module.finrank_linearMap, show Module.finrank F (Fin n → K) = + Module.finrank F K * Module.finrank K (Fin n → K) from + (Module.finrank_mul_finrank F K (Fin n → K)).symm, Module.finrank_fin_fun, + show Module.finrank F emb.range = Module.finrank F A from e.symm.toLinearEquiv.finrank_eq, + show Module.finrank F K * n * (Module.finrank F K * n) = (Module.finrank F K) ^ 2 * n ^ 2 + by simp only [pow_two]; group] at dim_eq1 + have dim_eq2 := iso.toLinearEquiv.finrank_eq + simp only [Module.finrank_tensorProduct, Module.finrank_self, _root_.one_mul, + Module.finrank_matrix, Fintype.card_fin] at dim_eq2 + rw [dim_eq2, ← pow_two] at dim_eq1 + let m := Module.finrank F B + let M := Module.finrank F K + haveI : Nontrivial B := ⟨0, 1, fun r ↦ by + simp only [zero_ne_one] at r⟩ + simp only [_root_.mul_one] at dim_eq1 + change m * n ^ 2 = M ^ 2 * _ at dim_eq1 + change M ^ 2 = m + clear_value m M + clear dim_eq2 + simp only [mul_eq_mul_right_iff, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, + pow_eq_zero_iff] at dim_eq1 + refine dim_eq1 |>.resolve_right hn.1 |>.symm + +example : True := ⟨⟩ + +/-- A splitting criterion in terms of a Brauer-equivalent algebra containing the splitting field. -/ +theorem isSplit_iff_dimension [FiniteDimensional F K] (A : CSA F) : + isSplit F A K ↔ + ∃ (B : CSA F), (Quotient.mk'' A : BrauerGroup F) = (Quotient.mk'' B) ∧ + ∃ (_ : K →ₐ[F] B), (Module.finrank F K) ^ 2 = Module.finrank F B := by + constructor + · intro split + obtain ⟨B, eq1, ι, eq2⟩ := exists_embedding_of_isSplit K F A split + refine ⟨⟨.of F B.1ᵐᵒᵖ⟩, ?_, { + toFun k := op <| ι k + map_one' := by simp + map_mul' := by + intros + simp [← op_mul, ← map_mul, mul_comm] + map_zero' := by simp + map_add' := by + intros + simp + commutes' := by + intros + simp + }, eq2.trans ?_⟩ + · rw [show (Quotient.mk'' A : BrauerGroup F) = (Quotient.mk'' B)⁻¹ by + rwa [eq_inv_iff_mul_eq_one]] + rfl + · refine LinearEquiv.finrank_eq (opLinearEquiv F) + · rintro ⟨B, eq, ⟨ι, dim_eq⟩⟩ + let n := Module.finrank F K + have n_pos : 0 < n := Module.finrank_pos + replace dim_eq : Module.finrank F B = n ^ 2 := dim_eq.symm + letI : Module K B := + { smul c a := a * ι c + one_smul := by + intros + change _ * _ = _ + simp + mul_smul := by + intros + change _ * _ = (_ * _) * _ + simp [_root_.mul_assoc, ← map_mul, mul_comm] + smul_zero := by + intros + change _ * _ = _ + simp + smul_add := by + intros + change _ * _ = _ * _ + _ * _ + simp [add_mul] + add_smul := by + intros + change _ * _ = _ * _ + _ * _ + simp [mul_add] + zero_smul := by + intros + change _ * _ = _ + simp } + have smul_def (r : K) (a : B) : r • a = a * (ι r) := rfl + haveI : SMulCommClass K F B := + { smul_comm := by + intro a b c + simp only [smul_def, Algebra.smul_mul_assoc] } + haveI : IsScalarTower F K B := + { smul_assoc := by + intro a b c + simp only [smul_def, map_smul, Algebra.mul_smul_comm] } + let μ : K →ₗ[F] B →ₗ[F] Module.End K B := + { toFun c := + { toFun a := + { toFun := fun a' => c • a • a' + map_add' := by + intro x y + simp only [smul_eq_mul, mul_add, smul_def, add_mul] + map_smul' := by + intro r x + simp only [smul_def, smul_eq_mul, _root_.mul_assoc, ← map_mul, mul_comm, + RingHom.id_apply] } + map_add' := by + intros x y + ext a' + simp only [smul_eq_mul, add_mul, smul_def, LinearMap.coe_mk, AddHom.coe_mk, + LinearMap.add_apply] + map_smul' := by + intros r x + ext a' + simp only [smul_eq_mul, Algebra.smul_mul_assoc, smul_def, LinearMap.coe_mk, + AddHom.coe_mk, RingHom.id_apply, LinearMap.smul_apply] } + map_add' := by + intros a a' + ext + simp [add_smul] + map_smul' := by + intros a x + ext r a' + simp [smul_eq_mul, smul_assoc, LinearMap.smul_apply] } + let μ' : K ⊗[F] B →ₗ[F] Module.End K B := TensorProduct.lift μ + let μ'' : K ⊗[F] B →ₗ[K] Module.End K B := + { __ := μ' + map_smul' := by + intro r a + induction a using TensorProduct.induction_on with + | zero => simp + | tmul c a => + ext a' + simp only [smul_eq_mul, smul_def, smul_tmul', AddHom.toFun_eq_coe, lift.tmul', + LinearMap.coe_mk, AddHom.coe_mk, RingHom.id_apply, LinearMap.smul_apply, μ', μ] + rw [mul_comm r c, map_mul] + simp only [_root_.mul_assoc] + | add x y hx hy => + simp only [AddHom.toFun_eq_coe, LinearMap.coe_toAddHom, RingHom.id_apply] at hx hy + simp only [smul_add, AddHom.toFun_eq_coe, LinearMap.coe_toAddHom, map_add, hx, hy, + RingHom.id_apply] } + let μAlg : K ⊗[F] B →ₐ[K] Module.End K B := AlgHom.ofLinearMap μ'' + (by + ext + simp only [smul_eq_mul, Algebra.TensorProduct.one_def, LinearMap.coe_mk, lift.tmul', + AddHom.coe_mk, one_smul, _root_.one_mul, Module.End.one_apply, μ'', μ', μ]) + (by + intro x y + ext a'' + induction x using TensorProduct.induction_on with + | zero => simp + | tmul c a => + induction y using TensorProduct.induction_on with + | zero => simp + | tmul c' a' => + simp only [smul_eq_mul, Algebra.TensorProduct.tmul_mul_tmul, mul_comm c c', + LinearMap.coe_mk, lift.tmul', AddHom.coe_mk, mul_smul, _root_.mul_assoc, + Module.End.mul_apply, map_smul, μ'', μ', μ] + | add m n hm hn => + simp only [mul_add, map_add, LinearMap.add_apply, hm, Module.End.mul_apply, hn] + | add m n hm hn => + simp only [add_mul, map_add, LinearMap.add_apply, hm, Module.End.mul_apply, hn]) + haveI : FiniteDimensional K B := FiniteDimensional.right F K B + let e : Module.End K B ≃ₐ[K] Matrix _ _ _ := algEquivMatrix (Module.finBasis _ _) + rw [split_sound' K F A B (Quotient.eq''.1 eq)] + refine ⟨Module.finrank K B, ⟨fun r => by have := Module.finrank_pos (R := K) (M := B); omega⟩, + ⟨AlgEquiv.trans (AlgEquiv.ofBijective μAlg ?_) e⟩⟩ + apply bijective_of_dim_eq_of_isCentralSimple + rw [show Module.finrank K (K ⊗[F] B) = n ^ 2 by simp [dim_eq]] + rw [show Module.finrank K (Module.End K B) = n ^ 2 by + rw [Module.finrank_linearMap] + have eq : Module.finrank F B = Module.finrank F K * Module.finrank K B := + (Module.finrank_mul_finrank F K B).symm + change Module.finrank F B = n * Module.finrank K B at eq + rw [dim_eq, pow_two] at eq + replace eq : n = Module.finrank K B := by + set m := Module.finrank K B + have m_pos : 0 < m := Module.finrank_pos + clear_value n m + simp only [mul_eq_mul_left_iff] at eq + refine eq.resolve_right (by omega) + simp only [← eq, pow_two]] + +end CSA + +section CSA2 + +/-- Splitting passes across Brauer equivalence. -/ +theorem isSplit_if_equiv (A B : CSA F) (hAB : IsBrauerEquivalent A B) (hA : isSplit F A K) : + isSplit F B K := by + obtain ⟨n, m, hn, hm, ⟨iso⟩⟩ := hAB + obtain ⟨p, hp, ⟨e⟩⟩ := hA + obtain ⟨q, hq, D, hD1, _, ⟨e'⟩⟩ := Wedderburn_Artin_algebra_version K (K ⊗[F] B) + haveI := is_fin_dim_of_wdb K (K ⊗[F] B) hq D e' + have ee := Matrix.reindexAlgEquiv _ _ finProdFinEquiv |>.symm.trans <| + Matrix.compAlgEquiv _ _ _ _ |>.symm.trans <| e'.mapMatrix.symm.trans <| + matrixTensorEquivTensor K F B (Fin m) |>.symm.trans <| + Algebra.TensorProduct.congr (A := K) (S := K) .refl iso |>.symm.trans <| + matrixTensorEquivTensor K F A (Fin n) |>.trans <| e.mapMatrix (m := (Fin n)) |>.trans <| + Matrix.compAlgEquiv (Fin n) (Fin p) K K |>.trans <| Matrix.reindexAlgEquiv K K + finProdFinEquiv + haveI : NeZero (m * q) := ⟨by aesop⟩ + haveI : NeZero (n * p) := ⟨by aesop⟩ + exact ⟨q, ⟨hq⟩, ⟨e'.trans <| + Wedderburn_Artin_uniqueness₀ K (Matrix (Fin (m * q)) (Fin (m * q)) D) (m * q) (n * p) + D AlgEquiv.refl K ee |>.some.mapMatrix⟩⟩ + +end CSA2 + +section DivisionRing + +variable (D : Type u) [DivisionRing D] [Algebra F D] [FiniteDimensional F D] + [Algebra.IsCentral F D] [IsSimpleRing D] + +/-- A maximal subfield of a central division algebra splits it. -/ +theorem isSplit_of_isMax (L : SubField F D) (hL : IsMax L) : isSplit F D L := by + rw [isSplit_iff_dimension L F ⟨.of F D⟩] + exact ⟨⟨.of F D⟩, rfl, L.val, by rw [pow_two]; exact dim_max_subfield F D L hL |>.symm⟩ + +end DivisionRing From daac4e1ee36d5b925c30cc8d3c44c7af38ee40f5 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 14:40:07 -0700 Subject: [PATCH 18/34] Port BrauerGroup cross product algebra --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew.lean | 1 + .../BrauerGroupNew/CrossProductAlgebra.lean | 497 ++++++++++++++++++ 3 files changed, 499 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/CrossProductAlgebra.lean diff --git a/LeanPool.lean b/LeanPool.lean index f40ae5ebfa..ce773d5c59 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -58,6 +58,7 @@ import LeanPool.BrauerGroupNew.AlgClosedUnion import LeanPool.BrauerGroupNew.BrauerGroup import LeanPool.BrauerGroupNew.CentralSimple import LeanPool.BrauerGroupNew.Centralizer +import LeanPool.BrauerGroupNew.CrossProductAlgebra import LeanPool.BrauerGroupNew.DoubleCentralizer import LeanPool.BrauerGroupNew.ExtendScalar import LeanPool.BrauerGroupNew.FieldCat diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index 420a7c49a4..fc9a66df5c 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -6,6 +6,7 @@ Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies import LeanPool.BrauerGroupNew.CentralSimple import LeanPool.BrauerGroupNew.Centralizer +import LeanPool.BrauerGroupNew.CrossProductAlgebra import LeanPool.BrauerGroupNew.ExtendScalar import LeanPool.BrauerGroupNew.FieldCat import LeanPool.BrauerGroupNew.AlgClosedUnion diff --git a/LeanPool/BrauerGroupNew/CrossProductAlgebra.lean b/LeanPool/BrauerGroupNew/CrossProductAlgebra.lean new file mode 100644 index 0000000000..b07db1a709 --- /dev/null +++ b/LeanPool/BrauerGroupNew/CrossProductAlgebra.lean @@ -0,0 +1,497 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie and contributors +-/ + +import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Equiv +import LeanPool.BrauerGroupNew.Mathlib.Data.DFinsupp.Submonoid +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.LinearIndependent.Defs +import LeanPool.BrauerGroupNew.Mathlib.LinearAlgebra.Span.Basic +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.Congruence.Basic +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Lattice +import LeanPool.BrauerGroupNew.Subfield.Splitting +import Mathlib.RepresentationTheory.Homological.GroupCohomology.LowDegree + +/-! +# Cross product algebra + +This file constructs the cross product algebra associated to a 2-cocycle of a field extension +`K / F` and shows that it is a central simple `F`-algebra of dimension `dim(K / F) ^ 2`. + +## References + +* [*Advanced Algebra*] +-/ + +open groupCohomology Function Module + +suppress_compilation + +variable {R S F K : Type*} [Field F] [Field K] [Algebra F K] {f : Gal(K, F) × Gal(K, F) → Kˣ} + +/-- The cross product algebra attached to a multiplicative two-cocycle on `Gal(K, F)`. -/ +@[ext] +structure CrossProductAlgebra (f : Gal(K, F) × Gal(K, F) → Kˣ) where + /-- The finitely supported coefficient function on the Galois group. -/ + val : Gal(K, F) →₀ K + +namespace CrossProductAlgebra + +variable {x y : CrossProductAlgebra f} + +lemma val_injective : Injective (val (f := f)) := fun _ _ ↦ CrossProductAlgebra.ext + +lemma val_surjective : Surjective (val (f := f)) := fun x ↦ ⟨⟨x⟩, rfl⟩ + +lemma val_bijective : Bijective (val (f := f)) := ⟨val_injective, val_surjective⟩ + +@[simp] lemma val_inj : x.val = y.val ↔ x = y := val_injective.eq_iff + +lemma «forall» {P : CrossProductAlgebra f → Prop} : (∀ x, P x) ↔ ∀ x, P (mk x) := by + rw [val_surjective.forall] + +instance : Nontrivial (CrossProductAlgebra f) := val_surjective.nontrivial + +instance : Zero (CrossProductAlgebra f) where + zero := ⟨0⟩ + +instance : Add (CrossProductAlgebra f) where + add x y := ⟨x.val + y.val⟩ + +instance : Neg (CrossProductAlgebra f) where + neg x := ⟨-x.val⟩ + +instance : Sub (CrossProductAlgebra f) where + sub x y := ⟨x.val - y.val⟩ + +instance [Semiring R] [Module R K] : SMul R (CrossProductAlgebra f) where + smul r x := ⟨r • x.val⟩ + +@[simp] lemma val_zero : (0 : CrossProductAlgebra f).val = 0 := rfl + +@[simp] lemma val_add (x y : CrossProductAlgebra f) : (x + y).val = x.val + y.val := rfl + +@[simp] lemma val_smul [Semiring R] [Module R K] (r : R) (x : CrossProductAlgebra f) : + (r • x).val = r • x.val := rfl + +@[simp] lemma val_neg (x : CrossProductAlgebra f) : (-x).val = -x.val := rfl + +@[simp] lemma val_sub (x y : CrossProductAlgebra f) : (x - y).val = x.val - y.val := rfl + +@[simp] lemma mk_zero : (mk 0 : CrossProductAlgebra f) = 0 := rfl + +@[simp] lemma mk_add_mk (x y : Gal(K, F) →₀ K) : + (mk x + mk y : CrossProductAlgebra f) = mk (x + y) := rfl + +@[simp] lemma smul_mk [Semiring R] [Module R K] (r : R) (x : Gal(K, F) →₀ K) : + (r • mk x : CrossProductAlgebra f) = mk (r • x) := rfl + +@[simp] lemma neg_mk (x : Gal(K, F) →₀ K) : (- mk x : CrossProductAlgebra f) = mk (-x) := rfl + +@[simp] lemma mk_sub_mk (x y : Gal(K, F) →₀ K) : + (mk x - mk y : CrossProductAlgebra f) = mk (x - y) := rfl + +instance addCommGroup : AddCommGroup (CrossProductAlgebra f) := + val_injective.addCommGroup val val_zero val_add val_neg val_sub (fun _ _ ↦ rfl) (fun _ _ ↦ rfl) + +/-- The additive equivalence with finitely supported functions on the Galois group. -/ +@[simps] +def valAddEquiv : CrossProductAlgebra f ≃+ (Gal(K, F) →₀ K) where + toFun := val + invFun := mk + left_inv _ := rfl + right_inv _ := rfl + map_add' := val_add + +@[simp] +lemma val_finsuppSum {α M : Type*} [AddCommMonoid M] (g : α →₀ M) + (h : α → M → CrossProductAlgebra f) : + (g.sum h).val = g.sum (fun a m ↦ (h a m).val) := map_finsuppSum valAddEquiv .. + +instance [Semiring R] [Module R K] : Module R (CrossProductAlgebra f) := + val_injective.module _ valAddEquiv.toAddMonoidHom val_smul + +instance [Semiring R] [Semiring S] [Module R K] [Module S K] [Module R S] [IsScalarTower R S K] : + IsScalarTower R S (CrossProductAlgebra f) where + smul_assoc r s x := by ext; simp [smul_assoc] + +/-- The linear equivalence with finitely supported functions on the Galois group. -/ +@[simps] +def valLinearEquiv [Semiring R] [Module R K] : + CrossProductAlgebra f ≃ₗ[R] (Gal(K, F) →₀ K) where + __ := valAddEquiv + map_smul' := val_smul + +/-- The standard basis of the cross product algebra over `K`. -/ +@[simps] +def basis : Basis Gal(K, F) K (CrossProductAlgebra f) where + repr := valLinearEquiv + +lemma basis_val (σ : Gal(K, F)) : (basis (f := f) σ).val = .single σ 1 := rfl + +lemma mk_single_one (σ : Gal(K, F)) : mk (.single σ 1) = basis (f := f) σ := rfl + +variable (f) in +/-- The bilinear multiplication map on the underlying finitely supported functions. -/ +def mulLinearMap : (Gal(K, F) →₀ K) →ₗ[F] (Gal(K, F) →₀ K) →ₗ[F] (Gal(K, F) →₀ K) := + Finsupp.lsum F fun σ => + { toFun c := Finsupp.lsum F fun τ => + { toFun d := .single (σ * τ) (c * σ d * f (σ, τ)) + map_add' := by simp [mul_add, add_mul] + map_smul' := by simp only [map_smul, Algebra.mul_smul_comm, Algebra.smul_mul_assoc, + RingHom.id_apply, Finsupp.smul_single, implies_true] } + map_add' _ _ := by ext; simp [add_mul] + map_smul' _ _ := by ext; simp only [Algebra.smul_mul_assoc, Finsupp.lsum_comp_lsingle, + LinearMap.coe_mk, AddHom.coe_mk, RingHom.id_apply, LinearMap.coe_comp, comp_apply, + Finsupp.lsingle_apply, LinearMap.smul_apply, Finsupp.coe_lsum, map_zero, mul_zero, zero_mul, + Finsupp.single_zero, Finsupp.sum_single_index, Finsupp.smul_single] } + +variable (f) in +@[simp] +lemma mulLinearMap_single_single (c d : K) (σ τ : Gal(K, F)) : + mulLinearMap f (.single σ c) (.single τ d) = .single (σ * τ) (c * σ d * f (σ, τ)) := by + simp [mulLinearMap] + +variable (f) in +@[simp] +lemma mulLinearMap_single_left_apply (c : K) (σ : Gal(K, F)) (x : Gal(K, F) →₀ K) + (τ : Gal(K, F)) : + mulLinearMap f (.single σ c) x τ = c * σ (x (σ⁻¹ * τ)) * f (σ, σ⁻¹ * τ) := by + classical simp +contextual [mulLinearMap, Finsupp.single_apply, ← eq_inv_mul_iff_mul_eq] + +variable (f) in +@[simp] +lemma mulLinearMap_single_right_apply (c : K) (σ : Gal(K, F)) (x : Gal(K, F) →₀ K) + (τ : Gal(K, F)) : + mulLinearMap f x (.single σ c) τ = x (τ * σ⁻¹) * τ (σ⁻¹ c) * f (τ * σ⁻¹, σ) := by + classical simp +contextual [mulLinearMap, Finsupp.single_apply, ← eq_mul_inv_iff_mul_eq] + +instance : One (CrossProductAlgebra f) where + one := ⟨.single 1 (f (1, 1))⁻¹⟩ + +instance : Mul (CrossProductAlgebra f) where + mul x y := ⟨mulLinearMap f x.val y.val⟩ + +lemma one_def : (1 : CrossProductAlgebra f) = ⟨.single 1 (f (1, 1))⁻¹⟩ := rfl + +@[simp] lemma val_one : (1 : CrossProductAlgebra f).val = .single 1 (f (1, 1))⁻¹ := rfl + +@[simp] +lemma val_mul (x y : CrossProductAlgebra f) : (x * y).val = mulLinearMap f x.val y.val := rfl + +@[simp] lemma mk_mul_mk (x y : Gal(K, F) →₀ K) : + (mk x * mk y : CrossProductAlgebra f) = mk (mulLinearMap f x y) := rfl + +variable [Fact <| IsMulCocycle₂ f] + +instance monoid : Monoid (CrossProductAlgebra f) where + one_mul := by + rintro ⟨x⟩ + ext : 1 + dsimp + induction x using Finsupp.induction_linear with + | zero => simp + | add => simp [*] + | single σ a => simp [map_one_fst_of_isMulCocycle₂ Fact.out σ, mul_right_comm _ a] + mul_one := by + rintro ⟨x⟩ + ext : 1 + dsimp + induction x using Finsupp.induction_linear with + | zero => simp + | add => simp [*] + | single σ a => simp [map_one_snd_of_isMulCocycle₂ Fact.out σ] + mul_assoc := by + rintro ⟨x⟩ ⟨y⟩ ⟨z⟩ + ext : 1 + dsimp + induction x using Finsupp.induction_linear with + | zero => simp + | add => simp [*] + | single σ a => + induction y using Finsupp.induction_linear with + | zero => simp + | add => simp [*] + | single τ b => + induction z using Finsupp.induction_linear with + | zero => simp + | add => simp [-mulLinearMap_single_single, *] + | single ν c => + simp only [mulLinearMap_single_single, mul_assoc, AlgEquiv.mul_apply, map_mul, + mul_left_comm _ (σ (τ c))] + congr 4 + simpa [mul_comm] using congr(($((Fact.out : IsMulCocycle₂ f) σ τ ν)).val) + +instance : Ring (CrossProductAlgebra f) where + __ := addCommGroup + __ := monoid + left_distrib := by intros; ext; simp + right_distrib := by intros; ext; simp + zero_mul := by intros; ext; simp + mul_zero := by intros; ext; simp + sub_eq_add_neg := by intros; ext; simp [sub_eq_add_neg] + neg_add_cancel := by intros; ext; simp + +instance algebra [CommSemiring R] [Algebra R F] [Module R K] [IsScalarTower R F K] : + Algebra R (CrossProductAlgebra f) := by + refine .ofModule ?_ ?_ <;> intros <;> ext <;> simp + +lemma algebraMap_val [CommSemiring R] [Algebra R F] [Algebra R K] [IsScalarTower R F K] (r : R) : + (algebraMap R (CrossProductAlgebra f) r).val = + .single 1 (algebraMap R K r * (f (1, 1))⁻¹) := by + rw [Algebra.algebraMap_eq_smul_one] + simp only [val_smul, val_one, Finsupp.smul_single, Units.val_inv_eq_inv_val, + ← Algebra.smul_def] + +omit [Fact <| IsMulCocycle₂ f] in +lemma basis_smul_comm (σ : Gal(K, F)) (k1 k2 : K) (x : CrossProductAlgebra f) : + (k1 • basis (f := f) σ) * (k2 • x) = σ k2 • k1 • basis σ * x := by + apply val_injective + simp only [basis, Basis.coe_ofRepr, valLinearEquiv_symm_apply, AddEquiv.toEquiv_eq_coe, + Equiv.invFun_as_coe, AddEquiv.coe_toEquiv_symm, val_mul, val_smul, valAddEquiv_symm_apply_val, + Finsupp.smul_single, smul_eq_mul, _root_.mul_one] + induction x.val using Finsupp.induction_linear with + | zero => simp + | add _ _ _ _ => simp_all [smul_add] + | single a b => + simp only [Finsupp.smul_single, smul_eq_mul, mulLinearMap_single_single, map_mul, ← mul_assoc, + mul_comm k1 (σ k2)] + +variable (f) in +/-- The inclusion from `K` into `CrossProductAlgebra f`. + +Note that this does *not* make `CrossProductAlgebra f` into a `K`-algebra, because that would +require `incl k * x = x * incl k`. -/ +@[simps -isSimp] +def incl : K →ₐ[F] CrossProductAlgebra f where + toFun k := k • 1 + map_zero' := by ext; simp + map_add' _ _ := by ext; simp [add_mul] + map_one' := by ext; simp + map_mul' _ _ := by + ext + simp only [val_smul, val_one, Finsupp.smul_single, smul_eq_mul, mul_assoc, val_mul, + mulLinearMap_single_single, mul_one, AlgEquiv.one_apply, mul_left_comm] + simp + commutes' _ := by ext; simp [Algebra.algebraMap_eq_smul_one] + +lemma smul_eq_incl_mul (k : K) (x : CrossProductAlgebra f) : k • x = incl f k * x := by + obtain ⟨x⟩ := x + ext : 1 + dsimp + induction x using Finsupp.induction_linear with + | zero => simp + | add => simp [*] + | single σ b => simp only [Finsupp.smul_single, smul_eq_mul, incl_apply, val_smul, val_one, + mulLinearMap_single_single, one_mul, AlgEquiv.one_apply, mul_right_comm _ _ b, + map_one_fst_of_isMulCocycle₂ Fact.out σ, ne_eq, Units.ne_zero, not_false_eq_true, + inv_mul_cancel_right₀] + +instance [CommSemiring R] [Algebra R K] : + IsScalarTower R (CrossProductAlgebra f) (CrossProductAlgebra f) where + smul_assoc r x y := by + simp only [← algebraMap_smul K r, smul_eq_mul, smul_eq_incl_mul, mul_assoc] + +variable (f) in +/-- The canonical unit associated to an element of the Galois group. -/ +@[simps] +def of (σ : Gal(K, F)) : (CrossProductAlgebra f)ˣ where + val.val := .single σ 1 + inv.val := .single σ⁻¹ <| (f (σ⁻¹, σ))⁻¹ * (f (1, 1))⁻¹ + val_inv := by + ext : 1 + simp only [Units.val_inv_eq_inv_val, mk_mul_mk, mulLinearMap_single_single, mul_inv_cancel, + map_mul, map_inv₀, one_mul, val_one] + congr + convert congr((σ (f (σ⁻¹, σ)))⁻¹ * (σ (f (1, 1)))⁻¹ * (f (1, 1))⁻¹ * + $((Fact.out : IsMulCocycle₂ f) σ σ⁻¹ σ)) using 1 + · simp [map_one_fst_of_isMulCocycle₂ Fact.out σ, mul_assoc] + · calc + (f (1, 1) : K)⁻¹ + _ = σ (f (1, 1)) * (σ (f (1, 1)))⁻¹ * σ (f (σ⁻¹, σ)) * + (σ (f (σ⁻¹, σ)))⁻¹ * (f (1, 1))⁻¹ := by + simp [← map_inv₀, ← map_mul] + _ = (σ (f (σ⁻¹, σ)))⁻¹ * (σ (f (1, 1)))⁻¹ * (f (1, 1))⁻¹ * + (σ (f (σ⁻¹, σ)) * σ (f (1, 1))) := by + group + _ = _ := by simp [map_one_snd_of_isMulCocycle₂ Fact.out σ] + inv_val := by + ext : 1 + simp only [Units.val_inv_eq_inv_val, mk_mul_mk, mulLinearMap_single_single, inv_mul_cancel, + map_one, mul_right_comm _ (f _ : K)⁻¹, mul_one, ne_eq, Units.ne_zero, not_false_eq_true, + inv_mul_cancel₀, one_mul, val_one] + +lemma basis_eq_of (σ : Gal(K, F)) : basis σ = (of f σ).val := rfl + +variable (f) in +@[simp] lemma of_one : of f 1 = incl f (f (1, 1)) := by ext; simp [incl_apply] + +variable (f) in +@[simp] lemma of_mul_of (σ τ : Gal(K, F)) : + of f σ * of f τ = incl f (f (σ, τ)) * of f (σ * τ) := by + ext + simp [incl_apply] + +@[simp] +lemma basis_mul_basis (σ τ : Gal(K, F)) : + basis (f := f) σ * basis τ = incl f (f (σ, τ)) * basis (σ * τ) := of_mul_of .. + +lemma of_mul_incl (σ : Gal(K, F)) (c : K) : of f σ * incl f c = incl f (σ c) * of f σ := by + ext : 1 + simp only [incl_apply, val_mul, val_of_val, val_smul, val_one, Finsupp.smul_single, smul_eq_mul, + mulLinearMap_single_single, mul_one, map_mul, map_inv₀, one_mul, + map_one_snd_of_isMulCocycle₂ Fact.out σ, AlgEquiv.smul_units_def, Units.coe_map, + MonoidHom.coe_coe, ne_eq, EmbeddingLike.map_eq_zero_iff, Units.ne_zero, not_false_eq_true, + inv_mul_cancel_right₀, smul_one_mul] + +lemma sum_of (x : CrossProductAlgebra f) : x.val.sum (fun σ c ↦ c • (of f σ).val) = x := by + ext + simp + +lemma of_conj (σ : Gal(K, F)) (k : K) : of f σ * incl f k * (of f σ)⁻¹ = incl f (σ k) := by + simp [of_mul_incl] + +variable [Module.Finite F K] [IsGalois F K] + +/-! ### Finite dimensionality -/ + +@[simp] lemma dim_eq_sq : Module.finrank F (CrossProductAlgebra f) = Module.finrank F K ^ 2 := by + rw [← Module.finrank_mul_finrank _ K, Module.finrank_eq_card_basis basis, + Fintype.card_eq_nat_card, IsGalois.card_aut_eq_finrank, sq] + +instance : Module.Finite F (CrossProductAlgebra f) := + Module.finite_of_finrank_pos <| by simp [pow_pos_iff two_ne_zero, Module.finrank_pos] + +/-! ### Centrality -/ + +instance : Algebra.IsCentral F (CrossProductAlgebra f) := by + classical + constructor + -- Assume `c` is central. + rintro c hc + rw [Subalgebra.mem_center_iff] at hc + -- By comparing the `σ * τ` coefficient of `c * d x_τ = d x_τ * c`, + -- we get `d τ(c_{τ⁻¹στ}) f(τ, τ⁻¹στ) = c_σ σ(d) f(σ, τ)`. + have key (d : K) (σ τ : Gal(K, F)) : + d * τ (c.val (τ⁻¹ * σ * τ)) * f (τ, τ⁻¹ * σ * τ) = c.val σ * σ d * f (σ, τ) := by + simpa [incl_apply, mul_assoc] using congr(($(hc <| incl f d * (of f τ).val)).val (σ * τ)) + -- By substituting `d = 1` in the previous equality, + -- we get `τ(c_{τ⁻¹στ}) f(τ, τ⁻¹στ) = c_σ f(σ, τ)`. + have key₁ (σ τ : Gal(K, F)) : + τ (c.val (τ⁻¹ * σ * τ)) * f (τ, τ⁻¹ * σ * τ) = c.val σ * f (σ, τ) := by + simpa using key 1 σ τ + -- By substituting `σ = 1` in the previous equality, we get `τ(c_1 f(1, 1)) = c_1 f(1, 1)`. + have key₁₁ (τ : Gal(K, F)) : τ (c.val 1 * f (1, 1)) = c.val 1 * f (1, 1) := by + simpa [map_one_fst_of_isMulCocycle₂ Fact.out τ, map_one_snd_of_isMulCocycle₂ Fact.out τ] + using key₁ 1 τ + -- Since `τ` is arbitrary, this says `c_1 f(1, 1) ∈ F`. + rw [← IsGalois.mem_bot_iff_fixed] at key₁₁ + -- If `c_σ ≠ 0`, we can substitute `key₁` in `key₁₁` and cancel `c_σ` on both sides to get + -- `σ(d) = d`, ie `σ = 1`. + have hc₁ {σ} (hσ : c.val σ ≠ 0) : σ = 1 := by + ext d + simpa [mul_assoc d, mul_assoc (σ d), mul_comm (c.val _), key₁, hσ] using + (key d σ default).symm + -- Therefore `c = c_1 x_1 = (c_1 f(1, 1)) * 1` is a `F`-multiple of the identity. + rw [← c.sum_of] + obtain ⟨a, ha⟩ := key₁₁ + refine finsuppSum_mem fun σ hσ ↦ ?_ + simpa [incl_apply, hc₁ hσ, of_one, ← mul_smul, ← ha, Algebra.ofId] + using Subalgebra.smul_mem _ (one_mem _) _ + +/-! ### Simplicity -/ + +variable {I : TwoSidedIdeal (CrossProductAlgebra f)} + +variable (I) in +/-- The standard basis for `CrossProductAlgebra f` descends to a basis for any of its non-trivial +quotients. -/ +private def quotientBasis (hI : I ≠ ⊤) : Basis Gal(K, F) K I.ringCon.Quotient := by + -- Let `ϕ` be the quotient map. + let ϕ := I.ringCon.mkL K + refine .mk (v := ϕ ∘ basis) ?_ ?_ + swap + · rw [Set.range_comp, ← Submodule.map_span, Basis.span_eq, ← LinearMap.range_eq_map, + LinearMap.range_eq_top_of_surjective] + exact Quotient.mk_surjective + classical + -- We show that `ϕ(x_τ)` is linearly independent over `τ ∈ J` for any finset `J`. + rw [linearIndependent_iff_linearIndepOn_finset] + rintro J + -- For this, we do induction on `J`. + induction J using Finset.cons_induction with + -- The case `J = ∅` is trivial. + | empty => simp + -- Let's deal with the `J ∪ {σ}` case. + | cons σ J hσ ih => + -- Assume that there is some `a : Gal(K, F) → K` such that `∑ τ ∈ J, a_τ • ϕ(x_τ) = ϕ(x_σ)`. + -- We want to prove `∀ τ ∈ J, a_τ = 0`. + rw [Finset.coe_cons, linearIndepOn_insert <| Finset.mem_coe.not.2 hσ, + Submodule.mem_span_image_finset_iff_exists_fun'] + simp only [ih, comp_apply, not_exists, true_and, basis_eq_of] + rintro a ha + have key (c : K) : ∀ τ ∈ J, a τ * τ c = σ c * a τ := by + refine linearIndepOn_finset_iffₛ.1 ih _ _ ?_ + have ϕ_map_mul (x y) : ϕ (x * y) = ϕ x * ϕ y := rfl + have aux τ : ϕ (of f τ) * ϕ (incl f c) = ϕ (incl f (τ c)) * ϕ (of f τ) := + congr(ϕ $(of_mul_incl (f := f) τ c)) + have aux' (d : K) (x : I.ringCon.Quotient) : d • x = ϕ (incl f d) * x := by + induction x using Quotient.ind + change ⟦_⟧ = ⟦_⟧ + simp [smul_eq_incl_mul] + calc + ∑ τ ∈ J, (a τ * τ c) • ϕ (of f τ) + _ = ∑ τ ∈ J, ϕ (incl f <| a τ) * (ϕ (incl f <| τ c) * ϕ (of f τ)) := by + simp [mul_assoc, aux', ϕ_map_mul] + _ = ∑ τ ∈ J, ϕ (incl f <| a τ) * (ϕ (of f τ) * ϕ (incl f c)) := by + simp [aux] + _ = ∑ τ ∈ J, ϕ (incl f <| σ c) * ϕ (incl f <| a τ) * ϕ (of f τ) := by + calc + ∑ τ ∈ J, ϕ (incl f <| a τ) * (ϕ (of f τ) * ϕ (incl f c)) + = (∑ τ ∈ J, a τ • ϕ (of f τ)) * ϕ (incl f c) := by + rw [Finset.sum_mul] + simp [mul_assoc, aux'] + _ = ϕ (of f σ) * ϕ (incl f c) := + congrArg (fun z ↦ z * ϕ (incl f c)) ha + _ = ϕ (incl f (σ c)) * ϕ (of f σ) := aux σ + _ = ϕ (incl f (σ c)) * ∑ τ ∈ J, a τ • ϕ (of f τ) := + (congrArg (fun z ↦ ϕ (incl f (σ c)) * z) ha).symm + _ = ∑ τ ∈ J, ϕ (incl f <| σ c) * ϕ (incl f <| a τ) * ϕ (of f τ) := by + rw [Finset.mul_sum] + simp [mul_assoc, aux'] + _ = ∑ τ ∈ J, (σ c * a τ) • ϕ (of f τ) := by + simp [mul_assoc, aux', ϕ_map_mul] + have : Nontrivial I.ringCon.Quotient := by simpa + have aux τ : ϕ (of f τ) ≠ 0 := ((of f τ).isUnit.map I.ringCon.mk').ne_zero + obtain ⟨τ, hτ, haτ⟩ := Finset.exists_ne_zero_of_sum_ne_zero <| ha.trans_ne <| aux _ + apply left_ne_zero_of_smul at haτ + exact ne_of_mem_of_not_mem hτ hσ <| by simpa [DFunLike.ext_iff, mul_comm, haτ] using + (key · τ hτ) + +variable (I) in +/-- `CrossProductAlgebra f` is isomorphic to any of its non-trivial quotients. -/ +private def equivQuotient (hI : I ≠ ⊤) : CrossProductAlgebra f ≃ₗ[K] I.ringCon.Quotient := + basis.repr ≪≫ₗ (quotientBasis I hI).repr.symm + +omit [Module.Finite F K] [IsGalois F K] in +variable (I) in +/-- `CrossProductAlgebra f` is isomorphic to any of its non-trivial quotients along the quotient +map. -/ +private lemma coe_equivQuotient (hI) : (equivQuotient I hI).toLinearMap = I.ringCon.mkL K := by + refine basis.ext fun σ ↦ ?_ + simp [equivQuotient, basis, CrossProductAlgebra.basis, RingCon.mkL, quotientBasis] + +instance : IsSimpleRing (CrossProductAlgebra f) := by + refine ⟨⟨fun I ↦ Classical.or_iff_not_imp_right.2 fun hI ↦ ?_⟩⟩ + rw [← I.ker_ringCon_mk', ← TwoSidedIdeal.injective_iff_ker_eq_bot] + convert (equivQuotient I hI).injective + exact congr(⇑$((coe_equivQuotient I hI).symm)) + +/-! ### The cross product algebra as a central simple algebra -/ + +variable (f) in +/-- The cross product algebra as a central simple algebra. -/ +def asCSA [IsGalois F K] : CSA F := ⟨.of F (CrossProductAlgebra f)⟩ + +end CrossProductAlgebra From 032d6f29057db4bf19e65d5492705faca0f149e3 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 14:57:40 -0700 Subject: [PATCH 19/34] Port BrauerGroup Morita change of rings --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew.lean | 1 + .../BrauerGroupNew/Morita/ChangeOfRings.lean | 378 ++++++++++++++++++ 3 files changed, 380 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/Morita/ChangeOfRings.lean diff --git a/LeanPool.lean b/LeanPool.lean index ce773d5c59..aedca5055d 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -108,6 +108,7 @@ import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Lattice import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Operations import LeanPool.BrauerGroupNew.MatrixCenterEquiv import LeanPool.BrauerGroupNew.MatrixEquivTensor +import LeanPool.BrauerGroupNew.Morita.ChangeOfRings import LeanPool.BrauerGroupNew.MoritaEquivalence import LeanPool.BrauerGroupNew.RelativeBrauer import LeanPool.BrauerGroupNew.SkolemNoether diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index fc9a66df5c..fae05697cb 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -15,6 +15,7 @@ import LeanPool.BrauerGroupNew.BrauerGroup import LeanPool.BrauerGroupNew.LemmasAboutSimpleRing import LeanPool.BrauerGroupNew.MatrixCenterEquiv import LeanPool.BrauerGroupNew.MatrixEquivTensor +import LeanPool.BrauerGroupNew.Morita.ChangeOfRings import LeanPool.BrauerGroupNew.MoritaEquivalence import LeanPool.BrauerGroupNew.SplittingOfCSA import LeanPool.BrauerGroupNew.TwoSidedIdeal diff --git a/LeanPool/BrauerGroupNew/Morita/ChangeOfRings.lean b/LeanPool/BrauerGroupNew/Morita/ChangeOfRings.lean new file mode 100644 index 0000000000..7c799127aa --- /dev/null +++ b/LeanPool/BrauerGroupNew/Morita/ChangeOfRings.lean @@ -0,0 +1,378 @@ +/- +Copyright (c) 2022 Jujian Zhang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jujian Zhang +-/ +import LeanPool.BrauerGroupNew.MoritaEquivalence +import Mathlib.Algebra.Category.ModuleCat.Abelian +import Mathlib.RingTheory.HopkinsLevitzki +import Mathlib.RingTheory.Morita.Basic +import Mathlib.RingTheory.SimpleModule.Rank + +open CategoryTheory Limits + +namespace ModuleCat + +universe v u₁ u₂ u₃ w + +instance {R₀ S} [CommRing R₀] [Ring S] [Algebra R₀ S] : + Linear R₀ (ModuleCat S) := Algebra.instLinear + +universe u₀ u u' u'' v' + +variable (R : Type u₀) [CommRing R] + +-- namespace IsMoritaEquivalent + +-- lemma refl {A : Type u₁} [Ring A] [Algebra R A] : IsMoritaEquivalent R A A where +-- cond := ⟨.refl R A⟩ + +-- lemma symm {A : Type u₁} [Ring A] [Algebra R A] {B : Type u₂} [Ring B] [Algebra R B] +-- (h : IsMoritaEquivalent R A B) : IsMoritaEquivalent R B A where +-- cond := h.cond.map <| .symm R + +-- lemma of_algEquiv {A : Type u₁} [Ring A] [Algebra R A] {B : Type u₂} [Ring B] [Algebra R B] +-- (f : A ≃ₐ[R] B) : IsMoritaEquivalent R A B where +-- cond := ⟨.ofAlgEquiv f⟩ + +-- end IsMoritaEquivalent +-- class IsMoritaEquivalent +-- (R : Type u) (S : Type u') [Ring R] [Ring S] : Prop where +-- out : Nonempty <| ModuleCat.{v} R ≌ ModuleCat.{v'} S + +-- namespace IsMoritaEquivalent + +-- variable (R : Type u) (S : Type u') (T : Type u'') [Ring R] [Ring S] [Ring T] + +-- noncomputable def equiv [IsMoritaEquivalent R S] : ModuleCat R ≌ ModuleCat S := +-- (inferInstance : IsMoritaEquivalent R S) |>.out.some + +-- instance [IsMoritaEquivalent R S] : (equiv R S).functor.Additive := inferInstance + +-- instance [IsMoritaEquivalent R S] : (equiv R S).inverse.Additive := +-- inferInstance + +-- @[refl] +-- lemma refl : IsMoritaEquivalent R R := +-- ⟨⟨CategoryTheory.Equivalence.refl (C := ModuleCat.{v} R)⟩⟩ + +-- instance : IsMoritaEquivalent.{u, u, v, v} R R := refl R + +-- @[symm] +-- lemma symm [IsMoritaEquivalent.{u, u', v, v'} R S] : IsMoritaEquivalent.{u', u, v', v} S R where +-- out := ⟨equiv R S |>.symm⟩ + +-- @[trans] +-- lemma trans [IsMoritaEquivalent.{u, u', v, v'} R S] [IsMoritaEquivalent.{u', u'', v', v''} S T] : +-- IsMoritaEquivalent.{u, u'', v, v''} R T where +-- out := ⟨(equiv R S).trans <| equiv S T⟩ + +suppress_compilation + +namespace MoritaEquivalence + +variable (A B : Type u) [Ring A] [Ring B] [Algebra R A] [Algebra R B] + +-- def equiv (h : MoritaEquivalence R A B) : ModuleCat A ≌ ModuleCat B := +-- h.eqv + +-- instance (h : IsMoritaEquivalent ℤ R S) : (equiv R S h).functor.Additive := +-- Functor.additive_of_preserves_binary_products _ + +-- instance (h : IsMoritaEquivalent ℤ R S) : (equiv R S h).inverse.Additive := +-- inferInstance + +instance (n : ℕ) [NeZero n] : Functor.Additive (moritaEquivalentToMatrix A (Fin n)).functor := + Functor.additive_of_preserves_binary_products _ + +-- instance (N : ModuleCat A) : Module R N := Module.compHom N (algebraMap R A) + +-- instance (N : ModuleCat A) : SMulCommClass A R N := sorry + +instance (n : ℕ) [NeZero n] : Functor.Linear R (moritaEquivalentToMatrix A (Fin n)).functor where + map_smul {M N} f r := by + ext m + apply funext + intro i + simp only [hom_smul, LinearMap.smul_apply, moritaEquivalentToMatrix, + toModuleCatOverMatrix_map] + change (algebraMap R A r) • (f.hom _) = + ∑ j : Fin n, (algebraMap R (Matrix (Fin n) (Fin n) A) r) _ _ • _ + simp [Matrix.algebraMap_matrix_apply] + rfl + +-- attribute [-instance] Linear.preadditiveIntLinear Linear.preadditiveNatLinear in +/-- The Morita equivalence between a ring and a positive-size matrix ring over it. -/ +def matrix (n : ℕ) : MoritaEquivalence R A (Matrix (Fin (n+1)) (Fin (n + 1)) A) := + letI : NeZero (n + 1) := ⟨by omega⟩ + { eqv := + moritaEquivalentToMatrix A _ + linear := inferInstance} + -- additive := inferIns + -- linear := _ + -- out := ⟨⟩ + +/-- The Morita equivalence between a ring and an `n × n` matrix ring, for nonzero `n`. -/ +def matrix' (n : ℕ) [hn : NeZero n] : MoritaEquivalence R A (Matrix (Fin n) (Fin n) A) where + eqv := moritaEquivalentToMatrix A _ +end MoritaEquivalence +-- abbrev ofIsoApp1 (e : R ≃+* S) (X : ModuleCat R) : X ⟶ +-- (ModuleCat.restrictScalars e.symm.toRingHom ⋙ ModuleCat.restrictScalars e.toRingHom).obj X := +-- ModuleCat.ofHom (Y := (ModuleCat.restrictScalars e.symm.toRingHom ⋙ +-- ModuleCat.restrictScalars e.toRingHom).obj X) +-- { toFun := LinearMap.id (R := R) +-- map_add' := fun _ _ ↦ rfl +-- map_smul' := fun r x ↦ by +-- change _ = X.isModule.smul _ x +-- simp; rfl } + +-- abbrev ofIsoApp2 (e : R ≃+* S) (X : ModuleCat R) : (ModuleCat.restrictScalars e.symm.toRingHom ⋙ +-- ModuleCat.restrictScalars e.toRingHom).obj X ⟶ X := +-- ModuleCat.ofHom (X := (ModuleCat.restrictScalars e.symm.toRingHom ⋙ +-- ModuleCat.restrictScalars e.toRingHom).obj X) +-- { toFun := LinearMap.id (R := R) +-- map_add' := fun _ _ ↦ rfl +-- map_smul' := fun r x ↦ by +-- change X.isModule.smul _ x = _ +-- simp; rfl } + +-- lemma ofIso (e : R ≃+* S) : IsMoritaEquivalent.{u, u', v, v} R S where +-- out := .intro +-- { functor := ModuleCat.restrictScalars e.symm.toRingHom +-- inverse := ModuleCat.restrictScalars e.toRingHom +-- unitIso := +-- { hom := +-- { app X := ofIsoApp1 R S e X +-- naturality := fun _ _ f => rfl } +-- inv := +-- { app X := ofIsoApp2 _ _ e X +-- naturality := fun _ _ f => rfl } +-- hom_inv_id := by ext; rfl +-- inv_hom_id := by ext; rfl } +-- counitIso := +-- { hom := +-- { app X := ofIsoApp2 _ _ e.symm X +-- naturality := fun _ _ f => rfl } +-- inv := +-- { app X := ofIsoApp1 _ _ e.symm X +-- naturality := fun _ _ f => rfl } +-- hom_inv_id := by ext; rfl +-- inv_hom_id := by ext; rfl } +-- functor_unitIso_comp := by intros; ext; rfl } + +namespace MoritaEquivalence + +variable (A B : Type u) [DivisionRing A] [DivisionRing B] [Algebra R A] [Algebra R B] + +instance : Algebra R (End (ModuleCat.of A A)) := inferInstance + +/-- Right multiplication identifies the opposite division ring with endomorphisms of its regular +module. -/ +@[simps] +def mopToEnd : Aᵐᵒᵖ →ₐ[R] End (ModuleCat.of A A) where + toFun a := ModuleCat.ofHom <| + { toFun := fun (x : A) ↦ x * a.unop + map_add' := by simp [add_mul] + map_smul' := by simp [mul_assoc] } + map_zero' := by simp; rfl + map_one' := by aesop + map_add' := fun x y => by simp [mul_add]; rfl + map_mul' := fun (x y) => by + simp only [MulOpposite.unop_mul, End.mul_def] + apply ModuleCat.hom_ext + simp only [ModuleCat.hom_comp]; ext; simp + commutes' := fun r ↦ by + apply hom_ext + simp only [MulOpposite.algebraMap_apply, MulOpposite.unop_op, ConcreteCategory.hom_ofHom] + ext + simp only [LinearMap.coe_mk, AddHom.coe_mk, one_mul] + change _ = (ModuleCat.ofHom _).hom 1 + rw [ModuleCat.hom_ofHom] + simp only [End.one_def, hom_id, LinearMap.smul_apply, LinearMap.id_coe, id_eq] + change _ = algebraMap R A r * 1 + rw [mul_one] + +-- variable [Algebra K R] + +-- instance : Algebra K (End (ModuleCat.of R R)) where +-- smul k f := ModuleCat.ofHom <| k • f.hom +-- algebraMap := { +-- toFun := fun k ↦ ModuleCat.ofHom (algebraMap K (R →ₗ[R] R) k) +-- map_one' := by simp; rfl +-- map_mul' := fun k1 k2 ↦ by simp; rfl +-- map_zero' := by simp; rfl +-- map_add' := fun k1 k2 ↦ by simp; rfl +-- } +-- commutes' := fun k f ↦ by apply ModuleCat.hom_ext; simp; ext; simp +-- smul_def' := fun k f ↦ by apply ModuleCat.hom_ext; simp; ext; simp; rfl + +-- @[simp] +-- def mopToEndAlgHom [Algebra K R] : Rᵐᵒᵖ →ₐ[K] End (ModuleCat.of R R) where +-- __ := mopToEnd R +-- commutes' := fun k ↦ by +-- apply ModuleCat.hom_ext +-- ext +-- simp +-- change _ = (ModuleCat.ofHom (algebraMap K (R →ₗ[R] R) k)).hom 1 +-- rw [ModuleCat.hom_ofHom] +-- simp [Module.algebraMap_end_apply, Algebra.algebraMap_eq_smul_one] + +lemma moptoend_bij : Function.Bijective (mopToEnd R A) := + ⟨RingHom.injective_iff_ker_eq_bot _ |>.mpr <| + SetLike.ext fun (α : Aᵐᵒᵖ) => ⟨fun (h : _ = _) => by + have h1 := congrArg (fun φ : End (ModuleCat.of A A) => φ.hom (1 : A)) h + rw [Submodule.mem_bot] + have hα : α.unop = (0 : A) := by + simpa only [mopToEnd_apply, hom_ofHom, LinearMap.coe_mk, AddHom.coe_mk, + ModuleCat.hom_zero, LinearMap.zero_apply, one_mul] using h1 + exact MulOpposite.unop_injective hα, + by rintro rfl; simp⟩, fun φ => ⟨MulOpposite.op (φ.hom.toFun (1 : A)), ModuleCat.hom_ext <| + LinearMap.ext fun r ↦ by + simp only [AddHom.toFun_eq_coe, LinearMap.coe_toAddHom, mopToEnd_apply, MulOpposite.unop_op, + hom_ofHom, LinearMap.coe_mk, AddHom.coe_mk] + rw [← smul_eq_mul, ← φ.hom.map_smul, smul_eq_mul, mul_one]⟩⟩ + +-- noncomputable def mopEquivEnd : Rᵐᵒᵖ ≃+* End (ModuleCat.of R R) := +-- RingEquiv.ofBijective (mopToEnd R) ⟨RingHom.injective_iff_ker_eq_bot _ |>.mpr $ +-- SetLike.ext fun (α : Rᵐᵒᵖ) => ⟨fun (h : _ = _) => by +-- rw [ModuleCat.hom_ext_iff] at h +-- simp only [mopToEnd, RingHom.coe_mk, MonoidHom.coe_mk, OneHom.coe_mk, ModuleCat.hom_zero, +-- LinearMap.ext_iff, LinearMap.coe_mk, AddHom.coe_mk, LinearMap.zero_apply, mul_eq_zero, +-- MulOpposite.unop_eq_zero_iff] at h +-- specialize h (1 : R) +-- simp_all only [one_ne_zero, false_or, Ideal.mem_bot], +-- by rintro rfl; simp⟩, fun $1 ↦ ⟨MulOpposite.op (φ.hom.toFun (1 : R)), ModuleCat.hom_ext <| +-- LinearMap.ext fun r ↦ by +-- simp only [AddHom.toFun_eq_coe, LinearMap.coe_toAddHom, MulOpposite.unop_op, +-- mopToEnd_apply_hom_apply, MulOpposite.unop_op] +-- rw [← smul_eq_mul, ← φ.hom.map_smul, smul_eq_mul, mul_one]⟩⟩ +/-- The opposite division ring is equivalent to endomorphisms of its regular module. -/ +noncomputable def mopAlgEquivEnd : Aᵐᵒᵖ ≃ₐ[R] End (ModuleCat.of A A) := + AlgEquiv.ofBijective (mopToEnd R A) <| moptoend_bij R A + +example : End (ModuleCat.of A A) ≃ₐ[R] Module.End A A := + mopAlgEquivEnd R A|>.symm.trans <| + {__ := RingEquiv.moduleEndSelf A, commutes' r := by ext; simp [Algebra.smul_def]} + +variable (e : MoritaEquivalence R A B) + +/-- Transport endomorphism algebras along the functor of a Morita equivalence. -/ +def aux1 : End (ModuleCat.of A A) ≃ₐ[R] End (e.eqv.functor.obj <| .of A A) where + toFun (f : _ ⟶ _) := e.eqv.functor.map f + invFun g := e.eqv.unit.app _ ≫ e.eqv.inverse.map g ≫ e.eqv.unitInv.app _ + left_inv := by + intro f + simp only [Functor.comp_obj, Equivalence.inv_fun_map, Functor.id_obj, Category.assoc] + rw [← Category.assoc] + change (e.eqv.unit ≫ e.eqv.unitInv).app _ ≫ _ = _ + simp + right_inv := by + intro g + simp only [Functor.comp_obj, Functor.map_comp, Equivalence.fun_inv_map, Functor.id_obj, + Category.assoc, Equivalence.counitInv_functor_comp, Category.comp_id] + exact e.eqv.functor_unit_comp_assoc (ModuleCat.of A A) g + map_mul' x y := by simp + map_add' x y := by + exact Functor.map_add e.eqv.functor (f := x) (g := y) + commutes' r := by + rw [Algebra.algebraMap_eq_smul_one (A := End (ModuleCat.of A A))] + calc + e.eqv.functor.map (r • (1 : End (ModuleCat.of A A))) + = r • e.eqv.functor.map (1 : End (ModuleCat.of A A)) := + e.linear.map_smul (1 : End (ModuleCat.of A A)) r + _ = r • (1 : End (e.eqv.functor.obj (ModuleCat.of A A))) := by + exact congrArg (fun z ↦ r • z) (e.eqv.functor.map_id (ModuleCat.of A A)) + _ = (algebraMap R (End (e.eqv.functor.obj (ModuleCat.of A A)))) r := + (Algebra.algebraMap_eq_smul_one + (A := End (e.eqv.functor.obj (ModuleCat.of A A))) r).symm + +-- instance (M : Type*) [AddCommGroup M] [Module B M] : Algebra R (Module.End B M) := +-- { +-- __ := Module.End.ring (R := B) (N₁ := M), +-- smul r f := { +-- toFun m := algebraMap R B r • f m +-- map_add' _ _ := by simp +-- map_smul' _ _ := by simp +-- }, +-- algebraMap := sorry +-- commutes' := sorry +-- smul_def' := fun r f => sorry +-- } + +-- def myaux1 : Module.End A A ≃ₐ[R] Module.End B (e.eqv.functor.obj (ModuleCat.of A A)) := sorry + +-- variable [Algebra K S] + +-- instance (M : ModuleCat S) : Module K M := Module.compHom M (algebraMap K S) + +-- -- instance : Algebra K (End (e.functor.obj (ModuleCat.of R R))) := +-- -- {__ := IsMoritaEquivalent.division_ring.instModuleCarrier +-- -- } + +-- -- variable {R S} in +-- def aux1' : End (ModuleCat.of A A) ≃ₐ[R] End (e.functor.obj <| ModuleCat.of A A) := sorry +/-- The target simple module associated to the source regular module under a Morita equivalence. -/ +noncomputable def aux20 : (e.eqv.functor.obj (ModuleCat.of A A)) ≅ ModuleCat.of B B := by + haveI : IsSimpleModule A A := by + rw [@isSimpleModule_iff_finrank_eq_one, Module.finrank_self] + have : IsSimpleModule A (ModuleCat.of A A) := inferInstanceAs <| IsSimpleModule A A + have : IsSimpleModule B (e.eqv.functor.obj (ModuleCat.of A A)) := + IsMoritaEquivalent.division_ring.IsSimpleModule.functor A B e.eqv (ModuleCat.of A A) + have := IsMoritaEquivalent.division_ring.division_ring_exists_unique_isSimpleModule B + (e.eqv.functor.obj <| .of A A) + exact this.some.toModuleIso +/-- Conjugation by a module isomorphism gives an equivalence of endomorphism algebras. -/ +def aux2 (M N : ModuleCat B) (f : M ≅ N) : End M ≃ₐ[R] End N where + toFun x := f.inv ≫ x ≫ f.hom + invFun x := f.hom ≫ x ≫ f.inv + left_inv x := by simp + right_inv x := by simp + map_mul' x y := by simp + map_add' x y := by + calc + f.inv ≫ (x + y) ≫ f.hom = (f.inv ≫ x + f.inv ≫ y) ≫ f.hom := by + exact congrArg (fun z ↦ z ≫ f.hom) (Preadditive.comp_add _ _ _ f.inv x y) + _ = f.inv ≫ x ≫ f.hom + f.inv ≫ y ≫ f.hom := + Preadditive.add_comp _ _ _ (f.inv ≫ x) (f.inv ≫ y) f.hom + commutes' r := by + apply hom_ext + ext n + simp only [hom_comp, LinearMap.coe_comp, Function.comp_apply] + change f.hom.hom ((ModuleCat.ofHom _).hom (f.inv.hom n)) = (ModuleCat.ofHom _).hom n + simp only [of_coe, End.one_def, hom_id, ConcreteCategory.hom_ofHom, LinearMap.smul_apply, + LinearMap.id_coe, id_eq] + erw [map_smul f.hom.hom] + simp + rfl +/-- A Morita equivalence between division rings induces an equivalence of opposite rings. -/ +noncomputable def toRingMopEquiv : Aᵐᵒᵖ ≃ₐ[R] Bᵐᵒᵖ := + mopAlgEquivEnd R A |>.trans <| + aux1 (R := R) (A := A) (B := B) e |>.trans <| + aux2 _ _ _ _ (aux20 R A B e ) |>.trans <| + mopAlgEquivEnd R B |>.symm +/-- A Morita equivalence between division rings induces an algebra equivalence. -/ +noncomputable def toRingEquiv : A ≃ₐ[R] B where + toFun r := toRingMopEquiv (R := R) (A := A) (B := B) e (.op r) |>.unop + invFun s := toRingMopEquiv (R := R) (A := A) (B := B) e |>.symm (.op s) |>.unop + left_inv r := by simp [MulOpposite.op_unop, MulOpposite.unop_op] + right_inv s := by simp [MulOpposite.op_unop, MulOpposite.unop_op] + map_mul' a b := by simp only [MulOpposite.op_mul, _root_.map_mul, MulOpposite.unop_mul] + map_add' a b := by simp only [MulOpposite.op_add, map_add, MulOpposite.unop_add] + commutes' r := by + rw [show (MulOpposite.op <| algebraMap R A r) = algebraMap R Aᵐᵒᵖ r by rfl] + rw [AlgEquiv.commutes] + rfl + +-- end division_ring + +-- noncomputable def ringEquivOfDivisionRing +-- (R S : Type u) [DivisionRing R] [DivisionRing S] [IsMoritaEquivalent R S] : +-- R ≃+* S := division_ring.toRingEquiv R S (equiv R S) +/-- Morita-equivalent division algebras over a commutative ring are algebra equivalent. -/ +noncomputable def algEquivOfDivisionRing (R : Type u) [CommRing R] + (D₁ D₂ : Type v) [DivisionRing D₁] [DivisionRing D₂] [Algebra R D₁] [Algebra R D₂] + (e : MoritaEquivalence R D₁ D₂) : D₁ ≃ₐ[R] D₂ := + ModuleCat.MoritaEquivalence.toRingEquiv (R := R) (A := D₁) (B := D₂) e + +end MoritaEquivalence +end ModuleCat From 8f3190a0ec82e561503ab78f6b9ef5982d9bd14e Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 15:40:09 -0700 Subject: [PATCH 20/34] Port BrauerGroup Azumaya basics --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew.lean | 1 + LeanPool/BrauerGroupNew/Azumaya/Basic.lean | 264 +++++++++++++++++++++ 3 files changed, 266 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/Azumaya/Basic.lean diff --git a/LeanPool.lean b/LeanPool.lean index aedca5055d..42340ea344 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -55,6 +55,7 @@ import LeanPool.ArtinWedderburn.SetProd import LeanPool.Basic import LeanPool.BrauerGroupNew import LeanPool.BrauerGroupNew.AlgClosedUnion +import LeanPool.BrauerGroupNew.Azumaya.Basic import LeanPool.BrauerGroupNew.BrauerGroup import LeanPool.BrauerGroupNew.CentralSimple import LeanPool.BrauerGroupNew.Centralizer diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index fae05697cb..92ee192821 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -8,6 +8,7 @@ import LeanPool.BrauerGroupNew.CentralSimple import LeanPool.BrauerGroupNew.Centralizer import LeanPool.BrauerGroupNew.CrossProductAlgebra import LeanPool.BrauerGroupNew.ExtendScalar +import LeanPool.BrauerGroupNew.Azumaya.Basic import LeanPool.BrauerGroupNew.FieldCat import LeanPool.BrauerGroupNew.AlgClosedUnion import LeanPool.BrauerGroupNew.FiniteField diff --git a/LeanPool/BrauerGroupNew/Azumaya/Basic.lean b/LeanPool/BrauerGroupNew/Azumaya/Basic.lean new file mode 100644 index 0000000000..ab10f05938 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Azumaya/Basic.lean @@ -0,0 +1,264 @@ +import LeanPool.BrauerGroupNew.BrauerGroup +import LeanPool.BrauerGroupNew.LemmasAboutSimpleRing +import LeanPool.BrauerGroupNew.Morita.ChangeOfRings + +universe u v + +open Module TensorProduct + +section Field +variable (K : Type u) [Field K] + +lemma TensorProduct.flip_mk_injective {R M N : Type*} [CommRing R] [IsDomain R] + [AddCommGroup M] [AddCommGroup N] + [Module R M] [Module R N] [NoZeroSMulDivisors R N] [Module.Flat R M] (a : N) (ha : a ≠ 0) : + Function.Injective ((TensorProduct.mk R M N).flip a) := by + intro x y e + apply (TensorProduct.rid R M).symm.injective + apply Module.Flat.lTensor_preserves_injective_linearMap (M := M) (LinearMap.toSpanSingleton R N a) + (smul_left_injective R ha) + simpa using e + +lemma IsCentral.left_of_tensor (B C : Type*) + [Ring B] [Ring C] [Nontrivial B] [Nontrivial C] [Algebra K C] [Algebra K B] + [FiniteDimensional K B] [hbc : Algebra.IsCentral K (B ⊗[K] C)] : + Algebra.IsCentral K B := by + letI : Nontrivial (B ⊗[K] C) := Module.FaithfullyFlat.lTensor_nontrivial _ _ _ + have h := (Subalgebra.equivOfEq (R := K) (A := B ⊗[K] C) _ _ <| + hbc.center_eq_bot K (B ⊗[K] C)) |>.trans <| Algebra.botEquiv K (B ⊗[K] C) + have : (Algebra.TensorProduct.includeLeft.comp (Subalgebra.center K B).val).range ≤ + Subalgebra.center K (B ⊗[K] C) := fun x hx ↦ by + simp only [AlgHom.mem_range, AlgHom.coe_comp, Subalgebra.coe_val, Function.comp_apply, + Algebra.TensorProduct.includeLeft_apply, Subtype.exists, exists_prop] at hx + obtain ⟨b, hb0, hb⟩ := hx + rw [Subalgebra.mem_center_iff] at hb0 ⊢ + intro bc + induction bc using TensorProduct.induction_on with + | zero => simp + | tmul b' c => + subst hb + simp only [Algebra.TensorProduct.tmul_mul_tmul, mul_one, one_mul] + congr 1 + exact hb0 b' + | add _ _ _ _ => simp_all [add_mul, mul_add] + have eq: (Algebra.TensorProduct.includeLeft.comp (Subalgebra.center K B).val).range = + (⊥ : Subalgebra K (B ⊗[K] C)) := by + refine le_antisymm ?_ <| OrderBot.bot_le _ + rw [← hbc.center_eq_bot]; exact this + let f : Subalgebra.center K B →ₐ[K] ((Algebra.TensorProduct.includeLeft (R := K) (B := C)).comp + (Subalgebra.center K B).val).range := { + toFun := fun ⟨b, hb⟩ ↦ ⟨b ⊗ₜ 1, ⟨⟨b, hb⟩, rfl⟩⟩ + map_one' := by simp; rfl + map_mul' := fun _ _ ↦ by ext : 1; simp + map_zero' := by ext; simp + map_add' := fun _ _ ↦ by ext; simp [add_tmul] + commutes' := fun _ ↦ rfl} + have f_surj : Function.Surjective f := fun ⟨bc, ⟨⟨b, hb⟩, h⟩⟩ ↦ ⟨⟨b, hb⟩, by + simp only [f, AlgHom.coe_mk, RingHom.coe_mk, MonoidHom.coe_mk, OneHom.coe_mk, + Subtype.mk.injEq] + change _ ⊗ₜ _ = _ at h + simp only [RingHom.coe_coe, Subalgebra.coe_val] at h⊢ + exact h⟩ + have e : ((Algebra.TensorProduct.includeLeft (R := K) (B := C)).comp + (Subalgebra.center K B).val).range ≃ₐ[K] (Subalgebra.center K B) := + (AlgEquiv.ofBijective f + ⟨fun ⟨b1, hb1⟩ ⟨b2, hb2⟩ h12 ↦ by + simp only [AlgHom.coe_mk, RingHom.coe_mk, MonoidHom.coe_mk, OneHom.coe_mk, + Subtype.mk.injEq, f] at h12 + ext + exact TensorProduct.flip_mk_injective _ one_ne_zero h12, + f_surj⟩).symm + have e2 := Subalgebra.equivOfEq _ _ eq |>.trans <| Algebra.botEquiv K _ + have ee: Subalgebra.center K B ≃ₐ[K] K := e.symm.trans e2 + exact ⟨le_of_eq <| Subalgebra.eq_of_le_of_finrank_eq (OrderBot.bot_le _) + (by rw [ee.toLinearEquiv.finrank_eq, Subalgebra.finrank_bot, Module.finrank_self])|>.symm⟩ + +variable (A : Type u) [Ring A] [Algebra K A] + +lemma Algebra.IsCentral_ofAlgEquiv (A B : Type*) [Ring A] [Ring B] [Algebra K A] [Algebra K B] + (e : A ≃ₐ[K] B) (hA : Algebra.IsCentral K A) : Algebra.IsCentral K B where + out x hx := by + obtain ⟨k, hk⟩ := hA.1 (show e.symm x ∈ _ by + simp only [Subalgebra.mem_center_iff] at hx ⊢ + exact fun x ↦ by simpa using congr(e.symm $(hx (e x)))) + exact ⟨k, by apply_fun e.symm; rw [← hk]; simp⟩ + +lemma IsSimpleRing.ofAlgEquiv (A B : Type*) [Ring A] [Ring B] [Algebra K A] [Algebra K B] + (e : A ≃ₐ[K] B) (hA : IsSimpleRing A) : IsSimpleRing B := + ⟨OrderIso.isSimpleOrder_iff (TwoSidedIdeal.orderIsoOfRingEquiv e.toRingEquiv)|>.1 hA.1⟩ + +theorem IsAzumaya_iff_CentralSimple [Nontrivial A] : IsAzumaya K A ↔ FiniteDimensional K A ∧ + Algebra.IsCentral K A ∧ IsSimpleRing A := + ⟨fun ⟨bij⟩ ↦ + letI e := AlgEquiv.ofBijective _ bij|>.trans <| algEquivMatrix <| Module.finBasis _ _ + letI : Nonempty (Fin (Module.finrank K A)) := ⟨⟨_, Module.finrank_pos⟩⟩ + ⟨IsAzumaya.toFinite, ⟨by + have : Algebra.IsCentral K (A ⊗[K] Aᵐᵒᵖ) := + Algebra.IsCentral_ofAlgEquiv K _ _ e.symm <| Algebra.IsCentral.matrix K K + (Fin (Module.finrank K A)) + exact IsCentral.left_of_tensor K A Aᵐᵒᵖ, by + haveI := IsSimpleRing.matrix (Fin (Module.finrank K A)) K + have sim : IsSimpleRing (A ⊗[K] Aᵐᵒᵖ) := IsSimpleRing.ofAlgEquiv K _ _ e.symm this + exact IsSimpleRing.left_of_tensor K A Aᵐᵒᵖ⟩⟩, + fun ⟨fin, cen, sim⟩ ↦ { + out := Module.Projective.out + eq_of_smul_eq_smul {k1} {k2} ha := by + specialize ha (1 : A) + rw [← Algebra.algebraMap_eq_smul_one, ← Algebra.algebraMap_eq_smul_one] at ha + exact FaithfulSMul.algebraMap_injective _ _ ha + fg_top := fin.1 + bij := bijective_of_dim_eq_of_isCentralSimple K _ _ + (AlgHom.mulLeftRight K A) <| tensor_self_op.dim_eq _ _ + }⟩ + +/-- The canonical equivalence `Fin (n * m) ≃ Fin (m * n)` induced by commutativity. -/ +def finswap {n m : ℕ} : Fin (n * m) ≃ Fin (m * n) where + toFun i := ⟨i.1, by rw [mul_comm m n]; exact i.2⟩ + invFun i := ⟨i.1, by rw [mul_comm n m]; exact i.2⟩ + left_inv _ := rfl + right_inv _ := rfl + +open ModuleCat in +lemma IsMorita_iff_IsBrauer' (R : Type u) [CommRing R] (A B : Type v) [Ring A] [Ring B] + [IsSimpleRing A] [IsSimpleRing B] [IsArtinianRing A] [IsArtinianRing B] [Algebra R A] + [Algebra R B] : + IsMoritaEquivalent R A B ↔ ∃(n m : ℕ), n ≠ 0 ∧ m ≠ 0 ∧ (Nonempty <| + Matrix (Fin n) (Fin n) A ≃ₐ[R] Matrix (Fin m) (Fin m) B) := ⟨fun hAB ↦ + by + obtain ⟨n, hn, D, _, _, ⟨e⟩⟩ := Wedderburn_Artin_algebra_version' R A + obtain ⟨m, hm, E, _, _, ⟨e'⟩⟩ := Wedderburn_Artin_algebra_version' R B + letI e1 := MoritaEquivalence.ofAlgEquiv e + letI e2 := MoritaEquivalence.ofAlgEquiv e' + have : NeZero m := ⟨hm⟩ + have : NeZero n := ⟨hn⟩ + haveI := MoritaEquivalence.matrix' R D n |>.symm + have ww := MoritaEquivalence.trans R e1 this |>.symm + haveI := MoritaEquivalence.matrix' R E m |>.symm + have ww' := MoritaEquivalence.trans R e2 this + haveI h := MoritaEquivalence.trans R ww hAB.cond.some + haveI h' := MoritaEquivalence.trans R h ww' + have := MoritaEquivalence.algEquivOfDivisionRing R D E h' + refine ⟨m, n, hm, hn, ⟨e.mapMatrix.trans <| Matrix.compAlgEquiv _ _ _ _ |>.trans <| + Matrix.reindexAlgEquiv _ _ finProdFinEquiv |>.trans <| this.mapMatrix.trans <| + Matrix.reindexAlgEquiv _ _ finswap|>.trans <| Matrix.reindexAlgEquiv _ _ + finProdFinEquiv.symm |>.trans <| Matrix.compAlgEquiv _ _ _ _|>.symm.trans + e'.symm.mapMatrix⟩⟩, + fun ⟨n, m, hn, hm, ⟨e⟩⟩ ↦ + letI : NeZero n := ⟨hn⟩ + letI : NeZero m := ⟨hm⟩ + ⟨⟨MoritaEquivalence.trans R (MoritaEquivalence.trans R + (MoritaEquivalence.matrix' R A n) (MoritaEquivalence.ofAlgEquiv e)) + (MoritaEquivalence.matrix' R B m).symm⟩⟩⟩ + +open ModuleCat in +theorem IsMorita_iff_IsBrauer (A B : CSA.{u, v} K) : + IsMoritaEquivalent K A B ↔ IsBrauerEquivalent (K := K) A B := + haveI : IsArtinianRing A := .of_finite K A + haveI : IsArtinianRing B := .of_finite K B + IsMorita_iff_IsBrauer' K A B + +end Field + +section Matrix + +open scoped TensorProduct + +variable (R : Type u) [CommRing R] + +instance (n : ℕ) [NeZero n] : FaithfulSMul R (Matrix (Fin n) (Fin n) R) where + eq_of_smul_eq_smul {r1 r2} h12 := by + specialize h12 (1 : Matrix _ _ _) + rw [← Matrix.ext_iff] at h12 + specialize h12 ⟨0, Nat.pos_of_neZero n⟩ ⟨0, Nat.pos_of_neZero _⟩ + simp only [Matrix.smul_apply, Matrix.one_apply_eq, smul_eq_mul, mul_one] at h12 + exact h12 + +open MulOpposite in +/-- The matrix algebra is equivalent to its opposite algebra over the base ring. -/ +abbrev matrixAlgEquivMatrixMop (n : ℕ) : + Matrix (Fin n) (Fin n) R ≃ₐ[R] (Matrix (Fin n) (Fin n) R)ᵐᵒᵖ := + (AlgEquiv.toOpposite R R).mapMatrix.trans <| AlgEquiv.ofRingEquiv + (f := matrixEquivMatrixMop n R) <| + fun r ↦ by + simp only [matrixEquivMatrixMop_apply, MulOpposite.algebraMap_apply, op_inj] + ext i j + simp [Matrix.algebraMap_matrix_apply] + split_ifs with h1 h2 h3 <;> tauto + +/-- The opposite algebra of `R` identifies with the endomorphism algebra of `R` as a module. -/ +noncomputable abbrev mopAlgEquivEnd : Rᵐᵒᵖ ≃ₐ[R] Module.End R R := + AlgEquiv.ofRingEquiv (f := mopEquivEnd R) fun r ↦ by + ext; simp [mopEquivEnd] + +/-- The tensor product `R ⊗[R] Rᵐᵒᵖ` identifies with `Module.End R R`. -/ +noncomputable abbrev tensorEquivEnd : R ⊗[R] Rᵐᵒᵖ ≃ₐ[R] Module.End R R := + Algebra.TensorProduct.lid R Rᵐᵒᵖ|>.trans <| mopAlgEquivEnd R + +lemma equal_mulLeftRight : tensorEquivEnd R = AlgHom.mulLeftRight R R := by + ext r + simp [mopEquivEnd, AlgHom.mulLeftRight_apply] + +lemma bij_Rtensor : Function.Bijective (AlgHom.mulLeftRight R R) := by + rw [← equal_mulLeftRight] + exact (tensorEquivEnd R).bijective + +instance : FaithfulSMul R R where + eq_of_smul_eq_smul {r1 r2} hr := by + specialize hr 1 + simp only [smul_eq_mul, mul_one] at hr + exact hr + +theorem IsAzumaya_R : IsAzumaya R R where + bij := bij_Rtensor R + +noncomputable section + +open MulOpposite Matrix + +/-- An explicit inverse to `AlgHom.mulLeftRight` for matrix algebras. -/ +abbrev Mat.inv (n : ℕ) : Module.End R (Matrix (Fin n) (Fin n) R) →ₗ[R] + Matrix (Fin n) (Fin n) R ⊗[R] (Matrix (Fin n) (Fin n) R)ᵐᵒᵖ where + toFun := fun f ↦ ∑ ⟨⟨i, j⟩, k, l⟩ : (Fin n × Fin n) × Fin n × Fin n, + f (single j k 1) i l • (single i j 1) ⊗ₜ[R] op (single k l 1) + map_add' := fun f1 f2 ↦ by + simp [add_smul, Finset.sum_add_distrib] + map_smul' := fun r f ↦ by + simp [SemigroupAction.mul_smul, Finset.smul_sum] + +lemma single.eq (n : ℕ) (i j : Fin n) : + single i j (1 : R) = of (fun i' j' ↦ if i = i' ∧ j = j' then 1 else 0) := rfl + +lemma Mat.inv_toFun1' (n : ℕ) : + (Mat.inv R n).comp (AlgHom.mulLeftRight R (Matrix (Fin n) (Fin n) R)).toLinearMap = .id := + Basis.ext ((Matrix.stdBasis _ _ _).tensorProduct ((Matrix.stdBasis _ _ _).map (opLinearEquiv ..))) + fun ⟨⟨i0, j0⟩, k0, l0⟩ ↦ by + simp [stdBasis_eq_single, AlgHom.mulLeftRight_apply, + single, ite_and, mul_apply, Fintype.sum_prod_type] + +lemma Mat.inv_toFun2' (n : ℕ) : + (AlgHom.mulLeftRight R (Matrix (Fin n) (Fin n) R)).toLinearMap.comp (Mat.inv R n) = .id := by + ext f : 1 + apply Basis.ext (Matrix.stdBasis _ _ _) + intro ⟨i, j⟩ + simp only [LinearMap.coe_comp, AlgHom.coe_toLinearMap, LinearMap.coe_mk, AddHom.coe_mk, + Function.comp_apply, map_sum, map_smul, LinearMap.coe_sum, LinearMap.coe_smul, + Finset.sum_apply, Pi.smul_apply, AlgHom.mulLeftRight_apply, unop_op, single_mul_mul_single, + one_mul, mul_one, smul_single, smul_eq_mul, LinearMap.id_coe, id_eq, stdBasis_eq_single] + ext k l + simp [sum_apply, single, Fintype.sum_prod_type, ite_and] + +lemma Mat.bij (n : ℕ) : Function.Bijective (AlgHom.mulLeftRight R (Matrix (Fin n) (Fin n) R)) := + ⟨Function.HasLeftInverse.injective ⟨Mat.inv R n, DFunLike.congr_fun (Mat.inv_toFun1' R n)⟩, + Function.HasRightInverse.surjective ⟨Mat.inv R n, DFunLike.congr_fun (Mat.inv_toFun2' R n)⟩⟩ + +end + +instance (n : ℕ) [NeZero n] : FaithfulSMul R (Matrix (Fin n) (Fin n) R) where + eq_of_smul_eq_smul {r1 r2} h := by + specialize h 1 + rw [← Matrix.ext_iff] at h + specialize h ⟨0, Nat.pos_of_neZero n⟩ ⟨0, Nat.pos_of_neZero n⟩ + simp only [Matrix.smul_apply, Matrix.one_apply_eq, smul_eq_mul, mul_one] at h + exact h + +end Matrix From 9aa75f40c30db6b68c05c78b70bf28eecd059e40 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 15:56:25 -0700 Subject: [PATCH 21/34] Port BrauerGroup Azumaya multiplication --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew.lean | 1 + LeanPool/BrauerGroupNew/Azumaya/Basic.lean | 6 + LeanPool/BrauerGroupNew/Azumaya/Mul.lean | 598 +++++++++++++++++++++ 4 files changed, 606 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/Azumaya/Mul.lean diff --git a/LeanPool.lean b/LeanPool.lean index 42340ea344..d2ac63c9af 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -56,6 +56,7 @@ import LeanPool.Basic import LeanPool.BrauerGroupNew import LeanPool.BrauerGroupNew.AlgClosedUnion import LeanPool.BrauerGroupNew.Azumaya.Basic +import LeanPool.BrauerGroupNew.Azumaya.Mul import LeanPool.BrauerGroupNew.BrauerGroup import LeanPool.BrauerGroupNew.CentralSimple import LeanPool.BrauerGroupNew.Centralizer diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index 92ee192821..7ba95193fa 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -9,6 +9,7 @@ import LeanPool.BrauerGroupNew.Centralizer import LeanPool.BrauerGroupNew.CrossProductAlgebra import LeanPool.BrauerGroupNew.ExtendScalar import LeanPool.BrauerGroupNew.Azumaya.Basic +import LeanPool.BrauerGroupNew.Azumaya.Mul import LeanPool.BrauerGroupNew.FieldCat import LeanPool.BrauerGroupNew.AlgClosedUnion import LeanPool.BrauerGroupNew.FiniteField diff --git a/LeanPool/BrauerGroupNew/Azumaya/Basic.lean b/LeanPool/BrauerGroupNew/Azumaya/Basic.lean index ab10f05938..58f62b040c 100644 --- a/LeanPool/BrauerGroupNew/Azumaya/Basic.lean +++ b/LeanPool/BrauerGroupNew/Azumaya/Basic.lean @@ -1,3 +1,9 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + import LeanPool.BrauerGroupNew.BrauerGroup import LeanPool.BrauerGroupNew.LemmasAboutSimpleRing import LeanPool.BrauerGroupNew.Morita.ChangeOfRings diff --git a/LeanPool/BrauerGroupNew/Azumaya/Mul.lean b/LeanPool/BrauerGroupNew/Azumaya/Mul.lean new file mode 100644 index 0000000000..c066583f64 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Azumaya/Mul.lean @@ -0,0 +1,598 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Azumaya.Basic +import Mathlib.Algebra.Azumaya.Matrix +import Mathlib.Algebra.Module.CharacterModule +import Mathlib.LinearAlgebra.Contraction +import Mathlib.LinearAlgebra.TensorProduct.Opposite + +suppress_compilation + +open Function +open scoped TensorProduct + +universe u v + +variable (R : Type u) [CommRing R] + +section formathlib + +variable (R : Type u) [CommRing R] (M N P Q : Type*) [AddCommGroup M] [AddCommGroup N] + [Module R M] [Module R N] [Module.Finite R M] [Module.Finite R N] [Module.Projective R M] + [Module.Projective R N] [AddCommGroup P] [AddCommGroup Q] [Module R P] [Module R Q] + +/-- The rank of a finite free module used to split a finite projective module. -/ +abbrev nn : ℕ := (Module.Finite.exists_comp_eq_id_of_projective R M).choose + +/-- The surjective map from a finite free module onto a finite projective module. -/ +abbrev f0 : (Fin (nn R M) → R) →ₗ[R] M := + (Module.Finite.exists_comp_eq_id_of_projective R M).choose_spec.choose + +/-- The injective splitting map from a finite projective module into a finite free module. -/ +abbrev g0 : M →ₗ[R] Fin (nn R M) → R := + (Module.Finite.exists_comp_eq_id_of_projective R M).choose_spec.choose_spec.choose + +lemma f0_surj : Function.Surjective (f0 R M) := + (Module.Finite.exists_comp_eq_id_of_projective R M).choose_spec.choose_spec.choose_spec|>.1 + +lemma g0_inj : Function.Injective (g0 R M) := + (Module.Finite.exists_comp_eq_id_of_projective R M).choose_spec.choose_spec.choose_spec|>.2.1 + +lemma fg : (f0 R M) ∘ₗ (g0 R M) = LinearMap.id := + (Module.Finite.exists_comp_eq_id_of_projective R M).choose_spec.choose_spec.choose_spec|>.2.2 + +/-- Precomposition with `f0`, embedding maps out of `M` into maps out of a finite free module. -/ +abbrev inclusion1 : (M →ₗ[R] P) →ₗ[R] ((Fin (nn R M) → R) →ₗ[R] P) where + toFun := fun f ↦ f.comp (f0 R M) + map_add' := by simp [LinearMap.add_comp] + map_smul' := by simp [LinearMap.smul_comp] + +/-- Precomposition with `g0`, projecting maps from the finite free cover +back to maps out of `M`. -/ +abbrev projection1 : ((Fin (nn R M) → R) →ₗ[R] P) →ₗ[R] (M →ₗ[R] P) where + toFun := fun f ↦ f.comp (g0 R M) + map_add' := by simp [LinearMap.add_comp] + map_smul' := by simp [LinearMap.smul_comp] + +/-- Hom(M, P) ⊗ Hom(N, Q) →ₗ[R] Hom(Rⁿ, P) ⊗ Hom(Rᵐ, Q) -/ +abbrev tensor_inclusion1 : + (M →ₗ[R] P) ⊗[R] (N →ₗ[R] Q) →ₗ[R] + ((Fin (nn R M) → R) →ₗ[R] P) ⊗[R] ((Fin (nn R N) → R) →ₗ[R] Q) := + TensorProduct.map (inclusion1 R M P) (inclusion1 R N Q) + +/-- Tensor product of the two first projection maps. -/ +abbrev tensor_projection1 := TensorProduct.map (projection1 R M P) (projection1 R N Q) + +lemma projection_inlusion1 : (projection1 R M P).comp (inclusion1 R M P) = LinearMap.id := by + ext f : 1 + simp [LinearMap.comp_assoc, fg] + +lemma tensor_inclusion1_projection1 : (tensor_projection1 R M N P Q).comp + (tensor_inclusion1 R M N P Q) = LinearMap.id := by + simp [← TensorProduct.map_comp, projection_inlusion1] + +lemma tensor_inclusion1_projection1_apply (x : (M →ₗ[R] P) ⊗[R] (N →ₗ[R] Q)) : + tensor_projection1 R M N P Q (tensor_inclusion1 R M N P Q x) = x := + DFunLike.congr_fun (tensor_inclusion1_projection1 R M N P Q) x + +lemma tensor_inclusion1_inj : Function.Injective (tensor_inclusion1 R M N P Q) := by + exact Function.LeftInverse.injective (g := tensor_projection1 R M N P Q) + <| DFunLike.congr_fun <| tensor_inclusion1_projection1 R M N P Q + +open TensorProduct in +lemma Tensor_isDirectSummand : ∃(s0 : M ⊗[R] N →ₗ[R] (Fin (nn R M) → R) ⊗[R] (Fin (nn R N) → R)) + (s1 : (Fin (nn R M) → R) ⊗[R] (Fin (nn R N) → R) →ₗ[R] M ⊗[R] N), s1.comp s0 = .id := + ⟨map (g0 R M) (g0 R N), map (f0 R M) (f0 R N), by simp [← map_comp, fg]⟩ + +variable {R M N} in +/-- The tensor-product inclusion induced by the free-module splittings of `M` and `N`. -/ +abbrev inclusion2 : M ⊗[R] N →ₗ[R] (Fin (nn R M) → R) ⊗[R] (Fin (nn R N) → R) := + TensorProduct.map (g0 R M) (g0 R N) + +variable {R M N} in +/-- The tensor-product projection induced by the free-module covers of `M` and `N`. -/ +abbrev projection2 : (Fin (nn R M) → R) ⊗[R] (Fin (nn R N) → R) →ₗ[R] M ⊗[R] N := + TensorProduct.map (f0 R M) (f0 R N) + +variable {M N} in +/-- Precomposition with `projection2` on homs out of `M ⊗ N`. -/ +abbrev tensor_inclusion2 : (M ⊗[R] N →ₗ[R] P ⊗[R] Q) →ₗ[R] + ((Fin (nn R M) → R) ⊗[R] (Fin (nn R N) → R) →ₗ[R] P ⊗[R] Q) where + toFun := fun f ↦ f.comp projection2 + map_add' := by simp [LinearMap.add_comp] + map_smul' := by simp [LinearMap.smul_comp] + +variable {M N} in +/-- Precomposition with `inclusion2` on homs out of the finite free tensor product. -/ +abbrev tensor_projection2 : ((Fin (nn R M) → R) ⊗[R] (Fin (nn R N) → R) →ₗ[R] + P ⊗[R] Q) →ₗ[R] (M ⊗[R] N →ₗ[R] P ⊗[R] Q) where + toFun := fun f ↦ f.comp inclusion2 + map_add' := by simp [LinearMap.add_comp] + map_smul' := by simp [LinearMap.smul_comp] + +lemma projection2_inclusion2 : (projection2).comp (inclusion2) = + LinearMap.id (R := R) (M := M ⊗[R] N) := + by simp [← TensorProduct.map_comp, fg] + +lemma projection2_inclusion2_apply (x : M ⊗[R] N) : (projection2) ((inclusion2) x) = x := + DFunLike.congr_fun (projection2_inclusion2 R M N) x + +lemma tensor_projection2_inclusion2 : (tensor_projection2 R P Q).comp (tensor_inclusion2 R P Q) = + LinearMap.id (R := R) (M := M ⊗[R] N →ₗ[R] P ⊗[R] Q) := by + ext f : 1 + simp [LinearMap.comp_assoc, projection2_inclusion2] + +lemma tensor_inclusion2_inj : Function.Injective (tensor_inclusion2 R (M := M) (N := N) P Q) := by + exact Function.LeftInverse.injective (g := tensor_projection2 R P Q) + <| DFunLike.congr_fun <| tensor_projection2_inclusion2 R M N P Q + +/-- This proves the following square commutes: + `TensorProduct.homTensorHomMap` +Hom(M, P) ⊗ Hom(N, Q) ---------------> Hom(M ⊗ N, P ⊗ Q) + | | | | + i | | j i' | | j' + | | | | + | | | | +Hom(Rⁿ, P) ⊗ Hom(Rᵐ, Q) -------------> Hom(Rⁿ ⊗ Rᵐ, P ⊗ Q) +-/ +lemma comm_square2 : (homTensorHomEquiv R (Fin (nn R M) → R) (Fin (nn R N) → R) P Q).toLinearMap ∘ₗ + tensor_inclusion1 R M N P Q = + tensor_inclusion2 R P Q ∘ₗ TensorProduct.homTensorHomMap _ M N P Q := by + ext f g : 4 + apply LinearMap.ext + intro v + apply LinearMap.ext + intro u + simp + +lemma comm_square2_apply (f : (M →ₗ[R] P) ⊗[R] (N →ₗ[R] Q)) : + (homTensorHomEquiv R (Fin (nn R M) → R) (Fin (nn R N) → R) P Q).toLinearMap + (tensor_inclusion1 R M N P Q f) = + tensor_inclusion2 R P Q (TensorProduct.homTensorHomMap _ M N P Q f) := + DFunLike.congr_fun (comm_square2 R M N P Q) f + +lemma homTensorHomMap_inj : Function.Injective (TensorProduct.homTensorHomMap (.id R) M N P Q) := by + apply Function.Injective.of_comp (f := tensor_inclusion2 R P Q) + rw [← LinearMap.coe_comp, ← comm_square2] + exact Function.Injective.comp (f := tensor_inclusion1 R M N P Q) + (homTensorHomEquiv R (Fin (nn R M) → R) (Fin (nn R N) → R) P Q).injective <| + tensor_inclusion1_inj R M N P Q + +lemma comm_square3 : (homTensorHomEquiv R _ _ _ _).toLinearMap ∘ₗ + tensor_inclusion1 R M N P Q ∘ₗ tensor_projection1 R M N P Q = tensor_inclusion2 R P Q ∘ₗ + tensor_projection2 R P Q ∘ₗ (homTensorHomEquiv R _ _ _ _).toLinearMap := by + ext f g : 4 + apply LinearMap.ext + intro v + apply LinearMap.ext + intro u + simp + +lemma comm_square3_apply (f : ((Fin (nn R M) → R) →ₗ[R] P) ⊗[R] ((Fin (nn R N) → R) →ₗ[R] Q)) : + (homTensorHomEquiv R _ _ _ _) (tensor_inclusion1 R M N P Q (tensor_projection1 R M N P Q f)) = + tensor_inclusion2 R P Q (tensor_projection2 R P Q (homTensorHomEquiv R _ _ _ _ f)) := + DFunLike.congr_fun (comm_square3 R M N P Q) f + +lemma comm_square1 : + tensor_projection1 R M N P Q ∘ₗ (homTensorHomEquiv R _ _ P Q).symm.toLinearMap ∘ₗ + tensor_inclusion2 R P Q ∘ₗ TensorProduct.homTensorHomMap _ M N P Q = + .id (R := R) (M := (M →ₗ[R] P) ⊗[R] (N →ₗ[R] Q)) := by + rw [← comm_square2] + apply LinearMap.ext + simp [-homTensorHomEquiv_toLinearMap, -homTensorHomEquiv_apply, + tensor_inclusion1_projection1_apply] + +lemma comm_square4 : + TensorProduct.homTensorHomMap _ M N P Q ∘ₗ tensor_projection1 R M N P Q ∘ₗ + (homTensorHomEquiv R _ _ _ _).symm.toLinearMap ∘ₗ tensor_inclusion2 R P Q = + .id (R := R) (M := (M ⊗[R] N) →ₗ[R] P ⊗[R] Q) := by + apply LinearMap.ext + intro fgfg + simp only [LinearMap.comp_apply] + apply tensor_inclusion2_inj + rw [← comm_square2_apply, LinearEquiv.coe_toLinearMap, comm_square3_apply] + simp only [LinearMap.coe_mk, AddHom.coe_mk, LinearEquiv.coe_coe, + LinearEquiv.apply_symm_apply, LinearMap.id_coe, id_eq] + apply LinearMap.ext + simp [projection2_inclusion2_apply] + +lemma homTensorHomMap_surj : Surjective (TensorProduct.homTensorHomMap (.id R) M N P Q) := by + apply Function.Surjective.of_comp (g := (tensor_projection1 R M N P Q ∘ₗ + (homTensorHomEquiv R _ _ _ _).symm.toLinearMap ∘ₗ tensor_inclusion2 R P Q)) + rw [← LinearMap.coe_comp, comm_square4] + exact CharacterModule.surjective_of_dual_injective LinearMap.id fun ⦃a₁ a₂⦄ a ↦ a + +end formathlib + +open MulOpposite + +-- @[ext] +-- structure Azumaya (R : Type u) [CommRing R] where +-- carrier : Type v +-- [isRing : Ring carrier] +-- [isAlgebra : Algebra R carrier] +-- isAzumaya : IsAzumaya R carrier + +/-- An Azumaya algebra over a commutative base ring, bundled as an algebra object. -/ +structure Azumaya (R : Type u) [CommRing R] extends AlgCat R where + isAzumaya : IsAzumaya R carrier + +@[coe] +instance : CoeSort (Azumaya R) (Type v) where + coe s := s.carrier + +attribute [instance] Azumaya.isAzumaya + +/-- Morita equivalence of the carrier algebras of two bundled Azumaya algebras. -/ +def Azumaya.IsMoritaEquivalent : Azumaya R → Azumaya R → Prop := + fun A B ↦ _root_.IsMoritaEquivalent R A.carrier B.carrier + +lemma Azumaya.IsMoritaEquivalent.iff {A B : Azumaya R} : + Azumaya.IsMoritaEquivalent R A B ↔ _root_.IsMoritaEquivalent R A.carrier B.carrier := + Iff.rfl + +lemma AzuMorita.equiv : Equivalence (Azumaya.IsMoritaEquivalent R) where + refl _ := .refl R _ + symm := .symm R + trans := .trans R + +/-- The setoid on Azumaya algebras induced by Morita equivalence. -/ +abbrev AzumayaSetoid : Setoid (Azumaya R) where + r := Azumaya.IsMoritaEquivalent R + iseqv := AzuMorita.equiv R + +namespace Azumaya + +variable (A B : Type v) [Ring A] [Ring B] [Algebra R A] [Algebra R B] +instance [Module.Finite R A] [Module.Finite R B] : + Module.Finite R (A ⊗[R] B) := Module.Finite.tensorProduct R A B + +variable {R A B} in +instance faithfulSMulTensor [Module.Projective R A] [Module.Projective R B] + [FaithfulSMul R A] [FaithfulSMul R B] : + FaithfulSMul R (A ⊗[R] B) where + eq_of_smul_eq_smul {r1 r2} eq := by + specialize eq 1 + rw [Algebra.TensorProduct.one_def, TensorProduct.smul_tmul', + TensorProduct.smul_tmul'] at eq + have := Algebra.TensorProduct.includeLeft_injective (R := R) (S := R) + (fun r1 r2 h ↦ by + rw [Algebra.algebraMap_eq_smul_one, Algebra.algebraMap_eq_smul_one] at h + exact eq_of_smul_eq_smul (M := R) (α := B) (m₁ := r1) (m₂ := r2) (by + intro b + rw [← one_mul b, ← smul_mul_assoc, h, smul_mul_assoc, one_mul])) eq + exact eq_of_smul_eq_smul (M := R) (α := A) (m₁ := r1) (m₂ := r2) <| + fun a ↦ by rw [← one_mul a, ← smul_mul_assoc, this, smul_mul_assoc, one_mul] + +-- abbrev u (n : ℕ) : Fin n → (Fin n → R) := fun i ↦ Function.update (0 : Fin n → R) i 1 + +-- abbrev v (n : ℕ) : Basis (Fin n) R (Fin n → R) := Basis.mk (v := u R n) (by +-- rw [Fintype.linearIndependent_iff] +-- refine fun f hf j ↦ ?_ +-- apply congrFun at hf +-- specialize hf j +-- change (∑ _, _ • Function.update _ _ _) _ = _ at hf +-- simp only [Finset.sum_apply, Pi.smul_apply, Function.update_apply, Pi.zero_apply, smul_eq_mul, +-- mul_ite, mul_one, mul_zero, Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte] at hf +-- exact hf) fun x _ ↦ by +-- refine Submodule.mem_span_range_iff_exists_fun R|>.2 ⟨x, ?_⟩ +-- change ∑ i : Fin n, _ • Function.update _ _ _ = x +-- ext j +-- simp [Function.update_apply] + +open Algebra.TensorProduct (assoc congr opAlgEquiv) in +variable {R A B} in +/-- Rebracketing equivalence used to compare `mulLeftRight` with tensor products. -/ +abbrev e : (A ⊗[R] Aᵐᵒᵖ) ⊗[R] (B ⊗[R] Bᵐᵒᵖ) ≃ₐ[R] (A ⊗[R] B) ⊗[R] (A ⊗[R] B)ᵐᵒᵖ := + (assoc R R R A B (Aᵐᵒᵖ ⊗[R] Bᵐᵒᵖ)|>.trans <| + (congr .refl (assoc R R R B Aᵐᵒᵖ Bᵐᵒᵖ)).symm.trans <| + congr .refl (congr (Algebra.TensorProduct.comm R _ _) .refl) |>.trans + <| congr .refl (assoc R R R Aᵐᵒᵖ B Bᵐᵒᵖ) |>.trans + <| assoc R R R A Aᵐᵒᵖ (B ⊗[R] Bᵐᵒᵖ)|>.symm).symm.trans + <| Algebra.TensorProduct.congr .refl <| opAlgEquiv R R A B + +lemma e_apply (a : A) (b : B) (a' : Aᵐᵒᵖ) (b' : Bᵐᵒᵖ) : + e ((a ⊗ₜ a') ⊗ₜ (b ⊗ₜ b')) = (a ⊗ₜ b) ⊗ₜ op (a'.unop ⊗ₜ[R] b'.unop) := rfl + +-- lemma top_square_comm' (A B : Azumaya R) (a : A) (a' : Aᵐᵒᵖ) (b : B) (b' : Bᵐᵒᵖ) : +-- ((TensorProduct.homTensorHomMap _ A B A B) ∘ (Algebra.TensorProduct.congr +-- (AlgEquiv.ofBijective (AlgHom.mulLeftRight R A) A.isAzumaya.bij) +-- (AlgEquiv.ofBijective (AlgHom.mulLeftRight R B) B.isAzumaya.bij))) ((a ⊗ₜ a') ⊗ₜ (b ⊗ₜ b')) = +-- ((AlgHom.mulLeftRight R (A ⊗[R] B)) ∘ e) ((a ⊗ₜ a') ⊗ₜ (b ⊗ₜ b')) := by +-- ext a0 b0 +-- simp [e_apply, AlgHom.mulLeftRight_apply, Module.endTensorEndAlgHom_apply] + +open TensorProduct.AlgebraTensorModule in +lemma top_square_comm'' (A B : Azumaya R) : + (TensorProduct.homTensorHomMap _ A B A B) ∘ₗ (Algebra.TensorProduct.congr + (AlgEquiv.ofBijective (AlgHom.mulLeftRight R A) A.isAzumaya.bij) + (AlgEquiv.ofBijective (AlgHom.mulLeftRight R B) B.isAzumaya.bij)).toLinearMap + = (AlgHom.mulLeftRight R (A ⊗[R] B)).toLinearMap ∘ₗ + (e (R := R) (A := A) (B := B)).toLinearEquiv.toLinearMap := by + ext a b c d a' b' + dsimp + simp only [AlgHom.mulLeftRight_apply, Algebra.TensorProduct.tmul_mul_tmul, unop_op] + +lemma top_square_comm (A B : Azumaya R) : + (TensorProduct.homTensorHomMap _ A B A B) ∘ (Algebra.TensorProduct.congr + (AlgEquiv.ofBijective (AlgHom.mulLeftRight R A) A.isAzumaya.bij) + (AlgEquiv.ofBijective (AlgHom.mulLeftRight R B) B.isAzumaya.bij)) + = (AlgHom.mulLeftRight R (A ⊗[R] B)) ∘ e := + congr_arg DFunLike.coe <| top_square_comm'' R A B + +/-- +A ⊗ Aᵐᵒᵖ ⊗ B ⊗ B ᵐᵒᵖ --------> (A ⊗ B) ⊗ (A ⊗ B)ᵐᵒᵖ + | | + | | + | | + | | + f ⊗ g ----> f ⊗ g +End R A ⊗ End R B ---------------> End R (A ⊗ B) + | | | | + i | | j i' | | j' + | | | | + | | `homTensorHomEquiv` | | +End R Rⁿ ⊗ End R Rᵐ -------------> End R (Rⁿ ⊗ Rᵐ) +-/ +lemma bij_homtensorhom (A B : Azumaya.{u, v} R) : + Function.Bijective (TensorProduct.homTensorHomMap (.id R) A B A B) := + ⟨homTensorHomMap_inj R A B A B, homTensorHomMap_surj R A B A B⟩ + +/-- The hom-tensor-hom equivalence for the carriers of two Azumaya algebras. -/ +abbrev e1 (A B : Azumaya.{u, v} R) : + (Module.End R A ⊗[R] Module.End R B) ≃ₗ[R] Module.End R (A ⊗[R] B) := + .ofBijective (TensorProduct.homTensorHomMap _ A B A B) <| bij_homtensorhom R A B + +/-- The tensor-product equivalence induced by the two `mulLeftRight` bijections. -/ +abbrev e2 (A B : Azumaya R) := (Algebra.TensorProduct.congr + (AlgEquiv.ofBijective (AlgHom.mulLeftRight R A) A.isAzumaya.bij) + (AlgEquiv.ofBijective (AlgHom.mulLeftRight R B) B.isAzumaya.bij)) + +lemma top_square_comm_apply (A B : Azumaya R) (x : (A ⊗[R] Aᵐᵒᵖ) ⊗[R] (B ⊗[R] Bᵐᵒᵖ)) : + (e1 R A B) (e2 R A B x) = (AlgHom.mulLeftRight R (A ⊗[R] B)) (e.toAlgHom x) := by + erw [← AlgHom.comp_apply, AlgHom.coe_comp, ← top_square_comm] + rfl + +lemma bij_mulLeftRight (A B : Azumaya.{u, v} R) : + Function.Bijective (AlgHom.mulLeftRight R (A ⊗[R] B)) := + Function.Bijective.of_comp_iff (AlgHom.mulLeftRight R (A ⊗[R] B)) + (e (R := R) (A := A) (B := B)).bijective|>.1 <| by + rw [← top_square_comm] + change Function.Bijective (e1 R A B ∘ e2 R A B) + exact (e1 R A B).bijective.comp (e2 R A B).bijective + +/-- Tensor product of bundled Azumaya algebras. -/ +abbrev mul (A B : Azumaya R) : Azumaya R where + __ := AlgCat.of R (A.carrier ⊗[R] B.carrier) + isAzumaya.out := Module.Projective.tensorProduct|>.out + isAzumaya.eq_of_smul_eq_smul := Azumaya.faithfulSMulTensor|>.eq_of_smul_eq_smul + isAzumaya.fg_top := Module.Finite.tensorProduct R A B|>.fg_top + isAzumaya.bij := bij_mulLeftRight R A B + +instance : Mul (Azumaya R) where + mul A B := mul R A B + +lemma mul_coe (A B : Azumaya.{u, v} R) : + (A * B) = ⟨.of R (A ⊗[R] B), ⟨bij_mulLeftRight R A B⟩⟩ := rfl + +instance : One (Azumaya R) where + one := ⟨.of R R, IsAzumaya_R R⟩ + +instance : FaithfulSMul R Rᵐᵒᵖ where + eq_of_smul_eq_smul {r1 r2} hr := by + specialize hr 1 + change op _ = op _ at hr + simp only [unop_one, smul_eq_mul, mul_one, op_inj] at hr + exact hr + +/-- +A ⊗ Aᵐᵒᵖ ------------> B ⊗ Bᵐᵒᵖ + | | + | | + | | + | | +End R A ------------> End R B +-/ +lemma small_comm_square (e : A ≃ₐ[R] B) : + (AlgHom.mulLeftRight R B).comp (Algebra.TensorProduct.congr e e.op).toAlgHom = + (e.toLinearEquiv.conjAlgEquiv R).toAlgHom.comp (AlgHom.mulLeftRight R A) := by + apply AlgHom.ext + intro a + induction a using TensorProduct.induction_on with + | zero => simp + | tmul a a' => + ext + simp [AlgHom.mulLeftRight_apply, LinearEquiv.conjAlgEquiv] + | add _ _ _ _ => simp_all [map_add] + +lemma _root_.IsAzumaya.ofAlgEquiv (e : A ≃ₐ[R] B) (hA : IsAzumaya R A) : IsAzumaya R B := + let _ : Module.Projective R B := .of_equiv e.toLinearEquiv + let _ : FaithfulSMul R B := .of_injective e e.injective + let _ : Module.Finite R B := .equiv e.toLinearEquiv + ⟨Function.Bijective.of_comp_iff (AlgHom.mulLeftRight R B) + (Algebra.TensorProduct.congr e e.op).bijective |>.1 <| by + erw [← AlgHom.coe_comp, small_comm_square] + simp [hA.bij]⟩ + +/-- Inclusion of endomorphisms induced by a finite free cover of a projective module. -/ +abbrev inclusion' (M : Type v) [AddCommGroup M] [Module R M] [Module.Finite R M] + [Module.Projective R M] : Module.End R M →ₗ[R] Module.End R (Fin (nn R M) → R) where + toFun := fun f ↦ g0 R M ∘ₗ f ∘ₗ f0 R M + map_add' := fun _ _ ↦ by simp [LinearMap.add_comp, LinearMap.comp_add] + map_smul' := fun _ _ ↦ by simp [LinearMap.smul_comp, LinearMap.comp_smul] + +/-- Projection of endomorphisms induced by a splitting of the finite free cover. -/ +abbrev projection' (M : Type v) [AddCommGroup M] [Module R M] [Module.Finite R M] + [Module.Projective R M] : Module.End R (Fin (nn R M) → R) →ₗ[R] Module.End R M where + toFun := fun f ↦ f0 R M ∘ₗ f ∘ₗ g0 R M + map_add' := fun _ _ ↦ by simp [LinearMap.add_comp, LinearMap.comp_add] + map_smul' := fun _ _ ↦ by simp [LinearMap.smul_comp, LinearMap.comp_smul] + +lemma projection'_inclusion' (M : Type v) [AddCommGroup M] [Module R M] [Module.Finite R M] + [Module.Projective R M] : projection' R M ∘ₗ inclusion' R M = LinearMap.id := by + ext f : 1 + simp [LinearMap.comp_assoc, fg] + rw [← LinearMap.comp_assoc, fg, LinearMap.id_comp] + +lemma projection'_surj (M : Type v) [AddCommGroup M] [Module R M] [Module.Finite R M] + [Module.Projective R M] : Function.Surjective (projection' R M) := + Function.Surjective.of_comp (g := inclusion' R M) <| by + rw [← LinearMap.coe_comp, projection'_inclusion'] + exact Function.surjective_id + +lemma _root_.Module.Projective.ofEnd (M : Type v) [AddCommGroup M] [Module R M] [Module.Finite R M] + [Module.Projective R M] : Module.Projective R (Module.End R M) := + .of_split (M := Module.End R (Fin (nn R M) → R)) (inclusion' R M) (projection' R M) + <| projection'_inclusion' R M + +instance _root_.Module.Finite.End (M : Type v) [AddCommGroup M] [Module R M] [Module.Finite R M] + [Module.Projective R M] : Module.Finite R (Module.End R M) := + Module.Finite.of_surjective (projection' R M) (projection'_surj R M) + +instance (M : Type v) [AddCommGroup M] [Module R M] [FaithfulSMul R M] : + FaithfulSMul R (Module.End R M) where + eq_of_smul_eq_smul {r1 r2} h12 := by + specialize h12 1 + rw [LinearMap.ext_iff] at h12 + simp only [LinearMap.smul_apply, Module.End.one_apply] at h12 + exact eq_of_smul_eq_smul h12 + +/-- The matrix algebra as a bundled Azumaya algebra. -/ +abbrev MatrixAlg (n : ℕ) [NeZero n] : Azumaya R := { + __ := AlgCat.of R (_root_.Matrix (Fin n) (Fin n) R) + isAzumaya := IsAzumaya.matrix R (Fin n) } + +/-- The endomorphism algebra of `R^n` as a bundled Azumaya algebra. -/ +abbrev EndRn (n : ℕ) [NeZero n] : Azumaya R := { + __ := AlgCat.of R (Module.End R (Fin n → R)) + isAzumaya := IsAzumaya.ofAlgEquiv R _ _ + LinearMap.toMatrixAlgEquiv'.symm <| IsAzumaya.matrix R (Fin n) +} + +variable (M : Type v) [AddCommGroup M] [Module R M] [Module.Finite R M] + [Module.Projective R M] + +open MulOpposite + +/-- Tensor inclusion on endomorphism algebras induced by `inclusion'`. -/ +abbrev tensor_inclusion1' : (Module.End R M) ⊗[R] (Module.End R M)ᵐᵒᵖ →ₗ[R] + (Module.End R (Fin (nn R M) → R)) ⊗[R] (Module.End R (Fin (nn R M) → R))ᵐᵒᵖ := + TensorProduct.map (inclusion' R M) <| + (opLinearEquiv R).toLinearMap ∘ₗ (inclusion' R M) ∘ₗ (opLinearEquiv R).symm.toLinearMap + +/-- Tensor projection on endomorphism algebras induced by `projection'`. -/ +abbrev tensor_projection1' : + Module.End R (Fin (nn R M) → R) ⊗[R] (Module.End R (Fin (nn R M) → R))ᵐᵒᵖ →ₗ[R] + Module.End R M ⊗[R] (Module.End R M)ᵐᵒᵖ := + TensorProduct.map (projection' R M) <| + (opLinearEquiv R).toLinearMap ∘ₗ (projection' R M) ∘ₗ (opLinearEquiv R).symm.toLinearMap + +lemma tensor_projection_inclusion1' : tensor_projection1' R M ∘ₗ tensor_inclusion1' R M = .id := by + ext f g + simp [LinearMap.comp_assoc, fg] + rw [← LinearMap.comp_assoc, fg, LinearMap.id_comp, ← LinearMap.comp_assoc, + fg, LinearMap.id_comp, op_unop] + +lemma tensor_inclusion1'_inj : Function.Injective (tensor_inclusion1' R M) := by + exact Function.LeftInverse.injective (g := tensor_projection1' R M) + <| DFunLike.congr_fun <| tensor_projection_inclusion1' R M + +/-- Inclusion between second endomorphism algebras induced by the free-module splitting. -/ +abbrev inclusion2' : Module.End R (Module.End R M) →ₗ[R] + Module.End R (Module.End R (Fin (nn R M) → R)) where + toFun f := inclusion' R M ∘ₗ f ∘ₗ projection' R M + map_add' _ _ := by simp [LinearMap.add_comp, LinearMap.comp_add] + map_smul' := by simp [LinearMap.smul_comp, LinearMap.comp_smul] + +/-- Projection between second endomorphism algebras induced by the free-module splitting. -/ +abbrev projection2' : Module.End R (Module.End R (Fin (nn R M) → R)) →ₗ[R] + Module.End R (Module.End R M) where + toFun f := projection' R M ∘ₗ f ∘ₗ inclusion' R M + map_add' _ _ := by simp [LinearMap.add_comp, LinearMap.comp_add] + map_smul' := by simp [LinearMap.smul_comp, LinearMap.comp_smul] + +lemma projection2'_inclusion2' : projection2' R M ∘ₗ inclusion2' R M = LinearMap.id := by + ext f g : 2 + simp [LinearMap.comp_assoc, fg] + simp [← LinearMap.comp_assoc, fg] + +lemma projection2'_surj : Function.Surjective (projection2' R M) := by + exact Function.RightInverse.surjective <| DFunLike.congr_fun <| projection2'_inclusion2' R M + +/-- +End R M ⊗ (End R M)ᵐᵒᵖ ------------> End R (End R M) + | | | | + | | | | + | | | | + | | | | +End R Rⁿ ⊗ (End R Rⁿ)ᵐᵒᵖ ----------> End R (End R Rⁿ) +-/ +lemma comm_square_endend : + inclusion2' R M ∘ₗ (AlgHom.mulLeftRight R (Module.End R M)).toLinearMap = + (AlgHom.mulLeftRight R (Module.End R (Fin (nn R M) → R))).toLinearMap ∘ₗ + (tensor_inclusion1' R M) := by + ext f1 g1 : 3 + apply LinearMap.ext + intro f2 + simp only [TensorProduct.AlgebraTensorModule.curry_apply, LinearMap.restrictScalars_comp, + TensorProduct.curry_apply, LinearMap.coe_comp, LinearMap.coe_restrictScalars, LinearMap.coe_mk, + AddHom.coe_mk, Function.comp_apply, AlgHom.toLinearMap_apply, + TensorProduct.map_tmul, LinearEquiv.coe_coe, coe_opLinearEquiv, coe_opLinearEquiv_symm, + AlgHom.mulLeftRight_apply, unop_op] + ext i j + simp + +lemma comm_square_endend' : + (AlgHom.mulLeftRight R (Module.End R M)).toLinearMap ∘ₗ tensor_projection1' R M = + projection2' R M ∘ₗ + (AlgHom.mulLeftRight R (Module.End R (Fin (nn R M) → R))).toLinearMap := by + ext f1 g1 : 3 + apply LinearMap.ext + intro f2 + simp only [TensorProduct.AlgebraTensorModule.curry_apply, LinearMap.restrictScalars_comp, + TensorProduct.curry_apply, LinearMap.coe_comp, LinearMap.coe_restrictScalars, + Function.comp_apply, TensorProduct.map_tmul, LinearMap.coe_mk, AddHom.coe_mk, + LinearEquiv.coe_coe, coe_opLinearEquiv, coe_opLinearEquiv_symm, AlgHom.toLinearMap_apply, + AlgHom.mulLeftRight_apply, unop_op] + ext m + simp + +variable [Nontrivial M] + +instance : NeZero (nn R M) := ⟨by + by_contra! hn + have : Subsingleton (Fin (nn R M) → R) := by + rw [hn] + exact Unique.instSubsingleton + have : Subsingleton M := Function.Surjective.subsingleton (f0_surj R M) + have : ¬ (Subsingleton M) := not_subsingleton_iff_nontrivial.2 inferInstance + tauto⟩ + +lemma inj_endM : Function.Injective (AlgHom.mulLeftRight R (Module.End R M)) := by + refine .of_comp (f := inclusion2' R M) ?_ + suffices Function.Injective ((inclusion2' R M) ∘ₗ (AlgHom.mulLeftRight _ _).toLinearMap) by + rw [LinearMap.coe_comp] at this; exact this + rw [comm_square_endend, LinearMap.coe_comp] + exact (EndRn R (nn R M)).isAzumaya.bij.injective.comp <| tensor_inclusion1'_inj R M + +lemma surj_endM : Function.Surjective (AlgHom.mulLeftRight R (Module.End R M)) := by + refine .of_comp (g := tensor_projection1' R M) ?_ + change Function.Surjective + ((AlgHom.mulLeftRight R (Module.End R M)).toLinearMap ∘ₗ tensor_projection1' R M) + rw [comm_square_endend', LinearMap.coe_comp] + exact (projection2'_surj R M).comp (EndRn R (nn R M)).isAzumaya.bij.surjective + +lemma bij_endM : Function.Bijective (AlgHom.mulLeftRight R (Module.End R M)) := + ⟨inj_endM R M, surj_endM R M⟩ + +/-- The endomorphism algebra of a faithful finite projective module is Azumaya. -/ +abbrev ofEnd [FaithfulSMul R M] : Azumaya R where + __ := AlgCat.of R (Module.End R M) + isAzumaya.out := Module.Projective.ofEnd R M|>.out + isAzumaya.bij := bij_endM R M + +end Azumaya From 01933f813dbe78ef8fb97d83910e1ad8ae36df6b Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 16:09:10 -0700 Subject: [PATCH 22/34] Fix BrauerGroup Azumaya warning-free build --- LeanPool/BrauerGroupNew/Azumaya/Mul.lean | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/LeanPool/BrauerGroupNew/Azumaya/Mul.lean b/LeanPool/BrauerGroupNew/Azumaya/Mul.lean index c066583f64..2783a0771e 100644 --- a/LeanPool/BrauerGroupNew/Azumaya/Mul.lean +++ b/LeanPool/BrauerGroupNew/Azumaya/Mul.lean @@ -435,7 +435,9 @@ abbrev projection' (M : Type v) [AddCommGroup M] [Module R M] [Module.Finite R M lemma projection'_inclusion' (M : Type v) [AddCommGroup M] [Module R M] [Module.Finite R M] [Module.Projective R M] : projection' R M ∘ₗ inclusion' R M = LinearMap.id := by ext f : 1 - simp [LinearMap.comp_assoc, fg] + simp only [LinearMap.coe_comp, LinearMap.coe_mk, AddHom.coe_mk, comp_apply, LinearMap.id_coe, + id_eq] + simp only [LinearMap.comp_assoc, fg, LinearMap.comp_id] rw [← LinearMap.comp_assoc, fg, LinearMap.id_comp] lemma projection'_surj (M : Type v) [AddCommGroup M] [Module R M] [Module.Finite R M] @@ -493,9 +495,13 @@ abbrev tensor_projection1' : lemma tensor_projection_inclusion1' : tensor_projection1' R M ∘ₗ tensor_inclusion1' R M = .id := by ext f g - simp [LinearMap.comp_assoc, fg] - rw [← LinearMap.comp_assoc, fg, LinearMap.id_comp, ← LinearMap.comp_assoc, - fg, LinearMap.id_comp, op_unop] + simp only [TensorProduct.AlgebraTensorModule.curry_apply, LinearMap.restrictScalars_self, + TensorProduct.curry_apply, LinearMap.coe_comp, comp_apply, TensorProduct.map_tmul, + LinearMap.coe_mk, AddHom.coe_mk, LinearEquiv.coe_coe, coe_opLinearEquiv, + coe_opLinearEquiv_symm, unop_op, LinearMap.id_coe, id_eq] + simp only [LinearMap.comp_assoc, fg, LinearMap.comp_id] + rw [← LinearMap.comp_assoc, fg, LinearMap.id_comp] + rw [← LinearMap.comp_assoc, fg, LinearMap.id_comp, op_unop] lemma tensor_inclusion1'_inj : Function.Injective (tensor_inclusion1' R M) := by exact Function.LeftInverse.injective (g := tensor_projection1' R M) From cc173b44fb4491b65ca709bf2dae074ffd732236 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 16:37:08 -0700 Subject: [PATCH 23/34] Port BrauerGroup Morita tensor product --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew.lean | 1 + .../BrauerGroupNew/Morita/TensorProduct.lean | 451 ++++++++++++++++++ 3 files changed, 453 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/Morita/TensorProduct.lean diff --git a/LeanPool.lean b/LeanPool.lean index d2ac63c9af..c44989de1b 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -111,6 +111,7 @@ import LeanPool.BrauerGroupNew.Mathlib.RingTheory.TwoSidedIdeal.Operations import LeanPool.BrauerGroupNew.MatrixCenterEquiv import LeanPool.BrauerGroupNew.MatrixEquivTensor import LeanPool.BrauerGroupNew.Morita.ChangeOfRings +import LeanPool.BrauerGroupNew.Morita.TensorProduct import LeanPool.BrauerGroupNew.MoritaEquivalence import LeanPool.BrauerGroupNew.RelativeBrauer import LeanPool.BrauerGroupNew.SkolemNoether diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index 7ba95193fa..02e3e2ce1c 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -18,6 +18,7 @@ import LeanPool.BrauerGroupNew.LemmasAboutSimpleRing import LeanPool.BrauerGroupNew.MatrixCenterEquiv import LeanPool.BrauerGroupNew.MatrixEquivTensor import LeanPool.BrauerGroupNew.Morita.ChangeOfRings +import LeanPool.BrauerGroupNew.Morita.TensorProduct import LeanPool.BrauerGroupNew.MoritaEquivalence import LeanPool.BrauerGroupNew.SplittingOfCSA import LeanPool.BrauerGroupNew.TwoSidedIdeal diff --git a/LeanPool/BrauerGroupNew/Morita/TensorProduct.lean b/LeanPool/BrauerGroupNew/Morita/TensorProduct.lean new file mode 100644 index 0000000000..d03ab341cd --- /dev/null +++ b/LeanPool/BrauerGroupNew/Morita/TensorProduct.lean @@ -0,0 +1,451 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Morita.ChangeOfRings + +universe u v w + +open scoped TensorProduct + +variable (R : Type u) [CommRing R] + +namespace ModuleCat + +/-- Bundling a scaled linear map agrees with scaling the bundled morphism. -/ +@[simp] +lemma ofHom_smul {R S : Type*} [Ring R] [Semiring S] {M N : ModuleCat R} + [Module S N] [SMulCommClass R S N] (r : S) (f : M →ₗ[R] N) : + ofHom (r • f) = r • ofHom f := by + apply hom_ext + simp only [hom_ofHom] + exact ((homLinearEquiv (R := R) (S := S) (M := M) (N := N)).map_smul r (ofHom f)).symm + +end ModuleCat + +namespace Morita + +open CategoryTheory + +variable (A B C D : Type v) [Ring A] [Ring B] [Ring C] [Ring D] + [Algebra R A] [Algebra R B] [Algebra R C] [Algebra R D] + (e1 : ModuleCat A ⥤ ModuleCat B) [e1.Additive] [e1.Linear R] + +variable (M : ModuleCat (A ⊗[R] C)) + +noncomputable instance (N : ModuleCat B) : Module R N := .compHom _ (algebraMap R B) + +instance (N : ModuleCat B) : IsScalarTower R B N := .of_algebraMap_smul fun _ _ ↦ rfl + +/-- Transport endomorphisms across an `R`-linear additive functor between module categories. -/ +noncomputable abbrev aux0 (N : ModuleCat A) : Module.End A N →ₐ[R] Module.End B (e1.obj N) where + toFun f := (e1.map (ModuleCat.ofHom f)).hom + map_one' := by ext; simp [Module.End.one_eq_id] + map_mul' f1 f2 := by ext; simp [Module.End.mul_eq_comp] + map_zero' := by ext; simp [show ModuleCat.ofHom 0 = 0 from rfl] + map_add' f1 f2 := by simp [show ModuleCat.ofHom (f1 + f2) = ModuleCat.ofHom f1 + + ModuleCat.ofHom f2 from rfl] + commutes' r := by + ext n + simp [Algebra.algebraMap_eq_smul_one, Module.End.one_eq_id] + +/-- Restrict scalars on an endomorphism algebra to a smaller scalar ring. -/ +abbrev _root_.Module.End.restrictScalars (R S M R₁ : Type*) [Ring R] [Ring S] [CommRing R₁] + [AddCommGroup M] [Module R M] [Module R₁ M] [Module S M] [Algebra R₁ R] [IsScalarTower R₁ R M] + [Algebra R₁ S] [IsScalarTower R₁ S M] [LinearMap.CompatibleSMul M M R S] : + Module.End S M →ₐ[R₁] (M →ₗ[R] M) := + AlgHom.ofLinearMap (LinearMap.restrictScalarsₗ R S M M R₁) (by rfl) (by intros; rfl) + +noncomputable section + +/-- The right tensor factor acts on an `A ⊗ C`-module after restriction to an `A`-module. -/ +abbrev moduleMapAux : C →ₐ[R] Module.End A ((ModuleCat.restrictScalars + Algebra.TensorProduct.includeLeftRingHom).obj M) where + toFun c := { + toFun (m : M) := ((1 : A) ⊗ₜ[R] c) • m + map_add' := by intros; exact smul_add _ _ _ + map_smul' r (m : M) := by simp [smul_smul] + } + map_one' := by ext; simp [← Algebra.TensorProduct.one_def] + map_mul' c1 c2 := by ext; simp [smul_smul] + map_zero' := by ext m; simp; rfl + map_add' c1 c2 := by ext m; simp [TensorProduct.tmul_add, add_smul]; rfl + commutes' r := by + ext m; simp [Algebra.algebraMap_eq_smul_one, ← Algebra.TensorProduct.one_def]; rfl + +/-- The tensor-product algebra action obtained after applying a Morita equivalence +to the left factor. -/ +abbrev moduleMap : B ⊗[R] C →ₐ[R] + Module.End R (e1.obj ((ModuleCat.restrictScalars + (Algebra.TensorProduct.includeLeftRingHom)).obj M)) := + Algebra.TensorProduct.lift (Algebra.lsmul _ _ _) ((Module.End.restrictScalars R B _ R).comp + ((aux0 R A B e1 _).comp (moduleMapAux R A C _))) fun b c ↦ by ext; simp + +instance modulefromtensor (M : ModuleCat (A ⊗[R] C)) : + Module (B ⊗[R] C) (e1.obj ((ModuleCat.restrictScalars + (Algebra.TensorProduct.includeLeftRingHom)).obj M)) := + Module.compHom _ (moduleMap R A B C e1 M).toRingHom + +end + +end Morita + +noncomputable section newcat + +open CategoryTheory + +variable (R : Type u) [CommRing R] (A B C D : Type v) [Ring A] [Ring B] [Ring C] [Ring D] + [Algebra R A] [Algebra R B] [Algebra R C] [Algebra R D] + +/-- use `Action` instead once it's generalized to enriched categories. -/ +structure TensorModule where + /-- The underlying module over the left tensor factor. -/ + carrier : ModuleCat.{v} A + /-- The action of the right tensor factor by left-factor-linear endomorphisms. -/ + morphism : C →ₐ[R] Module.End A carrier + +instance : CoeSort (TensorModule R A C) (Type v) where + coe M := M.carrier + +/-- Morphisms of tensor modules are maps that commute with the right tensor-factor action. -/ +@[ext] +structure TensorModule.Hom (M N : TensorModule R A C) where + /-- The underlying map of modules over the left tensor factor. -/ + hom : M.carrier ⟶ N.carrier + /-- Compatibility with the right tensor-factor action. -/ + commutes : ∀ c, hom ≫ ModuleCat.ofHom (N.morphism c) = ModuleCat.ofHom (M.morphism c) ≫ hom + +attribute [reassoc (attr := simp)] TensorModule.Hom.commutes + +@[simp] +lemma TensorModule.commutes_apply (M N : TensorModule R A C) (f : TensorModule.Hom R A C M N) + (c : C) (m : M) : f.hom.hom ((M.morphism c) m) = (N.morphism c) (f.hom.hom m) := by + have := f.commutes c + rw [ModuleCat.hom_ext_iff, LinearMap.ext_iff] at this + specialize this m + simp only [ModuleCat.of_coe, ModuleCat.hom_comp, LinearMap.coe_comp, + Function.comp_apply] at this + exact this.symm + +instance : Category (TensorModule R A C) where + Hom := TensorModule.Hom R A C + id M := { + hom := 𝟙 _ + commutes _ := rfl + } + comp f g := { + hom := f.hom ≫ g.hom + commutes _ := by simp + } + id_comp f := by simp + comp_id f := by simp + assoc _ _ := by simp + +@[simp] +lemma TensorModule.hom_id (M : TensorModule R A C) : + TensorModule.Hom.hom (𝟙 M) = 𝟙 M.carrier := rfl + +@[simp] +lemma TensorModule.hom_comp {M N K : TensorModule R A C} (f : M ⟶ N) (g : N ⟶ K) : + (f ≫ g).hom = f.hom ≫ g.hom := rfl + +@[ext] +lemma TensorModule.hom_ext {M N : TensorModule R A C} (f g : M ⟶ N) (h : f.hom = g.hom) : + f = g := by + rcases f + rcases g + simp_all + +/-- Build an isomorphism of tensor modules from an isomorphism of the underlying modules. -/ +@[simps] +def TensorModule.Iso_mk {M N : TensorModule R A C} (f : M.carrier ≅ N.carrier) + (h : ∀ c, f.hom ≫ ModuleCat.ofHom (N.morphism c) = + ModuleCat.ofHom (M.morphism c) ≫ f.hom) : + M ≅ N := { + hom := { + hom := f.hom + commutes := h + } + inv := { + hom := f.inv + commutes := by + intro c + rw [f.inv_comp_eq, reassoc_of%h] + simp + } + hom_inv_id := by ext; simp + inv_hom_id := by ext; simp +} + +instance (M N : TensorModule R A C) : Coe (M ⟶ N) (M.carrier ⟶ N.carrier) where + coe f := f.hom + +instance (M N : TensorModule R A C) : AddCommGroup (M ⟶ N) where + add f g := ⟨f.hom + g.hom, by simp⟩ + add_assoc f g h := by ext1; exact add_assoc _ _ _ + zero := ⟨0, by simp⟩ + zero_add _ := by ext1; exact zero_add _ + add_zero _ := by ext1; exact add_zero _ + nsmul n f := ⟨n • f.hom, by simp⟩ + nsmul_zero _ := by ext1; exact zero_nsmul _ + nsmul_succ _ _ := by ext1; exact AddMonoid.nsmul_succ _ _ + neg f := ⟨-f.hom, by simp⟩ + sub f g := ⟨f.hom - g.hom, by simp⟩ + sub_eq_add_neg f g := by ext1; exact sub_eq_add_neg _ _ + zsmul z f := ⟨z • f.hom, by simp⟩ + zsmul_zero' _ := by ext1; exact zero_zsmul _ + zsmul_succ' _ _ := by ext1; exact SubNegMonoid.zsmul_succ' _ _ + zsmul_neg' _ _ := by ext1; exact SubNegMonoid.zsmul_neg' _ _ + neg_add_cancel _ := by ext1; exact neg_add_cancel _ + add_comm _ _ := by ext1; exact add_comm _ _ + +instance : Preadditive (TensorModule R A C) where + add_comp _ _ _ _ _ _ := by ext1; exact Preadditive.add_comp _ _ _ _ _ _ + comp_add _ _ _ _ _ _ := by ext1; exact Preadditive.comp_add _ _ _ _ _ _ + +instance (M N : TensorModule R A C) : Module R (M ⟶ N) where + smul r g := ⟨r • g.hom, by simp⟩ + smul_add _ _ _ := by ext1; exact smul_add _ _ _ + add_smul _ _ _ := by ext1; exact add_smul _ _ _ + mul_smul _ _ _ := by ext1; exact mul_smul _ _ _ + one_smul _ := by ext1; exact one_smul _ _ + zero_smul _ := by ext1; exact zero_smul _ _ + smul_zero _ := by ext1; exact smul_zero _ + +instance : Linear R (TensorModule R A C) where + smul_comp _ _ _ _ _ _ := by ext1; exact Linear.smul_comp _ _ _ _ _ _ + comp_smul _ _ _ _ _ _ := by ext1; exact Linear.comp_smul _ _ _ _ _ _ + +/-- The `A ⊗ C` action associated to a tensor module. -/ +abbrev moduleAux (M : TensorModule R A C) : A ⊗[R] C →ₐ[R] Module.End R M := + Algebra.TensorProduct.lift (Algebra.lsmul _ _ _) + ((Module.End.restrictScalars R A M R).comp M.morphism) fun a c ↦ by ext; simp + +lemma moduleAux_apply (M : TensorModule R A C) (a : A) (c : C) (m : M) : + moduleAux R A C M (a ⊗ₜ[R] c) m = a • (M.morphism c) m := by + simp [moduleAux] + +instance moduletotensor (M : TensorModule R A C) : Module (A ⊗[R] C) M := + Module.compHom _ (moduleAux R A C M).toRingHom + +@[simp] +lemma smul_tensormod (x : A ⊗[R] C) (M : TensorModule R A C) (m : M) : + x • m = moduleAux R A C M x m := rfl + +/-- View a tensor module as a module over the tensor-product algebra. -/ +abbrev toModuleOverTensor : TensorModule R A C ⥤ ModuleCat (A ⊗[R] C) where + obj M := ModuleCat.of _ M + map {M N} f := ModuleCat.ofHom { + __ := f.hom.hom + map_smul' ac m := by + induction ac using TensorProduct.induction_on with + | zero => simp + | tmul a c => simp + | add _ _ _ _ => simp_all [add_smul] + } + map_id M := by ext; simp + map_comp _ _ := by ext; simp + +/-- Split an `A ⊗ C`-module into an `A`-module with a compatible `C`-action. -/ +abbrev fromModuleOverTensor : ModuleCat (A ⊗[R] C) ⥤ TensorModule R A C where + obj M := { + carrier := (ModuleCat.restrictScalars (Algebra.TensorProduct.includeLeftRingHom)).obj M + morphism := by exact Morita.moduleMapAux R A C M + } + map f := { + hom := (ModuleCat.restrictScalars (Algebra.TensorProduct.includeLeftRingHom)).map f + commutes c := by ext; simp + } + map_id M := by ext; simp + map_comp _ _ := by ext; simp + +/-- The unit component comparing tensor modules with modules over the tensor-product algebra. -/ +abbrev e01 (M : TensorModule R A C) : + (𝟭 (TensorModule R A C)).obj M ≅ (toModuleOverTensor R A C ⋙ + fromModuleOverTensor R A C).obj M := TensorModule.Iso_mk R A C + (LinearEquiv.toModuleIso (by + apply (config := {allowSynthFailures := true, newGoals := .all}) @LinearEquiv.mk + · apply (config := {allowSynthFailures := true, newGoals := .all}) @LinearMap.mk + · exact AddHom.id _ + · intro a m + change a • m = (moduleAux R A C M (a ⊗ₜ[R] (1 : C))) m + simp + rfl + · exact id + · exact congrFun rfl + · exact congrFun rfl)) fun c ↦ by + ext m + simp [Morita.moduleMapAux] + rfl + +/-- Naturality of the tensor-module unit comparison. -/ +lemma e01_naturality {X Y : TensorModule R A C} (f : X ⟶ Y) : + (𝟭 (TensorModule R A C)).map f ≫ (e01 R A C Y).hom = + (e01 R A C X).hom ≫ (toModuleOverTensor R A C ⋙ fromModuleOverTensor R A C).map f := by + ext (x : X) + simp + rfl + +/-- The unit isomorphism for the equivalence between tensor modules and modules over `A ⊗ C`. -/ +abbrev eModunitIso : 𝟭 (TensorModule R A C) ≅ toModuleOverTensor R A C ⋙ + fromModuleOverTensor R A C := + NatIso.ofComponents (e01 R A C) <| e01_naturality R A C + +/-- The counit component comparing modules over the tensor-product algebra with tensor modules. -/ +abbrev e02 (M : ModuleCat (A ⊗[R] C)) : + (fromModuleOverTensor R A C ⋙ toModuleOverTensor R A C).obj M ≅ + (𝟭 (ModuleCat (A ⊗[R] C))).obj M := LinearEquiv.toModuleIso <| by + apply (config := {allowSynthFailures := true, newGoals := .all}) @LinearEquiv.mk + · apply (config := {allowSynthFailures := true, newGoals := .all}) @LinearMap.mk + · exact AddHom.id _ + · intro ac m + induction ac using TensorProduct.induction_on with + | zero => + conv_lhs => erw [AddHom.toFun_eq_coe, AddHom.id_apply] + rw [RingHom.id_apply, zero_smul] + rfl + | tmul a c => + conv_lhs => erw [AddHom.toFun_eq_coe, AddHom.id_apply] + rw [RingHom.id_apply, AddHom.toFun_eq_coe] + conv_rhs => erw [AddHom.id_apply] + rw [smul_tensormod] + simp [smul_smul] + | add x y h1 h2 => + rw [RingHom.id_apply, AddHom.toFun_eq_coe] + erw [AddHom.id_apply, AddHom.id_apply] + conv_rhs => rw [add_smul] + erw [AddHom.toFun_eq_coe, AddHom.id_apply] at h1 h2 + simp only [RingHom.id_apply] at h1 h2 + erw [AddHom.id_apply] at h1 h2 + rw [← h1, ← h2] + rw [smul_tensormod, map_add] + rfl + · exact id + · exact congrFun rfl + · exact congrFun rfl + +/-- The counit isomorphism for the equivalence between tensor modules and modules over `A ⊗ C`. -/ +abbrev eModcounitIso : + fromModuleOverTensor R A C ⋙ toModuleOverTensor R A C ≅ 𝟭 (ModuleCat (A ⊗[R] C)) := + NatIso.ofComponents (e02 R A C) fun {X Y} f ↦ by ext (x : X); simp; rfl + +/-- Tensor modules are equivalent to modules over the tensor-product algebra. -/ +abbrev equivModuleOverTensor : TensorModule R A C ≌ ModuleCat (A ⊗[R] C) where + functor := toModuleOverTensor R A C + inverse := fromModuleOverTensor R A C + unitIso := eModunitIso R A C + counitIso := eModcounitIso R A C + functor_unitIso_comp M := by + ext + simp + rfl + +instance : (equivModuleOverTensor R A C).functor.Additive where + map_add := by intros; ext; rfl + +instance : (equivModuleOverTensor R A C).functor.Linear R where + map_smul {M N} f r := by + ext m + simp only [ConcreteCategory.hom_ofHom, LinearMap.coe_mk, LinearMap.coe_toAddHom, + ModuleCat.hom_smul, LinearMap.smul_apply] + change (r • f.hom.hom) m = _ + rw [LinearMap.smul_apply] + congr 1 + simp + +instance : (equivModuleOverTensor R A C).inverse.Linear R where + map_smul {M N} f r := by + ext1 + rfl + +/-- Apply an `R`-linear additive functor to the left factor of a tensor module. -/ +abbrev toBCfunctor (F : ModuleCat A ⥤ ModuleCat B) [F.Additive] [F.Linear R] : + TensorModule R A C ⥤ TensorModule R B C where + obj M := { + carrier := F.obj M.1 + morphism := (Morita.aux0 R A B F M.1).comp M.morphism + } + map {M N} f := { + hom := F.map f.hom + commutes c := by + simp only + rw [AlgHom.comp_apply, AlgHom.comp_apply] + simp_rw [ModuleCat.of_coe, AlgHom.coe_mk, RingHom.coe_mk, + MonoidHom.coe_mk, OneHom.coe_mk, ModuleCat.ofHom_hom] + rw [← Functor.map_comp, ← Functor.map_comp] + congr 1 + exact f.commutes c + } + map_id M := by ext : 1; exact F.map_id M.1 + map_comp f g := by ext1; exact F.map_comp f.hom g.hom + +/-- Tensor a Morita equivalence on the left with the identity on the right tensor factor. -/ +abbrev MoritaTensorAux0 (e : ModuleCat A ≌ ModuleCat B) [e.functor.Additive] [e.functor.Linear R] : + TensorModule R A C ≌ TensorModule R B C where + functor := toBCfunctor R A B C e.functor + inverse := toBCfunctor R B A C e.inverse + unitIso := NatIso.ofComponents (fun M ↦ TensorModule.Iso_mk _ _ _ + (e.unitIso.app M.1) fun c ↦ by + change (e.unitIso.app M.carrier).hom ≫ + e.inverse.map (e.functor.map (ModuleCat.ofHom (M.morphism c))) = + ModuleCat.ofHom (M.morphism c) ≫ (e.unitIso.app M.carrier).hom + exact (e.unitIso.hom.naturality (ModuleCat.ofHom (M.morphism c))).symm) fun {M N} f ↦ by + ext + simp + counitIso := NatIso.ofComponents (fun M ↦ TensorModule.Iso_mk _ _ _ + (e.counitIso.app M.1) fun c ↦ by + change (e.counitIso.app M.carrier).hom ≫ ModuleCat.ofHom (M.morphism c) = + e.functor.map (e.inverse.map (ModuleCat.ofHom (M.morphism c))) ≫ + (e.counitIso.app M.carrier).hom + exact (e.counitIso.hom.naturality (ModuleCat.ofHom (M.morphism c))).symm) fun {M N} f ↦ by + ext + simp + functor_unitIso_comp M := by ext; simp + +instance (e : ModuleCat A ≌ ModuleCat B) [e.functor.Additive] [e.functor.Linear R] : + (MoritaTensorAux0 R A B C e).functor.Additive where + map_add := by intros; ext1; exact e.functor.map_add + +instance (e : ModuleCat A ≌ ModuleCat B) [e.functor.Additive] [e.functor.Linear R] : + (MoritaTensorAux0 R A B C e).functor.Linear R where + map_smul {M N} f r := by + ext1 + exact e.functor.map_smul _ _ + +/-- The induced equivalence of module categories over tensor-product algebras. -/ +abbrev MoritaTensorAux1 (e : ModuleCat A ≌ ModuleCat B) [e.functor.Additive] [e.functor.Linear R] : + ModuleCat (A ⊗[R] C) ≌ ModuleCat (B ⊗[R] C) := + (equivModuleOverTensor R A C).symm.trans ((MoritaTensorAux0 R A B C e).trans + (equivModuleOverTensor R B C)) + +-- instance : Functor.Additive (@ModuleCat.restrictScalars A (A ⊗[R] C) _ _ +-- Algebra.TensorProduct.includeLeftRingHom) where +-- map_add := rfl + +instance : Functor.Linear R (@ModuleCat.restrictScalars A (A ⊗[R] C) _ _ + Algebra.TensorProduct.includeLeftRingHom) where + map_smul {X Y} f r := by + ext1; rfl + +instance MoritaTensorAux1_linear (e : ModuleCat A ≌ ModuleCat B) [e.functor.Additive] + [e.functor.Linear R] : (MoritaTensorAux1 R A B C e).functor.Linear R := by + dsimp [MoritaTensorAux1] + infer_instance + +/-- Morita equivalence is preserved by tensoring on the right. -/ +theorem MoritaTensorLeft (e : IsMoritaEquivalent R A B) : + IsMoritaEquivalent R (A ⊗[R] C) (B ⊗[R] C) where + cond := ⟨⟨MoritaTensorAux1 R A B C e.cond.some.eqv, inferInstance⟩⟩ + +open ModuleCat in +/-- Tensor products of Morita equivalent algebras are Morita equivalent. -/ +theorem MoritaTensor (e1 : IsMoritaEquivalent R A B) (e2 : IsMoritaEquivalent R C D) : + IsMoritaEquivalent R (A ⊗[R] C) (B ⊗[R] D) := + IsMoritaEquivalent.trans R (MoritaTensorLeft R A B C e1) <| IsMoritaEquivalent.trans R + (IsMoritaEquivalent.of_algEquiv R (Algebra.TensorProduct.comm R B C)) <| + IsMoritaEquivalent.trans R (MoritaTensorLeft R _ _ _ e2) <| IsMoritaEquivalent.of_algEquiv R + (Algebra.TensorProduct.comm R D B) + +end newcat From 08d7bfe9564f498f911de7c8e4bb54aa62960d60 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 16:57:52 -0700 Subject: [PATCH 24/34] Port BrauerGroup ShortComplex homology example --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew.lean | 1 + .../ShortComplex/LeftHomologyMapData.lean | 138 ++++++++++++++++++ 3 files changed, 140 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/Examples/ShortComplex/LeftHomologyMapData.lean diff --git a/LeanPool.lean b/LeanPool.lean index c44989de1b..740bf71f2f 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -62,6 +62,7 @@ import LeanPool.BrauerGroupNew.CentralSimple import LeanPool.BrauerGroupNew.Centralizer import LeanPool.BrauerGroupNew.CrossProductAlgebra import LeanPool.BrauerGroupNew.DoubleCentralizer +import LeanPool.BrauerGroupNew.Examples.ShortComplex.LeftHomologyMapData import LeanPool.BrauerGroupNew.ExtendScalar import LeanPool.BrauerGroupNew.FieldCat import LeanPool.BrauerGroupNew.FiniteField diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index 02e3e2ce1c..e91213d6bf 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -10,6 +10,7 @@ import LeanPool.BrauerGroupNew.CrossProductAlgebra import LeanPool.BrauerGroupNew.ExtendScalar import LeanPool.BrauerGroupNew.Azumaya.Basic import LeanPool.BrauerGroupNew.Azumaya.Mul +import LeanPool.BrauerGroupNew.Examples.ShortComplex.LeftHomologyMapData import LeanPool.BrauerGroupNew.FieldCat import LeanPool.BrauerGroupNew.AlgClosedUnion import LeanPool.BrauerGroupNew.FiniteField diff --git a/LeanPool/BrauerGroupNew/Examples/ShortComplex/LeftHomologyMapData.lean b/LeanPool/BrauerGroupNew/Examples/ShortComplex/LeftHomologyMapData.lean new file mode 100644 index 0000000000..2bce287d99 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Examples/ShortComplex/LeftHomologyMapData.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import Mathlib.Algebra.Homology.ShortComplex.ModuleCat + +universe v u + +open CategoryTheory + +variable (R : Type u) [CommRing R] (S₁ : ShortComplex (ModuleCat.{v} R)) + (S₂ : ShortComplex (ModuleCat R)) (f : S₁ ⟶ S₂) + +/-- The map on explicit cycle modules induced by a morphism of short complexes. -/ +abbrev φK : ↥(LinearMap.ker (ModuleCat.Hom.hom S₁.g)) →ₗ[R] + ↥(LinearMap.ker (ModuleCat.Hom.hom S₂.g)) := + LinearMap.restrict f.2.hom + fun x hx ↦ by + have := (LinearMap.ext_iff.1 <| ModuleCat.hom_ext_iff|>.1 f.5) x + simp at hx + simp [hx] at this + simp [this] + +/-- The map on cycles carries boundaries to boundaries. -/ +lemma φK_moduleCatToCycles (x : S₁.X₁) : + φK R S₁ S₂ f (S₁.moduleCatToCycles x) = S₂.moduleCatToCycles (f.τ₁ x) := by + ext + have h := LinearMap.ext_iff.1 ((ModuleCat.hom_ext_iff.1 f.comm₁₂).symm) x + simpa [φK, ShortComplex.moduleCatToCycles] using h + +/-- The map on cycles descends to the quotient by boundaries. -/ +lemma φK_maps_moduleCatToCycles_range : + S₁.moduleCatToCycles.range ≤ + Submodule.comap (φK R S₁ S₂ f) S₂.moduleCatToCycles.range := by + rintro _ ⟨x, rfl⟩ + exact ⟨f.τ₁ x, (φK_moduleCatToCycles R S₁ S₂ f x).symm⟩ + +/-- The induced map on explicit module-category left homology quotients. -/ +abbrev φH : + ModuleCat.of R (LinearMap.ker (ModuleCat.Hom.hom S₁.g) ⧸ LinearMap.range S₁.moduleCatToCycles) ⟶ + .of R (↥(LinearMap.ker (ModuleCat.Hom.hom S₂.g)) ⧸ LinearMap.range S₂.moduleCatToCycles) := + ModuleCat.ofHom <| Submodule.mapQ _ _ (φK _ _ _ f) <| + φK_maps_moduleCatToCycles_range R S₁ S₂ f + +/-- The explicit left homology map data for a morphism of short complexes of modules. -/ +@[simps] +def LeftHomologyMapData.ofModuleCat : + ShortComplex.LeftHomologyMapData f + (ShortComplex.moduleCatLeftHomologyData S₁) + (ShortComplex.moduleCatLeftHomologyData S₂) where + φK := ModuleCat.ofHom <| φK R S₁ S₂ f + φH := φH R S₁ S₂ f + commi := ModuleCat.hom_ext <| LinearMap.ext fun ⟨x, hx⟩ ↦ rfl + commf' := ModuleCat.hom_ext <| LinearMap.ext fun x ↦ by + change φK R S₁ S₂ f (S₁.moduleCatToCycles x) = S₂.moduleCatToCycles (f.τ₁ x) + exact φK_moduleCatToCycles R S₁ S₂ f x + commπ := ModuleCat.hom_ext <| LinearMap.ext fun ⟨x, hx⟩ ↦ by + change + (Submodule.mapQ _ _ (φK R S₁ S₂ f) + (φK_maps_moduleCatToCycles_range R S₁ S₂ f)) (Submodule.Quotient.mk ⟨x, hx⟩) = + Submodule.Quotient.mk ((φK R S₁ S₂ f) ⟨x, hx⟩) + rw [Submodule.mapQ_apply] + +/-- A concrete quotient criterion for quasi-isomorphisms of short complexes of modules. -/ +theorem ShortComplex.IsQuasiIsoAt_iff_moduleCat : + ShortComplex.QuasiIso f ↔ + (∀ a : S₁.X₂, ModuleCat.Hom.hom S₁.g a = 0 → + ∀ x : S₂.X₁, ConcreteCategory.hom S₂.f x = ModuleCat.Hom.hom f.τ₂ a → + ∃ y, ConcreteCategory.hom S₁.f y = a) ∧ + ∀ a : S₂.X₂, ModuleCat.Hom.hom S₂.g a = 0 → + ∃ a_1, ModuleCat.Hom.hom S₁.g a_1 = 0 ∧ + ∃ y, ConcreteCategory.hom S₂.f y = ModuleCat.Hom.hom f.τ₂ a_1 - a := by + rw [ShortComplex.LeftHomologyMapData.quasiIso_iff (LeftHomologyMapData.ofModuleCat R S₁ S₂ f)] + rw [ConcreteCategory.isIso_iff_bijective, Function.Bijective] + congr! + · rw [injective_iff_map_eq_zero] + constructor + · intro hinj a ha x hx + have hzero : (ConcreteCategory.hom (LeftHomologyMapData.ofModuleCat R S₁ S₂ f).φH) + (Submodule.Quotient.mk ⟨a, ha⟩) = 0 := by + change (S₁.moduleCatToCycles.range.mapQ S₂.moduleCatToCycles.range (φK R S₁ S₂ f) + (φK_maps_moduleCatToCycles_range R S₁ S₂ f)) (Submodule.Quotient.mk ⟨a, ha⟩) = + 0 + rw [Submodule.mapQ_apply] + rw [Submodule.Quotient.mk_eq_zero] + exact ⟨x, by ext; simpa [φK] using hx⟩ + have hz := hinj _ hzero + have hzmem := (Submodule.Quotient.mk_eq_zero S₁.moduleCatToCycles.range).1 hz + rcases hzmem with ⟨y, hy⟩ + use y + have hy' := congrArg Subtype.val hy + simpa using hy' + · intro h q + refine Submodule.Quotient.induction_on S₁.moduleCatToCycles.range q ?_ + intro z hq + rcases z with ⟨a, ha⟩ + change (S₁.moduleCatToCycles.range.mapQ S₂.moduleCatToCycles.range (φK R S₁ S₂ f) + (φK_maps_moduleCatToCycles_range R S₁ S₂ f)) (Submodule.Quotient.mk ⟨a, ha⟩) = + 0 at hq + rw [Submodule.mapQ_apply] at hq + have hzmem := (Submodule.Quotient.mk_eq_zero S₂.moduleCatToCycles.range).1 hq + rcases hzmem with ⟨x, hx⟩ + have ⟨y, hy⟩ := h a ha x (by + have hx' := congrArg Subtype.val hx + simpa [φK] using hx') + apply (Submodule.Quotient.mk_eq_zero S₁.moduleCatToCycles.range).2 + exact ⟨y, by ext; simpa using hy⟩ + · constructor + · intro hsurj a ha + rcases hsurj (Submodule.Quotient.mk ⟨a, ha⟩) with ⟨q, hq⟩ + revert hq + refine Submodule.Quotient.induction_on S₁.moduleCatToCycles.range q ?_ + intro z hq + rcases z with ⟨a₁, ha₁⟩ + use a₁, ha₁ + change (S₁.moduleCatToCycles.range.mapQ S₂.moduleCatToCycles.range (φK R S₁ S₂ f) + (φK_maps_moduleCatToCycles_range R S₁ S₂ f)) (Submodule.Quotient.mk ⟨a₁, ha₁⟩) = + Submodule.Quotient.mk ⟨a, ha⟩ at hq + rw [Submodule.mapQ_apply] at hq + have hmem := (Submodule.Quotient.eq S₂.moduleCatToCycles.range).1 hq + rcases hmem with ⟨y, hy⟩ + use y + have hy' := congrArg Subtype.val hy + simpa [φK] using hy' + · intro hsurj q + refine Submodule.Quotient.induction_on S₂.moduleCatToCycles.range q ?_ + intro z + rcases z with ⟨a, ha⟩ + rcases hsurj a ha with ⟨a₁, ha₁, y, hy⟩ + refine ⟨Submodule.Quotient.mk ⟨a₁, ha₁⟩, ?_⟩ + change (S₁.moduleCatToCycles.range.mapQ S₂.moduleCatToCycles.range (φK R S₁ S₂ f) + (φK_maps_moduleCatToCycles_range R S₁ S₂ f)) (Submodule.Quotient.mk ⟨a₁, ha₁⟩) = + Submodule.Quotient.mk ⟨a, ha⟩ + rw [Submodule.mapQ_apply] + apply (Submodule.Quotient.eq S₂.moduleCatToCycles.range).2 + exact ⟨y, by ext; simpa [φK] using hy⟩ From 1ce8ea66fd99bdfdff5acd3d65db8c0c977027bc Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 17:56:44 -0700 Subject: [PATCH 25/34] Port BrauerGroup second cohomology equivalence --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew.lean | 1 + LeanPool/BrauerGroupNew/ToSecond.lean | 1083 +++++++++++++++++++++++++ 3 files changed, 1085 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/ToSecond.lean diff --git a/LeanPool.lean b/LeanPool.lean index 740bf71f2f..a67de1d544 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -122,6 +122,7 @@ import LeanPool.BrauerGroupNew.Subfield.Defs import LeanPool.BrauerGroupNew.Subfield.FiniteDimensional import LeanPool.BrauerGroupNew.Subfield.Splitting import LeanPool.BrauerGroupNew.Subfield.Subfield +import LeanPool.BrauerGroupNew.ToSecond import LeanPool.BrauerGroupNew.TwoSidedIdeal import LeanPool.BrauerGroupNew.Wedderburn import LeanPool.BrauerGroupNew.ZeroSevenFourE diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index e91213d6bf..e6df5a1f4a 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -27,6 +27,7 @@ import LeanPool.BrauerGroupNew.Wedderburn import LeanPool.BrauerGroupNew.ZeroSevenFourE import LeanPool.BrauerGroupNew.RelativeBrauer import LeanPool.BrauerGroupNew.SkolemNoether +import LeanPool.BrauerGroupNew.ToSecond import LeanPool.BrauerGroupNew.DoubleCentralizer import LeanPool.BrauerGroupNew.Mathlib import LeanPool.BrauerGroupNew.Subfield diff --git a/LeanPool/BrauerGroupNew/ToSecond.lean b/LeanPool/BrauerGroupNew/ToSecond.lean new file mode 100644 index 0000000000..bdb26b807b --- /dev/null +++ b/LeanPool/BrauerGroupNew/ToSecond.lean @@ -0,0 +1,1083 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.CrossProductAlgebra +import LeanPool.BrauerGroupNew.Mathlib.RingTheory.Congruence.Defs +import LeanPool.BrauerGroupNew.Subfield.Splitting +import Mathlib.RepresentationTheory.Homological.GroupCohomology.LowDegree + +suppress_compilation + +open FiniteDimensional BrauerGroup Module groupCohomology + +variable {F K : Type} [Field K] [Field F] [Algebra F K] +variable (X : BrauerGroup F) + +variable (K) in +/-- A relative Brauer class representative with a splitting-field embedding. -/ +structure GoodRep extends CSA.{0, 0} F where + /-- The underlying central simple algebra represents the chosen Brauer class. -/ + quot_eq : Quotient.mk'' toCSA = X + /-- The chosen algebra embedding of the splitting field into the representative. -/ + ι : K →ₐ[F] toAlgCat + /-- The representative has the expected square dimension over the base field. -/ + dim_eq_sq : Module.finrank F carrier = (Module.finrank F K) ^ 2 + +namespace GoodRep + +variable {X : BrauerGroup F} (A B : GoodRep K X) + +instance : CoeSort (GoodRep K X) Type where + coe A := A.carrier + +/-- The splitting-field embedding identifies `K` with its range. -/ +def ιRange : K ≃ₐ[F] A.ι.range := .ofInjective _ (RingHom.injective _) + +instance : Algebra F A := inferInstanceAs <| Algebra F A + +instance : IsSimpleOrder (TwoSidedIdeal A.ι.range) := + TwoSidedIdeal.orderIsoOfRingEquiv A.ιRange.symm |>.isSimpleOrder + +lemma centralizerιRange : Subalgebra.centralizer F A.ι.range = A.ι.range := by + let L : SubField F A := + { __ := A.ι.range + mul_comm := by + rintro _ ⟨x, rfl⟩ _ ⟨y, rfl⟩ + simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe, ← map_mul, mul_comm] + exists_inverse := by + rintro _ ⟨x, rfl⟩ hx + refine ⟨A.ι x⁻¹, by simp, ?_⟩ + simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe, ← map_mul] + rw [mul_inv_cancel₀, map_one] + rintro rfl + simp at hx } + change Subalgebra.centralizer F (L.toSubalgebra : Set A) = L.toSubalgebra + apply cor_two_3to1 + apply cor_two_2to3 + change Module.finrank F A = Module.finrank F A.ι.range * Module.finrank F A.ι.range + rw [A.dim_eq_sq, pow_two, LinearEquiv.finrank_eq (f := A.ιRange.toLinearEquiv.symm)] + +instance : Module K A where + smul c a := A.ι c * a + one_smul a := show A.ι 1 * a = a by simp + mul_smul c c' x := show A.ι (c * c') * x = _ * (_ * _) by simp [_root_.mul_assoc] + smul_zero c := show A.ι c * 0 = 0 by simp + smul_add c x y := show A.ι c * (x + y) = _ * _ + _ * _ by simp [_root_.mul_add] + add_smul c c' x := show A.ι (c + c') * x = _ * _ + _ * _ by simp [_root_.add_mul] + zero_smul x := show A.ι 0 * x = 0 by simp + +@[simp] +lemma smul_def (c : K) (a : A) : c • a = A.ι c * a := rfl + +instance : FiniteDimensional F A := A.fin_dim + +instance : IsScalarTower F K A where + smul_assoc a b c := by simp + +instance : FiniteDimensional K A := FiniteDimensional.right F K A + +lemma dim_eq' [FiniteDimensional F K] : Module.finrank K A = Module.finrank F K := by + have : Module.finrank F A = Module.finrank F K * Module.finrank K A := + Eq.symm (Module.finrank_mul_finrank F K A.carrier) + rw [A.dim_eq_sq, pow_two] at this + simp only [mul_eq_mul_left_iff] at this + refine this.recOn Eq.symm fun rid ↦ ?_ + have : 0 < Module.finrank F K := Module.finrank_pos + omega + +variable (ρ σ τ : Gal(K, F)) + +/-- A unit implementing the Galois action by conjugation on the embedded splitting field. -/ +def conjFactor (σ : Gal(K, F)) : Type := {a : Aˣ // ∀ x : K, A.ι (σ x) = a * A.ι x * a⁻¹} + +/-- A chosen conjugating unit for each Galois automorphism, supplied by Skolem-Noether. -/ +def arbitraryConjFactor : A.conjFactor σ where + val := SkolemNoether' F A K A.ι (A.ι.comp σ) |>.choose + property x := SkolemNoether' F A K A.ι (A.ι.comp σ) |>.choose_spec x + +variable {A ρ σ τ} + +@[simp] lemma conjFactor_prop (x : A.conjFactor σ) (c : K) : + x.1 * A.ι c * x.1⁻¹ = A.ι (σ c) := x.2 c |>.symm + +/-- The product of two conjugating units as a conjugating unit for the product automorphism. -/ +def mul' (x : A.conjFactor σ) (y : A.conjFactor τ) : A.conjFactor (σ * τ) := +⟨x.1 * y.1, fun c ↦ by + simp only [AlgEquiv.mul_apply, Units.val_mul, _root_.mul_assoc, mul_inv_rev] + rw [← _root_.mul_assoc (A.ι c), ← mul_assoc (y.1 : A), ← mul_assoc (y.1 : A), + conjFactor_prop, ← _root_.mul_assoc, conjFactor_prop]⟩ + +@[simp] +lemma mul'_coe (x : A.conjFactor σ) (y : A.conjFactor τ) : (mul' x y).1.1 = x.1 * y.1 := rfl + +lemma conjFactor_rel_aux (x y : A.conjFactor σ) : + ∃ (c : K), x.1 = y.1 * A.ι c := by + have mem1 : (y.1⁻¹ * x.1 : A) ∈ Subalgebra.centralizer F A.ι.range := by + rw [Subalgebra.mem_centralizer_iff] + rintro _ ⟨z, rfl⟩ + have := x.2 z |>.symm.trans (y.2 z) + apply_fun (x.1⁻¹.1 * ·) at this + simp only [← _root_.mul_assoc, Units.inv_mul, _root_.one_mul] at this + apply_fun (· * x.1.1) at this + simp only [Units.inv_mul_cancel_right] at this + simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe] + conv_rhs => rw [this] + simp only [_root_.mul_assoc, Units.mul_inv_cancel_left, Units.inv_mul_cancel_left] + rw [A.centralizerιRange, AlgHom.mem_range] at mem1 + obtain ⟨c, hc⟩ := mem1 + use c + simp only [hc, Units.mul_inv_cancel_left] + +lemma conjFactor_rel (x y : A.conjFactor σ) : + ∃! (c : K), x.1 = y.1 * A.ι c := by + obtain ⟨c, hc⟩ := conjFactor_rel_aux x y + refine ⟨c, hc, fun c' (hc' : _ = _) => ?_⟩ + rw [hc] at hc' + simp only [Units.mul_right_inj] at hc' + exact RingHom.injective _ hc' |>.symm + +/-- The scalar comparing two conjugating units for the same automorphism. -/ +def conjFactorTwistCoeff (x y : A.conjFactor σ) : K := conjFactor_rel x y |>.choose + +lemma conjFactorTwistCoeff_spec (x y : A.conjFactor σ) : + x.1 = y.1 * A.ι (conjFactorTwistCoeff x y) := conjFactor_rel x y |>.choose_spec.1 + +lemma conjFactorTwistCoeff_unique (x y : A.conjFactor σ) (c : K) (h : x.1 = y.1 * A.ι c) : + c = conjFactorTwistCoeff x y := + conjFactor_rel x y |>.choose_spec.2 _ h + +@[simp] +lemma conjFactorTwistCoeff_self (x : A.conjFactor σ) : conjFactorTwistCoeff x x = 1 := + Eq.symm <| conjFactorTwistCoeff_unique _ _ _ <| by simp + +/-- The twist coefficient packaged as a unit. -/ +@[simps] +def conjFactorTwistCoeffAsUnit (x y : A.conjFactor σ) : Kˣ where + val := conjFactorTwistCoeff x y + inv := conjFactorTwistCoeff y x + val_inv := by + simpa using conjFactorTwistCoeff_unique y y + (conjFactorTwistCoeff x y * conjFactorTwistCoeff y x) + (by simp only [map_mul, ← _root_.mul_assoc, ← conjFactorTwistCoeff_spec]) + inv_val := by + simpa using conjFactorTwistCoeff_unique x x + (conjFactorTwistCoeff y x * conjFactorTwistCoeff x y) + (by simp only [map_mul, ← _root_.mul_assoc, ← conjFactorTwistCoeff_spec]) + +@[simp] +lemma conjFactorTwistCoeff_swap (x y : A.conjFactor σ) : + conjFactorTwistCoeff x y * conjFactorTwistCoeff y x = 1 := + conjFactorTwistCoeffAsUnit x y |>.val_inv + +lemma conjFactorTwistCoeff_inv (x y : A.conjFactor σ) : + conjFactorTwistCoeff x y = (conjFactorTwistCoeff y x)⁻¹ := by + apply eq_inv_of_mul_eq_one_left + simp + +lemma conjFactorTwistCoeff_swap' (x y : A.conjFactor σ) : + conjFactorTwistCoeff y x * conjFactorTwistCoeff x y = 1 := + conjFactorTwistCoeffAsUnit y x |>.val_inv + +@[simp] +lemma conjFactorTwistCoeff_swap'' (x y : A.conjFactor σ) : + A.ι (conjFactorTwistCoeff x y) * A.ι (conjFactorTwistCoeff y x) = 1 := by + simp [← map_mul] + +lemma conjFactorTwistCoeff_swap''' (x y : A.conjFactor σ) : + A.ι (conjFactorTwistCoeff y x) * A.ι (conjFactorTwistCoeff x y) = 1 := by + simp [← map_mul] + +lemma conjFactorTwistCoeff_spec' (x y : A.conjFactor σ) : + x.1 = A.ι (σ <| conjFactorTwistCoeff x y) * y.1 := by + calc x.1.1 + _ = x.1 * A.ι (conjFactorTwistCoeff x y) * x.1⁻¹ * (x.1 * A.ι (conjFactorTwistCoeff y x)) := by + simp only [_root_.mul_assoc, Units.inv_mul_cancel_left, conjFactorTwistCoeff_swap'', + _root_.mul_one] + _ = A.ι (σ <| conjFactorTwistCoeff x y) * (x.1 * A.ι (conjFactorTwistCoeff y x)) := by + simp only [conjFactor_prop] + _ = A.ι (σ <| conjFactorTwistCoeff x y) * y.1 := by + simp [← conjFactorTwistCoeff_spec] + +/-- The scalar measuring the defect of the chosen conjugating units from being multiplicative. -/ +def conjFactorCompCoeff (x : A.conjFactor σ) (y : A.conjFactor τ) (z : A.conjFactor (σ * τ)) : K := + σ <| τ <| conjFactorTwistCoeff (mul' x y) z + +/-- The composition coefficient packaged as a unit. -/ +@[simps] +def conjFactorCompCoeffAsUnit + (x : A.conjFactor σ) (y : A.conjFactor τ) (z : A.conjFactor (σ * τ)) : Kˣ where + val := conjFactorCompCoeff x y z + inv := σ <| τ <| conjFactorTwistCoeff z (mul' x y) + val_inv := by + simp only [conjFactorCompCoeff, ← map_mul, conjFactorTwistCoeff_swap, map_one] + inv_val := by + simp only [conjFactorCompCoeff, ← map_mul, conjFactorTwistCoeff_swap, map_one] + +lemma conjFactorCompCoeff_spec + (x : A.conjFactor σ) (y : A.conjFactor τ) (z : A.conjFactor (σ * τ)) : + (x.1 * y.1 : A) = A.ι (conjFactorCompCoeff x y z) * z.1 := + conjFactorTwistCoeff_spec' (mul' x y) z + +lemma conjFactorCompCoeff_spec'_ (x : A.conjFactor σ) (y : A.conjFactor τ) + (z : A.conjFactor (σ * τ)) : + A.ι (conjFactorCompCoeffAsUnit x y z)⁻¹ * (x.1 * y.1 : A) = z.1 := by + rw [conjFactorCompCoeff_spec (z := z), ← _root_.mul_assoc, ← map_mul] + simp only [conjFactorCompCoeffAsUnit, AlgEquiv.mul_apply] + rw [inv_mul_cancel₀, map_one, _root_.one_mul] + exact Units.ne_zero (conjFactorCompCoeffAsUnit x y z) + +lemma conjFactorCompCoeff_spec' (x : A.conjFactor σ) (y : A.conjFactor τ) + (z : A.conjFactor (σ * τ)) : + A.ι (σ <| τ <| conjFactorTwistCoeff z (mul' x y)) * (x.1 * y.1 : A) = z.1 := by + convert conjFactorCompCoeff_spec'_ x y z using 3 + norm_cast + +lemma conjFactorCompCoeff_spec'' (x : A.conjFactor σ) (y : A.conjFactor τ) + (z : A.conjFactor (σ * τ)) : + A.ι (conjFactorCompCoeff x y z) = x.1 * y.1 * z.1⁻¹ := by + suffices A.ι (conjFactorCompCoeff x y z) * z.val.val = x.val.val * y.val.val by simp [← this] + rw [← A.conjFactorCompCoeff_spec' x y z] + simp only [conjFactorCompCoeff, ← _root_.mul_assoc, ← map_mul, conjFactorTwistCoeff_swap, map_one, + _root_.one_mul] + +lemma conjFactorCompCoeff_inv (x : A.conjFactor σ) (y : A.conjFactor τ) (z : A.conjFactor (σ * τ)) : + A.ι ((conjFactorCompCoeff x y z)⁻¹) = z.1 * (y.1⁻¹ * x.1⁻¹) := by + suffices eq : Units.map A.ι (conjFactorCompCoeffAsUnit x y z)⁻¹ = z.1 * (y.1⁻¹ * x.1⁻¹) by + rw [Units.ext_iff] at eq + simp only [conjFactorCompCoeffAsUnit, Units.inv_mk, Units.coe_map, MonoidHom.coe_coe, + AlgEquiv.mul_apply, Units.val_mul] at eq + rw [← eq] + congr 1 + symm + apply eq_inv_of_mul_eq_one_left + simp only [conjFactorCompCoeff, ← map_mul, conjFactorTwistCoeff_swap, map_one] + rw [map_inv, inv_eq_iff_mul_eq_one] + ext + simp [conjFactorCompCoeffAsUnit, conjFactorCompCoeff_spec'', _root_.mul_assoc] + +lemma conjFactorCompCoeff_comp_comp₁ + (xρ : A.conjFactor ρ) (xσ : A.conjFactor σ) (xτ : A.conjFactor τ) + (xρσ : A.conjFactor (ρ * σ)) + (xρστ : A.conjFactor (ρ * σ * τ)) : + xρ.1.1 * xσ.1 * xτ.1 = + A.ι (conjFactorCompCoeff xρ xσ xρσ) * + A.ι (conjFactorCompCoeff xρσ xτ xρστ) * + xρστ.1 := by + rw [conjFactorCompCoeff_spec (z := xρσ), _root_.mul_assoc, + conjFactorCompCoeff_spec (z := xρστ), ← _root_.mul_assoc] + +lemma conjFactorCompCoeff_eq (x : A.conjFactor σ) (y : A.conjFactor τ) (z : A.conjFactor (σ * τ)) : + A.ι (conjFactorCompCoeff x y z) = (x.1 * y.1) * z.1⁻¹ := by + have := conjFactorTwistCoeff_spec' (mul' x y) z + simp only [AlgEquiv.mul_apply, mul'_coe] at this + rw [this] + simp only [AlgEquiv.mul_apply, Units.mul_inv_cancel_right] + rfl + +lemma conjFactorCompCoeff_comp_comp₂ + (xρ : A.conjFactor ρ) (xσ : A.conjFactor σ) (xτ : A.conjFactor τ) + (xστ : A.conjFactor (σ * τ)) + (xρστ : A.conjFactor (ρ * σ * τ)) : + xρ.1.1 * (xσ.1 * xτ.1) = + A.ι (ρ <| conjFactorCompCoeff xσ xτ xστ) * + A.ι (conjFactorCompCoeff xρ xστ xρστ) * + xρστ.1 := by + have eq1 : + xρ.1 * A.ι (conjFactorCompCoeff xσ xτ xστ) = + A.ι (ρ <| conjFactorCompCoeff xσ xτ xστ) * xρ.1 := by + have := xρ.2 (conjFactorCompCoeff xσ xτ xστ) + conv_rhs => rw [this, _root_.mul_assoc] + simp + conv_lhs => rw [conjFactorCompCoeff_spec (z := xστ), ← _root_.mul_assoc, eq1] + conv_rhs => rw [_root_.mul_assoc, ← conjFactorCompCoeff_spec, ← _root_.mul_assoc] + +lemma conjFactorCompCoeff_comp_comp₃ + (xρ : A.conjFactor ρ) (xσ : A.conjFactor σ) (xτ : A.conjFactor τ) + (xρσ : A.conjFactor (ρ * σ)) (xστ : A.conjFactor (σ * τ)) + (xρστ : A.conjFactor (ρ * σ * τ)) : + A.ι (conjFactorCompCoeff xρ xσ xρσ) * + A.ι (conjFactorCompCoeff xρσ xτ xρστ) * + xρστ.1 = + A.ι (ρ <| conjFactorCompCoeff xσ xτ xστ) * + A.ι (conjFactorCompCoeff xρ xστ xρστ) * + xρστ.1 := by + rw [← conjFactorCompCoeff_comp_comp₁, ← conjFactorCompCoeff_comp_comp₂, _root_.mul_assoc] + +lemma conjFactorCompCoeff_comp_comp + (xρ : A.conjFactor ρ) (xσ : A.conjFactor σ) (xτ : A.conjFactor τ) + (xρσ : A.conjFactor (ρ * σ)) (xστ : A.conjFactor (σ * τ)) + (xρστ : A.conjFactor (ρ * σ * τ)) : + conjFactorCompCoeff xρ xσ xρσ * + conjFactorCompCoeff xρσ xτ xρστ = + (ρ <| conjFactorCompCoeff xσ xτ xστ) * + conjFactorCompCoeff xρ xστ xρστ := by + apply_fun A.ι using RingHom.injective _ + simpa using conjFactorCompCoeff_comp_comp₃ xρ xσ xτ xρσ xστ xρστ + +variable (A) in +/-- The two-cocycle associated to a system of conjugating units. -/ +def toCocycles₂ (x_ : Π σ, A.conjFactor σ) : Gal(K, F) × Gal(K, F) → Kˣ := +fun p => + conjFactorCompCoeffAsUnit + (x_ p.1) + (x_ p.2) + (x_ <| p.1 * p.2) + +variable (ρ σ τ) in +lemma toCocycles₂_cond (x_ : Π σ, A.conjFactor σ) : + ρ (A.toCocycles₂ x_ (σ, τ)).1 * A.toCocycles₂ x_ (ρ, σ * τ) = + A.toCocycles₂ x_ (ρ, σ) * A.toCocycles₂ x_ (ρ * σ, τ) := by + delta toCocycles₂ + dsimp only [conjFactorCompCoeffAsUnit, AlgEquiv.mul_apply] + rw [conjFactorCompCoeff_comp_comp] + rfl + +lemma isMulCocycle₂ (x_ : Π σ, A.conjFactor σ) : + groupCohomology.IsMulCocycle₂ (A.toCocycles₂ x_) := by + intro ρ σ τ + ext : 1 + simp only [Units.val_mul] + erw [A.toCocycles₂_cond ρ σ τ] + rw [mul_comm] + +variable {σ τ : Gal(K, F)} + +lemma exists_iso : + Nonempty (A ≃ₐ[F] B) := by + obtain ⟨D, _, _, m, n, hm, hn, ⟨isoA⟩, ⟨isoB⟩⟩ := + IsBrauerEquivalent.exists_common_division_algebra F A.toCSA B.toCSA + (Quotient.eq''.1 (A.quot_eq.trans B.quot_eq.symm)) + have eq1 := isoA.toLinearEquiv.finrank_eq + have eq2 := isoB.toLinearEquiv.finrank_eq + simp only [A.dim_eq_sq, LinearEquiv.finrank_eq (matrixEquivTensor (Fin m) F D).toLinearEquiv, + Module.finrank_tensorProduct, Module.finrank_matrix, Fintype.card_fin, Module.finrank_self, + _root_.mul_one] at eq1 + simp only [B.dim_eq_sq, LinearEquiv.finrank_eq (matrixEquivTensor (Fin n) F D).toLinearEquiv, + Module.finrank_tensorProduct, Module.finrank_matrix, Fintype.card_fin, Module.finrank_self, + _root_.mul_one] at eq2 + have eq3 := eq1.symm.trans eq2 + haveI : FiniteDimensional F D := is_fin_dim_of_wdb _ _ (NeZero.ne _) _ isoB + have : 0 < Module.finrank F D := Module.finrank_pos + rw [Nat.mul_right_inj (by omega), ← pow_two, ← pow_two] at eq3 + simp only [zero_le, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, pow_left_inj₀] at eq3 + subst eq3 + exact ⟨isoA.trans isoB.symm⟩ + +/-- A chosen algebra equivalence between two representatives of the same Brauer class. -/ +def iso : A ≃ₐ[F] B := exists_iso (A := A) (B := B) |>.some + +/-- The unit conjugating the transported splitting-field embedding to the target embedding. -/ +def isoConjCoeff : Bˣ := + SkolemNoether' F B K (AlgHom.comp (A.iso B).toAlgHom A.ι) B.ι |>.choose + +lemma isoConjCoeff_spec : + ∀ r : K, B.ι r = (A.isoConjCoeff B) * (A.iso B <| A.ι r) * (A.isoConjCoeff B)⁻¹ := + SkolemNoether' F B K (AlgHom.comp (A.iso B).toAlgHom A.ι) B.ι |>.choose_spec + +lemma isoConjCoeff_spec' : + ∀ r : K, (A.isoConjCoeff B)⁻¹ * B.ι r * (A.isoConjCoeff B) = (A.iso B <| A.ι r) := by + intro c + rw [A.isoConjCoeff_spec B c] + simp [_root_.mul_assoc] + +lemma isoConjCoeff_spec'' (c : K) (x : A.conjFactor σ) : + B.ι (σ c) = + (A.isoConjCoeff B * (A.iso B <| x.1) * (A.isoConjCoeff B)⁻¹) * + B.ι c * + (A.isoConjCoeff B * (A.iso B <| x.1⁻¹.1) * (A.isoConjCoeff B)⁻¹) := by + have eq1 := congr(A.iso B $(x.2 c)) + have eq2 := A.isoConjCoeff_spec B (σ c) + simp only [eq1, map_mul] at eq2 + simp only [eq2, _root_.mul_assoc, Units.mul_right_inj] + congr 1 + simp only [← _root_.mul_assoc, Units.mul_left_inj] + congr 1 + rw [isoConjCoeff_spec'] + +/-- Transport a conjugating unit across the chosen algebra equivalence. -/ +def pushConjFactor (x : A.conjFactor σ) : B.conjFactor σ where + val := + { val := A.isoConjCoeff B * (A.iso B <| x.1) * (A.isoConjCoeff B)⁻¹ + inv := A.isoConjCoeff B * (A.iso B <| x.1⁻¹.1) * (A.isoConjCoeff B)⁻¹ + val_inv := by + simp only [← _root_.mul_assoc, Units.inv_mul_cancel_right, Units.mul_inv_eq_one] + simp only [_root_.mul_assoc, ← map_mul, Units.mul_inv, map_one, _root_.mul_one] + inv_val := by + simp only [← _root_.mul_assoc, Units.inv_mul_cancel_right, Units.mul_inv_eq_one] + simp only [_root_.mul_assoc, ← map_mul, Units.inv_mul, map_one, _root_.mul_one] } + property c := by + simp only [Units.inv_mk] + rw [isoConjCoeff_spec''] + +@[simp] lemma pushConjFactor_coe (x : A.conjFactor σ) : + (A.pushConjFactor B x).1.1 = A.isoConjCoeff B * (A.iso B <| x.1) * (A.isoConjCoeff B)⁻¹ := + rfl + +/-- The scalar comparing a transported conjugating unit with a chosen target unit. -/ +def pushConjFactorCoeff (x : A.conjFactor σ) (y : B.conjFactor σ) : K := +σ (conjFactorTwistCoeff y (A.pushConjFactor B x)) + +lemma pushConjFactorCoeff_spec (x : A.conjFactor σ) (y : B.conjFactor σ) : + y.1 = B.ι (A.pushConjFactorCoeff B x y) * (A.pushConjFactor B x).1 := + conjFactorTwistCoeff_spec' y (A.pushConjFactor B x) + +lemma pushConjFactorCoeff_spec' (x : A.conjFactor σ) (y : B.conjFactor σ) : + B.ι (A.pushConjFactorCoeff B x y) = + A.isoConjCoeff B * + A.iso B (A.ι <| A.pushConjFactorCoeff B x y) * + (A.isoConjCoeff B)⁻¹:= by + rw [isoConjCoeff_spec] + +/-- The transported-unit comparison scalar packaged as a unit. -/ +@[simps] +abbrev pushConjFactorCoeffAsUnit (x : A.conjFactor σ) (y : B.conjFactor σ) : Kˣ where + val := A.pushConjFactorCoeff B x y + inv := σ (conjFactorTwistCoeff (A.pushConjFactor B x) y) + val_inv := by simp [pushConjFactorCoeff, ← map_mul] + inv_val := by simp [pushConjFactorCoeff, ← map_mul] + +lemma compare_conjFactorCompCoeff + (xσ : A.conjFactor σ) (yσ : B.conjFactor σ) (xτ : A.conjFactor τ) (yτ : B.conjFactor τ) + (xστ : A.conjFactor (σ * τ)) (yστ : B.conjFactor (σ * τ)) : + B.conjFactorCompCoeff yσ yτ yστ * + A.pushConjFactorCoeff B xστ yστ = + A.pushConjFactorCoeff B xσ yσ * + σ (A.pushConjFactorCoeff B xτ yτ) * + A.conjFactorCompCoeff xσ xτ xστ := by + have eq1 := B.conjFactorCompCoeff_spec yσ yτ yστ + have eq2 : yσ.1.1 * yτ.1.1 = + (A.isoConjCoeff B) * + A.iso B + (A.ι (A.pushConjFactorCoeff B xσ yσ) * + xσ.1 * + A.ι (A.pushConjFactorCoeff B xτ yτ) * + xτ.1) * + (A.isoConjCoeff B)⁻¹ := by + rw [A.pushConjFactorCoeff_spec B xσ yσ, A.pushConjFactorCoeff_spec B xτ yτ, + pushConjFactorCoeff_spec', pushConjFactorCoeff_spec', + pushConjFactor_coe, pushConjFactor_coe] + simp only [_root_.mul_assoc, Units.inv_mul_cancel_left, map_mul] + rw [eq2] at eq1; clear eq2 + have eq2 : yστ.1.1 = + A.isoConjCoeff B * + (A.iso B <| A.ι (A.pushConjFactorCoeff B xστ yστ) * xστ.1) * + (A.isoConjCoeff B)⁻¹ := by + rw [A.pushConjFactorCoeff_spec B xστ yστ, pushConjFactorCoeff_spec'] + simp only [_root_.mul_assoc, AlgEquiv.mul_apply, pushConjFactor_coe, map_mul, + Units.inv_mul_cancel_left] + rw [eq2] at eq1; clear eq2 + rw [A.isoConjCoeff_spec B] at eq1 + simp only [← _root_.mul_assoc] at eq1 + conv_rhs at eq1 => + rw [_root_.mul_assoc _ _ (A.isoConjCoeff B).1, Units.inv_mul, _root_.mul_one, + _root_.mul_assoc _ _ (A.iso B _), ← map_mul] + rw [Units.mul_left_inj, Units.mul_right_inj] at eq1 + replace eq1 := (A.iso B).injective eq1 + have eq2 : xσ.1.1 * A.ι (A.pushConjFactorCoeff B xτ yτ) * xτ.1.1 = + A.ι (σ <| A.pushConjFactorCoeff B xτ yτ) * xσ.1.1 * xτ.1.1 := by + have := xσ.2 (A.pushConjFactorCoeff B xτ yτ) + rw [this] + simp [_root_.mul_assoc] + apply_fun (A.ι (A.pushConjFactorCoeff B xσ yσ) * ·) at eq2 + simp only [← _root_.mul_assoc] at eq2 + rw [eq2] at eq1; clear eq2 + simp only [_root_.mul_assoc] at eq1 + rw [A.conjFactorCompCoeff_spec xσ xτ xστ] at eq1 + simp only [← _root_.mul_assoc] at eq1 + rw [Units.mul_left_inj] at eq1 + apply_fun A.ι using RingHom.injective _ + simp only [map_mul, eq1] + +/-- The multiplicative two-coboundary associated to a one-cochain. -/ +def trivialFactorSet (c : Gal(K, F) → Kˣ) : Gal(K, F) × Gal(K, F) → Kˣ := + fun p ↦ c p.1 * Units.map p.1.toRingEquiv.toRingHom.toMonoidHom (c p.2) * (c (p.1 * p.2))⁻¹ + +lemma compare_toCocycles₂ (x_ : Π σ, A.conjFactor σ) (y_ : Π σ, B.conjFactor σ) : + B.toCocycles₂ y_ (σ, τ) * + A.pushConjFactorCoeffAsUnit B (x_ (σ * τ)) (y_ (σ * τ)) = + A.pushConjFactorCoeffAsUnit B (x_ σ) (y_ σ) * + Units.map σ (A.pushConjFactorCoeffAsUnit B (x_ τ) (y_ τ)) * + A.toCocycles₂ x_ (σ, τ) := by + delta toCocycles₂ + dsimp only + have := A.compare_conjFactorCompCoeff B + (x_ σ) (y_ σ) + (x_ τ) (y_ τ) + (x_ _) (y_ _) + simp only at this + ext : 1 + dsimp + rw [this] + +lemma compare_toCocycles₂' (x_ : Π σ, A.conjFactor σ) (y_ : Π σ, B.conjFactor σ) : + IsMulCoboundary₂ (B.toCocycles₂ y_ / A.toCocycles₂ x_) := by + fconstructor + · refine fun σ => + A.pushConjFactorCoeffAsUnit B (x_ σ) (y_ σ) + intro σ τ + dsimp only [AlgEquiv.smul_units_def, Pi.div_apply] + symm + rw [div_eq_iff_eq_mul, div_eq_mul_inv, mul_comm (Units.map _ _)] + simp only [_root_.mul_assoc] + symm + rw [inv_mul_eq_iff_eq_mul, mul_comm _ (B.toCocycles₂ y_ _)] + symm + erw [compare_toCocycles₂] + simp only [← _root_.mul_assoc] + congr 1 + rw [mul_comm] + +end GoodRep + +/-- The additive form of a multiplicative-distribution representation. -/ +@[simps!] +def _root_.Amelia.toAdditive (M G : Type 0) [Monoid M] [CommGroup G] [MulDistribMulAction M G] : + Rep.ofMulDistribMulAction M G ≃+ Additive G := AddEquiv.refl _ + +variable (F K) in +/-- The Galois action of `Gal(K/F)` on `Kˣ` as a representation. -/ +noncomputable def galAct : Rep ℤ Gal(K, F) := .ofMulDistribMulAction Gal(K, F) Kˣ + +@[simp] lemma galAct_ρ_apply (σ : Gal(K, F)) (x : Kˣ) : + (galAct F K).ρ σ (.ofMul x) = .ofMul (x.map σ) := rfl + +variable [FiniteDimensional F K] + +lemma mem_relativeBrGroup_iff_nonempty_goodRep {X : BrauerGroup F} : + X ∈ RelativeBrGroup K F ↔ Nonempty (GoodRep K X) := by + induction X using Quotient.inductionOn' with | h X => + simp only [RelativeBrGroup, MonoidHom.mem_ker, MonoidHom.coe_mk, OneHom.coe_mk, + Quotient.map'_mk''] + erw [← split_iff] + rw [isSplit_iff_dimension] + constructor + · rintro ⟨A, eq, i, dim⟩ + exact ⟨⟨A, eq.symm, i, dim.symm⟩⟩ + · rintro ⟨⟨A, eq, i, dim⟩⟩ + exact ⟨A, eq.symm, i, dim.symm⟩ + +/-- Choose a good representative for an element of the relative Brauer group. -/ +def RelativeBrGroup.goodRep (X : RelativeBrGroup K F) : GoodRep K X.1 := + mem_relativeBrGroup_iff_nonempty_goodRep.1 X.2 |>.some + +open groupCohomology + +namespace GoodRep + +variable {X : BrauerGroup F} (A : GoodRep K X) + +open groupCohomology in +/-- The cohomology class attached to a good representative and a system of conjugating units. -/ +def toH2 (x_ : Π σ, A.conjFactor σ) : H2 (galAct F K) := + H2π (galAct F K) <| cocyclesOfIsMulCocycle₂ (A.isMulCocycle₂ x_) + +end GoodRep + +/-- Send a relative Brauer class to its degree-two Galois cohomology class. -/ +def RelativeBrGroup.toSnd : RelativeBrGroup K F → groupCohomology.H2 (galAct F K) := + fun X ↦ (goodRep X).toH2 (goodRep X).arbitraryConjFactor + +lemma RelativeBrGroup.toSnd_wd (X : RelativeBrGroup K F) + (A : GoodRep K X.1) (x_ : Π σ, A.conjFactor σ) : + toSnd X = A.toH2 x_ := by + simp only [toSnd, GoodRep.toH2] + change H2π _ _ = H2π _ _ + rw [← sub_eq_zero, ← map_sub] + rw [H2π_eq_zero_iff] + set lhs := _; change lhs ∈ _ + have : IsMulCoboundary₂ (G := Gal(K, F)) (M := Kˣ) (lhs) := by + apply GoodRep.compare_toCocycles₂' + exact coboundariesOfIsMulCoboundary₂ this |>.2 + +namespace GoodRep + +variable {X : BrauerGroup F} (A : GoodRep K X) + +omit [FiniteDimensional F K] in +lemma conjFactor_linearIndependent (x_ : Π σ, A.conjFactor σ) : + LinearIndependent K (v := fun (i : Gal(K, F)) => (x_ i).1.1) := by + classical + by_contra! rid + obtain ⟨J, LI, maximal⟩ := exists_maximal_linearIndepOn K (fun (i : Gal(K, F)) => (x_ i).1.1) + have ne : J ≠ Set.univ := by + rintro rfl + refine rid ?_ + let e : (Set.univ : Set Gal(K, F)) ≃ Gal(K, F) := Equiv.Set.univ Gal(K, F) + have := linearIndependent_equiv e.symm |>.2 LI + exact this + rw [Set.ne_univ_iff_exists_notMem] at ne + obtain ⟨σ, hσ⟩ := ne + obtain ⟨c, c_ne_zero, hc⟩ := maximal σ hσ + let B := Basis.span LI + replace hc := Submodule.smul_mem _ c⁻¹ hc + rw [← mul_smul, inv_mul_cancel₀ c_ne_zero, one_smul] at hc + clear c c_ne_zero + have mem1 : (x_ σ).1.1 ∈ Submodule.span K (Set.range fun (σ : J) ↦ (x_ σ.1).1.1) := by + convert hc; aesop + have eq0 : (⟨(x_ σ).1.1, mem1⟩ : Submodule.span K (Set.range fun (σ : J) ↦ (x_ σ.1).1.1)) = + ∑ τ ∈ (B.repr ⟨_, mem1⟩).support, B.repr ⟨_, mem1⟩ τ • (x_ τ).1.1 := by + conv_lhs => rw [← B.linearCombination_repr ⟨(x_ σ).1.1, mem1⟩, Finsupp.linearCombination_apply, + Finsupp.sum] + rw [AddSubmonoidClass.coe_finset_sum] + refine Finset.sum_congr rfl fun i _ => ?_ + simp only [SetLike.val_smul, smul_def] + congr 1 + simp only [B, Basis.span_apply] + simp only [smul_def] at eq0 + have eq1 (c : K) := calc A.ι (σ c) * (x_ σ).1.1 + _ = (x_ σ).1.1 * A.ι c := by + rw [(x_ σ).2 c]; simp [_root_.mul_assoc] + _ = ∑ τ ∈ (B.repr ⟨_, mem1⟩).support, + A.ι (B.repr ⟨_, mem1⟩ τ) * (x_ τ).1.1 * A.ι c := by + conv_lhs => rw [eq0, Finset.sum_mul] + _ = ∑ τ ∈ (B.repr ⟨_, mem1⟩).support, + A.ι (B.repr ⟨_, mem1⟩ τ) * A.ι (τ.1 c) * (x_ τ).1.1 := + Finset.sum_congr rfl fun i _ => by + simp only [_root_.mul_assoc] + congr 1 + rw [(x_ i).2 c] + simp [_root_.mul_assoc, Units.inv_mul, _root_.mul_one] + _ = ∑ τ ∈ (B.repr ⟨_, mem1⟩).support, + A.ι (B.repr ⟨_, mem1⟩ τ * τ.1 c) * (x_ τ).1.1 := + Finset.sum_congr rfl fun i _ => by rw [map_mul] + have eq2 (c : K) := calc A.ι (σ c) * (x_ σ).1.1 + _ = ∑ τ ∈ (B.repr ⟨_, mem1⟩).support, + A.ι (σ c * (B.repr ⟨_, mem1⟩) τ) * (x_ τ).1.1 := by + conv_lhs => rw [eq0, Finset.mul_sum] + simp_rw [map_mul, _root_.mul_assoc] + have eq3 (c : K) : + ∑ τ ∈ (B.repr ⟨_, mem1⟩).support, + A.ι (B.repr ⟨_, mem1⟩ τ * τ.1 c) * (x_ τ).1.1 = + ∑ τ ∈ (B.repr ⟨_, mem1⟩).support, + A.ι (σ c * (B.repr ⟨_, mem1⟩) τ) * (x_ τ).1.1 := + eq1 c |>.symm.trans <| eq2 c + have eq4 (c : K) : + ∑ τ ∈ (B.repr ⟨_, mem1⟩).support, + A.ι (B.repr ⟨_, mem1⟩ τ * τ.1 c - σ c * (B.repr ⟨_, mem1⟩) τ) * (x_ τ).1.1 = 0 := by + simp only [map_sub, map_mul, sub_mul, Finset.sum_sub_distrib] + simp only [← map_mul, eq3, sub_self] + have eq5 (c : K) : + ∑ τ ∈ (B.repr ⟨_, mem1⟩).support, + (B.repr ⟨_, mem1⟩ τ * τ.1 c - σ c * (B.repr ⟨_, mem1⟩) τ) • (x_ τ).1.1 = 0 := by + rw [← eq4] + rfl + have eq6 (c : K) := linearIndependent_iff'' |>.1 LI (B.repr ⟨_, mem1⟩).support + (fun τ => B.repr ⟨_, mem1⟩ τ * τ.1 c - σ c * (B.repr ⟨_, mem1⟩) τ) + (by + intro i hi + simp only [Finsupp.mem_support_iff, ne_eq, Decidable.not_not] at hi + simp only [hi, zero_mul, mul_zero, sub_self]) (eq5 c) + simp only [sub_eq_zero, Subtype.forall] at eq6 + have : (B.repr ⟨_, mem1⟩).support ≠ ∅ := by + intro rid + simp only [rid, Finset.sum_empty, Units.ne_zero] at eq0 + obtain ⟨τ, τ_mem⟩ := Finset.nonempty_of_ne_empty this + have eq7 : σ = τ := by + ext c + specialize eq6 c τ τ.2 + rw [mul_comm] at eq6 + simp only [Subtype.coe_eta, mul_eq_mul_right_iff] at eq6 + refine eq6.recOn Eq.symm fun rid ↦ ?_ + simp only [Finsupp.mem_support_iff, ne_eq] at τ_mem + contradiction + subst eq7 + exact hσ τ.2 + +private lemma conjFactor_linearIndependent_boundary : True := by + trivial + +variable [IsGalois F K] in +/-- The basis of a good representative obtained from conjugating units. -/ +def conjFactorBasis (x_ : Π σ, A.conjFactor σ) : Basis Gal(K, F) K A := + basisOfLinearIndependentOfCardEqFinrank + (b := fun (i : Gal(K, F)) => (x_ i).1.1) + (A.conjFactor_linearIndependent x_) + (by rw [A.dim_eq', Fintype.card_eq_nat_card, IsGalois.card_aut_eq_finrank]) + +end GoodRep + +namespace RelativeBrGroup + +open CrossProductAlgebra + +variable [IsGalois F K] [DecidableEq Gal(K, F)] in +/-- Build a relative Brauer class from a two-cocycle via the cross-product algebra. -/ +noncomputable def fromCocycles₂ (f : cocycles₂ (galAct F K)) : RelativeBrGroup K F := + haveI := groupCohomology.isMulCocycle₂_of_mem_cocycles₂ _ f.2 + haveI : Fact (IsMulCocycle₂ (M := Kˣ) (Additive.toMul ∘ f)) := ⟨this⟩ + ⟨Quotient.mk'' (asCSA (⇑Additive.toMul ∘ f.1)), mem_relativeBrGroup_iff_nonempty_goodRep.2 <| + ⟨⟨asCSA (Additive.toMul ∘ f), rfl, incl (Additive.toMul ∘ f), dim_eq_sq⟩⟩⟩ + +open CategoryTheory in +variable [IsGalois F K] [DecidableEq Gal(K, F)] in +variable (F K) in +/-- Descend the cross-product construction to second cohomology. -/ +noncomputable def fromSnd : + (groupCohomology.shortComplexH2 (galAct F K)).moduleCatLeftHomologyData.H + -- H2 (galAct F K) + → RelativeBrGroup K F := + -- ShortComplex.descHomology _ (groupCohomology.isoCocycles₂ (galAct F K) ≫ )--_ _ _ + -- sorry + Quotient.lift fromCocycles₂ <| by + rintro ⟨(a : _ → Kˣ), ha⟩ ⟨(b : _ → Kˣ), hb⟩ (hab : Submodule.quotientRel _ _ _) + have H' : H2π (galAct F K) ⟨a, ha⟩ - H2π (galAct F K) ⟨b, hb⟩ = 0 := by + rw [← map_sub, H2π_eq_zero_iff] + simp only [Submodule.quotientRel_def, LinearMap.mem_range] at hab + obtain ⟨y, hy⟩ := hab + use y + exact congrArg Subtype.val hy + rw [← map_sub, H2π_eq_zero_iff] at H' + have ha : Fact <| IsMulCocycle₂ a := ⟨isMulCocycle₂_of_mem_cocycles₂ a ha⟩ + have hb : Fact <| IsMulCocycle₂ b := ⟨isMulCocycle₂_of_mem_cocycles₂ b hb⟩ + have hc : IsMulCoboundary₂ (G := Gal(K, F)) (M := Kˣ) (a / b) := + isMulCoboundary₂_of_mem_coboundaries₂ _ H' + obtain ⟨c, hc⟩ := hc + simp only [fromCocycles₂, Subtype.mk.injEq, Quotient.eq''] + let A := asCSA a + let B := asCSA b + change IsBrauerEquivalent A B + letI : Module K A := inferInstanceAs <| Module K (CrossProductAlgebra a) + letI : Module K B := inferInstanceAs <| Module K (CrossProductAlgebra b) + let basis : Basis Gal(K, F) K B := (basis (f := b)).unitsSMul c + let φ0 : A ≃ₗ[K] B := CrossProductAlgebra.basis.equiv basis (.refl _) + haveI : LinearMap.CompatibleSMul A B F K := by + constructor + have eq (c : F) (a : A) : c • a = algebraMap F K c • a := by + apply val_injective + change c • a.val = (algebraMap F K c) • a.val + induction a.val using Finsupp.induction_linear with + | zero => simp + | add f g _ _ => simp_all + | single σ k => simp + have eq' (c : F) (a : B) : c • a = algebraMap F K c • a := by + apply val_injective + change c • a.val = (algebraMap F K c) • a.val + induction a.val using Finsupp.induction_linear with + | zero => simp + | add f g _ _ => simp_all + | single σ k => simp + intro l c a + rw [eq, eq', map_smul] + let φ1 : A ≃ₗ[F] B := φ0.restrictScalars F + let φ2 : A ≃ₐ[F] B := AlgEquiv.ofLinearEquiv φ1 + (by + change φ0 1 = 1 + rw [show (1 : A) = (a (1, 1))⁻¹.1 • (CrossProductAlgebra.basis 1 : A) by + apply val_injective + change (1 : CrossProductAlgebra a).val = + ((a (1, 1))⁻¹.1 • (CrossProductAlgebra.basis 1 : CrossProductAlgebra a)).val + simp [CrossProductAlgebra.basis, CrossProductAlgebra.val_one, + CrossProductAlgebra.val_smul]] + refine (φ0.map_smul ((↑(a (1, 1))⁻¹) : K) + (CrossProductAlgebra.basis 1 : A)).trans ?_ + rw [show φ0 (CrossProductAlgebra.basis 1 : A) = + basis ((Equiv.refl Gal(K, F)) 1) by + exact Basis.equiv_apply (b := (CrossProductAlgebra.basis : Basis Gal(K, F) K A)) + (b' := basis) (e := Equiv.refl Gal(K, F)) 1] + apply val_injective + change ((↑((a (1, 1))⁻¹) : K) • + (basis ((Equiv.refl Gal(K, F)) 1) : CrossProductAlgebra b)).val = + (1 : CrossProductAlgebra b).val + simp only [Equiv.refl_apply, Units.val_inv_eq_inv_val, basis, B, + CrossProductAlgebra.val_one] + change ((↑(a (1, 1)))⁻¹ : K) • + ((CrossProductAlgebra.basis.unitsSMul c) 1).val = + Finsupp.single 1 (↑(b (1, 1)))⁻¹ + conv_lhs => enter [2, 1]; erw [Basis.unitsSMul_apply] + erw [CrossProductAlgebra.val_smul] + simp only [CrossProductAlgebra.basis, Basis.coe_ofRepr, valLinearEquiv_symm_apply, + AddEquiv.toEquiv_eq_coe, Equiv.invFun_as_coe, AddEquiv.coe_toEquiv_symm, + valAddEquiv_symm_apply_val, Finsupp.smul_single, smul_eq_mul, _root_.mul_one] + congr 1 + specialize hc 1 1 + simp only [one_smul, _root_.mul_one, div_self', _root_.one_mul, Pi.div_apply, + div_eq_mul_inv] at hc + simp [hc]) + (by + intro α β + change φ0 ((⟨α.val⟩ : CrossProductAlgebra a) * (⟨β.val⟩ : CrossProductAlgebra a)) = + φ0 (⟨α.val⟩ : CrossProductAlgebra a) * φ0 (⟨β.val⟩ : CrossProductAlgebra a) + induction α.val using Finsupp.induction_linear with + | zero => change φ0 (0 * _) = φ0 0 * _; simp + | add f g hf hg => + change φ0 ((_ + _) * _) = φ0 (_ + _) * φ0 _ + rw [add_mul] + simpa [map_add, add_mul] using + congrArg (fun z => z) (by exact congrArg₂ HAdd.hAdd hf hg) + | single σ k1 => + induction β.val using Finsupp.induction_linear with + | zero => change φ0 (_ * 0) = _ * φ0 0; simp + | add f g hf hg => + change φ0 (_ * (_ + _)) = φ0 _ * φ0 (_ + _) + rw [mul_add] + simpa [map_add, mul_add] using + congrArg (fun z => z) (by exact congrArg₂ HAdd.hAdd hf hg) + | single τ k2 => + change φ0 (⟨mulLinearMap a _ _⟩ : CrossProductAlgebra a) = _ + simp only [mulLinearMap_single_single, *] + rw [← mul_one (k1 * σ k2 * ↑(a (σ, τ))), ← smul_eq_mul _ 1, ← Finsupp.smul_single, + show (⟨_ • .single _ 1⟩ : CrossProductAlgebra a) = + (k1 * σ k2 * ↑(a (σ, τ))) • (CrossProductAlgebra.basis (σ * τ)) by + apply val_injective; simp [CrossProductAlgebra.basis], + show (⟨.single σ k1⟩ : CrossProductAlgebra a) = k1 • (CrossProductAlgebra.basis σ) by + apply val_injective; simp [CrossProductAlgebra.basis], + show (⟨.single τ k2⟩ : CrossProductAlgebra a) = k2 • (CrossProductAlgebra.basis τ) by + apply val_injective; simp [CrossProductAlgebra.basis]] + refine (φ0.map_smul ((k1 * σ k2 * ↑(a (σ, τ))) : K) + (CrossProductAlgebra.basis (σ * τ) : A)).trans ?_ + refine Eq.trans ?_ (congrArg₂ HMul.hMul + (φ0.map_smul ((k1 : K)) (CrossProductAlgebra.basis σ : A)).symm + (φ0.map_smul ((k2 : K)) (CrossProductAlgebra.basis τ : A)).symm) + rw [show φ0 (CrossProductAlgebra.basis (σ * τ) : A) = + basis ((Equiv.refl Gal(K, F)) (σ * τ)) by + exact Basis.equiv_apply (b := (CrossProductAlgebra.basis : Basis Gal(K, F) K A)) + (b' := basis) (e := Equiv.refl Gal(K, F)) (σ * τ), + show φ0 (CrossProductAlgebra.basis σ : A) = + basis ((Equiv.refl Gal(K, F)) σ) by + exact Basis.equiv_apply (b := (CrossProductAlgebra.basis : Basis Gal(K, F) K A)) + (b' := basis) (e := Equiv.refl Gal(K, F)) σ, + show φ0 (CrossProductAlgebra.basis τ : A) = + basis ((Equiv.refl Gal(K, F)) τ) by + exact Basis.equiv_apply (b := (CrossProductAlgebra.basis : Basis Gal(K, F) K A)) + (b' := basis) (e := Equiv.refl Gal(K, F)) τ] + simp only [Equiv.refl_apply] + apply val_injective + change (((k1 * σ k2 * ↑(a (σ, τ))) : K) • + (basis (σ * τ) : CrossProductAlgebra b)).val = + (((k1 : K) • (basis σ : CrossProductAlgebra b)) * + ((k2 : K) • (basis τ : CrossProductAlgebra b))).val + change ((k1 * σ k2 * ↑(a (σ, τ))) : K) • (basis (σ * τ)).val = + CrossProductAlgebra.mulLinearMap b ((k1 : K) • (basis σ).val) + ((k2 : K) • (basis τ).val) + unfold basis + erw [Basis.unitsSMul_apply, Basis.unitsSMul_apply, Basis.unitsSMul_apply] + erw [CrossProductAlgebra.val_smul, CrossProductAlgebra.val_smul, + CrossProductAlgebra.val_smul] + simp only [CrossProductAlgebra.basis, Basis.coe_ofRepr, valLinearEquiv_symm_apply, + AddEquiv.toEquiv_eq_coe, Equiv.invFun_as_coe, AddEquiv.coe_toEquiv_symm, + valAddEquiv_symm_apply_val, Finsupp.smul_single, smul_eq_mul, _root_.mul_one, + mulLinearMap_single_single, map_mul] + congr 1 + specialize hc σ τ + simp only [AlgEquiv.smul_units_def, Pi.div_apply, Units.ext_iff, Units.val_mul, + Units.val_div_eq_div_val, Units.coe_map, MonoidHom.coe_coe] at hc + simp only [_root_.mul_assoc] + congr 1 + rw [mul_comm (c σ).1, _root_.mul_assoc] + congr 1 + field_simp at hc + field_simp [hc, mul_comm] + convert hc.symm using 1 <;> ring) + apply IsBrauerEquivalent.iso_to_eqv (h := φ2) + +variable [IsGalois F K] +lemma fromSnd_wd (a : cocycles₂ (galAct F K)) : + haveI : Fact (IsMulCocycle₂ (M := Kˣ) (Additive.toMul ∘ a)) := + ⟨isMulCocycle₂_of_mem_cocycles₂ _ a.2⟩ + (fromSnd F K <| Quotient.mk'' a) = + ⟨Quotient.mk'' (CrossProductAlgebra.asCSA (Additive.toMul ∘ a)), + mem_relativeBrGroup_iff_nonempty_goodRep.2 + ⟨_, rfl, CrossProductAlgebra.incl _, CrossProductAlgebra.dim_eq_sq⟩⟩ := rfl + +/-- Convert a multiplicative two-coboundary witness into an additive cohomology coboundary. -/ +def _root_.Amfix.coboundariesOfIsMulCoboundary₂ {G M : Type} [Group G] [CommGroup M] + [MulDistribMulAction G M] {f : G × G → M} (hf : IsMulCoboundary₂ f) : + coboundaries₂ (Rep.ofMulDistribMulAction G M) := + ⟨Additive.ofMul ∘ f, hf.choose, funext fun g ↦ hf.choose_spec g.1 g.2⟩ + +open GoodRep groupCohomology in +lemma toSnd_fromSnd : toSnd ∘ fromSnd F K ∘ (H2Iso (galAct F K)).hom = id := by + ext a + induction a using H2_induction_on with | h a => + -- rcases a with ⟨(a : _ → Kˣ), ha'⟩ + let am := Additive.toMul ∘ Amelia.toAdditive _ _ ∘ a + have ha : IsMulCocycle₂ am := + isMulCocycle₂_of_mem_cocycles₂ _ (by simpa using a.2) + haveI : Fact (IsMulCocycle₂ am) := ⟨ha⟩ + simp only [Function.comp_apply, id_eq] + let A : GoodRep K (Quotient.mk'' <| CrossProductAlgebra.asCSA am) := + ⟨CrossProductAlgebra.asCSA am, rfl, CrossProductAlgebra.incl am, CrossProductAlgebra.dim_eq_sq⟩ + let y_ σ : A.conjFactor σ := + ⟨CrossProductAlgebra.of am σ, + fun c ↦ by erw [CrossProductAlgebra.of_conj]; rfl⟩ + simp only [CategoryTheory.ShortComplex.moduleCatLeftHomologyData_H, H2π, ModuleCat.hom_comp, + LinearMap.coe_comp, Function.comp_apply, π_comp_H2Iso_hom_apply, + CategoryTheory.Iso.inv_hom_id_apply] + change toSnd (fromSnd F K (Quotient.mk'' a)) = + (ModuleCat.Hom.hom (π (galAct F K) 2)) ((ModuleCat.Hom.hom (isoCocycles₂ (galAct F K)).inv) a) + rw [fromSnd_wd] + rw [toSnd_wd _ _ y_] + -- rw [toSnd_wd (fromSnd F K _)] + let b : Gal(K, F) × Gal(K, F) → Kˣ := A.toCocycles₂ y_ + -- rw [show A.toH2 y_ = Quotient.mk'' ⟨b, _⟩ by rfl] + -- rw [Quotient.eq''] + -- change (twoCoboundaries (galAct F K)).quotientRel.r _ _ + change H2π _ _ = H2π _ _ + rw [← sub_eq_zero, ← map_sub, H2π_eq_zero_iff] + -- rw [Submodule.quotientRel_def] + suffices H : IsMulCoboundary₂ _ from + (Amfix.coboundariesOfIsMulCoboundary₂ H).2 + refine ⟨fun _ => 1, ?_⟩ + intro σ τ + simp only [smul_one, div_self', _root_.mul_one, cocyclesOfIsMulCocycle₂_coe, Function.comp_apply, + cocycles₂.val_eq_coe] + -- change _ = (Additive.toMul _) / (am (σ, τ)) + erw [Equiv.symm_apply_apply] + simp only [toCocycles₂, conjFactorCompCoeffAsUnit] + -- change _ = _ / _ + ext : 1 + simp only [Units.val_one, Units.val_div_eq_div_val] + field_simp + change (am (σ, τ)).1 = _ + -- simp [conjFactorCompCoeff, conjFactorTwistCoeff] + -- simp only [AlgEquiv.mul_apply, y_] + change _ = A.conjFactorCompCoeff (y_ σ) (y_ τ) (y_ (σ * τ)) + apply_fun A.ι using RingHom.injective _ + rw [conjFactorCompCoeff_spec''] + simp only [A, y_] + calc + (CrossProductAlgebra.incl am) ↑(am (σ, τ)) = + (CrossProductAlgebra.incl am) ↑(am (σ, τ)) * (1 : CrossProductAlgebra am) := by + simp + _ = (CrossProductAlgebra.incl am) ↑(am (σ, τ)) * + ((CrossProductAlgebra.of am (σ * τ)).val * ↑(CrossProductAlgebra.of am (σ * τ))⁻¹) := by + rw [Units.mul_inv] + _ = _ := by + rw [← _root_.mul_assoc, ← CrossProductAlgebra.of_mul_of] + rfl + +lemma fromSnd_toSnd : (fromSnd F K ∘ (H2Iso (galAct F K)).hom) ∘ toSnd = id := by + ext X + obtain ⟨A⟩ := mem_relativeBrGroup_iff_nonempty_goodRep.1 X.2 + simp only [Function.comp_apply, id_eq, SetLike.coe_eq_coe] + rw [toSnd_wd (A := A) (x_ := A.arbitraryConjFactor)] + ext : 1 + conv_rhs => rw [← A.quot_eq] + simp only [CategoryTheory.ShortComplex.moduleCatLeftHomologyData_H, GoodRep.toH2, H2π, + ModuleCat.hom_comp, LinearMap.coe_comp, Function.comp_apply, π_comp_H2Iso_hom_apply, + CategoryTheory.Iso.inv_hom_id_apply] + change (fromSnd F K + (Quotient.mk'' (cocyclesOfIsMulCocycle₂ (GoodRep.isMulCocycle₂ + A.arbitraryConjFactor)))).1 = Quotient.mk'' A.toCSA + rw [fromSnd_wd] + rw [Quotient.eq''] + apply IsBrauerEquivalent.iso_to_eqv + set f : Gal(K, F) × Gal(K, F) → Kˣ := + Additive.toMul ∘ cocyclesOfIsMulCocycle₂ (GoodRep.isMulCocycle₂ + A.arbitraryConjFactor) + haveI : Fact (IsMulCocycle₂ f) := by + subst f + exact ⟨isMulCocycle₂_of_mem_cocycles₂ _ (cocyclesOfIsMulCocycle₂ + (GoodRep.isMulCocycle₂ A.arbitraryConjFactor)).2⟩ + change CrossProductAlgebra f ≃ₐ[F] A + letI : Module K (CrossProductAlgebra f) := inferInstance + let φ0 : CrossProductAlgebra f ≃ₗ[K] A := + CrossProductAlgebra.basis.equiv (A.conjFactorBasis A.arbitraryConjFactor) (.refl _) + haveI : LinearMap.CompatibleSMul (CrossProductAlgebra f) A F K := by + constructor + have eq (c : F) (a : A) : c • a = algebraMap F K c • a := by + simp only [algebraMap_smul] + have eq' (c : F) (a : CrossProductAlgebra f) : c • a = algebraMap F K c • a := by + apply CrossProductAlgebra.val_injective + change c • a.val = (algebraMap F K c) • a.val + induction a.val using Finsupp.induction_linear with + | zero => simp + | add f g _ _ => simp_all + | single σ k => simp + intro l c a + rw [eq, eq', map_smul] + let φ1 : CrossProductAlgebra f ≃ₗ[F] A := φ0.restrictScalars F + refine AlgEquiv.ofLinearEquiv φ1 ?_ ?_ + · change φ0 1 = 1 + conv_lhs => + enter [2] + rw [show (1 : CrossProductAlgebra f) = + ((A.toCocycles₂ A.arbitraryConjFactor) (1, 1))⁻¹.1 • (CrossProductAlgebra.basis 1) by + apply CrossProductAlgebra.val_injective + change (1 : CrossProductAlgebra f).val = + (((A.toCocycles₂ A.arbitraryConjFactor) (1, 1))⁻¹.1 • + (CrossProductAlgebra.basis 1 : CrossProductAlgebra f)).val + simp [f, CrossProductAlgebra.basis, CrossProductAlgebra.val_one, + CrossProductAlgebra.val_smul, GoodRep.toCocycles₂] + congr 1] + refine (φ0.map_smul ((↑(A.toCocycles₂ A.arbitraryConjFactor (1, 1))⁻¹) : K) + (CrossProductAlgebra.basis 1 : CrossProductAlgebra f)).trans ?_ + simp only [φ0] + erw [Basis.equiv_apply] + simp only [Units.val_inv_eq_inv_val, GoodRep.conjFactorBasis, + Equiv.refl_apply, coe_basisOfLinearIndependentOfCardEqFinrank, AlgEquiv.one_apply, + GoodRep.smul_def] + change A.ι (A.toCocycles₂ _ (1, 1))⁻¹ * _ = 1 + simp only [GoodRep.toCocycles₂, GoodRep.conjFactorCompCoeffAsUnit, AlgEquiv.one_apply] + have := A.conjFactorCompCoeff_spec' (A.arbitraryConjFactor 1) + (A.arbitraryConjFactor 1) + (A.arbitraryConjFactor (1 * 1)) + simp only [AlgEquiv.one_apply, AlgEquiv.mul_apply] at this + rw [GoodRep.conjFactorCompCoeff_inv] + erw [_root_.one_mul] + simp only [AlgEquiv.one_apply, ← _root_.mul_assoc, Units.mul_inv, _root_.one_mul, Units.inv_mul] + · intro x y + change φ0 (⟨x.val⟩ * ⟨y.val⟩) = φ0 ⟨x.val⟩ * φ0 ⟨y.val⟩ + induction x.val using Finsupp.induction_linear with + | zero => change φ0 (0 * _) = φ0 0 * _; simp + | add f g hf hg => + change φ0 ((_ + _) * _) = φ0 (_ + _) * φ0 _ + rw [add_mul, map_add] + change φ0 ({ val := f } * { val := y.val }) + + φ0 ({ val := g } * { val := y.val }) = + φ0 ({ val := f } + { val := g }) * φ0 { val := y.val } + rw [hf, hg, map_add, add_mul] + | single σ a => + induction y.val using Finsupp.induction_linear with + | zero => change φ0 (_ * 0) = _ * φ0 0; simp + | add f g hf hg => + change φ0 (_ * (_ + _)) = φ0 _ * φ0 (_ + _) + rw [mul_add, map_add] + change φ0 ({ val := Finsupp.single σ a } * { val := f }) + + φ0 ({ val := Finsupp.single σ a } * { val := g }) = + φ0 { val := Finsupp.single σ a } * φ0 ({ val := f } + { val := g }) + rw [hf, hg, map_add, mul_add] + | single τ b => + change φ0 (⟨CrossProductAlgebra.mulLinearMap f _ _⟩ : CrossProductAlgebra f) = _ + simp only [CrossProductAlgebra.mulLinearMap_single_single, *] + rw [← mul_one (a * σ b * _), ← smul_eq_mul _ 1, ← Finsupp.smul_single, + show (⟨_ • .single _ 1⟩ : CrossProductAlgebra f) = + (a * σ b * (f (σ, τ)).1) • (CrossProductAlgebra.basis (σ * τ)) by + apply CrossProductAlgebra.val_injective; simp [CrossProductAlgebra.basis], + show (⟨.single σ a⟩ : CrossProductAlgebra f) = a • (CrossProductAlgebra.basis σ) by + apply CrossProductAlgebra.val_injective; simp [CrossProductAlgebra.basis], + show (⟨.single τ b⟩ : CrossProductAlgebra f) = b • (CrossProductAlgebra.basis τ) by + apply CrossProductAlgebra.val_injective; simp [CrossProductAlgebra.basis]] + refine (φ0.map_smul ((a * σ b * ↑(f (σ, τ))) : K) + (CrossProductAlgebra.basis (σ * τ) : CrossProductAlgebra f)).trans ?_ + refine Eq.trans ?_ (congrArg₂ HMul.hMul + (φ0.map_smul ((a : K)) (CrossProductAlgebra.basis σ : CrossProductAlgebra f)).symm + (φ0.map_smul ((b : K)) (CrossProductAlgebra.basis τ : CrossProductAlgebra f)).symm) + erw [Basis.equiv_apply, Basis.equiv_apply, Basis.equiv_apply] + simp only [Equiv.refl_apply] + simp only [f, Function.comp_apply, GoodRep.conjFactorBasis, + coe_basisOfLinearIndependentOfCardEqFinrank, AlgEquiv.mul_apply, GoodRep.smul_def, + map_mul] + change _ * _ * A.ι (A.toCocycles₂ _ (σ, τ)) * _ = _ + simp only [GoodRep.toCocycles₂, GoodRep.conjFactorCompCoeffAsUnit, _root_.mul_assoc] + erw [A.conjFactorCompCoeff_spec''] + simp only [_root_.mul_assoc] + simp only [AlgEquiv.mul_apply, Units.inv_mul, _root_.mul_one, ← _root_.mul_assoc] + congr 1 + simp only [_root_.mul_assoc] + congr 1 + rw [(A.arbitraryConjFactor _).2 b] + simp [-GoodRep.conjFactor_prop] + +/-- The equivalence between the relative Brauer group and second Galois cohomology. -/ +@[simp] +def equivSnd : RelativeBrGroup K F ≃ H2 (galAct F K) where + toFun := toSnd + invFun := (fromSnd F K ∘ (H2Iso (galAct F K)).hom) + left_inv := congr_fun fromSnd_toSnd + right_inv := congr_fun toSnd_fromSnd + +end RelativeBrGroup From bb8843d12d01a6156d46d5c3e3fdab7a0b546f90 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 18:45:47 -0700 Subject: [PATCH 26/34] Port BrauerGroup additive cohomology isomorphism --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew.lean | 1 + LeanPool/BrauerGroupNew/IsoSecond.lean | 1102 ++++++++++++++++++++++++ 3 files changed, 1104 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/IsoSecond.lean diff --git a/LeanPool.lean b/LeanPool.lean index a67de1d544..9993249274 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -66,6 +66,7 @@ import LeanPool.BrauerGroupNew.Examples.ShortComplex.LeftHomologyMapData import LeanPool.BrauerGroupNew.ExtendScalar import LeanPool.BrauerGroupNew.FieldCat import LeanPool.BrauerGroupNew.FiniteField +import LeanPool.BrauerGroupNew.IsoSecond import LeanPool.BrauerGroupNew.LemmasAboutSimpleRing import LeanPool.BrauerGroupNew.Mathlib import LeanPool.BrauerGroupNew.Mathlib.Algebra diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index e6df5a1f4a..a0474ecc0e 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -28,6 +28,7 @@ import LeanPool.BrauerGroupNew.ZeroSevenFourE import LeanPool.BrauerGroupNew.RelativeBrauer import LeanPool.BrauerGroupNew.SkolemNoether import LeanPool.BrauerGroupNew.ToSecond +import LeanPool.BrauerGroupNew.IsoSecond import LeanPool.BrauerGroupNew.DoubleCentralizer import LeanPool.BrauerGroupNew.Mathlib import LeanPool.BrauerGroupNew.Subfield diff --git a/LeanPool/BrauerGroupNew/IsoSecond.lean b/LeanPool/BrauerGroupNew/IsoSecond.lean new file mode 100644 index 0000000000..98aae00097 --- /dev/null +++ b/LeanPool/BrauerGroupNew/IsoSecond.lean @@ -0,0 +1,1102 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.RepresentationTheory.Homological.GroupCohomology.LowDegree +import LeanPool.BrauerGroupNew.ToSecond + +suppress_compilation + +open Module +open scoped TensorProduct + +universe u +variable (K F : Type) [Field K] [Field F] [Algebra F K] + +-- namespace map_one_proof +-- section map_one + +-- variable [FiniteDimensional F K] [IsGalois F K] [DecidableEq Gal(K, F)] + +-- -- def φ0 : +-- CrossProduct (F := F) (K := K) (a := 1) +-- (ha := isMulCocycle₂_of_mem_cocycles₂ 0 <| Submodule.zero_mem _) →ₗ[K] +-- Module.End F K := +-- (CrossProductAlgebra.x_AsBasis (F := F) (K := K) (a := 1) +-- (ha := isMulCocycle₂_of_mem_cocycles₂ 0 <| Submodule.zero_mem _)).constr F +-- fun σ => σ.toLinearMap + +-- def φ1 : +-- CrossProductAlgebra (F := F) (K := K) (a := 1) (ha := isMulCocycle₂_of_cocycles₂ 0) →ₗ[F] +-- Module.End F K := +-- φ0 K F |>.restrictScalars F + +-- def φ3 : +-- CrossProductAlgebra (F := F) (K := K) (a := 1) (ha := isMulCocycle₂_of_cocycles₂ 0) ≃ₐ[F] +-- Module.End F K := +-- AlgEquiv.ofBijective (φ2 K F) (bijective_of_dim_eq_of_isCentralSimple _ _ _ _ <| by +-- rw [CrossProductAlgebra.dim_eq_sq] +-- rw [Module.finrank_linearMap, pow_two]) + +-- def φ4 : +-- CrossProductAlgebra (F := F) (K := K) (a := 1) (ha := isMulCocycle₂_of_cocycles₂ 0) ≃ₐ[F] +-- Matrix (Fin <| Module.finrank F K) (Fin <| Module.finrank F K) F := +-- φ3 K F |>.trans <| LinearMap.toMatrixAlgEquiv <| Module.finBasis F K + +-- lemma map_one' : RelativeBrGroup.fromCocycles₂ (F := F) (K := K) (a := 0) = 1 := by +-- ext1 +-- change Quotient.mk'' _ = Quotient.mk'' _ +-- erw [Quotient.eq''] +-- have : 0 < Module.finrank F K := Module.finrank_pos +-- haveI : NeZero (Module.finrank F K) := ⟨by omega⟩ +-- change IsBrauerEquivalent _ _ +-- refine ⟨1, Module.finrank F K, AlgEquiv.trans ?_ <| φ4 K F⟩ +-- exact dim_one_iso (CSA.mk (CrossProductAlgebra.asCSA _).carrier).carrier + +-- lemma fromSnd_zero : RelativeBrGroup.fromSnd (F := F) (K := K) 0 = 1 := map_one' K F + +-- end map_one + +-- end map_one_proof + +namespace map_mul_proof + +open groupCohomology + +variable {α β : Gal(K, F) × Gal(K, F) → Kˣ} [Fact (IsMulCocycle₂ α)] [Fact (IsMulCocycle₂ β)] + +local notation "A" => CrossProductAlgebra α +local notation "B" => CrossProductAlgebra β +local notation "C" => CrossProductAlgebra (α * β) + +variable {K F} + +variable (α β) in +/-- The balancing relations used to form the tensor-product quotient module. -/ +def S : Set (A ⊗[F] B) := + .range fun ((k, a, b) : K × A × B) ↦ (k • a) ⊗ₜ[F] b - a ⊗ₜ[F] (k • b) + +@[simp] +lemma mem_S (x : A ⊗[F] B) : + x ∈ S α β ↔ ∃ (k : K) (a : A) (b : B), x = (k • a) ⊗ₜ b - a ⊗ₜ (k • b) := by + simp only [S, Set.mem_range, Prod.exists] + aesop + +variable (α β) in +/-- The balanced tensor-product module used in the multiplicativity proof. -/ +@[reducible] def M := (A ⊗[F] B) ⧸ Submodule.span F (S α β) + +/-- Right multiplication by fixed tensor factors descends to the balanced quotient. -/ +def Aox_FB_smul_M_aux (a' : A) (b' : B) : M α β →ₗ[F] M α β := + Submodule.mapQ (Submodule.span F (S α β)) (Submodule.span F (S α β)) + (TensorProduct.lift + { toFun a := + { toFun b := (a * a') ⊗ₜ (b * b') + map_add' := by + intro b1 b2 + simp [add_mul, TensorProduct.tmul_add] + map_smul' := by + intro f b; simp } + map_add' := by + intro a1 a2 + ext b : 1 + simp [add_mul, TensorProduct.add_tmul] + map_smul' := by + intro f a + ext b : 1 + simp [TensorProduct.smul_tmul] }) + (by + rw [Submodule.span_le] + rintro _ ⟨⟨k, a, b⟩, rfl⟩ + simp only [Submodule.comap_coe, Set.mem_preimage, map_sub, TensorProduct.lift.tmul, + LinearMap.coe_mk, AddHom.coe_mk, SetLike.mem_coe] + refine Submodule.subset_span ⟨⟨k, a * a', b * b'⟩, by simp [smul_mul_assoc]⟩) + +/-- The auxiliary right action map as a linear map in the second tensor factor. -/ +def Aox_FB_smul_M_aux_aux (a : A) : B →ₗ[F] M α β →ₗ[F] M α β where + toFun b := Aox_FB_smul_M_aux a b + map_add' b1 b2 := by + ext a' b' + simp [Aox_FB_smul_M_aux, mul_add, TensorProduct.tmul_add] + map_smul' k b := by + ext a' b' + simp [Aox_FB_smul_M_aux, Algebra.mul_smul_comm] + +open TensorProduct + +/-- The right action of `A ⊗[F] B` on the balanced quotient module. -/ +def Aox_FB_smul_M : A ⊗[F] B →ₗ[F] M α β →ₗ[F] M α β := + TensorProduct.lift + { toFun := Aox_FB_smul_M_aux_aux + map_add' a1' a2' := by + ext b' a b + simp only [Aox_FB_smul_M_aux, mul_add, add_tmul, LinearMap.coe_mk, AddHom.coe_mk, + AlgebraTensorModule.curry_apply, curry_apply, LinearMap.coe_restrictScalars, + LinearMap.coe_comp, Function.comp_apply, Submodule.mkQ_apply, Submodule.mapQ_apply, + lift.tmul, Submodule.Quotient.mk_add, LinearMap.add_apply, Aox_FB_smul_M_aux_aux] + map_smul' f a' := by + ext b' a b + simp only [Aox_FB_smul_M_aux, Algebra.mul_smul_comm, LinearMap.coe_mk, AddHom.coe_mk, + AlgebraTensorModule.curry_apply, curry_apply, LinearMap.coe_restrictScalars, + LinearMap.coe_comp, Function.comp_apply, Submodule.mkQ_apply, Submodule.mapQ_apply, + lift.tmul, RingHom.id_apply, LinearMap.smul_apply, Aox_FB_smul_M_aux_aux] + rw [← smul_tmul'] + simp only [Submodule.Quotient.mk_smul] } + +@[simp] +lemma Aox_FB_smul_M_op_tmul_smul_mk_tmul (a' a : A) (b' b : B) : + Aox_FB_smul_M (a' ⊗ₜ[F] b') (Submodule.Quotient.mk (a ⊗ₜ[F] b) : M α β) = + (Submodule.Quotient.mk ((a * a') ⊗ₜ[F] (b * b')) : M α β) := rfl + +instance : SMul (A ⊗[F] B)ᵐᵒᵖ (M α β) where + smul x y := Aox_FB_smul_M x.unop y + +open MulOpposite in +@[simp] +lemma Aox_FB_op_tmul_smul_mk_tmul (a' a : A) (b' b : B) : + op (a' ⊗ₜ[F] b') • (Submodule.Quotient.mk (a ⊗ₜ[F] b) : M α β) = + Submodule.Quotient.mk ((a * a') ⊗ₜ[F] (b * b')) := rfl + +open MulOpposite in +instance : MulAction (A ⊗[F] B)ᵐᵒᵖ (M α β) where + one_smul := by + intro x + rw [show (1 : (A ⊗[F] B)ᵐᵒᵖ) = op 1 from rfl, + Algebra.TensorProduct.one_def] + change Aox_FB_smul_M (1 ⊗ₜ[F] 1) x = LinearMap.id (R := F) x + refine LinearMap.ext_iff |>.1 ?_ x + ext a b + simp only [AlgebraTensorModule.curry_apply, curry_apply, LinearMap.coe_restrictScalars, + LinearMap.coe_comp, Function.comp_apply, Submodule.mkQ_apply, + Aox_FB_smul_M_op_tmul_smul_mk_tmul, _root_.mul_one, LinearMap.id_comp] + mul_smul := by + rintro ⟨x⟩ ⟨y⟩ b + change Aox_FB_smul_M (y * x) _ = Aox_FB_smul_M x (Aox_FB_smul_M y b) + rw [← LinearMap.comp_apply] + refine LinearMap.ext_iff |>.1 ?_ b + ext a b + simp only [AlgebraTensorModule.curry_apply, curry_apply, LinearMap.coe_restrictScalars, + LinearMap.coe_comp, Function.comp_apply, Submodule.mkQ_apply] + induction x using TensorProduct.induction_on with + | tmul xl rl => + induction y using TensorProduct.induction_on with + | tmul yl yr => simp [Aox_FB_smul_M_op_tmul_smul_mk_tmul, _root_.mul_assoc] + | add y y' hy hy' => simp_all [add_mul] + | zero => simp + | add x x' hx hx' => simp_all [mul_add] + | zero => simp + +instance : DistribMulAction (A ⊗[F] B)ᵐᵒᵖ (M α β) where + smul_zero x := show Aox_FB_smul_M _ _ = _ by simp + smul_add x a b := show Aox_FB_smul_M _ _ = + Aox_FB_smul_M _ _ + Aox_FB_smul_M _ _ by simp + +instance : Module (A ⊗[F] B)ᵐᵒᵖ (M α β) where + add_smul x y a := show Aox_FB_smul_M _ _ = + Aox_FB_smul_M _ _ + Aox_FB_smul_M _ _ by simp + zero_smul x := show Aox_FB_smul_M _ _ = _ by simp + +open CrossProductAlgebra TensorProduct + +lemma F_smul_mul_compatible (f : F) (a a' : A) : (f • a) * a' = a * (f • a') := by + simp only [Algebra.smul_mul_assoc, Algebra.mul_smul_comm] + +variable [FiniteDimensional F K] + +/-- The auxiliary left action of the product cross-product algebra on the balanced quotient. -/ +def C_smul_aux (c : C) : M α β →ₗ[F] M α β := + Submodule.mapQ (Submodule.span F (S α β)) (Submodule.span F (S α β)) + (TensorProduct.lift + { toFun a := { + toFun b := ∑ σ : Gal(K, F), ((c.1 σ • basis σ) * a) ⊗ₜ (basis σ * b) + map_add' b b' := by + rw [← Finset.sum_add_distrib] + refine Finset.sum_congr rfl fun σ _ => ?_ + rw [mul_add, tmul_add] + map_smul' f b := by + dsimp only [RingHom.id_apply] + rw [Finset.smul_sum] + refine Finset.sum_congr rfl fun σ _ => ?_ + rw [smul_tmul', smul_tmul, ← F_smul_mul_compatible] + simp only [Algebra.smul_mul_assoc, tmul_smul] } + map_add' a a' := by + ext b : 1 + simp only [LinearMap.coe_mk, AddHom.coe_mk, LinearMap.add_apply] + rw [← Finset.sum_add_distrib] + refine Finset.sum_congr rfl fun σ _ => ?_ + simp [mul_add, add_tmul] + map_smul' f a := by + ext b : 1 + simp only [Algebra.mul_smul_comm, LinearMap.coe_mk, AddHom.coe_mk, + RingHom.id_apply, LinearMap.smul_apply] + rw [Finset.smul_sum] + refine Finset.sum_congr rfl fun σ _ => ?_ + rw [smul_tmul'] }) + (by + rw [Submodule.span_le] + rintro _ ⟨⟨k, a, b⟩, rfl⟩ + simp only [Submodule.comap_coe, Set.mem_preimage, map_sub, lift.tmul, + LinearMap.coe_mk, AddHom.coe_mk, SetLike.mem_coe] + rw [← Finset.sum_sub_distrib] + refine Submodule.sum_mem _ fun σ _ => + Submodule.subset_span ⟨⟨σ k, c.1 σ • (basis σ * a), basis σ * b⟩, ?_⟩ + simp only [← smul_mul_assoc, basis_smul_comm] + congr 2 + apply val_injective + simp only [val_mul, val_smul, CrossProductAlgebra.basis_val, Finsupp.smul_single, smul_eq_mul, + _root_.mul_one] + induction b.val using Finsupp.induction_linear with + | zero => simp + | add f g _ _ => simp_all + | single a b => + simp only [mulLinearMap_single_single, Finsupp.smul_single, smul_eq_mul, map_mul] + congr 1 + field_simp [← _root_.mul_assoc]) + +lemma C_smul_aux_calc (k : K) (σ : Gal(K, F)) (a : A) (b : B) : + C_smul_aux (k • basis σ) (Submodule.Quotient.mk (a ⊗ₜ[F] b) : M α β) = + Submodule.Quotient.mk (((k • basis σ) * a) ⊗ₜ (basis σ * b)) := by + delta C_smul_aux + rw [Submodule.mapQ_apply, lift.tmul] + congr 1 + dsimp only [LinearMap.coe_mk, AddHom.coe_mk] + rw [Finset.sum_eq_single_of_mem σ (Finset.mem_univ _)] + swap + · rintro τ - h + erw [show (k • CrossProductAlgebra.basis σ).val τ = 0 by + simp [CrossProductAlgebra.basis, Ne.symm h]] + simp + congr 2 + simp [CrossProductAlgebra.basis] + +/-- The left action of the product cross-product algebra on the balanced quotient. -/ +def C_smul : C →ₗ[F] M α β →ₗ[F] M α β where + toFun := C_smul_aux + map_add' c c' := by + ext a b + simp only [AlgebraTensorModule.curry_apply, curry_apply, LinearMap.coe_restrictScalars, + LinearMap.coe_comp, Function.comp_apply, Submodule.mkQ_apply, LinearMap.add_apply] + delta C_smul_aux + rw [Submodule.mapQ_apply, lift.tmul, Submodule.mapQ_apply, lift.tmul, + Submodule.mapQ_apply, lift.tmul] + change Submodule.Quotient.mk (∑ _, _) = Submodule.Quotient.mk ((∑ _, _) + (∑ _, _)) + change Submodule.mkQ _ _ = Submodule.mkQ _ _ + rw [map_sum, map_add, map_sum, map_sum, ← Finset.sum_add_distrib] + refine Finset.sum_congr rfl fun σ _ => ?_ + rw [← map_add, ← add_tmul] + congr 2 + simp [add_smul, add_mul] + map_smul' f c := by + ext a b + simp only [AlgebraTensorModule.curry_apply, curry_apply, LinearMap.coe_restrictScalars, + LinearMap.coe_comp, Function.comp_apply, Submodule.mkQ_apply, RingHom.id_apply, + LinearMap.smul_apply] + delta C_smul_aux + rw [Submodule.mapQ_apply, lift.tmul, Submodule.mapQ_apply, lift.tmul] + change Submodule.mkQ _ (∑ _, _) = f • Submodule.mkQ _ (∑ _, _) + rw [← map_smul, Finset.smul_sum] + simp_rw [smul_tmul'] + congr 1 + refine Finset.sum_congr rfl fun σ _ => ?_ + congr 1 + simp + +instance : SMul C (M α β) where + smul c x := C_smul c x + +lemma C_smul_def (c : C) (x : M α β) : c • x = C_smul c x := rfl + +lemma C_smul_calc (k : K) (σ : Gal(K, F)) (a : A) (b : B) : + (k • basis σ : C) • (Submodule.Quotient.mk (a ⊗ₜ[F] b) : M α β) = + Submodule.Quotient.mk (((k • basis σ) * a) ⊗ₜ (basis σ * b)) := + C_smul_aux_calc k σ a b + +theorem C_mul_smul' (x y : C) (ab : M α β) : (x * y) • ab = x • y • ab := by + change ((⟨x.val⟩ : C) * ⟨y.val⟩) • ab = (⟨x.val⟩ : C) • (⟨y.val⟩ : C) • ab + induction x.val using Finsupp.induction_linear with + | zero => change (0 * _) • _ = 0 • _; change C_smul _ _ = C_smul _ (C_smul _ _); simp + | add f g h1 h2 => + change ((⟨f⟩ + ⟨g⟩ : C) * _) • ab = (⟨f⟩ + ⟨g⟩ : C) • _ • _ + simp only [add_mul] + change C_smul _ _ = C_smul _ (C_smul _ _) at h1 h2 ⊢ + rw [map_add, LinearMap.add_apply, map_add, LinearMap.add_apply, h1, h2] + | single σ k1 => + induction y.val using Finsupp.induction_linear with + | zero => + change (_ * 0) • _ = _ • 0 • _; + change C_smul _ _ = C_smul _ (C_smul _ _) + simp + | add f g h1 h2 => + change C_smul (⟨.single σ k1⟩ * (_ + _) : C) _ = C_smul _ (C_smul (⟨f⟩ + ⟨g⟩ : C) _) + change C_smul _ _ = C_smul _ (C_smul _ _) at h1 h2 + rw [mul_add, map_add, LinearMap.add_apply, map_add, LinearMap.add_apply, h1, h2, map_add] + | single τ k2 => + induction ab using Submodule.Quotient.induction_on with | H ab => + induction ab using TensorProduct.induction_on with + | zero => + change C_smul _ _ = C_smul _ (C_smul _ _) + simp + | tmul a b => + change C_smul (⟨mulLinearMap _ (.single σ k1) (.single τ k2)⟩ : C) _ = C_smul _ (C_smul _ _) + simp only [mulLinearMap_single_single, Pi.mul_apply, Units.val_mul] + rw [← mul_one (k1 * σ k2 * ((α (σ, τ)).1 * (β (σ, τ)).1)), ← smul_eq_mul _ 1, + ← Finsupp.smul_single, ← CrossProductAlgebra.smul_mk, mk_single_one, ← mul_one k1, + ← mul_one k2, ← smul_eq_mul _ 1, ← Finsupp.smul_single, ← smul_mk, mk_single_one, + ← smul_eq_mul _ 1, ← Finsupp.smul_single, ← smul_mk, mk_single_one, ← C_smul_def, + ← C_smul_def, ← C_smul_def, C_smul_calc, C_smul_calc, C_smul_calc, Submodule.Quotient.eq] + simp only [smul_eq_mul, _root_.mul_one] + rw [← _root_.mul_assoc (basis σ) _ b, CrossProductAlgebra.basis_mul_basis σ τ, + incl_apply, smul_mul_assoc (β (σ, τ)).1, _root_.one_mul, smul_mul_assoc (β (σ, τ)).1, + ← _root_.mul_assoc (k1 • basis σ), basis_smul_comm, ← mul_smul (σ k2), mul_comm k1, + smul_mul_assoc (σ k2 * k1), CrossProductAlgebra.basis_mul_basis σ τ] + simp only [incl_apply, smul_one_mul] + rw [← mul_smul (σ k2 * k1), mul_comm (α (_, _)).1, ← _root_.mul_assoc, + mul_comm (σ k2 * k1) (β (_, _)).1, _root_.mul_assoc, mul_smul, smul_mul_assoc] + exact Submodule.subset_span ⟨⟨(β (σ, τ)).1, (σ k2 * k1 * ↑(α (σ, τ))) • basis (σ * τ) * a, + basis (σ * τ) * b⟩, rfl⟩ + | add x y h1 h2 => + simp only [C_smul_def, Submodule.Quotient.mk_add, map_add] at h1 h2 ⊢ + rw [h1, h2] + +instance : MulAction C (M α β) where + one_smul x := by + induction x using Quotient.inductionOn' with | h x => + change (1 : C) • Submodule.Quotient.mk x = Submodule.Quotient.mk x + induction x using TensorProduct.induction_on with + | tmul a b => + rw [show (1 : C) = ((β (1, 1)).1⁻¹ * (α (1, 1)).1⁻¹) • CrossProductAlgebra.basis 1 by + apply val_injective; simp [CrossProductAlgebra.basis], C_smul_calc, mul_smul, + show basis 1 = (⟨.single 1 1⟩ : CrossProductAlgebra α) from rfl, + show ((α (1, 1)).1)⁻¹ • (⟨.single 1 1⟩ : A) = ⟨(↑(α (1, 1)))⁻¹ • .single 1 1⟩ by + apply val_injective + simp only [smul_mk, Finsupp.smul_single, smul_eq_mul, mul_one] + congr + change _ = (α (1, 1))⁻¹.1 * 1 + simp, + Finsupp.smul_single, show (α (1, 1))⁻¹ • 1 = (α (1, 1)).1⁻¹ by + change (α (1, 1))⁻¹.1 * 1 = _; simp, + show (⟨.single 1 (α (1, 1)).1⁻¹⟩ : A) = 1 by rfl, + smul_mul_assoc, _root_.one_mul, Submodule.Quotient.eq] + refine Submodule.subset_span ⟨⟨(β (1, 1)).1⁻¹, a, basis 1 * b⟩, ?_⟩ + simp [← smul_mul_assoc, show ((β (1, 1)).1)⁻¹ • basis 1 = (1 : B) by + apply val_injective; simp [CrossProductAlgebra.basis]] + | add x y hx hy => + simp only [Submodule.Quotient.mk_add] + conv_rhs => rw [← hx, ← hy] + simp [C_smul_def, map_add] + | zero => + simp [Submodule.Quotient.mk_zero, C_smul_def, map_zero] + mul_smul := C_mul_smul' + +instance : DistribMulAction C (M α β) where + smul_zero c := show C_smul _ _ = 0 by simp + smul_add c x y := show C_smul _ _ = C_smul _ _ + C_smul _ _ by simp + +instance : Module C (M α β) where + add_smul c c' x := + show C_smul _ _ = C_smul _ _ + C_smul _ _ by + simp only [map_add, LinearMap.add_apply] + zero_smul x := show C_smul _ _ = _ by simp + +instance : SMulWithZero (A ⊗[F] B)ᵐᵒᵖ (M α β) where + zero_smul ab := show Aox_FB_smul_M 0 _ = 0 by simp + +open CrossProductAlgebra TensorProduct + +open MulOpposite + +instance : SMulCommClass (A ⊗[F] B)ᵐᵒᵖ C (M α β) where + smul_comm := by + rintro ⟨x⟩ c m + induction m using Quotient.inductionOn' with | h m => + change op x • c • Submodule.Quotient.mk _ = c • op x • Submodule.Quotient.mk _ + induction x using TensorProduct.induction_on with + | tmul a' b' => + induction m using TensorProduct.induction_on with + | tmul a b => + change _ • (⟨c.val⟩ : C) • _ = (⟨c.val⟩ : C) • _ • Submodule.Quotient.mk _ + induction c.val using Finsupp.induction_linear with + | zero => simp + | add f g h1 h2 => + rw [← mk_add_mk, add_smul, @smul_add (A ⊗[F] B)ᵐᵒᵖ (M α β) _ _, add_smul, h1, h2] + | single σ c => + rw [← mul_one c, ← smul_eq_mul _ 1, ← Finsupp.smul_single, ← smul_mk, mk_single_one, + C_smul_calc, Aox_FB_op_tmul_smul_mk_tmul, Aox_FB_op_tmul_smul_mk_tmul, C_smul_calc, + _root_.mul_assoc, _root_.mul_assoc] + | zero => simp + | add x y hx hy => + simp [Submodule.Quotient.mk_add, @smul_add (A ⊗[F] B)ᵐᵒᵖ (M α β) _ _, + @smul_add C (M α β) _ _, hx, hy] + | add x y hx hy => + simp only [op_add, @add_smul (A ⊗[F] B)ᵐᵒᵖ (M α β) _ _, hx, hy, smul_add] + | zero => + simp [op_zero, zero_smul] + +/-- The tensor-product action commutes with the cross-product action on `M`. -/ +lemma Aox_FB_smul_comm_C_smul (x : (A ⊗[F] B)ᵐᵒᵖ) (c : C) (m : M α β) : + x • c • m = c • x • m := + smul_comm x c m + +open CrossProductAlgebra TensorProduct in +instance : IsScalarTower F C (M α β) := .of_algebraMap_smul fun x m ↦ by + induction m using Submodule.Quotient.induction_on with | H m => + induction m using TensorProduct.induction_on with + | zero => simp + | add x y h1 h2 => + rw [Submodule.Quotient.mk_add, smul_add, h1, h2, smul_add] + | tmul a b => + rw [Algebra.algebraMap_eq_smul_one, one_def, ← mul_one ((α * β) _).1⁻¹, + ← smul_eq_mul _ 1, ← Finsupp.smul_single, ← smul_mk, mk_single_one, ← smul_assoc, C_smul_calc] + simp only [Pi.mul_apply, Units.val_mul, mul_inv_rev, smul_assoc, Algebra.smul_mul_assoc] + rw [← smul_tmul', Submodule.Quotient.mk_smul] + congr 1 + change Submodule.Quotient.mk ((_ • basis 1 * ⟨a.val⟩) ⊗ₜ (basis 1 * ⟨b.val⟩)) = + Submodule.Quotient.mk ((⟨a.val⟩ : A) ⊗ₜ[F] (⟨b.val⟩ : B)) + induction a.val using Finsupp.induction_linear with + | zero => simp + | add f g h1 h2 => + rw [← mk_add_mk, mul_add, add_tmul, add_tmul, Submodule.Quotient.mk_add, h1, h2, + Submodule.Quotient.mk_add] + | single σ k1 => + rw [smul_mul_assoc, ← mk_single_one] + change Submodule.Quotient.mk ((_ • (⟨mulLinearMap _ _ _⟩ : A)) ⊗ₜ _) = _ + simp only [mulLinearMap_single_single, _root_.one_mul, AlgEquiv.one_apply, smul_mk, + Finsupp.smul_single, smul_eq_mul] + induction b.val using Finsupp.induction_linear with + | zero => simp + | add f g h1 h2 => + rw [← mk_add_mk, mul_add, tmul_add, Submodule.Quotient.mk_add, h1, h2, tmul_add, + Submodule.Quotient.mk_add] + | single τ k2 => + rw [← mk_single_one] + change Submodule.Quotient.mk (_ ⊗ₜ (⟨mulLinearMap β _ _⟩ : B)) = _ + simp only [mulLinearMap_single_single, _root_.one_mul, AlgEquiv.one_apply, mul_comm k2] + rw [← smul_eq_mul (β _).1, ← Finsupp.smul_single, ← smul_mk, Submodule.Quotient.eq] + simp_rw [map_one_fst_of_isMulCocycle₂ Fact.out] + refine Submodule.subset_span ⟨⟨(β (1, 1)).1⁻¹, ⟨Finsupp.single σ k1⟩, + (β (1, 1)).1 • ⟨Finsupp.single τ k2⟩⟩, ?_⟩ + simp only [smul_mk, Finsupp.smul_single, smul_eq_mul, isUnit_iff_ne_zero, ne_eq, + Units.ne_zero, not_false_eq_true, IsUnit.inv_mul_cancel_left, sub_left_inj] + congr 3 + field_simp + +open CrossProductAlgebra TensorProduct in +/-- The representation of the opposite tensor product algebra by endomorphisms of `M`. -/ +noncomputable def φ0 : + (A ⊗[F] B)ᵐᵒᵖ →ₐ[F] Module.End C (M α β) where + toFun x := { + toFun m := x • m + map_add' _ _ := by simp [@smul_add (A ⊗[F] B)ᵐᵒᵖ (M α β)] + map_smul' c y := by + simp only [RingHom.id_apply] + rw [smul_comm] + } + map_one' := by + refine LinearMap.ext fun _ ↦ ?_ + simp only [one_smul, LinearMap.coe_mk, AddHom.coe_mk, Module.End.one_apply] + map_mul' x y := by + refine LinearMap.ext fun _ ↦ ?_ + simp only [LinearMap.coe_mk, AddHom.coe_mk, Module.End.mul_apply] + rw [mul_smul] + map_zero' := by + refine LinearMap.ext fun _ ↦ ?_ + simp only [zero_smul, LinearMap.coe_mk, AddHom.coe_mk, LinearMap.zero_apply] + map_add' x y := by + refine LinearMap.ext fun _ ↦ ?_ + simp only [LinearMap.coe_mk, AddHom.coe_mk, LinearMap.add_apply] + rw [add_smul] + commutes' f := by + refine LinearMap.ext fun m ↦ ?_ + simp only [MulOpposite.algebraMap_apply, Algebra.TensorProduct.algebraMap_apply, + LinearMap.coe_mk, AddHom.coe_mk, Module.algebraMap_end_apply] + induction m using Submodule.Quotient.induction_on with | H m => + induction m using TensorProduct.induction_on with + | tmul a b => + erw [Aox_FB_op_tmul_smul_mk_tmul] + rw [_root_.mul_one, ← Algebra.commutes, ← Algebra.smul_def, ← smul_tmul', + Submodule.Quotient.mk_smul] + | add x y hx hy => + simp only at hx hy ⊢ + have := congr($hx + $hy) + rw [← smul_add, ← smul_add] at this + exact this + | zero => + erw [smul_zero] + +open TensorProduct + +/-- The map from the balanced quotient to the tensor product over `K`. -/ +def MtoAox_KB : M α β →ₗ[F] A ⊗[K] B := + Submodule.liftQ _ + (TensorProduct.lift + { toFun a := + { toFun b := a ⊗ₜ b + map_add' := by simp [tmul_add] + map_smul' := by simp } + map_add' := by intros; ext; simp [add_tmul] + map_smul' := by intros; ext; simp only [LinearMap.coe_mk, AddHom.coe_mk, RingHom.id_apply, + LinearMap.smul_apply, smul_tmul'] }) + (by + rw [Submodule.span_le] + rintro _ ⟨⟨k, a, b⟩, rfl⟩ + simp only [SetLike.mem_coe, LinearMap.mem_ker, map_sub, lift.tmul, LinearMap.coe_mk, + AddHom.coe_mk, tmul_smul, smul_tmul', sub_self]) + +/-- The additive map from the tensor product over `K` back to the balanced quotient. -/ +def Aox_KBToM_aux : A ⊗[K] B →+ M α β := +TensorProduct.liftAddHom + { toFun a := + { toFun b := Submodule.Quotient.mk <| a ⊗ₜ b + map_zero' := by simp + map_add' := by simp [tmul_add] } + map_zero' := by ext; simp + map_add' := by intros; ext; simp [add_tmul] } fun k a b => by + simp only [AddMonoidHom.coe_mk, ZeroHom.coe_mk] + rw [Submodule.Quotient.eq] + exact Submodule.subset_span <| ⟨⟨k, a, b⟩, rfl⟩ + +/-- The linear map from the tensor product over `K` back to the balanced quotient. -/ +def Aox_KBToM : A ⊗[K] B →ₗ[F] M α β where + __ := Aox_KBToM_aux + map_smul' := by + intro f x + induction x using TensorProduct.induction_on with + | tmul a b => + simp only [Aox_KBToM_aux, smul_tmul', ZeroHom.toFun_eq_coe, AddMonoidHom.toZeroHom_coe, + liftAddHom_tmul, AddMonoidHom.coe_mk, ZeroHom.coe_mk, RingHom.id_apply] + rw [← Submodule.Quotient.mk_smul, smul_tmul'] + | add x y hx hy => + simp only [ZeroHom.toFun_eq_coe, AddMonoidHom.toZeroHom_coe, RingHom.id_apply, smul_add, + map_add] at hx hy ⊢ + simp only [hx, hy] + | zero => + simp only [smul_zero, ZeroHom.toFun_eq_coe, map_zero, + RingHom.id_apply] + +/-- The balanced quotient is linearly equivalent to the tensor product over `K`. -/ +def Aox_KBEquivM : M α β ≃ₗ[F] A ⊗[K] B := .ofLinear MtoAox_KB Aox_KBToM + (by + ext x + induction x using TensorProduct.induction_on with + | tmul a b => + simp only [MtoAox_KB, Aox_KBToM, Aox_KBToM_aux, ZeroHom.toFun_eq_coe, + AddMonoidHom.toZeroHom_coe, LinearMap.coe_comp, LinearMap.coe_mk, AddHom.coe_mk, + Function.comp_apply, liftAddHom_tmul, AddMonoidHom.coe_mk, ZeroHom.coe_mk, + Submodule.liftQ_apply, lift.tmul, LinearMap.id_coe, id_eq] + | add x y hx hy => + simp only [LinearMap.coe_comp, Function.comp_apply, LinearMap.id_coe, id_eq] at hx hy + simp only [LinearMap.coe_comp, Function.comp_apply, map_add, hx, hy, LinearMap.id_coe, id_eq] + | zero => simp) + (by + ext a b + simp only [Aox_KBToM, Aox_KBToM_aux, ZeroHom.toFun_eq_coe, AddMonoidHom.toZeroHom_coe, + MtoAox_KB, AlgebraTensorModule.curry_apply, curry_apply, LinearMap.coe_restrictScalars, + LinearMap.coe_comp, LinearMap.coe_mk, AddHom.coe_mk, Function.comp_apply, Submodule.mkQ_apply, + Submodule.liftQ_apply, lift.tmul, liftAddHom_tmul, AddMonoidHom.coe_mk, ZeroHom.coe_mk, + LinearMap.id_comp]) + +open Module + +lemma M_F_dim [IsGalois F K] : finrank F (M α β) = (finrank F K)^3 := by + rw [LinearEquiv.finrank_eq Aox_KBEquivM, + show finrank F (A ⊗[K] B) = finrank F K * finrank K (A ⊗[K] B) from + Eq.symm (finrank_mul_finrank F K (A ⊗[K] B)), + finrank_tensorProduct, finrank_eq_card_basis CrossProductAlgebra.basis, + finrank_eq_card_basis CrossProductAlgebra.basis, Fintype.card_eq_nat_card, + IsGalois.card_aut_eq_finrank, pow_three] + +instance [IsGalois F K] : FiniteDimensional F C := + .of_finrank_eq_succ (n := (finrank F K)^2 - 1) <| by + rw [CrossProductAlgebra.dim_eq_sq] + refine Nat.succ_pred_eq_of_pos (pow_two_pos_of_ne_zero ?_) |>.symm + have : 0 < finrank F K := finrank_pos + omega + +instance [IsGalois F K] : Module.Finite C (M α β) := + Module.Finite.right F C (M α β) + +open CrossProductAlgebra + +variable (α β) in +lemma exists_simple_module_directSum [IsGalois F K] : + ∃ (S : Type) (_ : AddCommGroup S) (_ : Module C S) (_ : IsSimpleModule C S) + (ι : Type) (_ : Fintype ι), + Nonempty (C ≃ₗ[C] ι →₀ S) := by + obtain ⟨S, _, _, _, ι, ⟨iso⟩⟩ := directSum_simple_module_over_simple_ring F C C + refine ⟨S, inferInstance, inferInstance, inferInstance, ι, ?_, ⟨iso⟩⟩ + haveI infinite : Module.Finite C (ι →₀ S) := Module.Finite.equiv iso + letI : Module F S := Module.compHom S (algebraMap F C) + haveI : LinearMap.CompatibleSMul C (ι →₀ S) F C := by + constructor + intro l f x + change _ = algebraMap F C f • l x + rw [← map_smul] + congr 1 + apply val_injective + simp only [val_smul, smul_eq_mul, val_mul] + induction x.val using Finsupp.induction_linear with + | zero => simp + | add f g _ _ => simp_all [smul_add] + | single σ c => + simp only [Finsupp.smul_single, Algebra.algebraMap_eq_smul_one, val_smul, val_one, + map_one_fst_of_isMulCocycle₂ Fact.out, Pi.mul_apply, Units.val_mul, mul_inv_rev, + mulLinearMap_single_single, one_mul, AlgEquiv.one_apply, Algebra.smul_mul_assoc] + rw [mul_comm _ c, mul_assoc c, ← smul_mul_assoc, ← mul_assoc ((β (1, 1)).1⁻¹ * _), + mul_assoc (β (1, 1)).1⁻¹, inv_mul_cancel₀ (by simp), _root_.mul_one] + field_simp + let iso' : C ≃ₗ[F] (ι →₀ S) := iso.restrictScalars F + haveI : IsScalarTower F C (ι →₀ S) := by + constructor + intro f c x + change _ = algebraMap F C f • _ • x + rw [Algebra.smul_def, mul_smul] + haveI : Module.Finite F (ι →₀ S) := Module.Finite.trans C (ι →₀ S) + have eq := LinearEquiv.finrank_eq iso' + -- rw [M_F_dim, pow_three] at eq + refine (@Cardinal.lt_aleph0_iff_fintype ι).1 ?_ |>.some + apply_fun ((↑) : ℕ → Cardinal) at eq + rw [finrank_eq_rank, finrank_eq_rank, rank_finsupp F S ι] at eq + have ineq : Module.rank F C < Cardinal.aleph0 := by + rw [rank_lt_aleph0_iff]; infer_instance + rw [eq] at ineq + simp only [Cardinal.lift_id] at ineq + haveI : Nontrivial S := IsSimpleModule.nontrivial C S + have ineq2 := @Cardinal.le_mul_left (Cardinal.mk ι) (Module.rank F S) + (by + suffices 0 < Module.rank F S by exact Ne.symm (ne_of_lt this) + apply rank_pos) + rw [mul_comm] at ineq2 + exact lt_of_le_of_lt ineq2 ineq + +variable [IsGalois F K] + +variable (α β) in +/-- A chosen simple module appearing in the Wedderburn decomposition of `C`. -/ +def SimpleMod : Type := exists_simple_module_directSum α β |>.choose + +local notation "SM" => SimpleMod α β + +instance : AddCommGroup SM := exists_simple_module_directSum _ _ |>.choose_spec.choose + +instance : Module C SM := exists_simple_module_directSum _ _ |>.choose_spec.choose_spec.choose + +instance : Module F SM := Module.compHom SM (algebraMap F C) + +instance : IsSimpleModule C SM := exists_simple_module_directSum _ _ + |>.choose_spec.choose_spec.choose_spec.choose + +variable (α β) in +/-- The finite index set for the simple-module decomposition of `C`. -/ +def IndexingSet : Type := exists_simple_module_directSum α β + |>.choose_spec.choose_spec.choose_spec.choose_spec.choose + +local notation "ι" => IndexingSet α β + +instance : Fintype ι := exists_simple_module_directSum α β + |>.choose_spec.choose_spec.choose_spec.choose_spec.choose_spec.choose + +/-- The decomposition of `C` as a finite direct sum of copies of the simple module. -/ +def isoιSM : C ≃ₗ[C] ι →₀ SM := exists_simple_module_directSum α β + |>.choose_spec.choose_spec.choose_spec.choose_spec.choose_spec.choose_spec.some + +instance : Nonempty ι := by by_contra!; exact not_subsingleton C isoιSM.toEquiv.subsingleton + +instance : NeZero (Fintype.card ι) := by + constructor + simp + +/-- The direct-sum decomposition rewritten as functions on the finite index set. -/ +def isoιSMPow : C ≃ₗ[C] ι → SM := isoιSM ≪≫ₗ Finsupp.linearEquivFunOnFinite C SM ι + +variable (α β) in +/-- The direct-sum decomposition reindexed by `Fin (Fintype.card ι)`. -/ +def isoιSMPow' : C ≃ₗ[C] Fin (Fintype.card ι) → SM := + isoιSMPow ≪≫ₗ + { __ := Equiv.arrowCongr (Fintype.equivFinOfCardEq (α := ι) rfl : ι ≃ Fin (Fintype.card ι)) + (Equiv.refl _) + map_add' := by + intros v w + rfl + map_smul' := by + intros; rfl } + +instance : LinearMap.CompatibleSMul (M α β) (ι →₀ SM) F C := by + constructor + intro l f x + change _ = algebraMap F C f • l x + rw [← map_smul] + congr 1 + simp + +instance : IsScalarTower F C SM := by + constructor + intro f c x + change _ = algebraMap F C f • _ • x + rw [Algebra.smul_def, mul_smul] + +instance : Module.Finite C (ι →₀ SM) := .equiv isoιSM +instance : Module.Finite F (ι →₀ SM) := .trans C (ι →₀ SM) + +instance : SMulCommClass C F SM where + smul_comm c f a := by + change c • algebraMap F C f • a = algebraMap F C f • _ + rw [← mul_smul, ← Algebra.commutes, mul_smul] + +/-- Endomorphisms of a finite power are matrix algebras over endomorphisms of the summand. -/ +def isoDagger (m : ℕ) : + Module.End C (Fin m → SM) ≃ₐ[F] Matrix (Fin m) (Fin m) (Module.End C SM) where + __ := endPowEquivMatrix C SM m + commutes' f := by + ext i j x + simp only [endPowEquivMatrix, endVecAlgEquivMatrixEnd, endVecRingEquivMatrixEnd, + RingEquiv.toEquiv_eq_coe, Equiv.toFun_as_coe, EquivLike.coe_coe, RingEquiv.coe_mk, + Equiv.coe_fn_mk, LinearMap.coe_mk, AddHom.coe_mk, Matrix.algebraMap_matrix_apply] + split_ifs with h + · simp only [h, algebraMap_end_apply, Pi.smul_apply, Pi.single_eq_same] + · simp only [algebraMap_end_apply, Pi.smul_apply, Pi.single_eq_of_ne h, smul_zero, + LinearMap.zero_apply] + +/-- The opposite algebra of `C` as endomorphisms of the regular `C`-module. -/ +def mopEquivEnd' : Cᵐᵒᵖ ≃ₐ[F] Module.End C C := + .ofRingEquiv (f := mopEquivEnd C) fun f ↦ by + ext x + simp [mopEquivEnd, Algebra.algebraMap_eq_smul_one] + +/-- Transport the regular-module endomorphism algebra across the simple-module decomposition. -/ +def C_iso_aux : Cᵐᵒᵖ ≃ₐ[F] Module.End C (Fin (Fintype.card ι) → SM) := + mopEquivEnd'.trans <| (isoιSMPow' α β).conjAlgEquiv F + +/-- The matrix form of the opposite algebra of `C`. -/ +def C_iso_aux' : + Cᵐᵒᵖ ≃ₐ[F] Matrix (Fin (Fintype.card ι)) (Fin (Fintype.card ι)) (Module.End C SM) := + C_iso_aux.trans <| isoDagger _ + +open MulOpposite + +lemma dim_endCSM : (finrank F K)^2 = + (Fintype.card ι) ^ 2 * finrank F (Module.End C SM) := by + have eq1 := (C_iso_aux' (α := α) (β := β)).toLinearEquiv.finrank_eq + rw [show finrank F Cᵐᵒᵖ = finrank F C by + refine LinearEquiv.finrank_eq + { toFun := unop + map_add' _ _ := rfl + map_smul' _ _ := rfl + invFun := op + left_inv := unop_op + right_inv _ := rfl }, CrossProductAlgebra.dim_eq_sq] at eq1 + rw [eq1, matrixEquivTensor (Fin (Fintype.card ι)) F (Module.End C SM) |>.toLinearEquiv.finrank_eq, + finrank_tensorProduct, finrank_matrix] + simp only [Fintype.card_fin, finrank_self, _root_.mul_one, pow_two] + group + +/-- Move the matrix algebra description from the opposite algebra back to `C`. -/ +def C_iso_aux'' : + C ≃ₐ[F] (Matrix (Fin (Fintype.card ι)) (Fin (Fintype.card ι)) (Module.End C SM))ᵐᵒᵖ where + toFun c := op <| C_iso_aux' (op c) + invFun m := (C_iso_aux'.symm m.unop).unop + left_inv c := by simp only [unop_op, AlgEquiv.symm_apply_apply] + right_inv m := by simp only [op_unop, AlgEquiv.apply_symm_apply] + map_mul' c c' := by simp [op_mul, map_mul] + map_add' c c' := by simp [op_add, map_add] + commutes' f := by simp [Algebra.algebraMap_eq_smul_one] + +/-- The final matrix-algebra model for the product cross-product algebra. -/ +def C_iso : C ≃ₐ[F] (Matrix (Fin (Fintype.card ι)) (Fin (Fintype.card ι)) (Module.End C SM)ᵐᵒᵖ) := + C_iso_aux''.trans (BrauerGroup.matrixEquivMatrixMop_algebra F (End C SM) (Fintype.card ι)).symm + +variable (α β) in +lemma M_directSum : ∃ (ιM : Type) (_ : Fintype ιM), Nonempty (M α β ≃ₗ[C] ιM →₀ SM) := by + obtain ⟨ιM, ⟨iso⟩⟩ := directSum_simple_module_over_simple_ring' F C (M α β) SM + refine ⟨ιM, ?_, ⟨iso⟩⟩ + haveI : LinearMap.CompatibleSMul C (ιM →₀ SM) F C := by + constructor + intro l f x + change _ = algebraMap F C f • l x + rw [← map_smul] + congr 1 + apply val_injective + simp [Algebra.algebraMap_eq_smul_one] + let iso' : M α β ≃ₗ[F] (ιM →₀ SM) := iso.restrictScalars F + haveI : IsScalarTower F C (ιM →₀ SM) := by + constructor + intro f c x + change _ = algebraMap F C f • _ • x + rw [Algebra.smul_def, mul_smul] + haveI : Module.Finite C (ιM →₀ SM) := Module.Finite.equiv iso + haveI : Module.Finite F (ιM →₀ SM) := Module.Finite.trans C (ιM →₀ SM) + have eq := LinearEquiv.finrank_eq iso' + rw [M_F_dim, pow_three] at eq + refine (@Cardinal.lt_aleph0_iff_fintype ιM).1 ?_ |>.some + apply_fun ((↑) : ℕ → Cardinal) at eq + simp only [Nat.cast_mul] at eq + rw [finrank_eq_rank, finrank_eq_rank, rank_finsupp F SM ιM] at eq + have ineq : Module.rank F K < Cardinal.aleph0 := by + rw [Module.rank_lt_aleph0_iff]; infer_instance + replace ineq : Module.rank F K * (Module.rank F K * Module.rank F K) < Cardinal.aleph0 := by + apply Cardinal.mul_lt_aleph0 + · assumption + apply Cardinal.mul_lt_aleph0 <;> + assumption + rw [eq] at ineq + simp only [Cardinal.lift_id] at ineq + haveI : Nontrivial SM := IsSimpleModule.nontrivial C SM + have ineq2 := @Cardinal.le_mul_left (Cardinal.mk ιM) (Module.rank F SM) + (by + suffices 0 < Module.rank F SM by exact Ne.symm (ne_of_lt this) + apply rank_pos) + rw [mul_comm] at ineq2 + exact lt_of_le_of_lt ineq2 ineq + +variable (α β) in +/-- The finite index set for the simple-module decomposition of `M`. -/ +def IndexingSetM : Type := (M_directSum α β).choose + +local notation "ιM" => IndexingSetM α β + +instance : Fintype ιM := (M_directSum α β).choose_spec.choose + +/-- The decomposition of `M` as a finite direct sum of copies of the simple module. -/ +def M_iso_directSum : M α β ≃ₗ[C] ιM →₀ SM := (M_directSum _ _).choose_spec.choose_spec.some + +instance : Module.Finite C SM := by + rw [Module.finite_def, Submodule.fg_def] + obtain ⟨a, ha⟩ := IsSimpleModule.instIsPrincipal C (M := SM) ⊤ + exact ⟨{a}, Set.finite_singleton a, ha.symm⟩ + +instance : Module.Finite F SM := .trans C SM + +lemma SM_F_dim : Fintype.card ι * finrank F SM = finrank F K ^ 2 := by + have eq1 := LinearEquiv.finrank_eq (isoιSMPow' α β |>.restrictScalars F) + rw [CrossProductAlgebra.dim_eq_sq] at eq1 + have eq2 := rank_fun (η := (Fin (Fintype.card ι))) (M := SM) (R := F) + rw [Fintype.card_fin, ← finrank_eq_rank F SM, + show (Fintype.card ι : Cardinal) * (finrank F SM : Cardinal) = + ((Fintype.card ι * finrank F SM : ℕ) : Cardinal) by simp] at eq2 + have := finrank_eq_of_rank_eq (n := Fintype.card ι * finrank F SM) eq2 + rw [this] at eq1 + exact eq1.symm + +instance : Module.Finite C (Fin (Fintype.card ι * finrank F K) → SM) := by + have := Finsupp.linearEquivFunOnFinite C SM (Fin (Fintype.card ι * finrank F K)) + exact .equiv this + +variable (α β) in +lemma M_iso_powAux : Nonempty (M α β ≃ₗ[C] Fin (finrank F K * Fintype.card ι) → SM) := by + rw [linearEquiv_iff_finrank_eq_over_simple_ring F C] + have eq2 := rank_fun (η := (Fin (finrank F K * Fintype.card ι))) (M := SM) (R := F) + rw [Fintype.card_fin, ← finrank_eq_rank F SM, + show ((finrank F K * Fintype.card ι : ℕ) : Cardinal) * (finrank F SM : Cardinal) = + ((finrank F K * Fintype.card ι * finrank F SM : ℕ) : Cardinal) by simp] at eq2 + have := finrank_eq_of_rank_eq eq2 + rw [this, M_F_dim, _root_.mul_assoc, SM_F_dim, pow_three, pow_two] + +variable (α β) in +/-- A linear equivalence from `M` to a finite power of the chosen simple module. -/ +def M_iso_pow : M α β ≃ₗ[C] Fin (finrank F K * Fintype.card ι) → SM := M_iso_powAux _ _ |>.some + +variable (α β) in +/-- The same finite-power equivalence over the base field. -/ +def M_iso_pow' : M α β ≃ₗ[F] Fin (finrank F K * Fintype.card ι) → SM := + (M_iso_pow α β).restrictScalars F + +variable (α β) in +/-- Conjugation by `M_iso_pow` identifies endomorphism algebras over `C`. -/ +def endCMIso : + Module.End C (M α β) ≃ₐ[F] Module.End C (Fin (finrank F K * Fintype.card ι) → SM) where + toFun x := (M_iso_pow α β) ∘ₗ x ∘ₗ (M_iso_pow α β).symm + invFun x := (M_iso_pow α β).symm ∘ₗ x ∘ₗ (M_iso_pow α β) + left_inv x := by + simp only [← LinearMap.comp_assoc, LinearEquiv.comp_coe, LinearEquiv.self_trans_symm, + LinearEquiv.refl_toLinearMap, LinearMap.id_comp] + simp only [LinearMap.comp_assoc, LinearEquiv.comp_coe, LinearEquiv.self_trans_symm, + LinearEquiv.refl_toLinearMap, LinearMap.comp_id] + right_inv x := by + simp only [← LinearMap.comp_assoc, LinearEquiv.comp_coe, LinearEquiv.symm_trans_self, + LinearEquiv.refl_toLinearMap, LinearMap.id_comp] + simp only [LinearMap.comp_assoc, LinearEquiv.comp_coe, LinearEquiv.symm_trans_self, + LinearEquiv.refl_toLinearMap, LinearMap.comp_id] + map_mul' x y := by + refine DFunLike.ext _ _ fun z ↦ ?_ + simp only [LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, Module.End.mul_apply, + LinearEquiv.symm_apply_apply] + map_add' x y := by + refine DFunLike.ext _ _ fun z ↦ ?_ + simp only [LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, LinearMap.add_apply, + map_add] + commutes' f := by + refine DFunLike.ext _ _ fun z ↦ ?_ + simp only [LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, + Module.algebraMap_end_apply] + change (M_iso_pow' α β) (f • (M_iso_pow' α β).symm z) = _ + rw [map_smul] + simp [LinearEquiv.apply_symm_apply] + +instance : NeZero (finrank F K * Fintype.card ι) := by + constructor + simp only [ne_eq, mul_eq_zero, Fintype.card_ne_zero, or_false] + have : 0 < finrank F K := finrank_pos + omega + +variable (α β) in +/-- The endomorphism algebra of `M` as a matrix algebra over endomorphisms of `SM`. -/ +def endCMIso' : + Module.End C (M α β) ≃ₐ[F] + Matrix (Fin (finrank F K * Fintype.card ι)) + (Fin (finrank F K * Fintype.card ι)) (Module.End C SM) := + endCMIso _ _ |>.trans <| isoDagger _ + +lemma dim_endCM : finrank F (Module.End C (M α β)) = (finrank F K)^4 := by + have := (endCMIso' α β).toLinearEquiv.finrank_eq + rw [this] + have := matrixEquivTensor (Fin (finrank F K * Fintype.card ι)) F (Module.End C SM) + |>.toLinearEquiv.finrank_eq + rw [this, finrank_tensorProduct, finrank_matrix] + simp only [Fintype.card_fin] + rw [show finrank F K * Fintype.card ι * (finrank F K * Fintype.card ι) = + (Fintype.card ι)^2 * (finrank F K)^2 by group] + rw [finrank_self, _root_.mul_one, ← _root_.mul_assoc, mul_comm _ ((Fintype.card ι)^2), + ← dim_endCSM, pow_two, pow_succ, pow_three] + group + +open MulOpposite in +/-- The opposite tensor product algebra as endomorphisms of the balanced quotient. -/ +def φ1 : (A ⊗[F] B)ᵐᵒᵖ ≃ₐ[F] Module.End C (M α β) := + .ofBijective φ0 <| bijective_of_dim_eq_of_isCentralSimple _ _ _ _ <| by + rw [dim_endCM, show finrank F (A ⊗[F] B)ᵐᵒᵖ = finrank F (A ⊗[F] B) by + refine LinearEquiv.finrank_eq + { toFun := unop + map_add' _ _ := rfl + map_smul' _ _ := rfl + invFun := op + left_inv := unop_op + right_inv _ := rfl }, finrank_tensorProduct, CrossProductAlgebra.dim_eq_sq, + CrossProductAlgebra.dim_eq_sq, pow_two, pow_succ] + group + +open MulOpposite in +/-- The tensor product algebra as the opposite of the endomorphism algebra of `M`. -/ +def φ2 : (A ⊗[F] B) ≃ₐ[F] (Module.End C (M α β))ᵐᵒᵖ where + toFun a := op <| φ1 (op a) + invFun g := (φ1.symm g.unop).unop + left_inv x := by simp + right_inv x := by simp + map_mul' := by intros; simp + map_add' := by intros; simp + commutes' f := by + simp only [Algebra.TensorProduct.algebraMap_apply, MulOpposite.algebraMap_apply, op_inj] + rw [Algebra.algebraMap_eq_smul_one, ← smul_tmul', op_smul, ← (φ0 (α := α) (β := β)).commutes f, + Algebra.algebraMap_eq_smul_one] + rfl + +/-- The tensor product algebra as an opposite matrix algebra over `End_C(SM)`. -/ +def φ3 : + (A ⊗[F] B) ≃ₐ[F] + (Matrix (Fin (finrank F K * Fintype.card ι)) (Fin (finrank F K * Fintype.card ι)) + (Module.End C SM))ᵐᵒᵖ := φ2.trans <| endCMIso' _ _ |>.op + +/-- The tensor product algebra as a matrix algebra over the opposite endomorphism algebra. -/ +def φ4 : + (A ⊗[F] B) ≃ₐ[F] + (Matrix (Fin (finrank F K * Fintype.card ι)) (Fin (finrank F K * Fintype.card ι)) + (Module.End C SM)ᵐᵒᵖ) := + φ3.trans ((BrauerGroup.matrixEquivMatrixMop_algebra F _ _).symm) + +lemma isBrauerEquivalent : IsBrauerEquivalent (⟨.of F (A ⊗[F] B)⟩ : CSA F) ⟨.of F C⟩ := by + let iso1 := C_iso (α := α) (β := β) |>.mapMatrix (m := Fin (finrank F K)) + let iso11 := iso1.trans (Matrix.compAlgEquiv _ _ _ _) |>.trans + (Matrix.reindexAlgEquiv _ _ finProdFinEquiv) + let iso2 := φ4 (α := α) (β := β) + let iso3 := iso11.trans iso2.symm + haveI : NeZero (finrank F K) := ⟨by have : 0 < finrank F K := finrank_pos; omega⟩ + exact ⟨1, finrank F K, one_ne_zero, (NeZero.ne' (finrank F K)).symm, + ⟨(BrauerGroup.dim_one_iso (⟨.of F (A ⊗[F] B)⟩ : CSA F)).trans iso3.symm⟩⟩ + +end map_mul_proof + +namespace RelativeBrGroup + +variable [FiniteDimensional F K] [IsGalois F K] [DecidableEq Gal(K, F)] + +-- @[simps] +-- def fromSndAddMonoidHom : +-- H2 (galAct F K) →+ Additive (RelativeBrGroup K F) where +-- toFun := Additive.ofMul ∘ RelativeBrGroup.fromSnd _ _ +-- map_zero' := by +-- simpa only [Function.comp_apply, ofMul_eq_zero] using map_one_proof.fromSnd_zero K F +-- map_add' := by +-- intro x y +-- induction x using Quotient.inductionOn' with | h x => +-- induction y using Quotient.inductionOn' with | h y => +-- simp only [Function.comp_apply] +-- rcases x with ⟨x, hx'⟩ +-- have hx := isMulCocycle₂_of_cocycles₂ ⟨x, hx'⟩ +-- rcases y with ⟨y, hy'⟩ +-- have hy := isMulCocycle₂_of_cocycles₂ ⟨y, hy'⟩ +-- rw [fromSnd_wd, fromSnd_wd] +-- erw [fromSnd_wd] +-- apply_fun Additive.toMul +-- simp only [AddMemClass.mk_add_mk, toMul_ofMul, toMul_add, MulMemClass.mk_mul_mk, +-- Subtype.mk.injEq] +-- change _ = Quotient.mk'' _ +-- rw [Quotient.eq''] +-- exact map_mul_proof.isBrauerEquivalent hx hy |>.symm + +-- def toSndAddMonoidHom : Additive (RelativeBrGroup K F) →+ H2 (galAct F K) where +-- toFun := RelativeBrGroup.toSnd ∘ Additive.toMul +-- map_zero' := by +-- simp only [Function.comp_apply, toMul_zero] +-- apply_fun fromSnd F K using equivSnd.symm.injective +-- rw [map_one_proof.fromSnd_zero] +-- exact congr_fun fromSnd_toSnd 1 +-- map_add' := by +-- intro x y +-- dsimp only +-- apply_fun fromSndAddMonoidHom K F using equivSnd.symm.injective +-- rw [map_add] +-- simp only [Function.comp_apply, toMul_add, fromSndAddMonoidHom_apply, +-- show ∀ x, fromSnd F K (toSnd x) = x by intro x; exact congr_fun fromSnd_toSnd x, ofMul_mul, +-- ofMul_toMul] + +open groupCohomology in +/-- The additive form of the isomorphism between the relative Brauer group and second cohomology. -/ +def isoSnd : Additive (RelativeBrGroup K F) ≃+ H2 (galAct F K) := + .symm <| .mk' (Additive.ofMul.symm.trans <| equivSnd (F := F) (K := K)).symm fun x y ↦ by + induction x using H2_induction_on with | h x => + induction y using H2_induction_on with | h y => + rcases x with ⟨x, hx'⟩ + have hx := isMulCocycle₂_of_mem_cocycles₂ _ hx' + rcases y with ⟨y, hy'⟩ + have hy := isMulCocycle₂_of_mem_cocycles₂ _ hy' + simp only [Additive.ofMul_symm_eq, equivSnd, + CategoryTheory.ShortComplex.moduleCatLeftHomologyData_H, H2π, ModuleCat.hom_comp, + LinearMap.coe_comp, Function.comp_apply, Equiv.symm_trans_apply, Additive.toMul_symm_eq, + Equiv.coe_fn_symm_mk] + apply_fun Additive.toMul + simp only [toMul_ofMul, toMul_add] + let L := ModuleCat.Hom.hom (H2Iso (galAct F K)).hom + let px := + (ModuleCat.Hom.hom (π (galAct F K) 2)) + ((ModuleCat.Hom.hom (isoCocycles₂ (galAct F K)).inv) ⟨x, hx'⟩) + let py := + (ModuleCat.Hom.hom (π (galAct F K) 2)) + ((ModuleCat.Hom.hom (isoCocycles₂ (galAct F K)).inv) ⟨y, hy'⟩) + change fromSnd F K (L (px + py)) = fromSnd F K (L px) * fromSnd F K (L py) + rw [map_add] + dsimp only [L, px, py] + simp only [CategoryTheory.ShortComplex.moduleCatLeftHomologyData_H, π_comp_H2Iso_hom_apply, + CategoryTheory.Iso.inv_hom_id_apply] + change fromSnd F K (Quotient.mk'' _) = + fromSnd F K (Quotient.mk'' _) * fromSnd F K (Quotient.mk'' _) + erw [fromSnd_wd, fromSnd_wd] + erw [fromSnd_wd] + simp only [MulMemClass.mk_mul_mk] + refine Subtype.ext ?_ + change _ = Quotient.mk'' _ + rw [Quotient.eq''] + change IsBrauerEquivalent _ _ + exact @map_mul_proof.isBrauerEquivalent _ _ _ _ _ _ _ ⟨hx⟩ ⟨hy⟩ _ _ |>.symm + + +end RelativeBrGroup From 275547d2c5e0e8c5ede7be7b1aa3347e8e23ffdf Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 19:57:36 -0700 Subject: [PATCH 27/34] Port BrauerGroup Frobenius theorem --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew.lean | 1 + LeanPool/BrauerGroupNew/FrobeniusTheorem.lean | 971 ++++++++++++++++++ 3 files changed, 973 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/FrobeniusTheorem.lean diff --git a/LeanPool.lean b/LeanPool.lean index 9993249274..559d457d52 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -66,6 +66,7 @@ import LeanPool.BrauerGroupNew.Examples.ShortComplex.LeftHomologyMapData import LeanPool.BrauerGroupNew.ExtendScalar import LeanPool.BrauerGroupNew.FieldCat import LeanPool.BrauerGroupNew.FiniteField +import LeanPool.BrauerGroupNew.FrobeniusTheorem import LeanPool.BrauerGroupNew.IsoSecond import LeanPool.BrauerGroupNew.LemmasAboutSimpleRing import LeanPool.BrauerGroupNew.Mathlib diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index a0474ecc0e..963f8bb26c 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -30,6 +30,7 @@ import LeanPool.BrauerGroupNew.SkolemNoether import LeanPool.BrauerGroupNew.ToSecond import LeanPool.BrauerGroupNew.IsoSecond import LeanPool.BrauerGroupNew.DoubleCentralizer +import LeanPool.BrauerGroupNew.FrobeniusTheorem import LeanPool.BrauerGroupNew.Mathlib import LeanPool.BrauerGroupNew.Subfield diff --git a/LeanPool/BrauerGroupNew/FrobeniusTheorem.lean b/LeanPool/BrauerGroupNew/FrobeniusTheorem.lean new file mode 100644 index 0000000000..4c88a2c19b --- /dev/null +++ b/LeanPool/BrauerGroupNew/FrobeniusTheorem.lean @@ -0,0 +1,971 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Subfield.FiniteDimensional +import LeanPool.BrauerGroupNew.Subfield.Subfield +import Mathlib.Algebra.QuaternionBasis +import Mathlib.Analysis.Quaternion +import Mathlib.LinearAlgebra.Complex.FiniteDimensional + +suppress_compilation + +open FiniteDimensional Module TensorProduct + +variable {D : Type} [DivisionRing D] + +section prerequisites + +theorem rank_1_D_iso_R [Algebra ℝ D] : Module.finrank ℝ D = 1 → + Nonempty (D ≃ₐ[ℝ] ℝ) := fun h ↦ by + have h' := Subalgebra.finrank_eq_one_iff (F := ℝ) (S := (⊤ : Subalgebra ℝ D)) + have : Module.finrank ℝ (⊤ : Subalgebra ℝ D) = 1 := by + simp_all only [Subalgebra.finrank_eq_one_iff, Subalgebra.bot_eq_top_of_finrank_eq_one] + exact ⟨Subalgebra.topEquiv.symm.trans <| Subalgebra.equivOfEq _ _ + (h'.1 this)|>.trans <| Algebra.botEquiv ℝ D⟩ + +lemma RealExtension_is_RorC (K : Type) [Field K] [Algebra ℝ K] [FiniteDimensional ℝ K] : + Nonempty (K ≃ₐ[ℝ] ℝ) ∨ Nonempty (K ≃ₐ[ℝ] ℂ) := by + let CC := AlgebraicClosure K + letI : Algebra ℝ CC := AlgebraicClosure.instAlgebra K + haveI : IsAlgClosure ℝ CC := ⟨inferInstance, Algebra.IsAlgebraic.trans ℝ K CC⟩ + haveI : IsAlgClosure ℝ ℂ := ⟨inferInstance, inferInstance⟩ + let e : ℂ ≃ₐ[ℝ] CC := IsAlgClosure.equiv ℝ _ _ + have dim_eq1 : Module.finrank ℝ CC = 2 := by + exact e.toLinearEquiv.finrank_eq.symm.trans Complex.finrank_real_complex + have dim_eq2 : Module.finrank ℝ K * Module.finrank K CC = 2 := by + rw [Module.finrank_mul_finrank, dim_eq1] + haveI : Module.Finite ℝ CC := by + exact FiniteDimensional.of_finrank_eq_succ (by simpa using dim_eq1) + haveI : Module.Finite K CC := Module.Finite.right ℝ K CC + have dim_eq3 : Module.finrank ℝ K = 1 ∨ Module.finrank ℝ K = 2 := by + have ineq1 : 0 < Module.finrank ℝ K := Module.finrank_pos + have ineq2 : 0 < Module.finrank K CC := Module.finrank_pos + have : Module.finrank ℝ K ∈ Nat.divisors 2 := by + simpa using ⟨Module.finrank K CC, dim_eq2.symm⟩ + rw [show Nat.divisors 2 = {1, 2} from rfl] at this + simpa using this + rcases dim_eq3 with ⟨h1⟩ | ⟨h2⟩ + · left + exact Nonempty.intro <| AlgEquiv.symm <| AlgEquiv.ofBijective (Algebra.ofId _ _) + (bijective_of_dim_eq_of_isCentralSimple _ _ _ _ <| by simp [h1]) + · right + exact Nonempty.intro <| AlgEquiv.ofBijective + (e.symm.toAlgHom.comp <| Algebra.ofId K CC |>.restrictScalars ℝ) + (bijective_of_dim_eq_of_isCentralSimple _ _ _ _ <| by + rw [h2] + exact Complex.finrank_real_complex.symm) + +end prerequisites + +namespace BrauerGroupNew + +variable [hD' : IsSimpleRing D] [Algebra ℝ D] (k : SubField ℝ D) (hk : IsMax k) (e : k ≃ₐ[ℝ] ℂ) + +open ComplexConjugate + +/-- The conjugation automorphism of a maximal subfield identified with `ℂ`. -/ +abbrev f : k →ₐ[ℝ] k where + toFun kk := e.symm <| conj (e kk) + map_one' := by simp only [map_one] + map_mul' := by simp only [map_mul, implies_true] + map_zero' := by simp only [map_zero] + map_add' x y := by simp only [map_add] + commutes' := fun r ↦ by + simp only [AlgEquiv.commutes, Complex.coe_algebraMap, Complex.conj_ofReal] + rw [← mul_one (algebraMap _ _ r), ← Algebra.smul_def] + nth_rw 1 [← mul_one r] + unfold Complex.ofReal + rw [← smul_eq_mul, show (⟨r • 1, 0⟩ : ℂ) = r • ⟨1, 0⟩ by + apply Complex.ext + · simp only [smul_eq_mul, mul_one, Complex.real_smul, Complex.mul_re, Complex.ofReal_re, + Complex.ofReal_im, mul_zero, sub_zero] + · simp only [Complex.real_smul, Complex.mul_im, Complex.ofReal_re, mul_zero, + Complex.ofReal_im, mul_one, add_zero]] + rw [_root_.map_smul, show ⟨1, 0⟩ = (1 : ℂ) by rfl, _root_.map_one] + +lemma f_injective : Function.Injective (f k e) := by + intro x y h + simp only [AlgHom.coe_mk, RingHom.coe_mk, MonoidHom.coe_mk, OneHom.coe_mk, + EmbeddingLike.apply_eq_iff_eq] at h + have : Function.Injective <| starRingEnd ℂ := by exact RingHom.injective (starRingEnd ℂ) + apply this at h + apply e.injective + exact h + +@[simp] +lemma f_apply (x : k) : f k e x = e.symm (conj (e x)) := rfl + +lemma f_apply_apply (z : ℂ) : f k e (e.symm z) = e.symm (conj z) := by + rw [f_apply] + congr + exact AlgEquiv.apply_symm_apply e z + +lemma linindep_one_xsq (x : Dˣ) (hxx : ¬x.1 ^ 2 ∈ Subalgebra.center ℝ D) : + LinearIndependent ℝ ![(1 : D), x.1^2] := by + rw [LinearIndependent.pair_iff] + by_contra! hh + obtain ⟨s, t, ⟨hst1, hst2⟩⟩ := hh + if hs : s = 0 then + rw [hs, zero_smul, zero_add] at hst1 + simp only [smul_eq_zero, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, pow_eq_zero_iff, + Units.ne_zero, or_false] at hst1 + apply hst2 at hs + exact hs hst1 + else + if ht : t = 0 then + rw [ht, zero_smul, add_zero, smul_eq_zero] at hst1 + simp only [one_ne_zero, or_false] at hst1 + exact hst2 hst1 ht + else + rw [add_eq_zero_iff_eq_neg, ← neg_smul] at hst1 + apply_fun ((-t)⁻¹ • ·) at hst1 + rw [← smul_assoc, ← smul_assoc, smul_eq_mul, + smul_eq_mul, inv_mul_cancel₀ (by simp_all only [ne_eq, not_true_eq_false, false_implies, + mul_neg, neg_smul, neg_eq_zero, not_false_eq_true]), one_smul] at hst1 + have : x.1^2 ∈ Subalgebra.center ℝ D := by + rw [Subalgebra.mem_center_iff] + intro d + rw [← hst1] + simp only [Algebra.mul_smul_comm, mul_one, Algebra.smul_mul_assoc, one_mul] + exact hxx this + +lemma x2_comm_k (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) : + ∀ (y : k), x.1^2 * k.val y = k.val y * x.1^2 := by + have hx2 := hx + intro y + specialize hx y + simp only [Subalgebra.coe_val] at hx + erw [Subtype.ext_iff.1 (f_apply k e y)] at hx + apply_fun (x.1 * · * x.1⁻¹) at hx + erw [← mul_assoc, ← mul_assoc] at hx + have : k.val y = (x.1⁻¹ * x.1⁻¹) * k.val y * (x.1 * x.1) := by + nth_rw 1 [← hx2 y, show ((f k e y) : D) = k.val (f k e y) from rfl, + ← hx2, show (f k e (f k e y)) = y by simp, show (y : D) = k.val y from rfl] + simp [← mul_assoc] + apply_fun (x.1 * x.1 * · ) at this + erw [← mul_assoc, ← mul_assoc, ← mul_assoc, ← mul_assoc, mul_assoc x.1 x.1 x.1⁻¹, + mul_inv_cancel₀ (by simp only [ne_eq, Units.ne_zero, not_false_eq_true]), mul_one, + mul_inv_cancel₀ (by simp only [ne_eq, Units.ne_zero, not_false_eq_true]), one_mul, + ← pow_two, mul_assoc, ← pow_two] at this + exact this + +lemma i_mul_i : (e.symm ⟨0, 1⟩ : D) * e.symm ⟨0, 1⟩ = (-1 : ℝ) • 1 := by + rw [← Subalgebra.coe_mul, ← _root_.map_mul e.symm, ← Complex.I, Complex.I_mul_I, map_neg, + map_one, Subalgebra.coe_neg, Subalgebra.coe_one]; simp + +lemma i_ne_zero : (e.symm ⟨0, 1⟩ : D) ≠ 0 := by + intro h + change _ = ((0 : k) : D) at h + simp only [ZeroMemClass.coe_zero, ZeroMemClass.coe_eq_zero, EmbeddingLike.map_eq_zero_iff] at h + rw [Complex.ext_iff] at h + obtain ⟨_, h⟩ := h + simp only [Complex.zero_im, one_ne_zero] at h + +lemma linindep1i : + LinearIndependent ℝ ![(1 : D), ↑(e.symm { re := 0, im := 1 })] := by + rw [LinearIndependent.pair_iff'] + · intro r + rw [show (1 : D) = (1 : k) from rfl, ← Subalgebra.coe_smul, + ← _root_.map_one e.symm, ← map_smul e.symm] + suffices (r : ℂ) ≠ (⟨0, 1⟩ : ℂ) by + intro h + apply this + rw [show (r : ℂ) = r • (1 : ℂ) by simp] + exact e.symm.injective (Subtype.ext h) + intro h + rw [Complex.ext_iff] at h + norm_num at h + · exact one_ne_zero + +variable [Algebra.IsCentral ℝ D] [FiniteDimensional ℝ D] + +lemma f_is_conjugation : ∃ (x : Dˣ), ∀ z, x.1⁻¹ * f k e z * x = k.val z := by + obtain ⟨x, hx⟩ := SkolemNoether' ℝ D k k.val (k.val.comp (f k e)) + use x + intro z + have hx2 := hx + specialize hx z + apply_fun fun y ↦ ↑x⁻¹ * y * ↑x at hx + nth_rw 2 [mul_assoc, mul_assoc] at hx + simp only [Units.val_inv_eq_inv_val, isUnit_iff_ne_zero, ne_eq, Units.ne_zero, not_false_eq_true, + IsUnit.inv_mul_cancel, mul_one, IsUnit.inv_mul_cancel_left] at hx + exact hx + +lemma xsq_ink (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (hDD : Module.finrank ℝ D = 4) : x.1^2 ∈ k := by + have := cor_two_1to2 ℝ D k|>.2 (by + rw [hDD, e.toLinearEquiv.finrank_eq] + calc + 4 = 2 * 2 := by norm_num + _ = Module.finrank ℝ ℂ * Module.finrank ℝ ℂ := by + rw [← Complex.finrank_real_complex]) + change x.1^2 ∈ k.1 + rw [← this, Subalgebra.mem_centralizer_iff] + simp only [SubField.coe_toSubalgebra, SetLike.mem_coe] + intro z hz + have := (x2_comm_k _ _ _ hx ⟨z, hz⟩).symm + simp only [Subalgebra.coe_val] at this + exact this + +lemma indep' (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (hDD : Module.finrank ℝ D = 4) (hxx : ¬x.1 ^ 2 ∈ Subalgebra.center ℝ D) : + LinearIndependent ℝ (M := k) ![1, ⟨x.1^2, (xsq_ink _ _ _ hx hDD)⟩] := by + have indep := linindep_one_xsq _ hxx + rw [LinearIndependent.pair_iff] at * + intro s t hst' + specialize indep s t + apply_fun k.val at hst' + rw [_root_.map_add, map_smul, map_smul] at hst' + simp only [Subalgebra.coe_val, OneMemClass.coe_one, ZeroMemClass.coe_zero] at hst' + exact indep hst' + +/-- The two-element basis of a maximal subfield generated by `1` and `x ^ 2`. -/ +abbrev IsBasis (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (hDD : Module.finrank ℝ D = 4) (hxx : ¬x.1 ^ 2 ∈ Subalgebra.center ℝ D) : + Basis (Fin (Nat.succ 0).succ) ℝ k := + .mk (M := k) (v := ![1, ⟨x.1^2, xsq_ink _ _ _ hx hDD⟩]) (indep' _ _ _ hx hDD hxx) <| by + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Matrix.range_cons, + Matrix.range_empty, Set.union_empty, Set.union_singleton, top_le_iff] + have : Module.finrank ℝ (Submodule.span ℝ {⟨x.1^2, xsq_ink _ _ _ hx hDD⟩, (1 : k)}) = 2 := by + have indep' := indep' _ _ _ hx hDD hxx + apply LinearIndependent.span_eq_top_of_card_eq_finrank' at indep' + simp only [Nat.succ_eq_add_one, zero_add, Nat.reduceAdd, Fintype.card_fin, + Matrix.range_cons, Matrix.range_empty, Set.union_empty, Set.union_singleton] at indep' + have : 2 = Module.finrank ℝ k := by + rw [LinearEquiv.finrank_eq e.toLinearEquiv] + symm + exact Complex.finrank_real_complex + apply indep' at this + rw [this, finrank_top] + change Module.finrank ℝ k = 2 + rw [LinearEquiv.finrank_eq e.toLinearEquiv] + exact Complex.finrank_real_complex + have eq := Submodule.topEquiv.finrank_eq.trans <| + e.toLinearEquiv.finrank_eq.trans Complex.finrank_real_complex + exact Submodule.eq_of_le_of_finrank_eq le_top <| this.trans eq.symm + +lemma IsBasis0 (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (hDD : Module.finrank ℝ D = 4) (hxx : ¬x.1 ^ 2 ∈ Subalgebra.center ℝ D) : + IsBasis _ _ _ hx hDD hxx 0 = 1 := by simp [IsBasis] + +lemma IsBasis1 (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (hDD : Module.finrank ℝ D = 4) (hxx : ¬x.1 ^ 2 ∈ Subalgebra.center ℝ D) : + IsBasis _ _ _ hx hDD hxx 1 = ⟨x.1^2, xsq_ink _ _ _ hx hDD⟩ := by simp [IsBasis] + +lemma x2_is_real (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (hDD : Module.finrank ℝ D = 4) : x.1^2 ∈ (algebraMap ℝ D).range := by + let hx2 := hx + have x2_is_central : x.1^2 ∈ Subalgebra.center ℝ D := by + have x2_commutes_K := x2_comm_k _ _ _ hx + by_contra! hxx + have xink := xsq_ink _ _ _ hx hDD + have indep' := indep' _ _ _ hx hDD hxx + let IsBasis := IsBasis _ _ _ hx hDD hxx + have x_commutes_k : ∀ (y : k), x.1 * k.val y = k.val y * x.1 := by + intro y + have := Basis.linearCombination_repr IsBasis y|>.symm + rw [this, Finsupp.linearCombination_apply, Finsupp.sum_fintype] + · simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Fin.sum_univ_two, Fin.isValue] + rw [IsBasis0, IsBasis1] + erw [mul_add, add_mul] + rw [Subalgebra.coe_smul, mul_smul_comm, smul_mul_assoc, Subalgebra.coe_one, + one_mul, mul_one, add_right_inj, Subalgebra.coe_smul, mul_smul_comm, + show ((⟨x.1^2, xink⟩ : k) : D) = x.1^2 by rfl, pow_two, ← mul_assoc, smul_mul_assoc] + · exact fun _ ↦ Subtype.ext_iff.2 <| zero_smul _ _ + specialize x_commutes_k <| e.symm ⟨0,1⟩ + specialize hx <| e.symm ⟨0,1⟩ + simp only [Subalgebra.coe_val] at hx + simp only [Subalgebra.coe_val] at x_commutes_k + apply_fun (· * x.1⁻¹) at x_commutes_k + simp only [isUnit_iff_ne_zero, ne_eq, Units.ne_zero, not_false_eq_true, + IsUnit.mul_inv_cancel_right] at x_commutes_k + erw [← hx, f_apply] at x_commutes_k + simp only [AlgEquiv.apply_symm_apply] at x_commutes_k + have : starRingEnd ℂ ⟨0, 1⟩ = ⟨0, -1⟩:= rfl + simp only [this, mul_assoc, isUnit_iff_ne_zero, ne_eq, Units.ne_zero, not_false_eq_true, + IsUnit.mul_inv_cancel, mul_one, IsUnit.mul_inv_cancel_left] at x_commutes_k + unfold f at hx2 + specialize hx2 <| e.symm ⟨0,1⟩ + simp only [this, f_apply, AlgEquiv.apply_symm_apply, Subalgebra.coe_val] at hx2 + erw [← mul_assoc, hx2] at x_commutes_k + simp only [SetLike.coe_eq_coe, EmbeddingLike.apply_eq_iff_eq, Complex.mk.injEq, true_and] + at x_commutes_k + norm_num at x_commutes_k + change _ ∈ (⊥ : Subalgebra ℝ D) + rw [← Algebra.IsCentral.center_eq_bot ℝ D] + exact x2_is_central + +open scoped algebraMap in +/-- The set of elements whose square is a negative real scalar. -/ +abbrev V : Set D := {x | ∃ r : ℝ, r < 0 ∧ x^2 = (r : D)} + +omit [Algebra.IsCentral ℝ D] [FiniteDimensional ℝ D] hD' in +lemma V_def (x : D) : x ∈ V ↔ ∃ r < 0, x ^ 2 = algebraMap ℝ D r := .rfl + +omit [Algebra.IsCentral ℝ D] [FiniteDimensional ℝ D] hD' in +lemma real_sq_in_R_or_V (x : D) : + x ^ 2 ∈ (algebraMap ℝ D).range → x ∈ (algebraMap ℝ D).range ∨ x ∈ V := by + rintro ⟨r, hr⟩ + if h'' : x ∈ V then + exact Or.inr h'' + else + left + simp only [V_def, not_exists, not_and] at h'' + have : r ≥ 0 := by + specialize h'' r + by_contra! + exact h'' this (id (Eq.symm hr)) + have eq1 : (x - algebraMap ℝ D (Real.sqrt r)) * ( x + algebraMap ℝ D (Real.sqrt r)) = 0 := by + simp only [mul_add, sub_mul] + rw [← pow_two, ← hr, ← map_mul, + show algebraMap ℝ D √r * x = x * algebraMap ℝ D √r from Algebra.commutes' _ _] + simp only [sub_add_sub_cancel, ← map_sub, map_eq_zero] + rw [sub_eq_zero, ← pow_two] + symm + apply Real.sq_sqrt + positivity + simp only [mul_eq_zero] at eq1 + rcases eq1 with eq1|eq1 + · use Real.sqrt r + rw [sub_eq_zero] at eq1 + rw [eq1] + · use - Real.sqrt r + rwa [map_neg, eq_comm, eq_neg_iff_add_eq_zero] + +lemma x_is_in_V (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x.1 = k.val z) + (hDD : Module.finrank ℝ D = 4) : x.1 ∈ V := by + let hx3 := hx + apply x2_is_real _ at hx + let hx' := hx hDD + have hx := real_sq_in_R_or_V _ hx' + have : x.1 ∉ (algebraMap ℝ D).range := by + by_contra! hxx + obtain ⟨r, hr⟩ := hxx + have xcomm : ∀ (y : k), x.1⁻¹ * k.val y * x.1 = k.val y := by + intro y + rw [← hr, mul_assoc] + simp only [Subalgebra.coe_val, ← Algebra.commutes, ← mul_assoc] + rw [mul_inv_cancel₀ (by simp [hr, Units.ne_zero]), one_mul] + specialize xcomm (e.symm Complex.I) + specialize hx3 (e.symm Complex.I) + rw [← xcomm] at hx3 + symm at hx3 + simp only [f_apply, AlgEquiv.apply_symm_apply, Complex.conj_I, map_neg, NegMemClass.coe_neg, + mul_neg, neg_mul, Subalgebra.coe_val, eq_neg_iff_add_eq_zero, ← two_mul, mul_eq_zero] at hx3 + obtain hx31 | hx32 := hx3 + · rw [show (2 : D) = (1 : D) + (1 : D) by norm_num, ← two_smul ℝ, + smul_eq_zero] at hx31; aesop + · simp only [inv_eq_zero, Units.ne_zero, ZeroMemClass.coe_eq_zero, + EmbeddingLike.map_eq_zero_iff, Complex.I_ne_zero, or_self] at hx32 + simp_all only [Set.mem_setOf_eq, false_or, RingHom.mem_range, not_exists] + +-- instance : NoZeroSMulDivisors ℝ D := inferInstance + +lemma x_corre_R (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x.1 = k.val z) + (hDD : Module.finrank ℝ D = 4) : + ∃(r : ℝ), algebraMap ℝ D r = - x.1^2 := by + have := x_is_in_V _ _ _ hx + rw [V_def] at this + obtain ⟨r, hr1, hr2⟩ := this hDD + use -r + simp only [map_neg, hr2] + +lemma r_pos (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x.1 = k.val z) + (hDD : Module.finrank ℝ D = 4) : + 0 < (x_corre_R _ _ _ hx hDD).choose := by + have eq1 := x_is_in_V _ _ _ hx + rw [V_def] at eq1 + obtain ⟨r, hr1, hr2⟩ := eq1 hDD + have eq2 := x_corre_R _ _ _ hx hDD|>.choose_spec + have : -r = (x_corre_R _ _ _ hx hDD).choose := by + apply_fun -(·) at hr2 + simp only [Pi.neg_apply] at hr2 + have := eq2.trans hr2 + simp only [← map_neg] at this + exact FaithfulSMul.algebraMap_injective _ _ this|>.symm + rw [← this] + simp only [Left.neg_pos_iff, hr1] + +lemma j_mul_j (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (hDD : Module.finrank ℝ D = 4) : + (algebraMap ℝ D) (Real.sqrt (x_corre_R _ _ _ hx hDD).choose)⁻¹ * ↑x * + ((algebraMap ℝ D) (Real.sqrt (x_corre_R _ _ _ hx hDD).choose)⁻¹ * ↑x) = (-1 : ℝ) • 1 := by + rw [← mul_assoc, show algebraMap ℝ D _ = (algebraMap ℝ k _ : D) from rfl] + have hx1 := hx + specialize hx <| (algebraMap ℝ k (Real.sqrt (x_corre_R _ _ _ hx hDD).choose)⁻¹) + simp only [AlgHom.commutes, Subalgebra.coe_val] at hx + apply_fun (x.1 * · ) at hx + rw [← mul_assoc, ← mul_assoc, mul_inv_cancel₀ (Units.ne_zero x), one_mul] at hx + rw [mul_assoc _ x.1, ← hx, ← mul_assoc, ← Subalgebra.coe_mul, ← map_mul (algebraMap ℝ k), + ← mul_inv, ← pow_two, Real.sq_sqrt, show (algebraMap ℝ k _ : D) = + algebraMap ℝ D _ from rfl, map_inv₀ (algebraMap ℝ D) (x_corre_R _ _ _ hx1 hDD).choose, + (x_corre_R _ _ _ hx1 hDD).choose_spec, mul_assoc, ← pow_two, ← neg_inv, neg_mul, + inv_mul_cancel₀ (by simp_all only [f_apply, Subalgebra.coe_val, Subtype.forall, map_inv₀, + ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, pow_eq_zero_iff, Units.ne_zero])] + · simp only [neg_smul, one_smul] + · exact (r_pos _ _ _ hx1 hDD).le + +lemma jij_eq_negi (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (hDD : Module.finrank ℝ D = 4) : + ((algebraMap ℝ D) (Real.sqrt (x_corre_R _ _ _ hx hDD).choose)⁻¹ * x.1) * e.symm ⟨0, 1⟩ * + ((algebraMap ℝ D) (Real.sqrt (x_corre_R _ _ _ hx hDD).choose)⁻¹ * x.1)⁻¹ = - e.symm ⟨0, 1⟩ := by + rw [show algebraMap ℝ D _ = (algebraMap ℝ k _ : D) from rfl, mul_inv_rev, ← mul_assoc] + have hx1 := hx + specialize hx <| e.symm ⟨0, 1⟩ + apply_fun (x.1 * · * x.1⁻¹) at hx + rw [← mul_assoc, ← mul_assoc, mul_inv_cancel₀ (Units.ne_zero x), one_mul, mul_assoc, + mul_inv_cancel₀ (Units.ne_zero x), mul_one] at hx + simp only [f_apply, AlgEquiv.apply_symm_apply, Subalgebra.coe_val] at hx + rw [mul_assoc, mul_assoc, mul_assoc]; nth_rw 2 [← mul_assoc, ← mul_assoc] + rw [← hx, ← Complex.I, Complex.conj_I, ← mul_assoc, ← Subalgebra.coe_mul, mul_comm, + Subalgebra.coe_mul, mul_assoc, mul_inv_cancel₀, mul_one, map_neg, Subalgebra.coe_neg] + simp only [map_inv₀, ne_eq, ZeroMemClass.coe_eq_zero, inv_eq_zero, map_eq_zero] + by_contra! zero + apply_fun (·)^2 at zero + rw [Pi.pow_apply, Real.sq_sqrt (le_of_lt (r_pos _ _ _ hx1 hDD)), Pi.pow_apply, + pow_two 0, zero_mul] at zero + haveI := r_pos _ _ _ hx1 + simp_all + +lemma k_sq_eq_negone (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (hDD : Module.finrank ℝ D = 4) : + (e.symm ⟨0, 1⟩ * ((algebraMap ℝ D (Real.sqrt + (x_corre_R k e x hx hDD).choose)⁻¹) * x.1))^2 = -1 := by + rw [pow_two] + set j := (algebraMap ℝ D (Real.sqrt (x_corre_R k e x hx hDD).choose)⁻¹) * x.1 with j_eq + nth_rw 2 [← mul_one (e.symm { re := 0, im := 1 })] + rw [Subalgebra.coe_mul, Subalgebra.coe_one] + nth_rw 1 [← @inv_mul_cancel₀ _ _ j (by + simp only [j_eq, map_inv₀, ne_eq, mul_eq_zero, inv_eq_zero, map_eq_zero, + Units.ne_zero, or_false] + by_contra! heq + apply_fun (·)^2 at heq + rw [Pi.pow_apply, Real.sq_sqrt (le_of_lt (r_pos _ _ _ hx hDD)), Pi.pow_apply, + pow_two 0, zero_mul] at heq + haveI := r_pos _ _ _ hx + simp_all only [Real.sqrt_zero, inv_zero, map_zero, zero_mul, lt_self_iff_false]), mul_assoc] + nth_rw 2 [← mul_assoc, ← mul_assoc, ← mul_assoc, ← mul_assoc] + rw [jij_eq_negi _ _ _ hx, ← Subalgebra.coe_neg, ← map_neg e.symm, ← mul_assoc, + ← mul_assoc, ← mul_assoc, ← Subalgebra.coe_mul, ← map_mul e.symm, ← Complex.I, mul_neg, + Complex.I_mul_I, neg_neg, map_one, Subalgebra.coe_one, one_mul, mul_assoc, j_mul_j _ _ _ hx] + · simp + · exact hDD + · exact hDD + +lemma j_ne_zero (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) (hDD : Module.finrank ℝ D = 4) : + (algebraMap ℝ D (Real.sqrt (x_corre_R _ _ _ hx hDD).choose)⁻¹) * x.1 ≠ 0 := by + intro h + simp only [mul_eq_zero, Units.ne_zero, or_false] at h + simp only [map_inv₀, inv_eq_zero, map_eq_zero] at h + apply_fun (· ^ 2) at h + rw [Real.sq_sqrt (r_pos _ _ _ hx _).le, pow_two 0, zero_mul] at h + · exact (r_pos _ _ _ hx hDD).ne' h + · exact hDD + +lemma k_ne_zero (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) (hDD : Module.finrank ℝ D = 4) : + e.symm ⟨0, 1⟩ * (algebraMap ℝ D (Real.sqrt (x_corre_R k e x hx hDD).choose)⁻¹ * x.1) ≠ 0 := + mul_ne_zero (i_ne_zero k e) (j_ne_zero _ _ _ hx hDD) + +lemma j_mul_i_eq_neg_i_mul_j (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (hDD : Module.finrank ℝ D = 4) : + (algebraMap ℝ D) (Real.sqrt (x_corre_R _ _ _ hx hDD).choose)⁻¹ * ↑x * + ↑(e.symm { re := 0, im := 1 }) = -(↑(e.symm { re := 0, im := 1 }) * + ((algebraMap ℝ D) (Real.sqrt (x_corre_R _ _ _ hx hDD).choose)⁻¹ * ↑x)) := by + have := k_sq_eq_negone _ _ _ hx hDD + rw [pow_two] at this + set j := (algebraMap ℝ D (Real.sqrt (x_corre_R k e x hx hDD).choose)⁻¹) * x.1 with j_eq + apply_fun (· * ((↑(e.symm { re := 0, im := 1 }) * j)⁻¹)) at this + rw [mul_assoc, mul_inv_cancel₀ (k_ne_zero _ _ _ hx hDD), mul_one, mul_inv_rev] at this + have jinv : j⁻¹ = -j := by + rw [← mul_eq_one_iff_inv_eq₀ (j_ne_zero _ _ _ hx hDD) , mul_neg, j_mul_j _ _ _ hx] + · simp + · exact hDD + have iinv : ((e.symm { re := 0, im := 1 })).1⁻¹ = - (e.symm { re := 0, im := 1 }).1 := by + rw [← mul_eq_one_iff_inv_eq₀ (i_ne_zero _ _), mul_neg, ← Subalgebra.coe_mul, + ← map_mul e.symm, ← Complex.I, Complex.I_mul_I, map_neg, map_one, Subalgebra.coe_neg, + neg_neg]; rfl + rw [jinv, iinv] at this + simp only [mul_neg, neg_mul, neg_neg, one_mul] at this + apply_fun fun x ↦ -x at this + simp only [neg_neg] at this + exact this.symm + +open Quaternion + +/-- The algebra homomorphism from Hamilton quaternions determined by the constructed basis. -/ +abbrev toFun (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (hDD : Module.finrank ℝ D = 4) : + ℍ[ℝ] →ₐ[ℝ] D := QuaternionAlgebra.lift (R := ℝ) (A := D) { + i := e.symm ⟨0, 1⟩ + j := (algebraMap ℝ D (Real.sqrt (x_corre_R k e x hx hDD).choose)⁻¹) * x.1 + k := e.symm ⟨0, 1⟩ * ((algebraMap ℝ D (Real.sqrt (x_corre_R k e x hx hDD).choose)⁻¹) * x.1) + i_mul_i := by rw [i_mul_i _ e, zero_smul, add_zero] + j_mul_j := j_mul_j _ _ _ hx hDD + i_mul_j := by rfl + j_mul_i := by + rw [j_mul_i_eq_neg_i_mul_j _ _ _ hx hDD, zero_smul, zero_sub] +} + +/-- The ordered quaternion basis `k, j, 1, i` inside the division algebra. -/ +abbrev basisijk (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) (hDD : Module.finrank ℝ D = 4) : + Fin 4 → D := + Fin.cons (e.symm ⟨0, 1⟩ * ((algebraMap ℝ D (Real.sqrt (x_corre_R k e x hx hDD).choose)⁻¹) * x.1)) + (Fin.cons ((algebraMap ℝ D (Real.sqrt (x_corre_R k e x hx hDD).choose)⁻¹) * x.1) + ![(1 : D), e.symm ⟨0, 1⟩]) + +lemma linindep1ij (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (hDD : Module.finrank ℝ D = 4) : + LinearIndependent ℝ + (Fin.cons (algebraMap ℝ D (Real.sqrt (x_corre_R _ _ _ hx hDD).choose)⁻¹ * ↑x) + ![1, ↑(e.symm { re := 0, im := 1 })]) := by + rw [linearIndependent_finCons] + constructor + · exact linindep1i _ _ + · simp only [map_inv₀, Matrix.range_cons, Matrix.range_empty, + Set.union_empty, Set.union_singleton] + rw [Submodule.mem_span_pair] + by_contra! h + obtain ⟨a, b, hab⟩ := h + rw [show (1 : D) = (1 : k) from rfl, ← Subalgebra.coe_smul, ← Subalgebra.coe_smul, + ← _root_.map_one e.symm, ← map_smul e.symm, ← map_smul e.symm, ← Subalgebra.coe_add, + ← map_add e.symm] at hab + have hsum : a • (⟨0, 1⟩ : ℂ) + b • (1 : ℂ) = (⟨b, a⟩ : ℂ) := by + apply Complex.ext <;> simp + replace hab : ((e.symm (⟨b, a⟩ : ℂ) : k) : D) = + ((algebraMap ℝ D) √(x_corre_R k e x hx hDD).choose)⁻¹ * ↑x := by + rw [← hsum] + exact hab + apply_fun ((algebraMap ℝ D) (Real.sqrt (x_corre_R _ _ _ hx hDD).choose) * · ) at hab + rw [← mul_assoc, mul_inv_cancel₀ (by + simp_all only [ne_eq, map_eq_zero] + by_contra! eqzero + rw [Real.sqrt_eq_zero (le_of_lt (r_pos _ _ _ hx hDD))] at eqzero + have := r_pos _ _ _ hx + simp_all only [Real.sqrt_zero, map_zero, zero_mul, inv_zero, mul_zero, lt_self_iff_false]), + one_mul] at hab + rw [show algebraMap ℝ D _ = (algebraMap ℝ k _ : D) from rfl, ← Subalgebra.coe_mul] at hab + have : ∃(y : k), y = x.1 := ⟨_, hab⟩ + obtain ⟨y, hy⟩ := this + have hyy : x.1 ≠ 0 := Units.ne_zero x + rw [← hy] at hx hyy + rw [show y.1⁻¹ = (y⁻¹ : k) by + apply_fun (· * (y : D)) using (mul_left_injective₀ hyy) + simp only + rw [inv_mul_cancel₀ hyy, ← Subalgebra.coe_mul, inv_mul_cancel₀ (Subtype.coe_ne_coe.1 hyy)] + rfl] at hx + simp_rw [← Subalgebra.coe_mul] at hx + change ∀(z : k), _ = (z : D) at hx + simp_rw [Subtype.coe_inj, mul_comm, ← mul_assoc, + mul_inv_cancel₀ (Subtype.coe_ne_coe.1 hyy), one_mul] at hx + simpa [Complex.ext_iff, neg_one_eq_one_iff] using congr(e $(hx <| e.symm Complex.I)) + +-- set_option maxHeartbeats 600000 in +lemma linindepijk (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (hDD : Module.finrank ℝ D = 4) : + LinearIndependent ℝ (basisijk k e x hx hDD) := by + rw [linearIndependent_finCons] + refine ⟨linindep1ij _ _ _ hx hDD, ?_⟩ + by_contra! h + simp only [Fin.range_cons, Matrix.range_cons, Matrix.range_empty, Set.union_empty, + Set.union_singleton, Submodule.mem_span_insert] at h + simp_rw [Submodule.mem_span_singleton] at h + obtain ⟨c, d, ⟨b, d', ⟨a, hc⟩, had⟩, heq⟩ := h + rw [← hc] at had; rw [had] at heq + rw [add_comm] at heq; nth_rw 2 [add_comm] at heq + clear hc had + set k' := ↑(e.symm { re := 0, im := 1 }) * + (algebraMap ℝ D (Real.sqrt (x_corre_R _ _ _ hx hDD).choose)⁻¹ * ↑x) with k_eq + have := k_sq_eq_negone _ _ _ hx hDD + set j := algebraMap ℝ D (Real.sqrt (x_corre_R _ e x hx hDD).choose)⁻¹ * x.1 with j_eq + set i := e.symm ⟨0, 1⟩ with i_eq + rw [← k_eq, heq, pow_two, mul_add, mul_add, add_mul, add_mul, add_mul, add_mul, add_mul, + add_mul] at this + simp only [Algebra.mul_smul_comm, mul_one, Algebra.smul_mul_assoc, one_mul] at this + rw [j_mul_j _ _ _ hx hDD, j_mul_i_eq_neg_i_mul_j _ _ _ hx hDD, i_mul_i _ _, ← j_eq, + ← i_eq, ← k_eq] at this + replace this : (a * a - b * b - c * c + (1 : ℝ)) • (1 : D) + (2 * a * b) • i + + (2 * a * c) • j = 0 := by linear_combination (norm := module) this + have ijindep := linindep1ij _ _ _ hx hDD + rw [← i_eq, ← j_eq, Fintype.linearIndependent_iff] at ijindep + specialize ijindep ![(2 * a * c), (a * a - b * b - c * c + (1 : ℝ)), (2 * a * b)] + simp only [Nat.succ_eq_add_one, Nat.reduceAdd] at ijindep + specialize ijindep (by + simp only [Fin.sum_univ_three, Fin.isValue, Matrix.cons_val_zero, Fin.cons_zero, + Matrix.cons_val_one, Matrix.head_cons, Fin.cons_one, Matrix.cons_val_two, + Nat.succ_eq_add_one, Nat.reduceAdd, Matrix.tail_cons] + rw [← Fin.succ_one_eq_two, Fin.cons_succ] + simp only [Fin.isValue, Matrix.cons_val_one] + rw [add_assoc, add_comm]; exact this) + have h1 := ijindep ⟨0, by omega⟩ + have h2 := ijindep ⟨1, by omega⟩ + have h3 := ijindep ⟨2, by omega⟩ + simp only [Fin.zero_eta, Fin.isValue, Matrix.cons_val_zero, mul_eq_zero, OfNat.ofNat_ne_zero, + false_or, Fin.mk_one, Matrix.cons_val_one, Matrix.head_cons, Fin.reduceFinMk, + Matrix.cons_val_two, Nat.succ_eq_add_one, Nat.reduceAdd, Matrix.tail_cons] at h1 h2 h3 + obtain rfl : a = 0 := by + by_contra! h + simp only [h, false_or] at h1 h3 + simp only [h3, mul_zero, sub_zero, h1, add_eq_zero_iff_eq_neg] at h2 + rw [← pow_two] at h2 + have haa := h2 + apply_fun Real.sqrt at h2 + if ha1 : a < 0 then + have e1: 0 < a^2 := sq_pos_of_ne_zero h + have e2: a^2 < 0 := by rw [haa]; simp + linarith + else + simp only [not_lt] at ha1 + rw [Real.sqrt_sq ha1, Real.sqrt_eq_zero_of_nonpos (by linarith)] at h2 + rw [h2, pow_two, mul_zero] at haa + norm_num at haa + simp only [mul_zero, zero_sub, zero_smul, zero_add] at h2 heq + obtain rfl : b = 0 := by + have heq' := heq + apply_fun (i.1 * ·) at heq + nth_rw 1 [k_eq, ← mul_assoc, i_mul_i] at heq + simp only [neg_smul, one_smul, neg_mul, one_mul, mul_add, Algebra.mul_smul_comm] at heq + rw [← k_eq, heq'] at heq + simp only [smul_add, smul_smul, ← add_assoc] at heq + symm at heq + rw [eq_neg_iff_add_eq_zero, add_assoc _ _ j] at heq + nth_rw 2 [← one_smul ℝ j] at heq; rw [← add_smul, i_mul_i _ _] at heq + have h1 := linindep1ij _ _ _ hx hDD + rw [Fintype.linearIndependent_iff] at h1 + specialize h1 ![(c * c + 1), -b, (c * b)] + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Fin.sum_univ_three, Fin.isValue, + Matrix.cons_val_zero, Fin.cons_zero, Matrix.cons_val_one, Matrix.head_cons, Fin.cons_one, + Matrix.cons_val_two, Matrix.tail_cons, ← j_eq, ← i_eq] at h1 + rw [← Fin.succ_one_eq_two, Fin.cons_succ] at h1 + simp only [Fin.isValue, Matrix.cons_val_one] at h1 + rw [add_comm, ← add_assoc, neg_smul, one_smul, smul_neg, ← neg_smul] at heq + specialize h1 heq ⟨1, by omega⟩ + simpa using h1 + obtain rfl : c = 0 := by + simp only [zero_smul, zero_add] at heq + rw [Algebra.smul_def, k_eq, mul_eq_mul_right_iff] at heq + have : j ≠ 0 := j_ne_zero _ _ _ hx hDD + simp only [this, or_false] at heq + change _ = (algebraMap ℝ k _ : D) at heq + simp only [SetLike.coe_eq_coe, i_eq] at heq + apply_fun e at heq + rw [e.apply_symm_apply] at heq + simp only [AlgEquiv.commutes, Complex.coe_algebraMap] at heq + change ⟨0, 1⟩ = (⟨c, 0⟩ : ℂ) at heq + rw [Complex.ext_iff] at heq + obtain ⟨hc, _⟩ := heq + simp only at hc + exact hc.symm + simp_all + +/-- The constructed `ℝ`-basis of a four-dimensional central real division algebra. -/ +abbrev isBasisijk (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (h : Module.finrank ℝ D = 4) : Basis (Fin 4) ℝ D := .mk + (v := basisijk _ _ _ hx h) (linindepijk _ _ _ hx h) + (by + suffices (⊤ : Submodule ℝ D) = Submodule.span ℝ (Set.range (basisijk _ _ _ hx h)) + from le_of_eq this + exact LinearIndependent.span_eq_top_of_card_eq_finrank (K := ℝ) (b := basisijk _ _ _ hx h) + (linindepijk _ _ _ hx h) (by simp only [Fintype.card_fin, h])|>.symm ) + +/-- The linear equivalence from Hamilton quaternions to the constructed basis. -/ +abbrev linEquivH (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (h : Module.finrank ℝ D = 4) : ℍ[ℝ] ≃ₗ[ℝ] D := + Basis.equiv (QuaternionAlgebra.basisOneIJK (-1 : ℝ) 0 (-1 : ℝ)) (isBasisijk _ _ _ hx h) { + toFun := ![2, 3, 1, 0] + invFun := ![3, 2, 0, 1] + left_inv i := by fin_cases i <;> simp + right_inv i := by fin_cases i <;> simp + } + +lemma toFun_i_eq (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (h : Module.finrank ℝ D = 4) : + toFun _ _ _ hx h ((QuaternionAlgebra.basisOneIJK (-1 : ℝ) 0 (-1 : ℝ)) 1) = e.symm ⟨0, 1⟩ := by + simp only [QuaternionAlgebra.lift_apply] + rw [show ((QuaternionAlgebra.basisOneIJK (-1 : ℝ) 0 (-1 : ℝ)) 1) = + ({ re := 0, imI := 1, imJ := 0, imK := 0 } : ℍ[ℝ]) by + ext <;> simp [QuaternionAlgebra.basisOneIJK]] + change (({ + i := ↑(e.symm { re := 0, im := 1 }) + j := (algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x + k := ↑(e.symm { re := 0, im := 1 }) * + ((algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x) + i_mul_i := by rw [i_mul_i _ e, zero_smul, add_zero] + j_mul_j := j_mul_j _ _ _ hx h + i_mul_j := by rfl + j_mul_i := by rw [j_mul_i_eq_neg_i_mul_j _ _ _ hx h, zero_smul, zero_sub] + } : QuaternionAlgebra.Basis D (-1 : ℝ) 0 (-1 : ℝ)).liftHom + ({ re := 0, imI := 1, imJ := 0, imK := 0 } : ℍ[ℝ])) = + ↑(e.symm { re := 0, im := 1 }) + change (({ + i := ↑(e.symm { re := 0, im := 1 }) + j := (algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x + k := ↑(e.symm { re := 0, im := 1 }) * + ((algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x) + i_mul_i := by rw [i_mul_i _ e, zero_smul, add_zero] + j_mul_j := j_mul_j _ _ _ hx h + i_mul_j := by rfl + j_mul_i := by rw [j_mul_i_eq_neg_i_mul_j _ _ _ hx h, zero_smul, zero_sub] + } : QuaternionAlgebra.Basis D (-1 : ℝ) 0 (-1 : ℝ)).lift + ({ re := 0, imI := 1, imJ := 0, imK := 0 } : ℍ[ℝ])) = + ↑(e.symm { re := 0, im := 1 }) + simp [QuaternionAlgebra.Basis.lift] + +lemma toFun_one_eq (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (h : Module.finrank ℝ D = 4) : + toFun _ _ _ hx h ((QuaternionAlgebra.basisOneIJK (-1 : ℝ) 0 (-1 : ℝ)) 0) = 1 := by + simp only [QuaternionAlgebra.lift_apply] + rw [show ((QuaternionAlgebra.basisOneIJK (-1 : ℝ) 0 (-1 : ℝ)) 0) = + ({ re := 1, imI := 0, imJ := 0, imK := 0 } : ℍ[ℝ]) by + ext <;> simp [QuaternionAlgebra.basisOneIJK]] + change (({ + i := ↑(e.symm { re := 0, im := 1 }) + j := (algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x + k := ↑(e.symm { re := 0, im := 1 }) * + ((algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x) + i_mul_i := by rw [i_mul_i _ e, zero_smul, add_zero] + j_mul_j := j_mul_j _ _ _ hx h + i_mul_j := by rfl + j_mul_i := by rw [j_mul_i_eq_neg_i_mul_j _ _ _ hx h, zero_smul, zero_sub] + } : QuaternionAlgebra.Basis D (-1 : ℝ) 0 (-1 : ℝ)).liftHom + ({ re := 1, imI := 0, imJ := 0, imK := 0 } : ℍ[ℝ])) = 1 + change (({ + i := ↑(e.symm { re := 0, im := 1 }) + j := (algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x + k := ↑(e.symm { re := 0, im := 1 }) * + ((algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x) + i_mul_i := by rw [i_mul_i _ e, zero_smul, add_zero] + j_mul_j := j_mul_j _ _ _ hx h + i_mul_j := by rfl + j_mul_i := by rw [j_mul_i_eq_neg_i_mul_j _ _ _ hx h, zero_smul, zero_sub] + } : QuaternionAlgebra.Basis D (-1 : ℝ) 0 (-1 : ℝ)).lift + ({ re := 1, imI := 0, imJ := 0, imK := 0 } : ℍ[ℝ])) = 1 + simp [QuaternionAlgebra.Basis.lift] + +lemma toFun_j_eq (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (h : Module.finrank ℝ D = 4) : + toFun _ _ _ hx h ((QuaternionAlgebra.basisOneIJK (-1 : ℝ) 0 (-1 : ℝ)) 2) = + (algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x := by + simp only [QuaternionAlgebra.lift_apply] + rw [show ((QuaternionAlgebra.basisOneIJK (-1 : ℝ) 0 (-1 : ℝ)) 2) = + ({ re := 0, imI := 0, imJ := 1, imK := 0 } : ℍ[ℝ]) by + ext <;> simp [QuaternionAlgebra.basisOneIJK]] + change (({ + i := ↑(e.symm { re := 0, im := 1 }) + j := (algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x + k := ↑(e.symm { re := 0, im := 1 }) * + ((algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x) + i_mul_i := by rw [i_mul_i _ e, zero_smul, add_zero] + j_mul_j := j_mul_j _ _ _ hx h + i_mul_j := by rfl + j_mul_i := by rw [j_mul_i_eq_neg_i_mul_j _ _ _ hx h, zero_smul, zero_sub] + } : QuaternionAlgebra.Basis D (-1 : ℝ) 0 (-1 : ℝ)).liftHom + ({ re := 0, imI := 0, imJ := 1, imK := 0 } : ℍ[ℝ])) = + (algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x + change (({ + i := ↑(e.symm { re := 0, im := 1 }) + j := (algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x + k := ↑(e.symm { re := 0, im := 1 }) * + ((algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x) + i_mul_i := by rw [i_mul_i _ e, zero_smul, add_zero] + j_mul_j := j_mul_j _ _ _ hx h + i_mul_j := by rfl + j_mul_i := by rw [j_mul_i_eq_neg_i_mul_j _ _ _ hx h, zero_smul, zero_sub] + } : QuaternionAlgebra.Basis D (-1 : ℝ) 0 (-1 : ℝ)).lift + ({ re := 0, imI := 0, imJ := 1, imK := 0 } : ℍ[ℝ])) = + (algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x + simp [QuaternionAlgebra.Basis.lift] + +lemma toFun_k_eq (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (h : Module.finrank ℝ D = 4) : + toFun _ _ _ hx h ((QuaternionAlgebra.basisOneIJK (-1 : ℝ) 0 (-1 : ℝ)) 3) = + ↑(e.symm { re := 0, im := 1 }) * + ((algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x) := by + simp only [QuaternionAlgebra.lift_apply] + rw [show ((QuaternionAlgebra.basisOneIJK (-1 : ℝ) 0 (-1 : ℝ)) 3) = + ({ re := 0, imI := 0, imJ := 0, imK := 1 } : ℍ[ℝ]) by + ext <;> simp [QuaternionAlgebra.basisOneIJK]] + change (({ + i := ↑(e.symm { re := 0, im := 1 }) + j := (algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x + k := ↑(e.symm { re := 0, im := 1 }) * + ((algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x) + i_mul_i := by rw [i_mul_i _ e, zero_smul, add_zero] + j_mul_j := j_mul_j _ _ _ hx h + i_mul_j := by rfl + j_mul_i := by rw [j_mul_i_eq_neg_i_mul_j _ _ _ hx h, zero_smul, zero_sub] + } : QuaternionAlgebra.Basis D (-1 : ℝ) 0 (-1 : ℝ)).liftHom + ({ re := 0, imI := 0, imJ := 0, imK := 1 } : ℍ[ℝ])) = + ↑(e.symm { re := 0, im := 1 }) * + ((algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x) + change (({ + i := ↑(e.symm { re := 0, im := 1 }) + j := (algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x + k := ↑(e.symm { re := 0, im := 1 }) * + ((algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x) + i_mul_i := by rw [i_mul_i _ e, zero_smul, add_zero] + j_mul_j := j_mul_j _ _ _ hx h + i_mul_j := by rfl + j_mul_i := by rw [j_mul_i_eq_neg_i_mul_j _ _ _ hx h, zero_smul, zero_sub] + } : QuaternionAlgebra.Basis D (-1 : ℝ) 0 (-1 : ℝ)).lift + ({ re := 0, imI := 0, imJ := 0, imK := 1 } : ℍ[ℝ])) = + ↑(e.symm { re := 0, im := 1 }) * + ((algebraMap ℝ D) (√(x_corre_R k e x hx h).choose)⁻¹ * ↑x) + simp [QuaternionAlgebra.Basis.lift] + +@[simp] theorem succ_two_eq_three (n : ℕ) : Fin.succ (2 : Fin (n + 3)) = 3 := rfl + +lemma linEquivH_eq_toFun (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (h : Module.finrank ℝ D = 4) : (linEquivH _ _ _ hx h).toLinearMap = toFun _ _ _ hx h := by + apply Basis.ext (QuaternionAlgebra.basisOneIJK (-1 : ℝ) 0 (-1 : ℝ)) + intro i + change (linEquivH _ _ _ hx h) _ = (toFun _ _ _ hx h) _ + fin_cases i + · erw [Basis.equiv_apply + (b := QuaternionAlgebra.basisOneIJK (-1 : ℝ) 0 (-1 : ℝ)) + (b' := isBasisijk k e x hx h)] + simp only [isBasisijk, basisijk, Equiv.coe_fn_mk, Basis.coe_mk] + norm_num + simpa [toFun, QuaternionAlgebra.lift_apply] using (toFun_one_eq k e x hx h).symm + · erw [Basis.equiv_apply + (b := QuaternionAlgebra.basisOneIJK (-1 : ℝ) 0 (-1 : ℝ)) + (b' := isBasisijk k e x hx h)] + simp only [isBasisijk, basisijk, Equiv.coe_fn_mk, Basis.coe_mk] + norm_num + simpa [toFun, QuaternionAlgebra.lift_apply] using (toFun_i_eq k e x hx h).symm + · erw [Basis.equiv_apply + (b := QuaternionAlgebra.basisOneIJK (-1 : ℝ) 0 (-1 : ℝ)) + (b' := isBasisijk k e x hx h)] + simp only [isBasisijk, basisijk, Equiv.coe_fn_mk, Basis.coe_mk] + norm_num + simpa [toFun, QuaternionAlgebra.lift_apply] using (toFun_j_eq k e x hx h).symm + · erw [Basis.equiv_apply + (b := QuaternionAlgebra.basisOneIJK (-1 : ℝ) 0 (-1 : ℝ)) + (b' := isBasisijk k e x hx h)] + simp only [isBasisijk, basisijk, Equiv.coe_fn_mk, Basis.coe_mk] + norm_num + simpa [toFun, QuaternionAlgebra.lift_apply] using (toFun_k_eq k e x hx h).symm + +-- set_option maxHeartbeats 600000 in +lemma bij_tofun (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (h : Module.finrank ℝ D = 4) : Function.Bijective (toFun _ _ _ hx h) := by + have eq1 := linEquivH_eq_toFun _ _ _ hx h + haveI := LinearEquiv.bijective (linEquivH _ _ _ hx h) + have eq2 : @DFunLike.coe (ℍ[ℝ] ≃ₗ[ℝ] D) ℍ[ℝ] (fun x ↦ D) EquivLike.toFunLike + (linEquivH k e x hx h) = @DFunLike.coe (ℍ[ℝ] →ₐ[ℝ] D) ℍ[ℝ] (fun x ↦ D) + AlgHom.funLike (toFun k e x hx h) := by + ext x + change (linEquivH _ _ _ hx h) x = (toFun _ _ _ hx h).toLinearMap x + exact DFunLike.congr eq1.symm rfl|>.symm + rw [← eq2]; exact this + +theorem rank4_iso_H (x : Dˣ) (hx : ∀ z, x.1⁻¹ * f k e z * x = k.val z) + (h : Module.finrank ℝ D = 4) : Nonempty (ℍ[ℝ] ≃ₐ[ℝ] D) := + ⟨AlgEquiv.ofBijective (toFun _ _ _ hx h) (bij_tofun _ _ _ hx h)⟩ + +attribute [-instance] Module.complexToReal + +/-- The complex scalar action induced by an isomorphism from `ℂ` to the center. -/ +abbrev SmulCA (A : Type) [DivisionRing A] [Algebra ℝ A] + (e : ℂ ≃ₐ[ℝ] (Subalgebra.center ℝ A)) : ℂ →+* A where + toFun z := e z + map_one' := by simp + map_mul' := by simp + map_zero' := by simp + map_add' z1 z2 := by simp + +/-- The resulting complex algebra structure on a real division algebra. -/ +abbrev AlgCA (A : Type) [DivisionRing A] [Algebra ℝ A] + (e : ℂ ≃ₐ[ℝ] (Subalgebra.center ℝ A)) : Algebra ℂ A where + __ := SmulCA A e + smul z a := (SmulCA A e z) * a + algebraMap := _ + commutes' z _ := by + simp [Subalgebra.mem_center_iff.1 (e z).2] + smul_def' _ _ := rfl + +lemma smulCRassoc (A : Type) [DivisionRing A] [Algebra ℝ A] [FiniteDimensional ℝ A] + (e : ℂ ≃ₐ[ℝ] (Subalgebra.center ℝ A)) (r : ℝ) (z : ℂ) (a : A) : e (r • z) * a = + r • (e z * a) := by + have hz : e (r • z) = r • e z := map_smul e r z + have hzD : (e (r • z) : A) = r • (e z : A) := by + simpa using congrArg (fun x : Subalgebra.center ℝ A => (x : A)) hz + rw [hzD] + exact smul_mul_assoc r (↑(e z)) a + +theorem centereqvCisoC (A : Type) [DivisionRing A] [Algebra ℝ A] [FiniteDimensional ℝ A] + (hA : Nonempty (Subalgebra.center ℝ A ≃ₐ[ℝ] ℂ)) : Nonempty (A ≃ₐ[ℝ] ℂ) := by + have hfiniteReal : Module.Finite ℝ A := ‹FiniteDimensional ℝ A› + have e := hA.some.symm + letI : Algebra ℂ A := AlgCA A e + letI : Module ℝ ℂ := Algebra.toModule + haveI : IsScalarTower ℝ ℂ A := { smul_assoc := smulCRassoc A e } + haveI : Module.Finite ℝ A := hfiniteReal + haveI : IsNoetherian ℝ A := IsNoetherian.iff_fg.2 hfiniteReal + haveI : FiniteDimensional ℂ A := .right ℝ ℂ A + have bij := IsAlgClosed.algebraMap_bijective_of_isIntegral (k := ℂ) (K := A) + exact ⟨.symm <| .ofBijective { + toFun := algebraMap ℂ A + map_one' := _ + map_mul' := _ + map_zero' := _ + map_add' := _ + commutes' r := by + simp only [Complex.coe_algebraMap] + change (algebraMap ℂ A) (algebraMap ℝ ℂ r) = _ + rw [Algebra.algebraMap_eq_smul_one, Algebra.algebraMap_eq_smul_one, + Algebra.algebraMap_eq_smul_one, smul_assoc, one_smul]} bij⟩ + +lemma center_eq_bot_of_iso_real (A : Type) [DivisionRing A] [Algebra ℝ A] + [FiniteDimensional ℝ A] (hR : Subalgebra.center ℝ A ≃ₐ[ℝ] ℝ) : + Subalgebra.center ℝ A = ⊥ := by + have hfinrank := LinearEquiv.finrank_eq hR.toLinearEquiv + simp only [Module.finrank_self, Subalgebra.finrank_eq_one_iff] at hfinrank + exact hfinrank + +lemma subfield_finrank_one_or_two (A : Type) [DivisionRing A] [Algebra ℝ A] + [FiniteDimensional ℝ A] (L : SubField ℝ A) : + Module.finrank ℝ L = 1 ∨ Module.finrank ℝ L = 2 := by + obtain hR | hH := RealExtension_is_RorC L + · have hfinrank := LinearEquiv.finrank_eq hR.some.toLinearEquiv + simp only [Module.finrank_self] at hfinrank + exact Or.inl hfinrank + · have hfinrank := LinearEquiv.finrank_eq hH.some.toLinearEquiv + exact Or.inr (hfinrank.trans Complex.finrank_real_complex) + +lemma not_real_subfield_of_finrank_two (A : Type) [DivisionRing A] [Algebra ℝ A] + [FiniteDimensional ℝ A] (L : SubField ℝ A) (h2 : Module.finrank ℝ L = 2) + (e1 : L ≃ₐ[ℝ] ℝ) : False := by + have hfinrank := LinearEquiv.finrank_eq e1.toLinearEquiv + rw [Module.finrank_self] at hfinrank + linarith + +lemma central_division_iso_real_or_quaternion (A : Type) [DivisionRing A] [Algebra ℝ A] + [FiniteDimensional ℝ A] [Algebra.IsCentral ℝ A] : + Nonempty (A ≃ₐ[ℝ] ℝ) ∨ Nonempty (A ≃ₐ[ℝ] ℍ[ℝ]) := by + obtain ⟨L, hL⟩ := SubField.exists_isMax ℝ A + have dimeq := dim_max_subfield ℝ A L hL + obtain h1 | h2 := subfield_finrank_one_or_two A L + · left + simp only [h1, mul_one] at dimeq + exact rank_1_D_iso_R dimeq + · right + simp only [h2, Nat.reduceMul] at dimeq + obtain hReal | e2 := RealExtension_is_RorC L + · obtain ⟨e1⟩ := hReal + exact False.elim (not_real_subfield_of_finrank_two A L h2 e1) + · exact ⟨(rank4_iso_H L e2.some (f_is_conjugation L e2.some).choose + (f_is_conjugation L e2.some).choose_spec dimeq).some.symm⟩ + +theorem FrobeniusTheorem (A : Type) [DivisionRing A] [Algebra ℝ A] [FiniteDimensional ℝ A] : + Nonempty (A ≃ₐ[ℝ] ℂ) ∨ Nonempty (A ≃ₐ[ℝ] ℝ) ∨ Nonempty (A ≃ₐ[ℝ] ℍ[ℝ]) := by + obtain ⟨⟨hR⟩⟩ | hC := RealExtension_is_RorC (Subalgebra.center ℝ A) + · right + have hcenter : Subalgebra.center ℝ A = ⊥ := center_eq_bot_of_iso_real A hR + haveI : Algebra.IsCentral ℝ A := ⟨le_of_eq hcenter⟩ + exact central_division_iso_real_or_quaternion A + · left; exact centereqvCisoC A hC + +end BrauerGroupNew From a415b60c6f1246063ae1b2ce9c922edddc7706ca Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 20:43:11 -0700 Subject: [PATCH 28/34] Port BrauerGroup separable subfields --- LeanPool.lean | 1 + LeanPool/BrauerGroupNew/Subfield.lean | 1 + .../BrauerGroupNew/Subfield/Separable.lean | 532 ++++++++++++++++++ 3 files changed, 534 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/Subfield/Separable.lean diff --git a/LeanPool.lean b/LeanPool.lean index 559d457d52..98716f69f2 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -122,6 +122,7 @@ import LeanPool.BrauerGroupNew.SplittingOfCSA import LeanPool.BrauerGroupNew.Subfield import LeanPool.BrauerGroupNew.Subfield.Defs import LeanPool.BrauerGroupNew.Subfield.FiniteDimensional +import LeanPool.BrauerGroupNew.Subfield.Separable import LeanPool.BrauerGroupNew.Subfield.Splitting import LeanPool.BrauerGroupNew.Subfield.Subfield import LeanPool.BrauerGroupNew.ToSecond diff --git a/LeanPool/BrauerGroupNew/Subfield.lean b/LeanPool/BrauerGroupNew/Subfield.lean index cb8b7b5efd..9b2072ac75 100644 --- a/LeanPool/BrauerGroupNew/Subfield.lean +++ b/LeanPool/BrauerGroupNew/Subfield.lean @@ -6,6 +6,7 @@ Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies import LeanPool.BrauerGroupNew.Subfield.Defs import LeanPool.BrauerGroupNew.Subfield.FiniteDimensional +import LeanPool.BrauerGroupNew.Subfield.Separable import LeanPool.BrauerGroupNew.Subfield.Splitting import LeanPool.BrauerGroupNew.Subfield.Subfield diff --git a/LeanPool/BrauerGroupNew/Subfield/Separable.lean b/LeanPool/BrauerGroupNew/Subfield/Separable.lean new file mode 100644 index 0000000000..009a5f1f63 --- /dev/null +++ b/LeanPool/BrauerGroupNew/Subfield/Separable.lean @@ -0,0 +1,532 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Subalgebra.Lattice +import LeanPool.BrauerGroupNew.Subfield.Splitting +import Mathlib.FieldTheory.JacobsonNoether + +-- section +-- variable {ι R A : Type*} (B : ι → Type*) [Preorder ι] [CommRing R] +-- [Ring A] [Algebra R A] [∀ i, Ring (B i)] [∀ i, Algebra R (B i)] + +-- lemma Algebra.IsSeparable.of_directedSystem [IsDirected ι (· ≤ ·)] [∀ i, Algebra.IsSeparable R (B i)] +-- (map : ∀ i j, i ≤ j → B i →ₐ[R] B j) +-- (directedSystem_map : DirectedSystem B fun i j hij ↦ map i j hij) +-- (cone : ∀ i, B i →ₐ[R] A) +-- (hcone : ∀ i j (hij : i ≤ j), cone i = (cone j).comp (map i j hij)) +-- (hlimit : ∀ a , ∃ i, a ∈ Set.range (cone i)) : +-- Algebra.IsSeparable R A where +-- isSeparable' a := by +-- obtain ⟨i, b, rfl⟩ := hlimit a +-- sorry +-- -- exact IsSeparable.map _ (f := (cone i).toRingHom) + +-- end + +universe u + +variable (K D : Type u) [Field K] [DivisionRing D] [Algebra K D] [Algebra.IsCentral K D] + [FiniteDimensional K D] + +open Polynomial + +-- se_option maxHeartbeats 3200000 in +omit [Algebra.IsCentral K D] [FiniteDimensional K D] in +lemma SubField.adjoin_centralizer_mul_comm (L : SubField K D) (a : D) + (ha : a ∈ Subalgebra.centralizer K L) : ∀ (x y : D), x ∈ Algebra.adjoin K (L ∪ {a}) → + y ∈ Algebra.adjoin K (L ∪ {a}) → x * y = y * x := + fun x y hx hy ↦ by + simp [Algebra.mem_adjoin_iff, Subalgebra.mem_centralizer_iff] at hx hy ha + refine Subring.closure_induction₂ (R := D) (fun x1 y1 hx1 hy1 ↦ by + simp at hx1 hy1 + obtain hx11 | hx12 | hx13 := hx1 + all_goals obtain hy11 | hy12 | hy13 := hy1 + · simp_all + · obtain ⟨b, rfl⟩ := hy12 + exact Algebra.commutes _ _ |>.symm + · subst hx11 + exact ha _ hy13|>.symm + · obtain ⟨b, rfl⟩ := hx12 + exact Algebra.commutes _ _ + · obtain ⟨b, rfl⟩ := hx12 + exact Algebra.commutes _ _ + · obtain ⟨b, rfl⟩ := hx12 + exact Algebra.commutes _ _ + · subst hy11 + exact ha _ hx13 + · obtain ⟨b, rfl⟩ := hy12 + exact Algebra.commutes _ _ |>.symm + · exact L.2 hx13 hy13) ?_ ?_ ?_ ?_ ?_ ?_ ?_ ?_ ?_ ?_ hx hy + all_goals try simp_all [add_mul, mul_add] + · rintro x y z - - - hxz hyz + rw [mul_assoc, hyz, ← mul_assoc, hxz, mul_assoc] + · rintro x y z - - - hxy hxz + rw [← mul_assoc, hxy, mul_assoc, hxz, ← mul_assoc] + +/-- The commutative ring structure on the algebra generated by adjoining a centralizing element. -/ +@[reducible] +def SubField.adjoin_commRing (L : SubField K D) (a : D) (ha : a ∈ Subalgebra.centralizer K L) : + CommRing (Algebra.adjoin K (L ∪ {a})) where + mul_comm := fun ⟨x, hx⟩ ⟨y, hy⟩ ↦ by + ext + simp [SubField.adjoin_centralizer_mul_comm K D L a ha x y hx hy] + +instance SubField.adjoin_isDomain (L : SubField K D) (a : D) : + IsDomain (Algebra.adjoin K (L ∪ {a})) where + mul_left_cancel_of_ne_zero {x} hx y z eq := by + have eq' := Subtype.ext_iff.1 eq + simp at eq' + exact eq'.resolve_right hx + mul_right_cancel_of_ne_zero {x} hx y z eq := by + have eq' := Subtype.ext_iff.1 eq + simp at eq' + exact eq'.resolve_right hx + +/-- The subfield generated by a subfield and an element centralizing that subfield. -/ +def SubField.adjoin (L : SubField K D) (a : D) (ha : a ∈ Subalgebra.centralizer K L) : + SubField K D where + __ := Algebra.adjoin K (L ∪ {a}) + algebraMap_mem' k := by + have : ⊥ ≤ Algebra.adjoin K (L ∪ {a}) := bot_le + change (Algebra.ofId _ _).range ≤ _ at this + exact this (by change _ ∈ (algebraMap K D).range; exact + RingHom.mem_range_self (algebraMap K D) k) + mul_comm x y hx hy := by + exact SubField.adjoin_centralizer_mul_comm K D L a ha x hx y hy + exists_inverse x hx hx0 := by + letI := SubField.adjoin_commRing K D L a ha + haveI := isField_of_isIntegral_of_isField' (R := K) (S := Algebra.adjoin K (L ∪ {a})) + (Semifield.toIsField K) + exact ⟨(this.3 (Subtype.coe_ne_coe.mp hx0 : (⟨x, hx⟩ : Algebra.adjoin K _) ≠ 0)).choose.1, + ⟨(this.3 (Subtype.coe_ne_coe.mp hx0 : (⟨x, hx⟩ : Algebra.adjoin _ _) ≠ 0)).choose.2, + haveI := (this.3 (Subtype.coe_ne_coe.mp hx0 : (⟨x, hx⟩ : Algebra.adjoin _ _) ≠ 0)).choose_spec + (Submonoid.mk_eq_one (Algebra.adjoin _ _).toSubring.toSubmonoid).mp this⟩⟩ + +/-- The natural algebra structure over a subfield after adjoining a centralizing element. -/ +noncomputable local instance IsLAlg (L : SubField K D) (a : D) + (ha : a ∈ Subalgebra.centralizer K L) : + Algebra L (SubField.adjoin K D L a ha) := RingHom.toAlgebra' (Subalgebra.inclusion <| + Set.subset_union_left |>.trans Algebra.subset_adjoin).toRingHom fun ⟨x, hx⟩ ⟨y, hy⟩ ↦ + Subtype.ext_iff|>.2 <| SubField.adjoin_centralizer_mul_comm K D L a ha _ y + (Subalgebra.inclusion _ (⟨x, hx⟩ : L)).2 hy + +local instance SubField.adjoin_scalarTower (L : SubField K D) (a : D) + (ha : a ∈ Subalgebra.centralizer K L) : + IsScalarTower K L (SubField.adjoin K D L a ha) where + smul_assoc k l x := Subtype.ext_iff.2 <| by + change (k • (l : D)) * (x : D) = k • ((l : D) * (x : D)) + rw [smul_mul_assoc] + +omit [Algebra.IsCentral K D] [FiniteDimensional K D] in +lemma SubField.le_centralizer (L : SubField K D) : L.toSubalgebra ≤ Subalgebra.centralizer _ L := + fun _ hx _ hy ↦ L.mul_comm hy hx + +omit [Algebra.IsCentral K D] in +lemma SubField.adjoin_le_centralizer (L : SubField K D) (a : D) + (ha : a ∈ Subalgebra.centralizer K L) : + (SubField.adjoin K D L a ha).1 ≤ Subalgebra.centralizer K (A := D) L := by + change Algebra.adjoin _ _ ≤ _ + rw [Algebra.adjoin_le_iff, Set.union_subset_iff, Set.singleton_subset_iff] + exact ⟨SubField.le_centralizer _ _ _, ha⟩ + +/-- The set of subfields of a division algebra that are separable over the center. -/ +abbrev AllSepSubfield : Set (SubField K D) := + { L : SubField K D | Algebra.IsSeparable K L } + +instance : Nonempty (AllSepSubfield K D) := + ⟨⊥, by simpa using Algebra.IsSeparable.of_algHom K K <| Algebra.botEquiv K D⟩ + +instance : PartialOrder (AllSepSubfield K D) where + le L1 L2 := L1.1 ≤ L2.1 + le_refl _ := by simp + le_trans _ _ _ _ _ _ _ := by aesop + le_antisymm _ _ _ _ := by aesop + +/-- The supremum of a nonempty chain of separable subfields, as a separable subfield. -/ +noncomputable abbrev iSup_chain_sepsubfield (c : Set (AllSepSubfield K D)) [Nonempty c] + (hc1 : IsChain (· ≤ ·) c) : AllSepSubfield K D where + val := { + __ := (⨆ (L : c), L.1.1.1 : Subalgebra K D) + mul_comm x hx y hy := by + simp only [Subsemiring.coe_carrier_toSubmonoid, Subalgebra.coe_toSubsemiring, + SetLike.mem_coe] at hx hy + have := Subalgebra.coe_iSup_of_directed hc1.directed + dsimp at this + change x ∈ (_ : Set _) at hx + change _ ∈ ( _ : Set _) at hy + erw [this] at hx hy + + -- rw [this] at hx hy + simp only [Set.mem_iUnion, SetLike.mem_coe] at hx hy + obtain ⟨L1, hx⟩ := hx + obtain ⟨L2, hy⟩ := hy + obtain ⟨L3, hL31, hL32⟩ := hc1.directed L1 L2 + exact L3.1.1.mul_comm (hL31 hx) (hL32 hy) + exists_inverse x hx hx0 := by + simp only [Subalgebra.coe_toSubsemiring, + Subsemiring.coe_carrier_toSubmonoid, SetLike.mem_coe] at * + letI : Nonempty c := Set.Nonempty.to_subtype (Set.Nonempty.of_subtype) + have := Subalgebra.coe_iSup_of_directed hc1.directed + dsimp at this + change x ∈ (_ : Set _) at hx + erw [this] at hx + simp only [Set.mem_iUnion, SetLike.mem_coe] at hx + obtain ⟨L1, hx⟩ := hx + use L1.1.1.3 hx hx0|>.choose + constructor + · have : L1.1.1.1 ≤ ⨆ (L : c), (L.1.1).toSubalgebra := by + exact le_iSup_of_le L1 (by rfl) + exact this (L1.1.1.3 hx hx0).choose_spec.1 + · exact L1.1.1.3 hx hx0|>.choose_spec.2 + } + property := by + simp only [Set.coe_setOf, Set.mem_setOf_eq] + rw [Algebra.isSeparable_def] + simp + intro a ha + have := Subalgebra.coe_iSup_of_directed hc1.directed + simp at this + change a ∈ (_ : Set _) at ha + erw [this] at ha + simp at ha + obtain ⟨L, ⟨ha', h⟩, hL2⟩ := ha + exact IsSeparable.map (F := K) (L := ((⨆ (L : c), L.1.1.1) : Subalgebra K D)) (x := (⟨a, hL2⟩ : L)) + (Subalgebra.inclusion (le_iSup_of_le ⟨⟨L, ha'⟩, h⟩ le_rfl)) + (Subalgebra.inclusion_injective _) <| Algebra.isSeparable_def _ _|>.1 ha' ⟨a, hL2⟩ + +omit [Algebra.IsCentral K D] [FiniteDimensional K D] in +lemma exists_max_sepSub : ∃ L : AllSepSubfield K D, IsMax L := + zorn_le_nonempty (α := AllSepSubfield K D) fun c hc1 hc2 ↦ by + haveI : Nonempty c := Set.Nonempty.to_subtype hc2 + use iSup_chain_sepsubfield K D c hc1 + change _ ∈ {L | _} + simp only [Set.mem_setOf_eq] + intro L hL + change L.1.1 ≤ (⨆ (L : c), L.1.1.1 : Subalgebra K D) + exact le_iSup_of_le ⟨L, hL⟩ (by rfl) + +theorem Set.centralizer.qsmul_mem (K D : Type u) [Field K] [DivisionRing D] [Algebra K D] + (L : Set D) (q : ℚ) (a : D) (ha : a ∈ Set.centralizer L) : + q • a ∈ Set.centralizer L := by + rw [Rat.smul_def] + intro m hm + simp_all [mem_centralizer_iff] + have (m : D) := Commute.left_comm <| Rat.cast_commute q m|>.symm + rw [this, ha _ hm, mul_assoc] + +instance (L : SubField K D) : DivInvMonoid (Subalgebra.centralizer K (A := D) L) where + __ := (inferInstance : Monoid (Subalgebra.centralizer K (A := D) L)) + inv a := ⟨a⁻¹, Set.inv_mem_centralizer₀ a.2⟩ + div x y := ⟨(x / y : D), Set.div_mem_centralizer₀ x.2 y.2⟩ + div_eq_mul_inv x y := by ext; simp [← div_eq_mul_inv]; rfl + +instance (L : SubField K D) : RatCast (Subalgebra.centralizer K (A := D) L) where + ratCast q := ⟨q, Subalgebra.mem_centralizer_iff _|>.2 fun _ _↦ Rat.cast_commute _ _|>.symm⟩ + +omit [Algebra.IsCentral K D] [FiniteDimensional K D] in +@[simp] +lemma SubField.centralizer.coe_ratCast (L : SubField K D) (q : ℚ) : + ((q : Subalgebra.centralizer K (A := D) L) : D) = q := rfl + +instance (L : SubField K D) : NNRatCast (Subalgebra.centralizer K (A := D) L) where + nnratCast q := ⟨q, Subalgebra.mem_centralizer_iff _|>.2 fun _ _ ↦ NNRat.cast_commute _ _|>.symm⟩ + +omit [Algebra.IsCentral K D] [FiniteDimensional K D] in +@[simp] +lemma SubField.centralizer.nnratCast_eq (L : SubField K D) (q : NNRat) : + ((q : Subalgebra.centralizer K (A := D) L) : D) = q := rfl + +instance centralizerSubfieldDiv (L : SubField K D) : + DivisionRing (Subalgebra.centralizer K (A := D) L) where + mul_inv_cancel a ha := by + ext + change (a : D) * (a : D)⁻¹ = 1 + exact mul_inv_cancel₀ (fun h ↦ ha (Subtype.ext h)) + inv_zero := by + ext + change ((0 : D)⁻¹) = 0 + simp + ratCast_def q := by + ext + change (q : D) = (q.num : D) / (q.den : D) + rw [Rat.cast_def] + nnratCast q := ⟨q, Subalgebra.mem_centralizer_iff _|>.2 fun x _ ↦ NNRat.cast_commute _ _|>.symm⟩ + nnratCast_def q := by + ext + change (q : D) = (q.num : D) / (q.den : D) + rw [NNRat.cast_def] + qsmul q a := ⟨q • a.1, Set.centralizer.qsmul_mem K D (L.1.1) q a.1 a.2⟩ + qsmul_def q x := by ext; simp [Rat.smul_def q x.1] + nnqsmul q a := ⟨q.1 • a.1, Set.centralizer.qsmul_mem K D L.1.1 q a.1 a.2⟩ + nnqsmul_def q a := by ext; simp [Rat.smul_def] + +noncomputable instance (L : SubField K D) : Algebra L (Subalgebra.centralizer K (A := D) L) where + smul l1 x := ⟨l1 * x, Set.mul_mem_centralizer + (Subalgebra.mem_centralizer_iff K|>.2 fun _ hy ↦ L.2 l1.2 hy |>.symm) x.2⟩ + algebraMap := Subalgebra.inclusion (fun _ hx ↦ Subalgebra.mem_centralizer_iff K|>.2 + fun _ hy ↦ L.2 hx hy|>.symm : L.1 ≤ Subalgebra.centralizer K (A := D) L) + commutes' l x := Subtype.ext_iff.2 <| Subalgebra.mem_centralizer_iff K|>.1 x.2 l.1 l.2 + smul_def' _ _ := rfl + +instance (L : SubField K D) : IsScalarTower K L (Subalgebra.centralizer K (A := D) L) where + smul_assoc k l x := Subtype.ext_iff.2 <| by + change (k • (l : D)) * (x : D) = k • ((l : D) * (x : D)) + rw [smul_mul_assoc] + +instance (L : SubField K D) : FiniteDimensional L (Subalgebra.centralizer K (A := D) L) := + haveI : FiniteDimensional K (Subalgebra.centralizer K (A := D) L) := inferInstance + -- haveI : FiniteDimensional K L := sorry + Module.Finite.of_restrictScalars_finite K _ _ + +/-- The center of a centralizer is equivalent to its image in the ambient division algebra. -/ +noncomputable abbrev ZCL_equiv_ZCL_map (L : SubField K D) : + (Subalgebra.center K (Subalgebra.centralizer K (A := D) L)) ≃ₐ[K] Subalgebra.map + (Subalgebra.centralizer K (A := D) L).val + (Subalgebra.center K (Subalgebra.centralizer K (A := D) L)) := + AlgEquiv.ofBijective { + toFun x := ⟨x.1, ⟨⟨x.1, by simp⟩, by simp⟩⟩ + map_one' := by ext; rfl + map_mul' _ _ := by ext; simp + map_zero' := by ext; rfl + map_add' _ _ := by ext; simp + commutes' _ := by ext; simp } + ⟨fun ⟨x, hx⟩ ⟨y, hy⟩ eq ↦ by simp_all, fun ⟨y, ⟨y', hy1, hy2⟩⟩ ↦ ⟨⟨y', hy1⟩, by simpa using hy2⟩⟩ + +/-- The subfield generated by one element over the base field. -/ +abbrev SubField.bot_adjoin (a : D) : SubField K D := + SubField.adjoin K D ⊥ a (by + rw [Subalgebra.mem_centralizer_iff]; + intro y (hy : y ∈ (Algebra.ofId _ _).range); + obtain ⟨y, rfl⟩ := hy + exact Algebra.commutes _ _) + +omit [Algebra.IsCentral K D] in +@[simp] +lemma SubField.self_mem_bot_adjoin (a : D) : + a ∈ (SubField.bot_adjoin K D a) := by + apply Algebra.subset_adjoin + simp + +omit [Algebra.IsCentral K D] in +lemma SubField.bot_adjoin_coe (a : D) : + (SubField.bot_adjoin K D a).1 = Algebra.adjoin K {a} := by + apply le_antisymm + · change Algebra.adjoin _ _ ≤ _ + rw [Algebra.adjoin_le_iff, Set.union_subset_iff] + exact ⟨bot_le (α := Subalgebra K D), by simp⟩ + · rw [Algebra.adjoin_le_iff, Set.singleton_subset_iff] + simp + -- change x ∈ Algebra.adjoin K ((Algebra.ofId _ _).range ∪ {a}) ↔ _ + -- simp [Algebra.adjoin_algebraMap] +-- lemma extend_sep_sep (K D : Type u) [Field K] [DivisionRing D] [Algebra K D] [Algebra.IsCentral K D] +-- [FiniteDimensional K D] (L : Subalgebra K D) [Algebra.IsSeparable K L] [CommRing L] [Algebra L D] (a : D) +-- (ha : a ∈ Subalgebra.centralizer K L) (ha' : IsSeparable L a) : +-- Algebra.IsSeparable K (Algebra.adjoin K (L ∪ {a})) := by +-- rw [Algebra.isSeparable_def] +-- intro ⟨x, hx⟩ +-- refine Algebra.adjoin_induction _ _ _ _ hx +-- sorry + -- Algebra.IsSeparable K (SubField.adjoin K D L a ha) := by + -- rw [Algebra.isSeparable_def] + -- intro x hx + -- change x ∈ Algebra.adjoin _ _ at hx + -- obtain ⟨y, hy⟩ := hx + -- have := SubField.adjoin_centralizer_mul_comm K D L a ha y x hy hx + -- simp at this + -- exact H y hy this + +-- todo: replace mathlib version with this one +theorem IsSeparable.of_algHom_of_map + {F : Type*} [Field F] {K : Type*} {E : Type*} [Field K] [Ring E] + [Algebra F K] [Algebra F E] [Nontrivial E] (f : K →ₐ[F] E) {x : K} + (h : IsSeparable F (f x)) : IsSeparable F x := + have ⟨_q, hq⟩ := minpoly.dvd F x (p := minpoly F (f x)) (by + apply f.injective + simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe, map_zero, ← aeval_algHom_apply, minpoly.aeval]) + (Eq.mp (congrArg Separable hq) h).of_mul_left + +open Subalgebra in +theorem exists_sep_masSubfield' : ∃ (a : D), IsMax (SubField.bot_adjoin K D a) ∧ + Algebra.IsSeparable K (SubField.bot_adjoin K D a) := by + obtain ⟨L, hL⟩ := exists_max_sepSub K D + let CL := Subalgebra.centralizer K (A := D) L + -- have := comm_of_centralizer K D L.1.1 (fun ⟨x, hx⟩ ⟨y, hy⟩ ↦ by simpa using L.1.2 x y hx hy) + suffices h : CL = L.1.1 by + have Lmax := maxsubfield_of_div_iff K D L.1 |>.1 <| cor_two_2to3 K D L.1 (cor_two_1to2 K D L.1 |>.1 h) + haveI : Algebra.IsSeparable _ _ := L.2 + obtain ⟨a, ha⟩ := Field.exists_primitive_element K L.1 + use a + constructor + · convert Lmax + apply SubField.toSubalgebra_injective + simp [SubField.bot_adjoin_coe] + have hmap := congrArg + (fun E : IntermediateField K L.1 ↦ E.toSubalgebra.map L.1.toSubalgebra.val) ha + simpa [IntermediateField.adjoin_simple_toSubalgebra_of_isAlgebraic, AlgHom.map_adjoin, + Set.image_singleton, Subalgebra.range_val] using hmap + · exact Algebra.IsSeparable.of_algHom K (E := (SubField.bot_adjoin K D a.1)) L.1 <| + Subalgebra.inclusion (by + rw [SubField.bot_adjoin_coe K D a.1, Algebra.adjoin_le_iff] + simp) + by_contra! h + let ZCL := Subalgebra.center K CL + let CCL := Subalgebra.centralizer K (A := D) CL + letI : Field L.1 := inferInstance + haveI sim : IsSimpleRing L.1.1 := inferInstance + have eq1 := double_centralizer (F := K) (A := D) L.1.1 + change CCL = L.1.1 at eq1 + have eq2 : CCL = ZCL.map (Subalgebra.val _) := by + dsimp [CCL, ZCL, CL] at * + refine le_antisymm ?_ ?_ + · rw [eq1] + intro x hx + simp + constructor + · simp [Subalgebra.mem_center_iff] + intro y hy + simp [Subalgebra.mem_centralizer_iff] at hy + exact hy x hx|>.symm + · simp [Subalgebra.mem_centralizer_iff] + exact fun y hy ↦ L.1.2 hy hx + · convert le_trans ?_ (Subalgebra.map_centralizer_le_centralizer_image ⊤ (centralizer K (L.1.1: Set D)).val) + · simp + apply Subalgebra.map_mono + exact Subalgebra.center_le_centralizer _ _ + -- rw [eq1] + rw [eq1] at eq2 + haveI inst1 : Algebra.IsAlgebraic L CL := Algebra.IsAlgebraic.of_finite L CL + haveI inst2 : FiniteDimensional ZCL CL := inferInstance + haveI inst3: Algebra.IsAlgebraic ZCL CL := Algebra.IsAlgebraic.of_finite ZCL CL + have ass : Subring.center ↥CL ≠ ⊤ := by + rw [eq2] at h + symm + contrapose! h + apply Subalgebra.toSubring_injective + convert congr(Subring.map CL.val.toRingHom $h) + ext + simp + obtain ⟨a, ha1, ha2⟩ := @JacobsonNoether.exists_separable_and_not_isCentral + (Subalgebra.centralizer K (A := D) L) _ inst3 ass + obtain ⟨L, hLsep⟩ := L + have ha1_aux : a.1 ∉ L := by + by_contra! haa + have : a ∈ Subring.center (centralizer K L) := by + rw [Subring.mem_center_iff] + intro ⟨b, hb⟩ + rw [Subalgebra.mem_centralizer_iff] at hb + ext + simp [hb a.1 haa] + tauto + have cond3 : L ≠ SubField.adjoin K D L a.1 a.2 := by + by_contra! eq + obtain eq' := (SetLike.ext_iff.1 eq) a.1 |>.2 (Algebra.subset_adjoin <| by simp) + tauto + simp_all only + let e1 := Subalgebra.equivOfEq L.1 _ eq2 + let e2 := ZCL_equiv_ZCL_map K D L + have asep := IsSeparable.of_equiv_equiv (A₁ := Subalgebra.center K (Subalgebra.centralizer K (A := D) L)) + (A₂ := L) (e2.trans e1.symm).toRingEquiv (RingEquiv.refl _) (by + ext x + simp only [AlgEquiv.toRingEquiv_eq_coe, AlgEquiv.toRingEquiv_toRingHom, RingHom.coe_comp, + RingHom.coe_coe, Function.comp_apply, RingEquiv.coe_ringHom_refl, RingHomCompTriple.comp_eq, + SetLike.coe_eq_coe] + unfold e1 e2 + simp only [equivOfEq_symm] + erw [AlgEquiv.trans_apply] + simp only [AlgEquiv.coe_ofBijective, AlgHom.coe_mk, RingHom.coe_mk, MonoidHom.coe_mk, + OneHom.coe_mk] + change algebraMap _ _ x = _ + rfl) ha2 + simp at asep + have cond1 : Algebra.IsSeparable K (SubField.adjoin K D L a.1 a.2) := by + rw [Algebra.isSeparable_def] + rintro ⟨x, hx⟩ + change x ∈ Algebra.adjoin _ _ at hx + refine Algebra.adjoin_induction (by + intro x1 hx1 + simp at hx1 + obtain hx11 | hx12 := hx1 + · subst hx11 + letI : Algebra.IsSeparable K L := hLsep + letI := IsLAlg K D L a.1 a.2 + letI := SubField.adjoin_scalarTower K D L a.1 a.2 + exact IsSeparable.of_algebra_isSeparable_of_isSeparable K (E := L) + (K := SubField.adjoin K D L a.1 a.2) (x := ⟨a.1, Algebra.subset_adjoin hx1⟩) <| by + let f : SubField.adjoin K D L a.1 a.2 →ₐ[L] centralizer K (L : Set D) := + ⟨(Subalgebra.inclusion (SubField.adjoin_le_centralizer K D L a.1 a.2)).toRingHom, fun r ↦ rfl⟩ + refine IsSeparable.of_algHom_of_map f asep + · simp [Algebra.isSeparable_def] at hLsep + have := IsSeparable.map (F := K) (K := L) (L := SubField.adjoin K D L a.1 a.2) + (x := (⟨x1, hx12⟩ : L)) (Subalgebra.inclusion (Set.subset_union_left |>.trans + Algebra.subset_adjoin)) (Subalgebra.inclusion_injective _ ) <| hLsep x1 hx12 + exact this) + (fun k ↦ IsSeparable.map (Algebra.ofId K _) (FaithfulSMul.algebraMap_injective _ _) + (Algebra.IsSeparable.isSeparable' k)) + (fun _ _ _ _ ↦ Field.isSeparable_add) (fun _ _ _ _ ↦ Field.isSeparable_mul) hx + have : (SubField.adjoin K D L a.1 a.2) ∈ AllSepSubfield K D := by + simp [cond1] + have cond2 : L ≤ SubField.adjoin K D L a.1 a.2 := + Set.subset_union_left (s := L.1) (t := {a.1}) |>.trans <| Algebra.subset_adjoin (R := K) + simp [IsMax] at hL + specialize hL (SubField.adjoin K D L a.1 a.2) cond1 cond2 + have : L = SubField.adjoin K D L a.1 a.2 := le_antisymm cond2 hL + tauto + +theorem exists_sep_masSubfield : ∃ L : SubField K D, IsMax L ∧ Algebra.IsSeparable K L := by + obtain ⟨a, hL1, hL2⟩ := exists_sep_masSubfield' K D + exact ⟨SubField.bot_adjoin K D a, hL1, hL2⟩ + +theorem exists_sep_splitting : ∃ (L : Type u)(_ : Field L)(_ : Algebra K L)(_ : FiniteDimensional K L), + Algebra.IsSeparable K L ∧ isSplit K D L := by + obtain ⟨L, hL1, hL2⟩ := exists_sep_masSubfield K D + exact ⟨L, inferInstance, inferInstance, inferInstance, hL2, isSplit_of_isMax K D L hL1⟩ + +omit [DivisionRing D] [Algebra K D] [Algebra.IsCentral K D] [FiniteDimensional K D] in +private theorem algHom_fieldRange_isSeparable {L Kbar : Type u} [Field L] [Field Kbar] + [Algebra K L] [Algebra K Kbar] [Algebra.IsSeparable K L] (f : L →ₐ[K] Kbar) : + Algebra.IsSeparable K f.fieldRange := + Algebra.IsSeparable.of_equiv_equiv (B₁ := L) (B₂ := f.fieldRange) (RingEquiv.refl K) + (AlgEquiv.ofInjectiveField f).toRingEquiv <| by + ext + erw [AlgEquiv.ofInjective_apply _ f.injective] + simp + +omit [DivisionRing D] [Algebra K D] [Algebra.IsCentral K D] [FiniteDimensional K D] in +private theorem normalClosure_isSeparable {Kbar : Type u} [Field Kbar] + [Algebra K Kbar] [IsAlgClosed Kbar] (L : Type u) [Field L] [Algebra K L] + [Algebra.IsSeparable K L] [Algebra.IsAlgebraic K L] : + Algebra.IsSeparable K (IntermediateField.normalClosure K L Kbar) := by + haveI : ∀ f : L →ₐ[K] Kbar, Algebra.IsSeparable K f.fieldRange := fun f ↦ + algHom_fieldRange_isSeparable (K := K) (L := L) (Kbar := Kbar) f + rw [normalClosure_def] + infer_instance + +theorem exists_finite_galois_split : ∃ (L : Type u)(_ : Field L)(_ : Algebra K L)(_ : FiniteDimensional K L), + IsGalois K L ∧ isSplit K D L := by + obtain ⟨L, _, _, _, hL1, hL2⟩ := exists_sep_splitting K D + haveI : FiniteDimensional K L := inferInstance + let K_bar := AlgebraicClosure K + haveI : IsAlgClosed K_bar := inferInstance + haveI : Algebra.IsAlgebraic K L := inferInstance + let L' := IntermediateField.normalClosure K L K_bar + let f := normalClosure.algHomEquiv K L K_bar |>.symm IsAlgClosed.lift + letI : Algebra.IsSeparable K L := hL1 + letI : Algebra L L' := RingHom.toAlgebra f + haveI : IsScalarTower K L L' := { + smul_assoc k l x := by + simp only [Algebra.smul_def, map_mul] + rw [mul_assoc] + congr 1 + change (normalClosure.algHomEquiv K L K_bar |>.symm IsAlgClosed.lift) _ = _ + simp only [AlgHom.commutes] + rfl } + haveI : Algebra.IsSeparable K L' := by + simpa [L'] using normalClosure_isSeparable (K := K) (Kbar := K_bar) L + haveI : IsGalois K L' := { + to_isSeparable := inferInstance + to_normal := inferInstance } + have hsplit : isSplit K D L' := extension_over_split' K K_bar D L L' hL2 + exact ⟨L', inferInstance, inferInstance, inferInstance, inferInstance, hsplit⟩ From 02c6f334b10f07f192b908788d70b29b8082e032 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 21:09:58 -0700 Subject: [PATCH 29/34] Port BrauerGroup real and absolute results --- LeanPool.lean | 2 + LeanPool/BrauerGroupNew.lean | 2 + LeanPool/BrauerGroupNew/AbsoluteIsoH2.lean | 10 + LeanPool/BrauerGroupNew/BrauerOverR.lean | 275 +++++++++++++++++++++ 4 files changed, 289 insertions(+) create mode 100644 LeanPool/BrauerGroupNew/AbsoluteIsoH2.lean create mode 100644 LeanPool/BrauerGroupNew/BrauerOverR.lean diff --git a/LeanPool.lean b/LeanPool.lean index 98716f69f2..96e68fe79c 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -54,10 +54,12 @@ import LeanPool.ArtinWedderburn.PrimeRing import LeanPool.ArtinWedderburn.SetProd import LeanPool.Basic import LeanPool.BrauerGroupNew +import LeanPool.BrauerGroupNew.AbsoluteIsoH2 import LeanPool.BrauerGroupNew.AlgClosedUnion import LeanPool.BrauerGroupNew.Azumaya.Basic import LeanPool.BrauerGroupNew.Azumaya.Mul import LeanPool.BrauerGroupNew.BrauerGroup +import LeanPool.BrauerGroupNew.BrauerOverR import LeanPool.BrauerGroupNew.CentralSimple import LeanPool.BrauerGroupNew.Centralizer import LeanPool.BrauerGroupNew.CrossProductAlgebra diff --git a/LeanPool/BrauerGroupNew.lean b/LeanPool/BrauerGroupNew.lean index 963f8bb26c..6b0f927589 100644 --- a/LeanPool/BrauerGroupNew.lean +++ b/LeanPool/BrauerGroupNew.lean @@ -29,8 +29,10 @@ import LeanPool.BrauerGroupNew.RelativeBrauer import LeanPool.BrauerGroupNew.SkolemNoether import LeanPool.BrauerGroupNew.ToSecond import LeanPool.BrauerGroupNew.IsoSecond +import LeanPool.BrauerGroupNew.AbsoluteIsoH2 import LeanPool.BrauerGroupNew.DoubleCentralizer import LeanPool.BrauerGroupNew.FrobeniusTheorem +import LeanPool.BrauerGroupNew.BrauerOverR import LeanPool.BrauerGroupNew.Mathlib import LeanPool.BrauerGroupNew.Subfield diff --git a/LeanPool/BrauerGroupNew/AbsoluteIsoH2.lean b/LeanPool/BrauerGroupNew/AbsoluteIsoH2.lean new file mode 100644 index 0000000000..f50baa57b2 --- /dev/null +++ b/LeanPool/BrauerGroupNew/AbsoluteIsoH2.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.IsoSecond +import Mathlib.FieldTheory.IsSepClosed + +variable (F F_star : Type) [Field F] [Field F_star] [Algebra F F_star] [IsSepClosure F F_star] diff --git a/LeanPool/BrauerGroupNew/BrauerOverR.lean b/LeanPool/BrauerGroupNew/BrauerOverR.lean new file mode 100644 index 0000000000..cca934be62 --- /dev/null +++ b/LeanPool/BrauerGroupNew/BrauerOverR.lean @@ -0,0 +1,275 @@ +/- +Copyright (c) 2026 Yunzhou Xie and contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies +-/ + +import LeanPool.BrauerGroupNew.FrobeniusTheorem + +suppress_compilation + +open Quaternion BrauerGroup TensorProduct BrauerGroupNew + +/-- Left multiplication by `q1` and right multiplication by `star q2` as a real-linear +endomorphism. -/ +abbrev toEnd_map_aux (q1 q2 : ℍ[ℝ]) : Module.End ℝ ℍ[ℝ] where + toFun x := q1 * x * (star q2) + map_add' x1 x2 := by simp [mul_add, add_mul] + map_smul' r x := by simp + +/-- The second argument of `toEnd_map_aux` packaged as a real-linear map to endomorphisms. -/ +abbrev toEnd_map_aux' (q1 : ℍ[ℝ]) : ℍ[ℝ] →ₗ[ℝ] Module.End ℝ ℍ[ℝ] where + toFun q2 := toEnd_map_aux q1 q2 + map_add' x1 x2 := by ext : 1; simp [mul_add] + map_smul' r x := by ext : 1; simp [Algebra.mul_smul_comm _ _ (star x)] + +/-- The real-linear map `ℍ ⊗ ℍ → End_R(ℍ)` induced by two-sided quaternion multiplication. -/ +abbrev toEnd_map : ℍ[ℝ] ⊗[ℝ] ℍ[ℝ] →ₗ[ℝ] Module.End ℝ (ℍ[ℝ]) := TensorProduct.lift { + toFun := fun q1 ↦ toEnd_map_aux' q1 + map_add' := fun x1 x3 ↦ by ext : 2; simp [add_mul] + map_smul' := fun r x ↦ by ext : 2; simp +} + +lemma toEnd_map.map_mul (x1 x2 : ℍ[ℝ] ⊗[ℝ] ℍ[ℝ]) : toEnd_map (x1 * x2) = + toEnd_map x1 * toEnd_map x2 := by + induction x1 using TensorProduct.induction_on with + | zero => simp + | tmul q1 q2 => + induction x2 using TensorProduct.induction_on with + | zero => simp + | tmul q3 q4 => ext : 1; simp [← _root_.mul_assoc] + | add x y h1 h2 => + rw [mul_add, map_add, map_add, mul_add, h1, h2] + | add x y h1 h2 => rw [add_mul, map_add, map_add, add_mul, h1, h2] + +/-- The algebra homomorphism `ℍ ⊗ ℍ → End_R(ℍ)` from two-sided quaternion multiplication. -/ +abbrev toEnd : ℍ[ℝ] ⊗[ℝ] ℍ[ℝ] →ₐ[ℝ] Module.End ℝ (ℍ[ℝ]) where + toFun := toEnd_map + map_one' := by ext : 1; simp [Algebra.TensorProduct.one_def] + map_mul' := toEnd_map.map_mul + map_zero' := rfl + map_add' := toEnd_map.map_add + commutes' r := by ext : 1; simp only [Algebra.TensorProduct.algebraMap_apply, + algebraMap_def, lift.tmul, LinearMap.coe_mk, AddHom.coe_mk, star_one, _root_.mul_one, + Module.algebraMap_end_apply]; exact coe_mul_eq_smul r _ + +instance : Algebra.IsCentral ℝ ℍ[ℝ] := ⟨fun q hq ↦ by + rw [Subalgebra.mem_center_iff] at hq + change ∃(_ : _), _ = _ + use q.1 + let eq1 := hq ⟨0, 1, 0, 0⟩ + let eq2 := hq ⟨0, 0, 1, 0⟩ + let eq3 := hq ⟨0, 0, 0, 1⟩ + rw [Quaternion.ext_iff] at eq1 eq2 eq3 + obtain ⟨_, _, eq13, eq14⟩ := eq1 + obtain ⟨_, eq22, _, eq24⟩ := eq2 + obtain ⟨_, eq32, eq33, _⟩ := eq3 + simp only [re_mul, zero_mul, _root_.one_mul, zero_sub, sub_zero, mul_zero, _root_.mul_one, + imI_mul, zero_add, add_zero, imJ_mul, sub_self, imK_mul, AlgHom.toRingHom_eq_coe, + RingHom.coe_coe] at * + have hI : q.imI = 0 := by linarith [eq33] + have hJ : q.imJ = 0 := by linarith [eq14] + have hK : q.imK = 0 := by linarith [eq13] + change (⟨q.re, 0, 0, 0⟩ : ℍ[ℝ]) = q + ext <;> simp [hI, hJ, hK]⟩ + +instance : IsSimpleRing (ℍ[ℝ] ⊗[ℝ] ℍ[ℝ]) := IsCentralSimple.TensorProduct.simple _ _ _ + +lemma toEnd_bij : Function.Bijective toEnd := + bijective_of_dim_eq_of_isCentralSimple ℝ (ℍ[ℝ] ⊗[ℝ] ℍ[ℝ]) (Module.End ℝ ℍ[ℝ]) toEnd <| by + rw [show Module.finrank ℝ (Module.End ℝ _) = + Module.finrank ℝ (Matrix (Fin <| Module.finrank ℝ ℍ[ℝ]) (Fin <| Module.finrank ℝ ℍ[ℝ]) ℝ) + from (algEquivMatrix <| Module.finBasis _ _).toLinearEquiv.finrank_eq] + simp [Quaternion.finrank_eq_four, Fintype.card_fin, Module.finrank_matrix] + +/-- The tensor square of Hamilton's quaternions is equivalent to `4 × 4` real matrices. -/ +def QuaternionTensorEquivMatrix : ℍ[ℝ] ⊗[ℝ] ℍ[ℝ] ≃ₐ[ℝ] Matrix (Fin 4) (Fin 4) ℝ := + (AlgEquiv.ofBijective toEnd toEnd_bij).trans <| algEquivMatrix + (QuaternionAlgebra.basisOneIJK (-1 : ℝ) 0 (-1 : ℝ)) + +lemma QuaternionTensorEquivOne : IsBrauerEquivalent (K := ℝ) ⟨.of ℝ (ℍ[ℝ] ⊗[ℝ] ℍ[ℝ])⟩ ⟨.of ℝ ℝ⟩ := + ⟨1, 4, one_ne_zero, by omega, ⟨dim_one_iso _ |>.trans QuaternionTensorEquivMatrix⟩⟩ + +lemma QuaternionNotEquivR : ¬ IsBrauerEquivalent (K := ℝ) ⟨.of ℝ ℍ[ℝ]⟩ ⟨.of ℝ ℝ⟩ := by + intro h + obtain ⟨n, m, hn, hm, ⟨e⟩⟩ := h + letI : NeZero n := ⟨hn⟩ + letI : NeZero m := ⟨hm⟩ + obtain ⟨e'⟩ := Wedderburn_Artin_uniqueness₀ ℝ (Matrix (Fin n) (Fin n) ℍ[ℝ]) + n m ℍ[ℝ] AlgEquiv.refl ℝ e + have eq2 := e'.toLinearEquiv.finrank_eq + simp only [Module.finrank_self] at eq2 + haveI := eq2.symm.trans <| Quaternion.finrank_eq_four (R := ℝ) + norm_num at this + +lemma BrauerOverR (A : CSA.{0, 0} ℝ) : + IsBrauerEquivalent A ⟨.of ℝ ℝ⟩ ∨ IsBrauerEquivalent A ⟨.of ℝ ℍ[ℝ]⟩ := by + if h : IsBrauerEquivalent A ⟨.of ℝ ℝ⟩ then left; assumption + else + right + obtain ⟨n, hn, D, _, _, ⟨e⟩⟩ := Wedderburn_Artin_algebra_version.{0, 0} ℝ A + letI := A.4 + letI : FiniteDimensional ℝ D := is_fin_dim_of_wdb ℝ A hn D e + obtain ⟨⟨e'⟩⟩ | hD2 | hD3 := FrobeniusTheorem D + · have := is_central_of_wdb ℝ A n D hn e|>.center_eq_bot + have e2 : Subalgebra.center ℝ D ≠ ⊥ := by + refine ne_of_gt ?_ + letI : Algebra ℂ D := RingHom.toAlgebra' e'.symm fun z d ↦ by + simp only [RingHom.coe_coe] + rw [← e'.symm_apply_apply d, ← map_mul, mul_comm, map_mul] + letI : IsScalarTower ℝ ℂ D := { + smul_assoc := fun r z d ↦ by + change e'.symm _ * _ = _ • (e'.symm z * d) + rw [map_smul, Algebra.smul_mul_assoc] + } + have : Subalgebra.center ℝ D = ⊤ := by + apply le_antisymm (fun _ _ ↦ trivial) <| by + rintro d - + rw [Subalgebra.mem_center_iff] + intro d' + rw [← e'.symm_apply_apply d, ← e'.symm_apply_apply d'] + conv_lhs => rw [← _root_.map_mul e'.symm, mul_comm, map_mul] + rw [this] + exact SetLike.lt_iff_le_and_exists.2 ⟨fun _ _ ↦ ⟨⟩, ⟨e'.symm Complex.I, ⟨⟨⟩, by + by_contra! mem + change ∃(_ : _), _ = _ at mem + obtain ⟨r, eq⟩ := mem + simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe] at eq + apply_fun e' at eq + rw [e'.apply_symm_apply] at eq + rw [Algebra.ofId_apply, Algebra.algebraMap_eq_smul_one, map_smul, map_one] at eq + simp only [Complex.real_smul, _root_.mul_one] at eq + rw [Complex.ext_iff] at eq + obtain ⟨_, fal⟩ := eq + simp only [Complex.ofReal_im, Complex.I_im, zero_ne_one] at fal⟩⟩⟩ + tauto + · have : IsBrauerEquivalent A ⟨.of ℝ ℝ⟩ := + ⟨1, n, one_ne_zero, hn, ⟨dim_one_iso A|>.trans <| e.trans hD2.some.mapMatrix⟩⟩ + tauto + · exact ⟨1, n, one_ne_zero, hn, ⟨dim_one_iso A |>.trans <| e.trans hD3.some.mapMatrix⟩⟩ + +open scoped Classical in +/-- Classifies a real Brauer class as split or quaternionic, giving an element of `ZMod 2`. -/ +abbrev toC2 : Additive (BrauerGroup ℝ) →+ ZMod 2 where + toFun := Quotient.lift (fun A ↦ if h1 : IsBrauerEquivalent A (one_in') + then 0 else 1) <| + fun A B hAB ↦ by + change IsBrauerEquivalent _ _ at hAB + if h : IsBrauerEquivalent A (BrauerGroup.one_in') then + simp [h, hAB.symm.trans h] + else + simp [h] + have : ¬ IsBrauerEquivalent B (BrauerGroup.one_in') := by + by_contra! + haveI := hAB.trans this + tauto + simpa using this + map_zero' := by + change Quotient.lift _ _ (Quotient.mk'' (BrauerGroup.one_in')) = 0 + simp only [dite_eq_ite, Quotient.lift_mk, ite_eq_left_iff, one_ne_zero, imp_false, + Decidable.not_not] + exact IsBrauerEquivalent.refl _ + map_add' A B := by + induction A using Quotient.inductionOn' with | h A + induction B using Quotient.inductionOn' with | h B + have hab' : @HAdd.hAdd (Additive (BrauerGroup ℝ)) _ + _ instHAdd (Quotient.mk'' A) (Quotient.mk'' B)= + (Quotient.mk'' (mul A B) : Additive _) := rfl + rw [hab'] + simp + if hA : IsBrauerEquivalent A one_in' then + if hB : IsBrauerEquivalent B one_in' then + simp only [hA, ↓reduceIte, hB, add_zero, ite_eq_left_iff, one_ne_zero, imp_false, + Decidable.not_not] + have := eqv_tensor_eqv _ _ _ _ hA hB + refine this.trans ?_ + change IsBrauerEquivalent ⟨.of ℝ (ℝ ⊗[ℝ] ℝ)⟩ ⟨.of ℝ ℝ⟩ + exact IsBrauerEquivalent.iso_to_eqv _ _ (BrauerGroupHom.someEquivs.e7.symm) + else + simp only [hA, ↓reduceIte, hB, zero_add, ite_eq_right_iff, zero_ne_one, imp_false] + have : IsBrauerEquivalent (mul A B) B := by + exact (eqv_tensor_eqv A one_in' B B hA (IsBrauerEquivalent.refl B)).trans <| + IsBrauerEquivalent.iso_to_eqv _ _ (Algebra.TensorProduct.lid ℝ B) + -- rw [this] + by_contra! hBB + haveI := this.symm.trans hBB + tauto + else + if hB : IsBrauerEquivalent B one_in' then + simp only [hA, ↓reduceIte, hB, add_zero, ite_eq_right_iff, zero_ne_one, imp_false] + have : IsBrauerEquivalent (mul A B) A := by + exact (eqv_tensor_eqv A A B one_in' (IsBrauerEquivalent.refl A) hB).trans <| + IsBrauerEquivalent.iso_to_eqv _ _ (Algebra.TensorProduct.rid ℝ ℝ A) + by_contra! hAA + haveI := this.symm.trans hAA + tauto + else + simp only [hA, ↓reduceIte, hB] + change _ = 0 + change ¬ IsBrauerEquivalent _ ⟨.of ℝ ℝ⟩ at hA hB + have hA1 := BrauerOverR A + have hB1 := BrauerOverR B + simp only [hA, false_or] at hA1 + simp only [hB, false_or] at hB1 + have : IsBrauerEquivalent (mul A B) one_in' := + (eqv_tensor_eqv A ⟨.of ℝ ℍ[ℝ]⟩ B ⟨.of ℝ ℍ[ℝ]⟩ hA1 hB1).trans <| by + simpa [mul, one_in'] using QuaternionTensorEquivOne + simp [this] + +/-- Sends `0` to the split Brauer class and `1` to Hamilton's quaternion class. -/ +abbrev C2toBrauerOverR : ZMod 2 →+ Additive (BrauerGroup ℝ) where + toFun x := if hx : x = 0 then Quotient.mk'' one_in' else Quotient.mk'' ⟨.of ℝ ℍ[ℝ]⟩ + map_zero' := by simp only [↓reduceDIte]; rfl + map_add' x y := by + let H : CSA ℝ := ⟨.of ℝ ℍ[ℝ]⟩ + fin_cases x <;> fin_cases y <;> simp only [dite_eq_ite] + · change (1 : BrauerGroup ℝ) = 1 * 1 + simp + · change ((Quotient.mk'' H : BrauerGroup ℝ)) = 1 * Quotient.mk'' H + simp + · change ((Quotient.mk'' H : BrauerGroup ℝ)) = Quotient.mk'' H * 1 + simp + · change (1 : BrauerGroup ℝ) = Quotient.mk'' H * Quotient.mk'' H + apply Quotient.sound + change IsBrauerEquivalent one_in' (mul H H) + exact QuaternionTensorEquivOne.symm + +lemma toC2.left_inv : Function.LeftInverse C2toBrauerOverR toC2 := fun A ↦ by + classical + induction A using Quotient.inductionOn' with | h A + obtain h1 | h2 := BrauerOverR A + · change IsBrauerEquivalent A one_in' at h1 + simp only [AddMonoidHom.coe_mk, dite_eq_ite, ZeroHom.coe_mk, Quotient.lift_mk, h1, ↓reduceIte] + rw [Quotient.sound']; exact h1.symm + · have : ¬ (IsBrauerEquivalent A one_in') := fun h ↦ QuaternionNotEquivR <| h2.symm.trans h + change C2toBrauerOverR (if IsBrauerEquivalent A one_in' then (0 : ZMod 2) else 1) = + Quotient.mk'' A + rw [if_neg this] + change (if ((1 : ZMod 2) = 0) then Quotient.mk'' one_in' else + Quotient.mk'' ⟨.of ℝ ℍ[ℝ]⟩) = Quotient.mk'' A + rw [if_neg (by norm_num : ¬ ((1 : ZMod 2) = 0))] + exact Quotient.sound' h2.symm + +lemma toC2.right_inv : Function.RightInverse C2toBrauerOverR toC2 := fun x ↦ by + classical + let H : CSA ℝ := ⟨.of ℝ ℍ[ℝ]⟩ + fin_cases x + · change toC2 (if ((0 : ZMod 2) = 0) then Quotient.mk'' one_in' else Quotient.mk'' H) = 0 + rw [if_pos rfl] + simp [toC2, IsBrauerEquivalent.refl] + · change toC2 (if ((1 : ZMod 2) = 0) then Quotient.mk'' one_in' else Quotient.mk'' H) = 1 + have hone : ¬ ((1 : ZMod 2) = 0) := by norm_num + rw [if_neg hone] + change toC2 (Quotient.mk'' H) = (1 : ZMod 2) + change (if IsBrauerEquivalent H one_in' then (0 : ZMod 2) else 1) = 1 + have hH : ¬ IsBrauerEquivalent H one_in' := by + exact QuaternionNotEquivR + rw [if_neg hH] + +/-- The real Brauer group is the cyclic group of order two, generated by Hamilton's quaternions. -/ +def BrauerGroupOverR : Additive (BrauerGroup ℝ) ≃+ ZMod 2 where + toFun := toC2 + invFun := C2toBrauerOverR + left_inv := toC2.left_inv + right_inv := toC2.right_inv + map_add' := toC2.map_add From 4dc2d5bff73545c9d837bfe31d74372d74040503 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 21:15:39 -0700 Subject: [PATCH 30/34] Restore BrauerGroup compatibility declarations --- LeanPool/BrauerGroupNew/BrauerGroup.lean | 28 +++++++++++++++++++ .../Mathlib/LinearAlgebra/Span/Basic.lean | 24 ++++++++++++---- 2 files changed, 46 insertions(+), 6 deletions(-) diff --git a/LeanPool/BrauerGroupNew/BrauerGroup.lean b/LeanPool/BrauerGroupNew/BrauerGroup.lean index 4fc5365697..e5b43062f8 100644 --- a/LeanPool/BrauerGroupNew/BrauerGroup.lean +++ b/LeanPool/BrauerGroupNew/BrauerGroup.lean @@ -591,6 +591,34 @@ def baseChangeTensorEquiv : rw [Algebra.TensorProduct.tmul_mul_tmul, Algebra.TensorProduct.tmul_mul_tmul] ring_nf) +/-- If the matrix index is empty, the scalar-extension tensor source is subsingleton. -/ +lemma e3Aux3 (hm : m = 0) : + Subsingleton ((E ⊗[K] A) ⊗[E] (E ⊗[K] Matrix (Fin m) (Fin m) K)) := by + suffices ∀ a : (E ⊗[K] A) ⊗[E] (E ⊗[K] Matrix (Fin m) (Fin m) K), a = 0 by + exact ⟨fun a b => by rw [this a, this b]⟩ + subst hm + intro x + induction x using TensorProduct.induction_on with + | zero => rfl + | add e a he ha => rw [he, ha, zero_add] + | tmul e a => + induction a using TensorProduct.induction_on with + | zero => simp + | add _ _ hx hy => rw [TensorProduct.tmul_add, hx, hy, add_zero] + | tmul e' mat => + rw [show mat = 0 from Subsingleton.elim _ _] + simp + +/-- The algebra homomorphism underlying `e3`. -/ +def e3Aux4 : + (E ⊗[K] A) ⊗[E] (E ⊗[K] Matrix (Fin m) (Fin m) K) →ₐ[E] + E ⊗[K] (A ⊗[K] Matrix (Fin m) (Fin m) K) := + (baseChangeTensorEquiv A (Matrix (Fin m) (Fin m) K)).toAlgHom + +/-- The algebra homomorphism underlying `e3` is surjective. -/ +lemma e3Aux5 : Function.Surjective (e3Aux4 (K := K) (E := E) A m) := + (baseChangeTensorEquiv A (Matrix (Fin m) (Fin m) K)).surjective + /-- Rewrites matrices over a scalar extension as a tensor product with matrices over the extension. -/ def e1 : Matrix (Fin m) (Fin m) (E ⊗[K] A) ≃ₐ[E] (E ⊗[K] A) ⊗[E] Matrix (Fin m) (Fin m) E := diff --git a/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Span/Basic.lean b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Span/Basic.lean index cef230621d..d832918952 100644 --- a/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Span/Basic.lean +++ b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Span/Basic.lean @@ -7,10 +7,22 @@ import Mathlib.Algebra.BigOperators.GroupWithZero.Action import Mathlib.Algebra.Module.Submodule.Basic import Mathlib.LinearAlgebra.Span.Defs -/-! -# Span compatibility imports +variable {α R M : Type*} [Semiring R] [AddCommMonoid M] [Module R M] {v : α → M} {x : M} -The upstream file supplied `Submodule.mem_span_image_finset_iff_exists_fun`; -that declaration is available in the current Mathlib import graph, so this file -is kept as an import-compatible shim. --/ +lemma Submodule.mem_span_image_finset_iff_exists_fun {s : Finset α} : + x ∈ span R (v '' s) ↔ ∃ c : α → R, ∑ i ∈ s, c i • v i = x := by + refine ⟨?_, ?_⟩ + · intro hx + simp at hx + refine Submodule.span_induction (hx := hx) ?_ ?_ ?_ ?_ + · rintro c ⟨c', hc1, hc2⟩ + classical + exact ⟨Function.update (0 : α → R) c' 1 , by + simp only [Function.update, eq_rec_constant, Pi.zero_apply, dite_eq_ite, ite_smul, one_smul, + zero_smul, Finset.sum_ite_eq']; aesop⟩ + · exact ⟨0, by simp⟩ + · rintro x y hx hy ⟨c1, hc1⟩ ⟨c2, hc2⟩ + exact ⟨c1 + c2, by simp_all [add_smul, Finset.sum_add_distrib]⟩ + · exact fun r x hx ⟨c, hc⟩ ↦ ⟨r • c, by simp_all [mul_smul, ← Finset.smul_sum]⟩ + · rintro ⟨c, rfl⟩ + exact sum_mem fun i hi ↦ smul_mem _ _ <| subset_span ⟨i, hi, by simp⟩ From 9d7c140c1ffed1c097a84518c6a473386578f84e Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 21:17:07 -0700 Subject: [PATCH 31/34] Restore BrauerGroup congruence compatibility import --- .../BrauerGroupNew/Mathlib/RingTheory/Congruence/Basic.lean | 2 ++ 1 file changed, 2 insertions(+) diff --git a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/Congruence/Basic.lean b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/Congruence/Basic.lean index 7c53eed243..0b99f01e29 100644 --- a/LeanPool/BrauerGroupNew/Mathlib/RingTheory/Congruence/Basic.lean +++ b/LeanPool/BrauerGroupNew/Mathlib/RingTheory/Congruence/Basic.lean @@ -8,6 +8,8 @@ import Mathlib.Algebra.Algebra.Hom import Mathlib.Algebra.RingQuot import Mathlib.RingTheory.Congruence.Basic +open Function + /-! # Ring congruence quotient compatibility From 5e9435cfa52bb6ceddd5d7f2a0c11bb1ae86f897 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 21:19:51 -0700 Subject: [PATCH 32/34] Restore BrauerGroup tensor compatibility helper --- LeanPool/BrauerGroupNew/BrauerGroup.lean | 69 ++++++++++++++++++++++++ 1 file changed, 69 insertions(+) diff --git a/LeanPool/BrauerGroupNew/BrauerGroup.lean b/LeanPool/BrauerGroupNew/BrauerGroup.lean index e5b43062f8..2a122c06d5 100644 --- a/LeanPool/BrauerGroupNew/BrauerGroup.lean +++ b/LeanPool/BrauerGroupNew/BrauerGroup.lean @@ -677,6 +677,75 @@ def e4 : def e5 (e : A ≃ₐ[K] B) : (E ⊗[K] A) ≃ₐ[E] (E ⊗[K] B) := Algebra.TensorProduct.congr AlgEquiv.refl e +set_option maxHeartbeats 800000 in +-- This restores the upstream compatibility homomorphism, whose tensor-product proof is expensive. +/-- The algebra homomorphism underlying scalar-extension compatibility with tensor products. -/ +def e6Aux0 : (E ⊗[K] A) ⊗[E] (E ⊗[K] B) →ₐ[E] E ⊗[K] (A ⊗[K] B) := + Algebra.TensorProduct.lift + (Algebra.TensorProduct.lift + { toFun e := e ⊗ₜ[K] (1 ⊗ₜ 1) + map_one' := rfl + map_mul' := fun e e' => by + simp only [Algebra.TensorProduct.tmul_mul_tmul, _root_.mul_one] + map_zero' := by simp + map_add' := fun e e' => by simp [TensorProduct.add_tmul] + commutes' e := rfl } + { toFun a := 1 ⊗ₜ[K] (a ⊗ₜ 1) + map_one' := rfl + map_mul' := fun _ _ => by + simp only [Algebra.TensorProduct.tmul_mul_tmul, _root_.mul_one] + map_zero' := by simp + map_add' := fun _ _ => by simp [TensorProduct.add_tmul, TensorProduct.tmul_add] + commutes' k := by + simp only [Algebra.TensorProduct.algebraMap_apply] + rw [show (algebraMap K A) k ⊗ₜ[K] (1 : B) = k • (1 : A ⊗[K] B) by + rw [Algebra.algebraMap_eq_smul_one] + rw [← TensorProduct.smul_tmul'] + rfl] + rw [TensorProduct.tmul_smul] + rw [Algebra.smul_def (A := E ⊗[K] (A ⊗[K] B))] + convert _root_.mul_one _ } fun e a => + show (_ ⊗ₜ[K] _) * (_ ⊗ₜ[K] _) = (_ ⊗ₜ[K] _) * (_ ⊗ₜ[K] _) by simp) + (Algebra.TensorProduct.lift + { toFun e := e ⊗ₜ[K] (1 ⊗ₜ 1) + map_one' := rfl + map_mul' := fun e e' => by + simp only [Algebra.TensorProduct.tmul_mul_tmul, _root_.mul_one] + map_zero' := by simp + map_add' := fun e e' => by simp [TensorProduct.add_tmul] + commutes' e := rfl } + { toFun b := 1 ⊗ₜ[K] (1 ⊗ₜ b) + map_one' := rfl + map_mul' := fun _ _ => by + simp only [Algebra.TensorProduct.tmul_mul_tmul, _root_.mul_one] + map_zero' := by simp + map_add' := fun _ _ => by simp [TensorProduct.tmul_add] + commutes' k := by + simp only [Algebra.TensorProduct.algebraMap_apply] + rw [show (1 : A) ⊗ₜ[K] (algebraMap K B) k = k • (1 : A ⊗[K] B) by + rw [Algebra.algebraMap_eq_smul_one] + rw [TensorProduct.tmul_smul] + rfl] + rw [TensorProduct.tmul_smul] + rw [Algebra.smul_def (A := E ⊗[K] (A ⊗[K] B))] + convert _root_.mul_one _ } + fun e b => show (_ ⊗ₜ _) * (_ ⊗ₜ _) = (_ ⊗ₜ _) * (_ ⊗ₜ _) by simp) + fun x y => show _ = _ by + induction x using TensorProduct.induction_on with + | zero => simp only [map_zero, zero_mul, mul_zero] + | add x x' hx hx' => simp only [map_add, mul_add, hx, hx', add_mul] + | tmul e a => + simp only [Algebra.TensorProduct.lift_tmul, AlgHom.coe_mk, RingHom.coe_mk] + induction y using TensorProduct.induction_on with + | zero => simp only [map_zero, mul_zero, zero_mul] + | add y y' hy hy' => simp only [map_add, mul_add, hy, hy', add_mul] + | tmul e' b => + simp only [Algebra.TensorProduct.lift_tmul, AlgHom.coe_mk, RingHom.coe_mk] + change (_ ⊗ₜ _) * (_ ⊗ₜ _) * ((_ ⊗ₜ _) * (_ ⊗ₜ _)) = + (_ ⊗ₜ _) * (_ ⊗ₜ _) * ((_ ⊗ₜ _) * (_ ⊗ₜ _)) + simp only [Algebra.TensorProduct.tmul_mul_tmul, _root_.mul_one, _root_.one_mul] + rw [mul_comm] + /-- Scalar extension is compatible with tensor products of algebras. -/ def e6 : (E ⊗[K] A) ⊗[E] (E ⊗[K] B) ≃ₐ[E] E ⊗[K] (A ⊗[K] B) := From 1b75fcf17f8fcb55854fb5cfcd6c90c29f232eb6 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 21:28:15 -0700 Subject: [PATCH 33/34] Use Mathlib span compatibility theorem --- LeanPool/BrauerGroupNew/BrauerGroup.lean | 2 -- .../Mathlib/LinearAlgebra/Span/Basic.lean | 26 ++++++------------- 2 files changed, 8 insertions(+), 20 deletions(-) diff --git a/LeanPool/BrauerGroupNew/BrauerGroup.lean b/LeanPool/BrauerGroupNew/BrauerGroup.lean index 2a122c06d5..ababe98d98 100644 --- a/LeanPool/BrauerGroupNew/BrauerGroup.lean +++ b/LeanPool/BrauerGroupNew/BrauerGroup.lean @@ -677,8 +677,6 @@ def e4 : def e5 (e : A ≃ₐ[K] B) : (E ⊗[K] A) ≃ₐ[E] (E ⊗[K] B) := Algebra.TensorProduct.congr AlgEquiv.refl e -set_option maxHeartbeats 800000 in --- This restores the upstream compatibility homomorphism, whose tensor-product proof is expensive. /-- The algebra homomorphism underlying scalar-extension compatibility with tensor products. -/ def e6Aux0 : (E ⊗[K] A) ⊗[E] (E ⊗[K] B) →ₐ[E] E ⊗[K] (A ⊗[K] B) := Algebra.TensorProduct.lift diff --git a/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Span/Basic.lean b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Span/Basic.lean index d832918952..580745a5d9 100644 --- a/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Span/Basic.lean +++ b/LeanPool/BrauerGroupNew/Mathlib/LinearAlgebra/Span/Basic.lean @@ -5,24 +5,14 @@ Authors: Yunzhou Xie, Yichen Feng, Jujian Zhang, Yael Dillies -/ import Mathlib.Algebra.BigOperators.GroupWithZero.Action import Mathlib.Algebra.Module.Submodule.Basic +import Mathlib.LinearAlgebra.Finsupp.LinearCombination import Mathlib.LinearAlgebra.Span.Defs -variable {α R M : Type*} [Semiring R] [AddCommMonoid M] [Module R M] {v : α → M} {x : M} +/-! +# Span compatibility imports -lemma Submodule.mem_span_image_finset_iff_exists_fun {s : Finset α} : - x ∈ span R (v '' s) ↔ ∃ c : α → R, ∑ i ∈ s, c i • v i = x := by - refine ⟨?_, ?_⟩ - · intro hx - simp at hx - refine Submodule.span_induction (hx := hx) ?_ ?_ ?_ ?_ - · rintro c ⟨c', hc1, hc2⟩ - classical - exact ⟨Function.update (0 : α → R) c' 1 , by - simp only [Function.update, eq_rec_constant, Pi.zero_apply, dite_eq_ite, ite_smul, one_smul, - zero_smul, Finset.sum_ite_eq']; aesop⟩ - · exact ⟨0, by simp⟩ - · rintro x y hx hy ⟨c1, hc1⟩ ⟨c2, hc2⟩ - exact ⟨c1 + c2, by simp_all [add_smul, Finset.sum_add_distrib]⟩ - · exact fun r x hx ⟨c, hc⟩ ↦ ⟨r • c, by simp_all [mul_smul, ← Finset.smul_sum]⟩ - · rintro ⟨c, rfl⟩ - exact sum_mem fun i hi ↦ smul_mem _ _ <| subset_span ⟨i, hi, by simp⟩ +The upstream file supplied `Submodule.mem_span_image_finset_iff_exists_fun`; +that declaration is available in current Mathlib from +`Mathlib.LinearAlgebra.Finsupp.LinearCombination`, so this file is kept as an +import-compatible shim. +-/ From 8445168c782424d012127a02fc8ad9f2583fb63c Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sun, 24 May 2026 22:06:44 -0700 Subject: [PATCH 34/34] Clean BrauerGroup separable subfield warnings --- .../BrauerGroupNew/Subfield/Separable.lean | 169 ++++++++---------- 1 file changed, 75 insertions(+), 94 deletions(-) diff --git a/LeanPool/BrauerGroupNew/Subfield/Separable.lean b/LeanPool/BrauerGroupNew/Subfield/Separable.lean index 009a5f1f63..d40740008c 100644 --- a/LeanPool/BrauerGroupNew/Subfield/Separable.lean +++ b/LeanPool/BrauerGroupNew/Subfield/Separable.lean @@ -8,59 +8,47 @@ import LeanPool.BrauerGroupNew.Mathlib.Algebra.Algebra.Subalgebra.Lattice import LeanPool.BrauerGroupNew.Subfield.Splitting import Mathlib.FieldTheory.JacobsonNoether --- section --- variable {ι R A : Type*} (B : ι → Type*) [Preorder ι] [CommRing R] --- [Ring A] [Algebra R A] [∀ i, Ring (B i)] [∀ i, Algebra R (B i)] - --- lemma Algebra.IsSeparable.of_directedSystem [IsDirected ι (· ≤ ·)] [∀ i, Algebra.IsSeparable R (B i)] --- (map : ∀ i j, i ≤ j → B i →ₐ[R] B j) --- (directedSystem_map : DirectedSystem B fun i j hij ↦ map i j hij) --- (cone : ∀ i, B i →ₐ[R] A) --- (hcone : ∀ i j (hij : i ≤ j), cone i = (cone j).comp (map i j hij)) --- (hlimit : ∀ a , ∃ i, a ∈ Set.range (cone i)) : --- Algebra.IsSeparable R A where --- isSeparable' a := by --- obtain ⟨i, b, rfl⟩ := hlimit a --- sorry --- -- exact IsSeparable.map _ (f := (cone i).toRingHom) - --- end - universe u variable (K D : Type u) [Field K] [DivisionRing D] [Algebra K D] [Algebra.IsCentral K D] [FiniteDimensional K D] open Polynomial - --- se_option maxHeartbeats 3200000 in omit [Algebra.IsCentral K D] [FiniteDimensional K D] in lemma SubField.adjoin_centralizer_mul_comm (L : SubField K D) (a : D) (ha : a ∈ Subalgebra.centralizer K L) : ∀ (x y : D), x ∈ Algebra.adjoin K (L ∪ {a}) → y ∈ Algebra.adjoin K (L ∪ {a}) → x * y = y * x := fun x y hx hy ↦ by - simp [Algebra.mem_adjoin_iff, Subalgebra.mem_centralizer_iff] at hx hy ha + rw [Algebra.mem_adjoin_iff] at hx hy + rw [Subalgebra.mem_centralizer_iff] at ha refine Subring.closure_induction₂ (R := D) (fun x1 y1 hx1 hy1 ↦ by - simp at hx1 hy1 + simp only [Set.mem_union, SetLike.mem_coe, Set.mem_singleton_iff, Set.mem_range] at hx1 hy1 obtain hx11 | hx12 | hx13 := hx1 all_goals obtain hy11 | hy12 | hy13 := hy1 - · simp_all - · obtain ⟨b, rfl⟩ := hy12 - exact Algebra.commutes _ _ |>.symm - · subst hx11 - exact ha _ hy13|>.symm - · obtain ⟨b, rfl⟩ := hx12 - exact Algebra.commutes _ _ - · obtain ⟨b, rfl⟩ := hx12 - exact Algebra.commutes _ _ - · obtain ⟨b, rfl⟩ := hx12 - exact Algebra.commutes _ _ - · subst hy11 - exact ha _ hx13 - · obtain ⟨b, rfl⟩ := hy12 - exact Algebra.commutes _ _ |>.symm - · exact L.2 hx13 hy13) ?_ ?_ ?_ ?_ ?_ ?_ ?_ ?_ ?_ ?_ hx hy - all_goals try simp_all [add_mul, mul_add] + · obtain ⟨b, rfl⟩ := hx11 + obtain ⟨c, rfl⟩ := hy11 + exact Algebra.commutes b ((algebraMap K D) c) + · obtain ⟨b, rfl⟩ := hx11 + exact Algebra.commutes b y1 + · obtain ⟨b, rfl⟩ := hx11 + subst hy13 + exact Algebra.commutes b y1 + · obtain ⟨b, rfl⟩ := hy11 + exact (Algebra.commutes b x1).symm + · exact L.2 hx12 hy12 + · subst hy13 + exact ha _ hx12 + · subst hx13 + obtain ⟨b, rfl⟩ := hy11 + exact (Algebra.commutes b x1).symm + · subst hx13 + exact ha _ hy12 |>.symm + · subst hx13 + subst hy13 + simp) ?_ ?_ ?_ ?_ ?_ ?_ ?_ ?_ ?_ ?_ hx hy + all_goals try + simp_all only [Set.union_singleton, Set.union_insert, zero_mul, mul_zero, one_mul, mul_one, + neg_mul, mul_neg, add_mul, mul_add, forall_const, implies_true] · rintro x y z - - - hxz hyz rw [mul_assoc, hyz, ← mul_assoc, hxz, mul_assoc] · rintro x y z - - - hxy hxz @@ -158,8 +146,6 @@ noncomputable abbrev iSup_chain_sepsubfield (c : Set (AllSepSubfield K D)) [None change x ∈ (_ : Set _) at hx change _ ∈ ( _ : Set _) at hy erw [this] at hx hy - - -- rw [this] at hx hy simp only [Set.mem_iUnion, SetLike.mem_coe] at hx hy obtain ⟨L1, hx⟩ := hx obtain ⟨L2, hy⟩ := hy @@ -185,15 +171,16 @@ noncomputable abbrev iSup_chain_sepsubfield (c : Set (AllSepSubfield K D)) [None property := by simp only [Set.coe_setOf, Set.mem_setOf_eq] rw [Algebra.isSeparable_def] - simp + simp only [Subtype.forall] intro a ha have := Subalgebra.coe_iSup_of_directed hc1.directed - simp at this + dsimp at this change a ∈ (_ : Set _) at ha erw [this] at ha - simp at ha - obtain ⟨L, ⟨ha', h⟩, hL2⟩ := ha - exact IsSeparable.map (F := K) (L := ((⨆ (L : c), L.1.1.1) : Subalgebra K D)) (x := (⟨a, hL2⟩ : L)) + simp only [Set.mem_iUnion, SetLike.mem_coe, Subtype.exists] at ha + obtain ⟨L, ha', h, hL2⟩ := ha + exact IsSeparable.map (F := K) (L := ((⨆ (L : c), L.1.1.1) : Subalgebra K D)) + (x := (⟨a, hL2⟩ : L)) (Subalgebra.inclusion (le_iSup_of_le ⟨⟨L, ha'⟩, h⟩ le_rfl)) (Subalgebra.inclusion_injective _) <| Algebra.isSeparable_def _ _|>.1 ha' ⟨a, hL2⟩ @@ -211,9 +198,9 @@ lemma exists_max_sepSub : ∃ L : AllSepSubfield K D, IsMax L := theorem Set.centralizer.qsmul_mem (K D : Type u) [Field K] [DivisionRing D] [Algebra K D] (L : Set D) (q : ℚ) (a : D) (ha : a ∈ Set.centralizer L) : q • a ∈ Set.centralizer L := by - rw [Rat.smul_def] + rw [Set.mem_centralizer_iff] at ha ⊢ intro m hm - simp_all [mem_centralizer_iff] + rw [Rat.smul_def] have (m : D) := Commute.left_comm <| Rat.cast_commute q m|>.symm rw [this, ha _ hm, mul_assoc] @@ -319,24 +306,6 @@ lemma SubField.bot_adjoin_coe (a : D) : exact ⟨bot_le (α := Subalgebra K D), by simp⟩ · rw [Algebra.adjoin_le_iff, Set.singleton_subset_iff] simp - -- change x ∈ Algebra.adjoin K ((Algebra.ofId _ _).range ∪ {a}) ↔ _ - -- simp [Algebra.adjoin_algebraMap] --- lemma extend_sep_sep (K D : Type u) [Field K] [DivisionRing D] [Algebra K D] [Algebra.IsCentral K D] --- [FiniteDimensional K D] (L : Subalgebra K D) [Algebra.IsSeparable K L] [CommRing L] [Algebra L D] (a : D) --- (ha : a ∈ Subalgebra.centralizer K L) (ha' : IsSeparable L a) : --- Algebra.IsSeparable K (Algebra.adjoin K (L ∪ {a})) := by --- rw [Algebra.isSeparable_def] --- intro ⟨x, hx⟩ --- refine Algebra.adjoin_induction _ _ _ _ hx --- sorry - -- Algebra.IsSeparable K (SubField.adjoin K D L a ha) := by - -- rw [Algebra.isSeparable_def] - -- intro x hx - -- change x ∈ Algebra.adjoin _ _ at hx - -- obtain ⟨y, hy⟩ := hx - -- have := SubField.adjoin_centralizer_mul_comm K D L a ha y x hy hx - -- simp at this - -- exact H y hy this -- todo: replace mathlib version with this one theorem IsSeparable.of_algHom_of_map @@ -345,7 +314,8 @@ theorem IsSeparable.of_algHom_of_map (h : IsSeparable F (f x)) : IsSeparable F x := have ⟨_q, hq⟩ := minpoly.dvd F x (p := minpoly F (f x)) (by apply f.injective - simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe, map_zero, ← aeval_algHom_apply, minpoly.aeval]) + simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe, map_zero, ← aeval_algHom_apply, + minpoly.aeval]) (Eq.mp (congrArg Separable hq) h).of_mul_left open Subalgebra in @@ -353,9 +323,9 @@ theorem exists_sep_masSubfield' : ∃ (a : D), IsMax (SubField.bot_adjoin K D a) Algebra.IsSeparable K (SubField.bot_adjoin K D a) := by obtain ⟨L, hL⟩ := exists_max_sepSub K D let CL := Subalgebra.centralizer K (A := D) L - -- have := comm_of_centralizer K D L.1.1 (fun ⟨x, hx⟩ ⟨y, hy⟩ ↦ by simpa using L.1.2 x y hx hy) suffices h : CL = L.1.1 by - have Lmax := maxsubfield_of_div_iff K D L.1 |>.1 <| cor_two_2to3 K D L.1 (cor_two_1to2 K D L.1 |>.1 h) + have Lmax := maxsubfield_of_div_iff K D L.1 |>.1 <| + cor_two_2to3 K D L.1 (cor_two_1to2 K D L.1 |>.1 h) haveI : Algebra.IsSeparable _ _ := L.2 obtain ⟨a, ha⟩ := Field.exists_primitive_element K L.1 use a @@ -383,15 +353,18 @@ theorem exists_sep_masSubfield' : ∃ (a : D), IsMax (SubField.bot_adjoin K D a) refine le_antisymm ?_ ?_ · rw [eq1] intro x hx - simp + simp only [mem_map, coe_val, Subtype.exists, exists_and_right, exists_eq_right] constructor - · simp [Subalgebra.mem_center_iff] - intro y hy - simp [Subalgebra.mem_centralizer_iff] at hy - exact hy x hx|>.symm - · simp [Subalgebra.mem_centralizer_iff] + · rw [Subalgebra.mem_center_iff] + intro y + ext + have hy := y.2 + rw [Subalgebra.mem_centralizer_iff] at hy + exact hy x hx |>.symm + · rw [Subalgebra.mem_centralizer_iff] exact fun y hy ↦ L.1.2 hy hx - · convert le_trans ?_ (Subalgebra.map_centralizer_le_centralizer_image ⊤ (centralizer K (L.1.1: Set D)).val) + · convert le_trans ?_ + (Subalgebra.map_centralizer_le_centralizer_image ⊤ (centralizer K (L.1.1 : Set D)).val) · simp apply Subalgebra.map_mono exact Subalgebra.center_le_centralizer _ _ @@ -427,11 +400,12 @@ theorem exists_sep_masSubfield' : ∃ (a : D), IsMax (SubField.bot_adjoin K D a) simp_all only let e1 := Subalgebra.equivOfEq L.1 _ eq2 let e2 := ZCL_equiv_ZCL_map K D L - have asep := IsSeparable.of_equiv_equiv (A₁ := Subalgebra.center K (Subalgebra.centralizer K (A := D) L)) + have asep := IsSeparable.of_equiv_equiv + (A₁ := Subalgebra.center K (Subalgebra.centralizer K (A := D) L)) (A₂ := L) (e2.trans e1.symm).toRingEquiv (RingEquiv.refl _) (by ext x - simp only [AlgEquiv.toRingEquiv_eq_coe, AlgEquiv.toRingEquiv_toRingHom, RingHom.coe_comp, - RingHom.coe_coe, Function.comp_apply, RingEquiv.coe_ringHom_refl, RingHomCompTriple.comp_eq, + simp only [AlgEquiv.toRingEquiv_toRingHom, RingHom.coe_comp, RingHom.coe_coe, + Function.comp_apply, RingEquiv.coe_ringHom_refl, RingHomCompTriple.comp_eq, SetLike.coe_eq_coe] unfold e1 e2 simp only [equivOfEq_symm] @@ -440,29 +414,33 @@ theorem exists_sep_masSubfield' : ∃ (a : D), IsMax (SubField.bot_adjoin K D a) OneHom.coe_mk] change algebraMap _ _ x = _ rfl) ha2 - simp at asep have cond1 : Algebra.IsSeparable K (SubField.adjoin K D L a.1 a.2) := by rw [Algebra.isSeparable_def] rintro ⟨x, hx⟩ change x ∈ Algebra.adjoin _ _ at hx refine Algebra.adjoin_induction (by intro x1 hx1 - simp at hx1 - obtain hx11 | hx12 := hx1 - · subst hx11 + simp only [Set.mem_union, SetLike.mem_coe, Set.mem_singleton_iff] at hx1 + obtain hxL | hxa := hx1 + · have hLsep' : Algebra.IsSeparable K L := hLsep + rw [Algebra.isSeparable_def] at hLsep' + have := IsSeparable.map (F := K) (K := L) + (L := SubField.adjoin K D L a.1 a.2) (x := (⟨x1, hxL⟩ : L)) + (Subalgebra.inclusion (Set.subset_union_left |>.trans Algebra.subset_adjoin)) + (Subalgebra.inclusion_injective _) <| hLsep' ⟨x1, hxL⟩ + exact this + · subst hxa letI : Algebra.IsSeparable K L := hLsep letI := IsLAlg K D L a.1 a.2 letI := SubField.adjoin_scalarTower K D L a.1 a.2 exact IsSeparable.of_algebra_isSeparable_of_isSeparable K (E := L) - (K := SubField.adjoin K D L a.1 a.2) (x := ⟨a.1, Algebra.subset_adjoin hx1⟩) <| by + (K := SubField.adjoin K D L a.1 a.2) + (x := ⟨a.1, Algebra.subset_adjoin (by simp)⟩) <| by let f : SubField.adjoin K D L a.1 a.2 →ₐ[L] centralizer K (L : Set D) := - ⟨(Subalgebra.inclusion (SubField.adjoin_le_centralizer K D L a.1 a.2)).toRingHom, fun r ↦ rfl⟩ + ⟨(Subalgebra.inclusion + (SubField.adjoin_le_centralizer K D L a.1 a.2)).toRingHom, fun r ↦ rfl⟩ refine IsSeparable.of_algHom_of_map f asep - · simp [Algebra.isSeparable_def] at hLsep - have := IsSeparable.map (F := K) (K := L) (L := SubField.adjoin K D L a.1 a.2) - (x := (⟨x1, hx12⟩ : L)) (Subalgebra.inclusion (Set.subset_union_left |>.trans - Algebra.subset_adjoin)) (Subalgebra.inclusion_injective _ ) <| hLsep x1 hx12 - exact this) + ) (fun k ↦ IsSeparable.map (Algebra.ofId K _) (FaithfulSMul.algebraMap_injective _ _) (Algebra.IsSeparable.isSeparable' k)) (fun _ _ _ _ ↦ Field.isSeparable_add) (fun _ _ _ _ ↦ Field.isSeparable_mul) hx @@ -470,8 +448,9 @@ theorem exists_sep_masSubfield' : ∃ (a : D), IsMax (SubField.bot_adjoin K D a) simp [cond1] have cond2 : L ≤ SubField.adjoin K D L a.1 a.2 := Set.subset_union_left (s := L.1) (t := {a.1}) |>.trans <| Algebra.subset_adjoin (R := K) - simp [IsMax] at hL - specialize hL (SubField.adjoin K D L a.1 a.2) cond1 cond2 + change ∀ M : AllSepSubfield K D, (⟨L, hLsep⟩ : AllSepSubfield K D) ≤ M → + M ≤ ⟨L, hLsep⟩ at hL + specialize hL ⟨SubField.adjoin K D L a.1 a.2, cond1⟩ cond2 have : L = SubField.adjoin K D L a.1 a.2 := le_antisymm cond2 hL tauto @@ -479,7 +458,8 @@ theorem exists_sep_masSubfield : ∃ L : SubField K D, IsMax L ∧ Algebra.IsSep obtain ⟨a, hL1, hL2⟩ := exists_sep_masSubfield' K D exact ⟨SubField.bot_adjoin K D a, hL1, hL2⟩ -theorem exists_sep_splitting : ∃ (L : Type u)(_ : Field L)(_ : Algebra K L)(_ : FiniteDimensional K L), +theorem exists_sep_splitting : + ∃ (L : Type u) (_ : Field L) (_ : Algebra K L) (_ : FiniteDimensional K L), Algebra.IsSeparable K L ∧ isSplit K D L := by obtain ⟨L, hL1, hL2⟩ := exists_sep_masSubfield K D exact ⟨L, inferInstance, inferInstance, inferInstance, hL2, isSplit_of_isMax K D L hL1⟩ @@ -504,7 +484,8 @@ private theorem normalClosure_isSeparable {Kbar : Type u} [Field Kbar] rw [normalClosure_def] infer_instance -theorem exists_finite_galois_split : ∃ (L : Type u)(_ : Field L)(_ : Algebra K L)(_ : FiniteDimensional K L), +theorem exists_finite_galois_split : + ∃ (L : Type u) (_ : Field L) (_ : Algebra K L) (_ : FiniteDimensional K L), IsGalois K L ∧ isSplit K D L := by obtain ⟨L, _, _, _, hL1, hL2⟩ := exists_sep_splitting K D haveI : FiniteDimensional K L := inferInstance