diff --git a/LeanPool.lean b/LeanPool.lean index 8842c513d7..cb8c24021b 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -386,6 +386,104 @@ import LeanPool.LowDimSolvClassification.LemmasDim3 import LeanPool.LowDimSolvClassification.QuotientSolvable import LeanPool.LowDimSolvClassification.Semidirect import LeanPool.LowDimSolvClassification.Tactics +import LeanPool.Monlib4 +import LeanPool.Monlib4.LinearAlgebra +import LeanPool.Monlib4.LinearAlgebra.Coalgebra +import LeanPool.Monlib4.LinearAlgebra.Coalgebra.FiniteDimensional +import LeanPool.Monlib4.LinearAlgebra.Coalgebra.Lemmas +import LeanPool.Monlib4.LinearAlgebra.Coalgebra.MulOpposite +import LeanPool.Monlib4.LinearAlgebra.DirectSumFromTo +import LeanPool.Monlib4.LinearAlgebra.End +import LeanPool.Monlib4.LinearAlgebra.InnerAut +import LeanPool.Monlib4.LinearAlgebra.InvariantSubmodule +import LeanPool.Monlib4.LinearAlgebra.Ips +import LeanPool.Monlib4.LinearAlgebra.Ips.Basic +import LeanPool.Monlib4.LinearAlgebra.Ips.Frob +import LeanPool.Monlib4.LinearAlgebra.Ips.Functional +import LeanPool.Monlib4.LinearAlgebra.Ips.Ips +import LeanPool.Monlib4.LinearAlgebra.Ips.MatIps +import LeanPool.Monlib4.LinearAlgebra.Ips.MinimalProj +import LeanPool.Monlib4.LinearAlgebra.Ips.MulOp +import LeanPool.Monlib4.LinearAlgebra.Ips.Nontracial +import LeanPool.Monlib4.LinearAlgebra.Ips.OpUnop +import LeanPool.Monlib4.LinearAlgebra.Ips.Pos +import LeanPool.Monlib4.LinearAlgebra.Ips.RankOne +import LeanPool.Monlib4.LinearAlgebra.Ips.Strict +import LeanPool.Monlib4.LinearAlgebra.Ips.Symm +import LeanPool.Monlib4.LinearAlgebra.Ips.TensorHilbert +import LeanPool.Monlib4.LinearAlgebra.Ips.Vn +import LeanPool.Monlib4.LinearAlgebra.IsProj' +import LeanPool.Monlib4.LinearAlgebra.IsReal +import LeanPool.Monlib4.LinearAlgebra.KroneckerToTensor +import LeanPool.Monlib4.LinearAlgebra.LinearMapOp +import LeanPool.Monlib4.LinearAlgebra.LmulRmul +import LeanPool.Monlib4.LinearAlgebra.Matrix +import LeanPool.Monlib4.LinearAlgebra.Matrix.Basic +import LeanPool.Monlib4.LinearAlgebra.Matrix.Cast +import LeanPool.Monlib4.LinearAlgebra.Matrix.Conj +import LeanPool.Monlib4.LinearAlgebra.Matrix.IncludeBlock +import LeanPool.Monlib4.LinearAlgebra.Matrix.IsAlmostHermitian +import LeanPool.Monlib4.LinearAlgebra.Matrix.PiMat +import LeanPool.Monlib4.LinearAlgebra.Matrix.PosDefRpow +import LeanPool.Monlib4.LinearAlgebra.Matrix.PosEqLinearMapIsPositive +import LeanPool.Monlib4.LinearAlgebra.Matrix.Reshape +import LeanPool.Monlib4.LinearAlgebra.Matrix.Spectra +import LeanPool.Monlib4.LinearAlgebra.Matrix.StarOrderedRing +import LeanPool.Monlib4.LinearAlgebra.Mul'' +import LeanPool.Monlib4.LinearAlgebra.MyBimodule +import LeanPool.Monlib4.LinearAlgebra.MySpec +import LeanPool.Monlib4.LinearAlgebra.Nacgor +import LeanPool.Monlib4.LinearAlgebra.OfNorm +import LeanPool.Monlib4.LinearAlgebra.PiDirectSum +import LeanPool.Monlib4.LinearAlgebra.PiStarOrderedRing +import LeanPool.Monlib4.LinearAlgebra.PosMapIsReal +import LeanPool.Monlib4.LinearAlgebra.QuantumSet +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Basic +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.DeltaForm +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Instances +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.PhiMap +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Pi +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.QIso +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.SchurMul +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.SchurMulTensor +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Subset +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Symm +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.TensorProduct +import LeanPool.Monlib4.LinearAlgebra.TensorProduct +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.BasicLemmas +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.FiniteDimensional +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.Lemmas +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.OrthonormalBasis +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.Submodule +import LeanPool.Monlib4.LinearAlgebra.ToMatrixOfEquiv +import LeanPool.Monlib4.Monlib +import LeanPool.Monlib4.Other +import LeanPool.Monlib4.Other.Sonia +import LeanPool.Monlib4.Preq +import LeanPool.Monlib4.Preq.Complex +import LeanPool.Monlib4.Preq.Dite +import LeanPool.Monlib4.Preq.Equiv +import LeanPool.Monlib4.Preq.Finset +import LeanPool.Monlib4.Preq.Ites +import LeanPool.Monlib4.Preq.RCLikeLe +import LeanPool.Monlib4.Preq.Set +import LeanPool.Monlib4.Preq.StarAlgEquiv +import LeanPool.Monlib4.QuantumGraph +import LeanPool.Monlib4.QuantumGraph.Basic +import LeanPool.Monlib4.QuantumGraph.Degree +import LeanPool.Monlib4.QuantumGraph.Example +import LeanPool.Monlib4.QuantumGraph.Grad +import LeanPool.Monlib4.QuantumGraph.Iso +import LeanPool.Monlib4.QuantumGraph.Matrix +import LeanPool.Monlib4.QuantumGraph.Nontracial +import LeanPool.Monlib4.QuantumGraph.OfClassicalGraph +import LeanPool.Monlib4.QuantumGraph.PiMat +import LeanPool.Monlib4.QuantumGraph.PiMatFinTwo +import LeanPool.Monlib4.QuantumGraph.QamA +import LeanPool.Monlib4.QuantumGraph.QamAExample +import LeanPool.Monlib4.QuantumGraph.ToProjections +import LeanPool.Monlib4.RepTheory +import LeanPool.Monlib4.RepTheory.AutMat import LeanPool.Monsky import LeanPool.Monsky.Appendix import LeanPool.Monsky.BasicDefinitions diff --git a/LeanPool/Monlib4.lean b/LeanPool/Monlib4.lean new file mode 100644 index 0000000000..b0e474bd35 --- /dev/null +++ b/LeanPool/Monlib4.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.Monlib + +/-! +# Monlib4 Operator-Algebra and Quantum-Set Core + +Source: doi:10.4169/amer.math.monthly.124.10.966 +Authors: Monica Omar +Status: verified +Main declarations: `Matrix.aut_mat_inner`, `QuantumSet`, `schurMul`, `QuantumGraph` +Tags: linear-algebra, operator-algebras, quantum-sets, quantum-graphs, representation-theory +MSC: 15A69, 16W20 +-/ + +/-! +## Mathematical overview + +A theorem-bearing subset of `monlib4` — a Lean 4 formalization of +non-commutative graph theory. The upstream library builds quantum-graph and +quantum-set theory on substantial matrix / inner-product-space infrastructure. + +This vendored subset includes the upstream matrix-algebra automorphism theorem: +every automorphism of a finite matrix algebra over a field is inner, implemented +by conjugation with an invertible matrix (`Matrix.aut_mat_inner` and +`Matrix.aut_mat_inner'`). As a corollary, such automorphisms preserve trace +(`Matrix.aut_mat_inner_trace_preserving`). + +The recovered downstream operator-algebra layer adds unitary inner +star-algebra automorphisms (`unitary.innerAutStarAlg`), their matrix +specialization as linear maps (`Matrix.innerAut`), and preservation results for +trace, spectrum, multiplication, star, inverses, and Hermitian matrices. The +quantum-set core now includes `starAlgebra`, `InnerProductAlgebra`, +`QuantumSet`, the modular-automorphism identities, the complex quantum set +instance `Complex.quantumSet`, finite product quantum sets, delta-form quantum +sets, and the star-preserving map API `LinearMap.IsReal` / `LinearMap.real`. +The recovered quantum-graph core includes the Schur product `schurMul`, Schur +projections, and the predicates `QuantumGraph` / `QuantumGraph.Real`. + +The supporting imported infrastructure also includes a `Matrix.reshape` linear +equivalence between `Mₙₓₘ(R)` and `Rⁿˣᵐ`, the entrywise conjugate `Matrix.conj` +with the `ᴴᵀ` notation, the projection `directSumFromTo` between summands of a +dependent direct sum, basic spectrum commutativity (`isUnit_comm`, +`spectrum.comm`), the `PiMat` matrix-family abbreviation, permutation-matrix +unitarity, self-adjoint/inner-product extensionality lemmas, strict +tensor-product coercions, left/right multiplication maps and bimodule maps on +tensor products, the finite-dimensional Hilbert-algebra coalgebra instance, +coalgebras on multiplicative opposites, and helper lemmas for finite sums, +ites/dites, digit-sum divisibility in arbitrary bases, and `RCLike`-valued +order relations. + +## Provenance + +Imported from (originally Lean +`v4.21.0-rc3`) and ported to Lean Pool's `v4.30.0-rc2` / Mathlib `v4.30.0-rc2`. +The successor of (the Lean 3 version). +Large parts of the upstream quantum-graph and Schur-product theorem stack are +not yet vendored. In particular, upstream modules such as +`QuantumGraph.OfClassicalGraph` and the deeper theorem sections of +`QuantumSet.SchurMul` / `QuantumGraph.Basic` depend on the older +`PiLp`/normed-ring scaffold and upstream heartbeat or linter overrides that +Lean Pool does not permit. +-/ diff --git a/LeanPool/Monlib4/LinearAlgebra.lean b/LeanPool/Monlib4/LinearAlgebra.lean new file mode 100644 index 0000000000..34f44b7157 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.Coalgebra +import LeanPool.Monlib4.LinearAlgebra.DirectSumFromTo +import LeanPool.Monlib4.LinearAlgebra.End +import LeanPool.Monlib4.LinearAlgebra.InnerAut +import LeanPool.Monlib4.LinearAlgebra.InvariantSubmodule +import LeanPool.Monlib4.LinearAlgebra.Ips +import LeanPool.Monlib4.LinearAlgebra.IsProj' +import LeanPool.Monlib4.LinearAlgebra.IsReal +import LeanPool.Monlib4.LinearAlgebra.KroneckerToTensor +import LeanPool.Monlib4.LinearAlgebra.LinearMapOp +import LeanPool.Monlib4.LinearAlgebra.LmulRmul +import LeanPool.Monlib4.LinearAlgebra.Matrix +import LeanPool.Monlib4.LinearAlgebra.Mul'' +import LeanPool.Monlib4.LinearAlgebra.MyBimodule +import LeanPool.Monlib4.LinearAlgebra.MySpec +import LeanPool.Monlib4.LinearAlgebra.Nacgor +import LeanPool.Monlib4.LinearAlgebra.OfNorm +import LeanPool.Monlib4.LinearAlgebra.PiDirectSum +import LeanPool.Monlib4.LinearAlgebra.PiStarOrderedRing +import LeanPool.Monlib4.LinearAlgebra.PosMapIsReal +import LeanPool.Monlib4.LinearAlgebra.QuantumSet +import LeanPool.Monlib4.LinearAlgebra.TensorProduct +import LeanPool.Monlib4.LinearAlgebra.ToMatrixOfEquiv + +/-! +# LinearAlgebra + +Import-only index for the `LinearAlgebra` directory of the monlib4 import. +-/ diff --git a/LeanPool/Monlib4/LinearAlgebra/Coalgebra.lean b/LeanPool/Monlib4/LinearAlgebra/Coalgebra.lean new file mode 100644 index 0000000000..ab5bf3c1b5 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Coalgebra.lean @@ -0,0 +1,16 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.Coalgebra.FiniteDimensional +import LeanPool.Monlib4.LinearAlgebra.Coalgebra.Lemmas +import LeanPool.Monlib4.LinearAlgebra.Coalgebra.MulOpposite + +/-! +# Coalgebra + +Import-only index for the `LinearAlgebra/Coalgebra` directory of the monlib4 +import. +-/ diff --git a/LeanPool/Monlib4/LinearAlgebra/Coalgebra/FiniteDimensional.lean b/LeanPool/Monlib4/LinearAlgebra/Coalgebra/FiniteDimensional.lean new file mode 100644 index 0000000000..182f98fecb --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Coalgebra/FiniteDimensional.lean @@ -0,0 +1,348 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.Coalgebra.Lemmas +import Mathlib.RingTheory.Coalgebra.Equiv +import Mathlib.Analysis.InnerProductSpace.Basic +import LeanPool.Monlib4.LinearAlgebra.Nacgor +import LeanPool.Monlib4.LinearAlgebra.Ips.TensorHilbert +import LeanPool.Monlib4.LinearAlgebra.Ips.RankOne +import LeanPool.Monlib4.LinearAlgebra.Mul'' + +variable {R A : Type*} +local notation "lT" => LinearMap.lTensor +local notation "rT" => LinearMap.rTensor +local notation "m" => LinearMap.mul' R +local notation "ϰ" => TensorProduct.assoc R +local notation "τ" => TensorProduct.lid R +local notation "η" => Algebra.linearMap R + +attribute [local instance] Algebra.ofIsScalarTowerSmulCommClass +open scoped TensorProduct + +lemma algebraMapCLM_eq_ket_one {R A : Type*} [RCLike R] [NormedAddCommGroupOfRing A] + [InnerProductSpace R A] [SMulCommClass R A A] [IsScalarTower R A A] : + algebraMapCLM R A = ket R 1 := +rfl + +lemma algebraMapCLM_adjoint_eq_bra_one {R A : Type*} [RCLike R] [NormedAddCommGroupOfRing A] + [InnerProductSpace R A] [SMulCommClass R A A] [IsScalarTower R A A] [CompleteSpace A] : + ContinuousLinearMap.adjoint (algebraMapCLM R A) = bra R 1 := +by + rw [algebraMapCLM_eq_ket_one, ← bra_adjoint_eq_ket, ContinuousLinearMap.adjoint_adjoint] + +lemma LinearMap.rTensor_adjoint {𝕜 A B C : Type*} [RCLike 𝕜] + [NormedAddCommGroup A] [NormedAddCommGroup B] [NormedAddCommGroup C] + [InnerProductSpace 𝕜 A] [InnerProductSpace 𝕜 B] [InnerProductSpace 𝕜 C] + [FiniteDimensional 𝕜 A] [FiniteDimensional 𝕜 B] [FiniteDimensional 𝕜 C] + (f : A →ₗ[𝕜] B) : + adjoint (rTensor C f) = rTensor C (adjoint f) := +by + simp_rw [rTensor, TensorProduct.map_adjoint, adjoint_id] +lemma LinearMap.lTensor_adjoint {𝕜 A B C : Type*} [RCLike 𝕜] + [NormedAddCommGroup A] [NormedAddCommGroup B] [NormedAddCommGroup C] + [InnerProductSpace 𝕜 A] [InnerProductSpace 𝕜 B] [InnerProductSpace 𝕜 C] + [FiniteDimensional 𝕜 A] [FiniteDimensional 𝕜 B] [FiniteDimensional 𝕜 C] + (f : A →ₗ[𝕜] B) : + adjoint (lTensor C f) = lTensor C (adjoint f) := +by + simp_rw [lTensor, TensorProduct.map_adjoint, adjoint_id] + +lemma TensorProduct.rid_adjoint {𝕜 E : Type*} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] : + LinearMap.adjoint (TensorProduct.rid 𝕜 E).toLinearMap = + (TensorProduct.rid 𝕜 E).symm.toLinearMap := + by + ext1 + apply @ext_inner_right 𝕜 + intro y + simp only [LinearMap.adjoint_inner_left, LinearEquiv.coe_toLinearMap, + TensorProduct.rid_symm_apply] + exact y.induction_on + (by simp only [inner_zero_right, map_zero]) + (fun α z => by + simp only [TensorProduct.rid_tmul, TensorProduct.inner_tmul, RCLike.inner_apply, + starRingEnd_apply, star_one, inner_smul_right, mul_comm, mul_one]) + (fun z w hz hw => by simp only [_root_.map_add, inner_add_right, hz, hw]) + +-- @[reducible] +-- structure FiniteDimensionalHilbertAlgebra (R A : Type*) [RCLike R] extends +-- NormedAddCommGroupOfRing A, InnerProductSpace R A, SMulCommClass R A A, +-- IsScalarTower R A A, Finite R A where + +@[reducible, instance] +noncomputable +def Coalgebra.ofFiniteDimensionalHilbertAlgebra + [RCLike R] [NormedAddCommGroupOfRing A] [InnerProductSpace R A] + [SMulCommClass R A A] [IsScalarTower R A A] [FiniteDimensional R A] : + Coalgebra R A := +{ comul := + (LinearMap.adjoint (LinearMap.mul' R A : (A ⊗[R] A) →ₗ[R] A) : + A →ₗ[R] A ⊗[R] A) + counit := (LinearMap.adjoint (Algebra.linearMap R A : R →ₗ[R] A) : A →ₗ[R] R) + coassoc := by + rw [← LinearMap.rTensor_adjoint, ← LinearMap.lTensor_adjoint, + ← TensorProduct.assoc_symm_adjoint] + simp_rw [← LinearMap.adjoint_comp, Algebra.mul_comp_rTensor_mul] + simp_rw [LinearMap.comp_assoc] + simp only [LinearEquiv.comp_coe, LinearEquiv.symm_trans_self, + LinearEquiv.refl_toLinearMap] + rfl + rTensor_counit_comp_comul := by + rw [← LinearMap.rTensor_adjoint, ← LinearMap.adjoint_comp, Algebra.mul_comp_rTensor_unit, + TensorProduct.lid_adjoint] + rfl + lTensor_counit_comp_comul := by + rw [← LinearMap.lTensor_adjoint, ← LinearMap.adjoint_comp, Algebra.mul_comp_lTensor_unit, + TensorProduct.rid_adjoint] + rfl } +-- scoped[ofFiniteDimensionalHilbertAlgebra] attribute [instance] +-- Coalgebra.ofFiniteDimensionalHilbertAlgebra +-- def NormedAddCommGroup.ofFiniteDimensionalCoAlgebra +-- [RCLike R] [Ring A] [Algebra R A] [Coalgebra R A] [FiniteDimensional R A] : +-- NormedAddCommGroup A := +-- @InnerProductSpace.Core.toNormedAddCommGroup R A _ _ _ +-- { inner := counit () } + +-- open scoped ofFiniteDimensionalHilbertAlgebra in +lemma Coalgebra.comul_eq_mul_adjoint + [RCLike R] [NormedAddCommGroupOfRing A] [InnerProductSpace R A] + [SMulCommClass R A A] [IsScalarTower R A A] [FiniteDimensional R A] : + Coalgebra.comul = + (LinearMap.adjoint (LinearMap.mul' R A : (A ⊗[R] A) →ₗ[R] A) : + A →ₗ[R] A ⊗[R] A) := +rfl +-- open scoped ofFiniteDimensionalHilbertAlgebra in +lemma Coalgebra.counit_eq_unit_adjoint + [RCLike R] [NormedAddCommGroupOfRing A] [InnerProductSpace R A] + [SMulCommClass R A A] [IsScalarTower R A A] [FiniteDimensional R A] : + Coalgebra.counit = (LinearMap.adjoint (Algebra.linearMap R A : R →ₗ[R] A) : A →ₗ[R] R) := +rfl + +open scoped InnerProductSpace +-- open scoped ofFiniteDimensionalHilbertAlgebra in +lemma Coalgebra.inner_eq_counit' [RCLike R] [NormedAddCommGroupOfRing A] [InnerProductSpace R A] + [SMulCommClass R A A] [IsScalarTower R A A] [FiniteDimensional R A] : + (⟪(1 : A), ·⟫_R) = Coalgebra.counit := +by + simp_rw [Coalgebra.counit] + ext + apply ext_inner_left R + intro a + simp_rw [LinearMap.adjoint_inner_right, Algebra.linearMap_apply, + Algebra.algebraMap_eq_smul_one, inner_smul_left, inner, mul_comm, starRingEnd_apply] +-- @[reducible] +-- class NormedAddCommGroupOfStarRing (B : Type _) extends +-- NormedAddCommGroupOfRing B, StarRing B + +lemma Coalgebra.counit_eq_bra_one [RCLike R] [NormedAddCommGroupOfRing A] [InnerProductSpace R A] + [SMulCommClass R A A] [IsScalarTower R A A] [FiniteDimensional R A] : + Coalgebra.counit = (bra R (1 : A)).toLinearMap := +by + haveI := FiniteDimensional.complete R A + rw [counit_eq_unit_adjoint, ← algebraMapCLM_adjoint_eq_bra_one] + rfl + +open Coalgebra LinearMap TensorProduct in +theorem Coalgebra.rTensor_mul_comp_lTensor_comul + [RCLike R] [NormedAddCommGroupOfRing A] [InnerProductSpace R A] + [SMulCommClass R A A] [IsScalarTower R A A] [FiniteDimensional R A] + (h : ∃ σ : A → A, ∀ x y z : A, ⟪x * y, z⟫_R = ⟪y, σ x * z⟫_R) : + (rT A (m A)) ∘ₗ (ϰ A A A).symm.toLinearMap ∘ₗ (lT A comul) = comul ∘ₗ (m A) := +by + rw [TensorProduct.ext_iff'] + intro x y + rw [TensorProduct.inner_ext_iff'] + intro a b + simp_rw [comp_apply, lTensor_tmul] + obtain ⟨σ, h⟩ := h + obtain ⟨α, β, hy⟩ := TensorProduct.eq_span (comul y : A ⊗[R] A) + simp_rw [← hy, tmul_sum, _root_.map_sum, sum_inner, LinearEquiv.coe_coe, assoc_symm_tmul, + rTensor_tmul, mul'_apply, inner_tmul, h, ← inner_tmul, ← sum_inner, hy, + comul_eq_mul_adjoint, LinearMap.adjoint_inner_left, mul'_apply, mul_assoc, h] + +-- open scoped ofFiniteDimensionalHilbertAlgebra in +theorem Coalgebra.rTensor_mul_comp_lTensor_mul_adjoint + [RCLike R] [NormedAddCommGroupOfRing A] [InnerProductSpace R A] + [SMulCommClass R A A] [IsScalarTower R A A] [FiniteDimensional R A] + (h : ∃ σ : A → A, ∀ x y z : A, ⟪x * y, z⟫_R = ⟪y, σ x * z⟫_R) : + (rT A (m A)) ∘ₗ (ϰ A A A).symm.toLinearMap + ∘ₗ (lT A (LinearMap.adjoint (m A))) = + (LinearMap.adjoint (m A)) ∘ₗ (m A) := +Coalgebra.rTensor_mul_comp_lTensor_comul h + +-- /-- An equivalence between structures that are both co-algebras and algebras -/ +-- structure CoAlgEquiv (R A B : Type*) [CommSemiring R] +-- [Semiring A] [Semiring B] [Algebra R A] [Algebra R B] [Coalgebra R A] [Coalgebra R B] extends +-- A ≃ₗc[R] B, A ≃ₐ[R] B where + +-- attribute [nolint docBlame] CoAlgEquiv.toCoalgEquiv +-- attribute [nolint docBlame] CoAlgEquiv.toAlgEquiv + +-- @[inherit_doc CoAlgEquiv] +-- infixr:25 " ≃ₐc " => CoAlgEquiv _ +-- @[inherit_doc CoAlgEquiv] +-- notation:50 A " ≃ₐc[" R "] " B => CoAlgEquiv R A B + +-- class CoAlgEquivClass (F : Type*) (R A B : outParam Type*) [CommSemiring R] +-- [Semiring A] [Semiring B] [Algebra R A] [Algebra R B] [Coalgebra R A] [Coalgebra R B] +-- [EquivLike F A B] extends CoalgEquivClass F R A B, AlgEquivClass F R A B : +-- Prop + +-- namespace CoAlgEquivClass + +-- variable {F R A B : Type*} [CommSemiring R] +-- [Semiring A] [Semiring B] [Algebra R A] [Algebra R B] [Coalgebra R A] [Coalgebra R B] + +-- @[coe] +-- def toCoAlgEquiv [EquivLike F A B] [CoAlgEquivClass F R A B] (f : F) : A ≃ₐc[R] B := +-- { (f : A ≃ₐ[R] B), (f : A →ₗc[R] B) with } + +-- instance instCoeToCoAlgEquiv +-- [EquivLike F A B] [CoAlgEquivClass F R A B] : CoeHead F (A ≃ₐc[R] B) where +-- coe f := toCoAlgEquiv f + +-- end CoAlgEquivClass + +-- namespace CoAlgEquiv +-- variable {F R A B : Type*} [CommSemiring R] +-- [Semiring A] [Semiring B] [Algebra R A] [Algebra R B] [Coalgebra R A] [Coalgebra R B] + +-- def toEquiv : (A ≃ₐc[R] B) → A ≃ B := fun f => f.toAlgEquiv.toEquiv + +-- theorem toEquiv_injective : Function.Injective (toEquiv : (A ≃ₐc[R] B) → A ≃ B) := +-- fun ⟨_, _, _⟩ ⟨_, _, _⟩ h => +-- (CoAlgEquiv.mk.injEq _ _ _ _ _ _).mpr +-- (CoalgEquiv.toEquiv_inj.mp h) + +-- @[simp] +-- theorem toEquiv_inj {e₁ e₂ : A ≃ₐc[R] B} : e₁.toEquiv = e₂.toEquiv ↔ e₁ = e₂ := +-- toEquiv_injective.eq_iff + +-- theorem toCoalgEquiv_injective : Function.Injective (toCoalgEquiv : (A ≃ₐc[R] B) → A ≃ₗc[R] B) := +-- fun _ _ H => toEquiv_injective <| Equiv.ext <| CoalgEquiv.congr_fun H + +-- instance : EquivLike (A ≃ₐc[R] B) A B where +-- inv := CoAlgEquiv.invFun +-- left_inv := CoAlgEquiv.left_inv +-- right_inv := CoAlgEquiv.right_inv +-- coe_injective' _ _ h _ := toCoalgEquiv_injective (DFunLike.coe_injective h) +-- -- left_inv := _ +-- -- right_inv := _ + +-- instance : FunLike (A ≃ₐc[R] B) A B where +-- coe := DFunLike.coe +-- coe_injective' := DFunLike.coe_injective + +-- instance : CoAlgEquivClass (A ≃ₐc[R] B) R A B where +-- map_add := (·.map_add') +-- map_smulₛₗ := (·.map_smul') +-- counit_comp := (·.counit_comp) +-- map_comp_comul := (·.map_comp_comul) + +-- -- @[simp, norm_cast] +-- -- theorem coe_coe {e : A ≃ₐc[R] B} : (e : A → B) = e := +-- -- rfl + +open Coalgebra LinearMap TensorProduct in +theorem Coalgebra.lTensor_mul_comp_rTensor_comul_of + [RCLike R] [NormedAddCommGroupOfRing A] [InnerProductSpace R A] + [SMulCommClass R A A] [IsScalarTower R A A] [FiniteDimensional R A] + (h : ∃ σ : A → A, ∀ x y z : A, ⟪x * y, z⟫_R = ⟪y, σ x * z⟫_R) : + (lT A (m A)) ∘ₗ (ϰ A A A).toLinearMap ∘ₗ (rT A comul) = comul ∘ₗ (m A) := +by + apply_fun adjoint using LinearEquiv.injective _ + simp_rw [comul_eq_mul_adjoint] + letI : NormedAddCommGroup (A ⊗[R] A) := by infer_instance + letI : InnerProductSpace R (A ⊗[R] A) := by infer_instance + simp_rw [LinearMap.adjoint_comp] + simp_rw [lTensor_adjoint, rTensor_adjoint,adjoint_adjoint, + TensorProduct.assoc_adjoint, LinearMap.comp_assoc] + exact Coalgebra.rTensor_mul_comp_lTensor_mul_adjoint h + +open Coalgebra LinearMap TensorProduct in +theorem Coalgebra.lTensor_mul_comp_rTensor_mul_adjoint_of + [RCLike R] [NormedAddCommGroupOfRing A] [InnerProductSpace R A] + [SMulCommClass R A A] [IsScalarTower R A A] [FiniteDimensional R A] + (h : ∃ σ : A → A, ∀ x y z : A, ⟪x * y, z⟫_R = ⟪y, σ x * z⟫_R) : + (lT A (m A)) ∘ₗ (ϰ A A A).toLinearMap + ∘ₗ (rT A (LinearMap.adjoint (m A))) = + LinearMap.adjoint (m A) ∘ₗ (m A) := +Coalgebra.lTensor_mul_comp_rTensor_comul_of h + +/-- Construct the Frobenius algebra structure from finite-dimensional Hilbert-algebra data. -/ +@[reducible] +noncomputable def FiniteDimensionalCoAlgebra_isFrobeniusAlgebra_of + [RCLike R] [NormedAddCommGroupOfRing A] [InnerProductSpace R A] + [SMulCommClass R A A] [IsScalarTower R A A] [FiniteDimensional R A] + (h : ∃ σ : A → A, ∀ x y z : A, ⟪x * y, z⟫_R = ⟪y, σ x * z⟫_R) : + FrobeniusAlgebra R A where + lTensor_mul_comp_rTensor_comul_commute := by + rw [Coalgebra.lTensor_mul_comp_rTensor_comul_of h, Coalgebra.rTensor_mul_comp_lTensor_comul h] + +open CoalgebraStruct +/-- Predicate for linear maps that preserve the counit and comultiplication. -/ +structure LinearMap.IsCoalgHom {R A B : Type*} + [CommSemiring R] [AddCommMonoid A] [Module R A] [AddCommMonoid B] [Module R B] + [CoalgebraStruct R A] [CoalgebraStruct R B] (x : A →ₗ[R] B) : Prop where + counit_comp : counit ∘ₗ x = counit + map_comp_comul : TensorProduct.map x x ∘ₗ comul = comul ∘ₗ x +lemma LinearMap.isCoalgHom_iff {R A B : Type*} + [CommSemiring R] [AddCommMonoid A] [Module R A] [AddCommMonoid B] [Module R B] + [CoalgebraStruct R A] [CoalgebraStruct R B] (x : A →ₗ[R] B) : + x.IsCoalgHom ↔ counit ∘ₗ x = counit ∧ TensorProduct.map x x ∘ₗ comul = comul ∘ₗ x := +⟨fun h => ⟨h.1, h.2⟩, fun h => ⟨h.1, h.2⟩⟩ + +/-- Predicate for linear maps that preserve the unit and multiplication. -/ +structure LinearMap.IsAlgHom {R A B : Type*} [CommSemiring R] [Semiring A] [Semiring B] + [Algebra R A] [Algebra R B] (x : A →ₗ[R] B) : Prop where + comp_unit : x ∘ₗ Algebra.linearMap R A = Algebra.linearMap R B + mul'_comp_map : (mul' R B) ∘ₗ (TensorProduct.map x x) = x ∘ₗ (mul' R A) +lemma LinearMap.isAlgHom_iff {R A B : Type*} [CommSemiring R] [Semiring A] [Semiring B] + [Algebra R A] [Algebra R B] (x : A →ₗ[R] B) : + x.IsAlgHom ↔ + x ∘ₗ Algebra.linearMap R A = Algebra.linearMap R B + ∧ (mul' R B) ∘ₗ (TensorProduct.map x x) = x ∘ₗ (mul' R A) := +⟨fun h => ⟨h.1, h.2⟩, fun h => ⟨h.1, h.2⟩⟩ + +lemma AlgHom.isAlgHom + {R A B : Type*} [CommSemiring R] [Semiring A] + [Semiring B] [Algebra R A] [Algebra R B] + (x : A →ₐ[R] B) : + x.toLinearMap.IsAlgHom := +by + rw [LinearMap.isAlgHom_iff, commutes_with_mul'_iff, commutes_with_unit_iff] + simp only [toLinearMap_apply, map_one, map_mul, implies_true, and_self] +lemma AlgEquiv.isAlgHom + {R A B : Type*} [CommSemiring R] [Semiring A] + [Semiring B] [Algebra R A] [Algebra R B] + (x : A ≃ₐ[R] B) : + x.toLinearMap.IsAlgHom := +AlgHom.isAlgHom _ + +variable {B : Type*} [RCLike R] [NormedAddCommGroupOfRing A] [NormedAddCommGroupOfRing B] + [InnerProductSpace R A] [InnerProductSpace R B] + [SMulCommClass R A A] [SMulCommClass R B B] [IsScalarTower R A A] [IsScalarTower R B B] + [FiniteDimensional R A] [FiniteDimensional R B] + (x : A →ₗ[R] B) + +theorem LinearMap.isAlgHom_iff_adjoint_isCoalgHom : + x.IsAlgHom ↔ (LinearMap.adjoint x).IsCoalgHom := +by + simp_rw [isAlgHom_iff, isCoalgHom_iff, Coalgebra.counit_eq_unit_adjoint, + Coalgebra.comul_eq_mul_adjoint, ← TensorProduct.map_adjoint, ← LinearMap.adjoint_comp] + constructor + · rintro ⟨h1, h2⟩ + simp_rw [h1, h2, and_self] + · rintro ⟨h1, h2⟩ + apply_fun adjoint at h1 h2 + simp_rw [adjoint_adjoint] at h1 h2 + exact ⟨h1, h2⟩ + +theorem LinearMap.isCoalgHom_iff_adjoint_isAlgHom : + x.IsCoalgHom ↔ (LinearMap.adjoint x).IsAlgHom := +by + rw [isAlgHom_iff_adjoint_isCoalgHom, adjoint_adjoint] diff --git a/LeanPool/Monlib4/LinearAlgebra/Coalgebra/Lemmas.lean b/LeanPool/Monlib4/LinearAlgebra/Coalgebra/Lemmas.lean new file mode 100644 index 0000000000..180826a4b0 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Coalgebra/Lemmas.lean @@ -0,0 +1,539 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import Mathlib.RingTheory.Coalgebra.Basic +import Mathlib.RingTheory.Coalgebra.CoassocSimps +import Mathlib.Algebra.Algebra.Bilinear +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.BasicLemmas + +theorem TensorProduct.map_left_up {R A B C D : Type*} + [CommSemiring R] + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] + (f : A →ₗ[R] B) (g : C →ₗ[R] D) : + map f g = (map f LinearMap.id) ∘ₗ (map LinearMap.id g) := +ext rfl +alias TensorProduct.map_right_down := TensorProduct.map_left_up + +theorem TensorProduct.map_right_up {R A B C D : Type*} [CommSemiring R] + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] + (f : A →ₗ[R] B) (g : C →ₗ[R] D) : + map f g = (map LinearMap.id g) ∘ₗ (map f LinearMap.id) := +ext rfl +alias TensorProduct.map_left_down := TensorProduct.map_right_up + +open TensorProduct LinearMap +theorem Algebra.linearMap_mul'_assoc {R A : Type*} [CommSemiring R] [Semiring A] [Algebra R A] : + (mul' R A) ∘ₗ (map (mul' R A) LinearMap.id) + = (mul' R A) ∘ₗ (map LinearMap.id (mul' R A)) + ∘ₗ (_root_.TensorProduct.assoc R A A A) := +by + refine TensorProduct.ext_threefold ?_ + intro x y z + simp only [coe_comp, Function.comp_apply, map_tmul, mul'_apply, id_coe, id_eq, + LinearEquiv.coe_coe, assoc_tmul, mul_assoc] +alias Algebra.assoc := Algebra.linearMap_mul'_assoc + +theorem Algebra.assoc' {R A : Type*} [CommSemiring R] [Semiring A] [Algebra R A] : + (mul' R A) ∘ₗ (rTensor A (mul' R A)) + = (mul' R A) ∘ₗ (lTensor A (mul' R A)) ∘ₗ (_root_.TensorProduct.assoc R A A A) := +Algebra.assoc +alias Algebra.mul_comp_rTensor_mul := Algebra.assoc' + +open scoped TensorProduct +theorem Algebra.mul_comp_rTensor_unit {R A : Type*} [CommSemiring R] [Semiring A] [Algebra R A] : + (mul' R A) ∘ₗ (rTensor A (Algebra.linearMap R A)) + = _root_.TensorProduct.lid R A := +by + apply _root_.TensorProduct.ext' + intro r a + simp_rw [LinearMap.rTensor, LinearMap.comp_apply, map_tmul, + LinearMap.id_apply, Algebra.linearMap_apply, LinearMap.mul'_apply, + LinearEquiv.coe_coe, lid_tmul, algebraMap_eq_smul_one, + smul_mul_assoc, one_mul] +theorem Algebra.mul_comp_rTensor_unit_comp_lid_symm + {R A : Type*} [CommSemiring R] [Semiring A] [Algebra R A] : + (mul' R A) ∘ₗ (rTensor A (Algebra.linearMap R A)) + ∘ₗ (_root_.TensorProduct.lid R A).symm + = LinearMap.id := +by + rw [← LinearMap.comp_assoc, Algebra.mul_comp_rTensor_unit] + simp + +theorem Algebra.mul_comp_lTensor_unit {R A : Type*} [CommSemiring R] [Semiring A] [Algebra R A] : + (mul' R A) ∘ₗ (lTensor A (Algebra.linearMap R A)) + = _root_.TensorProduct.rid R A := +by + apply _root_.TensorProduct.ext' + intro r a + simp_rw [LinearMap.lTensor, LinearMap.comp_apply, map_tmul, + LinearMap.id_apply, Algebra.linearMap_apply, LinearMap.mul'_apply, + LinearEquiv.coe_coe, _root_.TensorProduct.rid_tmul, algebraMap_eq_smul_one, + mul_smul_comm, mul_one] + +theorem Algebra.mul_comp_lTensor_unit_comp_rid_symm + {R A : Type*} [CommSemiring R] [Semiring A] [Algebra R A] : + (mul' R A) ∘ₗ (lTensor A (Algebra.linearMap R A)) ∘ₗ (_root_.TensorProduct.rid R A).symm + = LinearMap.id := +by + rw [← LinearMap.comp_assoc, Algebra.mul_comp_lTensor_unit] + simp + +open Coalgebra +theorem counit_comp_mul_comp_rTensor_unit {R A : Type*} [CommSemiring R] [Semiring A] [Algebra R A] + [Coalgebra R A] : + counit ∘ₗ (LinearMap.mul' R _) ∘ₗ + (LinearMap.rTensor A (Algebra.linearMap R A)) + ∘ₗ (TensorProduct.lid R A).symm.toLinearMap + = counit := +calc counit ∘ₗ (LinearMap.mul' R _) ∘ₗ + (LinearMap.rTensor A (Algebra.linearMap R A)) + ∘ₗ ((TensorProduct.mk R _ _) 1) + = counit ∘ₗ (TensorProduct.lid R _).toLinearMap ∘ₗ ((TensorProduct.mk R R A) 1) := + by simp_rw [← Algebra.mul_comp_rTensor_unit, LinearMap.comp_assoc] + _ = counit := by aesop + +theorem counit_comp_mul_lTensor_unit {R A : Type*} [CommSemiring R] [Semiring A] [Algebra R A] + [Coalgebra R A] : + counit ∘ₗ (mul' R _) ∘ₗ + (lTensor A (Algebra.linearMap R A)) + ∘ₗ (TensorProduct.rid R A).symm.toLinearMap + = counit := +calc counit ∘ₗ (mul' R _) ∘ₗ (lTensor A (Algebra.linearMap R A)) + ∘ₗ ((TensorProduct.mk R A R).flip 1) + = counit ∘ₗ (TensorProduct.rid R A).toLinearMap ∘ₗ ((TensorProduct.mk R A R).flip 1) := + by simp_rw [← Algebra.mul_comp_lTensor_unit, LinearMap.comp_assoc] + _ = counit := by aesop + +theorem lTensor_counit_comp_comul_unit {R A : Type*} [CommSemiring R] [Semiring A] [Algebra R A] + [Coalgebra R A] : + (lTensor A counit) ∘ₗ comul ∘ₗ (Algebra.linearMap R A) + = (TensorProduct.rid R A).symm ∘ₗ (Algebra.linearMap R A) := +by + ext + simp_all only [LinearMap.coe_comp, Function.comp_apply, + Algebra.linearMap_apply, _root_.map_one, lTensor_counit_comul, + LinearEquiv.coe_coe, TensorProduct.rid_symm_apply] + +variable {R : Type*} [CommSemiring R] + +local notation "lT" => LinearMap.lTensor +local notation "rT" => LinearMap.rTensor +local notation "m" => LinearMap.mul' R +local notation "ϰ" => TensorProduct.assoc R +local notation "τ" => TensorProduct.lid R +local notation x " ⊗ₘ " y => TensorProduct.map x y +-- local notation "ϰ⁻¹" => LinearEquiv.symm ϰ + +lemma Coalgebra.rTensor_counit_comp_comul' + {A : Type*} [AddCommMonoid A] [Module R A] [Coalgebra R A] : + ((rT _ counit) ∘ₗ comul) = (TensorProduct.lid R A).symm.toLinearMap := +by + rw [rTensor_counit_comp_comul] + rfl + +lemma TensorProduct.assoc_symm_comp_rTensor {A B C D : Type*} + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] (x : A →ₗ[R] D) : + (LinearEquiv.symm (ϰ D B C)) ∘ₗ (rT _ x) = + (rT _ (rT _ x)) + ∘ₗ (LinearEquiv.symm (ϰ A B C)).toLinearMap := +by + apply TensorProduct.ext_threefold' + intro a b c + simp only [coe_comp, LinearEquiv.coe_coe, Function.comp_apply, rTensor_tmul, assoc_symm_tmul] +lemma TensorProduct.assoc_symm_comp_lTensor_lTensor {A B C D : Type*} + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] (x : A →ₗ[R] D) : + (ϰ B C D).symm.toLinearMap ∘ₗ (lT _ (lT _ x)) = + (lT _ x) ∘ₗ (ϰ B C A).symm.toLinearMap := +by + apply TensorProduct.ext_threefold' + intro b c a + rfl + +lemma TensorProduct.rTensor_lTensor_comp_assoc_symm {A B C D : Type*} + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] (x : A →ₗ[R] D) : + (rT _ (lT _ x)) ∘ₗ (LinearEquiv.symm (ϰ _ _ _)).toLinearMap = + (LinearEquiv.symm (ϰ B D C)).toLinearMap ∘ₗ (lT _ (rT _ x)) := +by + simp_rw [rTensor, lTensor, map_map_comp_assoc_symm_eq] +lemma TensorProduct.assoc_comp_rTensor_rTensor {A B C D : Type*} + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] (x : A →ₗ[R] D) : + (ϰ D B C).toLinearMap ∘ₗ (rT _ (rT _ x)) = (rT _ x) ∘ₗ (ϰ _ _ _).toLinearMap := +by + apply TensorProduct.ext_threefold + intro a b c + rfl + +lemma TensorProduct.ext_fourfold_right {A B C D E : Type*} + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [AddCommMonoid E] + [Module R A] [Module R B] [Module R C] [Module R D] + [Module R E] {f g : (A ⊗[R] (B ⊗[R] (C ⊗[R] D))) →ₗ[R] E} : + (∀ x y z w, f (x ⊗ₜ (y ⊗ₜ (z ⊗ₜ w))) = g (x ⊗ₜ (y ⊗ₜ (z ⊗ₜ w)))) → f = g := +by + intro h + ext x y z w + exact h x y z w + +lemma TensorProduct.assoc_comp_rTensor_assoc_symm_comp_assoc_symm_comp_lTensor_assoc_symm + {A B C D : Type*} + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] : + (ϰ _ _ _).toLinearMap ∘ₗ (rT _ (ϰ _ _ _).symm.toLinearMap) ∘ₗ (ϰ _ _ _).symm.toLinearMap + ∘ₗ (lT _ (ϰ _ _ _).symm.toLinearMap) = (ϰ A B (C ⊗[R] D)).symm.toLinearMap := +by + apply TensorProduct.ext_fourfold_right + intro x y z w + simp only [coe_comp, LinearEquiv.coe_coe, Function.comp_apply, lTensor_tmul, assoc_symm_tmul, + rTensor_tmul, assoc_tmul] + +lemma TensorProduct.rTensor_comp_rTensor {A B C D : Type*} + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] + (x : B →ₗ[R] C) (y : A →ₗ[R] B) : + (rT D x) ∘ₗ (rT D y) = rT D (x ∘ₗ y) := +by + simp_rw [rTensor, ← map_comp, id_comp] +lemma TensorProduct.lTensor_comp_lTensor {A B C D : Type*} + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] + (x : B →ₗ[R] C) (y : A →ₗ[R] B) : + (lT D x) ∘ₗ (lT D y) = lT D (x ∘ₗ y) := +by + simp_rw [lTensor, ← map_comp, id_comp] + +lemma lid_tensor_toLinearMap {A B : Type*} [AddCommMonoid A] + [Module R A] [AddCommMonoid B] [Module R B] : + (τ (A ⊗[R] B)).toLinearMap + = rT _ (τ _).toLinearMap ∘ₗ (LinearEquiv.symm (ϰ _ _ _)).toLinearMap := +by + simpa [LinearEquiv.coe_trans] using + congrArg LinearEquiv.toLinearMap (TensorProduct.lid_tensor (R := R) (M := A) (N := B)) + +lemma lid_tensor {A B : Type*} [AddCommMonoid A] + [Module R A] [AddCommMonoid B] [Module R B] : + (τ (A ⊗[R] B)).toLinearMap + = rT _ (τ _).toLinearMap ∘ₗ (LinearEquiv.symm (ϰ _ _ _)).toLinearMap := +lid_tensor_toLinearMap + +lemma rTensor_comp_lTensor' {A B C D : Type*} + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] (x : A →ₗ[R] B) (y : C →ₗ[R] D) : + (rT _ x) ∘ₗ (lT _ y) = (lT _ y) ∘ₗ (rT _ x) := +by + simp only [rTensor_comp_lTensor, lTensor_comp_rTensor] + +variable {A : Type*} [Semiring A] [Algebra R A] + [Coalgebra R A] + +open TensorProduct + +/-- if `(id ⊗ mul) (comul ⊗ id) = (mul ⊗ id) (id ⊗ comul)`, + then `(id ⊗ mul) (comul ⊗ id) = comul ∘ mul`. + + This is sometimes referred to as the Frobenius equations. -/ +theorem lTensor_mul_comp_rTensor_comul_of + (h : (lT A (m A)) ∘ₗ (ϰ A A A) ∘ₗ (rT A comul) = + (rT A (m A)) ∘ₗ (LinearEquiv.symm (ϰ A A A)) ∘ₗ (lT A comul)) : + (lT A (m A)) ∘ₗ (ϰ A A A) ∘ₗ (rT A comul) = comul ∘ₗ (m A) := +by + calc + (lT A (m A)) ∘ₗ (ϰ A A A) ∘ₗ (rT A comul) = + (rT A (m A)) ∘ₗ (LinearEquiv.symm (ϰ A A A)) ∘ₗ (lT A comul) := h + _ = (rT _ (m A)) + ∘ₗ (ϰ _ _ _).symm.toLinearMap + ∘ₗ ((((τ _).toLinearMap ∘ₗ ((rT _ counit) ∘ₗ comul))) ⊗ₘ comul) := by + congr 2 + rw [rTensor_counit_comp_comul, lTensor] + congr + ext + simp only [id_coe, id_eq, coe_comp, LinearEquiv.coe_coe, Function.comp_apply, mk_apply, + lid_tmul, one_smul] + _ = (rT _ (m A)) + ∘ₗ (ϰ _ _ _).symm.toLinearMap + ∘ₗ (rT _ (τ _).toLinearMap) + ∘ₗ (rT _ (rT _ counit)) + ∘ₗ (comul ⊗ₘ comul) := by + simp only [rTensor_comp_map] + _ = (rT _ ((m _) + ∘ₗ (τ _).toLinearMap + ∘ₗ (rT _ counit) + ∘ₗ (ϰ A A A).toLinearMap)) + ∘ₗ (ϰ _ _ _).symm.toLinearMap + ∘ₗ (comul ⊗ₘ comul) := by + simp_rw [← LinearMap.comp_assoc] + congr 1 + apply TensorProduct.ext_fourfold' + intro a b c d + simp only [coe_comp, LinearEquiv.coe_coe, Function.comp_apply, rTensor_tmul, lid_tmul, + assoc_symm_tmul, mul'_apply, Algebra.smul_mul_assoc, assoc_tmul, LinearMapClass.map_smul] + _ = (rT _ ((τ _).toLinearMap ∘ₗ ((lT _ (m A)) ∘ₗ (rT _ counit)) ∘ₗ (ϰ _ _ _).toLinearMap)) + ∘ₗ (ϰ _ _ _).symm.toLinearMap + ∘ₗ (comul ⊗ₘ comul) := by + simp_rw [← LinearMap.comp_assoc] + congr 5 + apply TensorProduct.ext' + intro a b + simp only [coe_comp, LinearEquiv.coe_coe, Function.comp_apply, lid_tmul, + LinearMapClass.map_smul, lTensor_tmul] + _ = (rT _ ((τ _).toLinearMap ∘ₗ ((rT _ counit) ∘ₗ (lT _ (m A))) ∘ₗ (ϰ _ _ _).toLinearMap)) + ∘ₗ (ϰ _ _ _).symm.toLinearMap + ∘ₗ (comul ⊗ₘ comul) := by + simp only [lTensor_comp_rTensor, rTensor_comp_lTensor] + _ = (rT _ ((τ _).toLinearMap ∘ₗ ((rT _ counit) ∘ₗ (lT _ (m A)) ) ∘ₗ (ϰ _ _ _).toLinearMap)) + ∘ₗ ((ϰ _ _ _).symm.toLinearMap + ∘ₗ (rT _ comul)) + ∘ₗ (lT _ comul) := by + simp only [comp_assoc, rTensor_comp_lTensor] + _ = (rT _ ((τ _).toLinearMap ∘ₗ ((rT _ counit) ∘ₗ (lT _ (m A)) ) ∘ₗ (ϰ _ _ _).toLinearMap)) + ∘ₗ (rT _ (rT _ comul)) + ∘ₗ (ϰ _ _ _).symm.toLinearMap + ∘ₗ (lT _ comul) := by + simp only [TensorProduct.assoc_symm_comp_rTensor, comp_assoc] + _ = ((τ _).toLinearMap + ∘ₗ (rT _ counit)) + ∘ₗ (ϰ _ _ _).toLinearMap + ∘ₗ ((rT _ ((rT _ (m A)) ∘ₗ (ϰ _ _ _).symm.toLinearMap ∘ₗ (lT _ comul))) + ∘ₗ (ϰ _ _ _).symm.toLinearMap) + ∘ₗ (lT A comul) := by + rw [← h] + simp_rw [← comp_assoc] + congr 2 + simp_rw [rTensor_comp_rTensor, lid_tensor_toLinearMap] + symm + nth_rw 3 [comp_assoc] + rw [assoc_symm_comp_rTensor] + simp_rw [← comp_assoc, rTensor_comp_rTensor] + nth_rw 2 [comp_assoc] + simp only [LinearEquiv.comp_coe, LinearEquiv.self_trans_symm, LinearEquiv.refl_toLinearMap, + comp_id] + simp_rw [rTensor_comp_rTensor, comp_assoc] + _ = (τ (A ⊗[R] A)).toLinearMap + ∘ₗ (rT _ counit) + ∘ₗ (ϰ _ _ _).toLinearMap + ∘ₗ (rT _ (rT _ (m A))) + ∘ₗ (rT A (ϰ A A A).symm.toLinearMap) + ∘ₗ (ϰ _ _ _).symm.toLinearMap + ∘ₗ (lT _ ((rT A comul) ∘ₗ comul)) := by + simp_rw [comp_assoc] + congr 3 + simp_rw [← comp_assoc] + rw [rTensor_comp_rTensor] + nth_rw 1 [← rTensor_comp_rTensor] + simp_rw [comp_assoc] + congr 1 + rw [← comp_assoc, TensorProduct.rTensor_lTensor_comp_assoc_symm, comp_assoc, + lTensor_comp_lTensor] + _ = (τ (A ⊗[R] A)).toLinearMap + ∘ₗ (rT _ counit) + ∘ₗ (ϰ _ _ _).toLinearMap + ∘ₗ (rT _ (rT _ (m A))) + ∘ₗ (rT A (ϰ A A A).symm.toLinearMap) + ∘ₗ (ϰ _ _ _).symm.toLinearMap + ∘ₗ (lT _ ((ϰ _ _ _).symm.toLinearMap ∘ₗ (lT A comul) ∘ₗ comul)) := by + rw [Coalgebra.coassoc_symm] + _ = (τ (A ⊗[R] A)).toLinearMap + ∘ₗ (rT _ counit) + ∘ₗ (ϰ _ _ _).toLinearMap + ∘ₗ (rT _ (rT _ (m A))) + ∘ₗ (rT A (ϰ A A A).symm.toLinearMap) + ∘ₗ (ϰ _ _ _).symm.toLinearMap + ∘ₗ (lT _ (ϰ _ _ _).symm.toLinearMap) + ∘ₗ (lT _ (lT A comul)) + ∘ₗ (lT _ comul) := by + simp_rw [lTensor_comp_lTensor] + _ = (τ (A ⊗[R] A)).toLinearMap + ∘ₗ (rT _ counit) + ∘ₗ ((rT _ (m A)) + ∘ₗ (ϰ _ _ _).toLinearMap) + ∘ₗ (rT A (ϰ A A A).symm.toLinearMap) + ∘ₗ (ϰ _ _ _).symm.toLinearMap + ∘ₗ (lT _ (ϰ _ _ _).symm.toLinearMap) + ∘ₗ (lT _ (lT A comul)) + ∘ₗ (lT _ comul) := by + simp_rw [← assoc_comp_rTensor_rTensor, comp_assoc] + _ = (τ (A ⊗[R] A)).toLinearMap + ∘ₗ (rT _ counit) + ∘ₗ (rT _ (m A)) + ∘ₗ ((ϰ _ _ _).symm.toLinearMap + ∘ₗ (lT _ (lT A comul))) + ∘ₗ (lT _ comul) := by + symm + rw [← assoc_comp_rTensor_assoc_symm_comp_assoc_symm_comp_lTensor_assoc_symm] + simp_rw [comp_assoc] + _ = (τ (A ⊗[R] A)).toLinearMap ∘ₗ (rT _ counit) + ∘ₗ ((rT _ (m A)) + ∘ₗ (lT _ comul)) + ∘ₗ (ϰ _ _ _).symm.toLinearMap + ∘ₗ (lT _ comul) := by + simp_rw [assoc_symm_comp_lTensor_lTensor, comp_assoc] + _ = (τ (A ⊗[R] A)).toLinearMap ∘ₗ (rT _ counit) + ∘ₗ (lT _ comul) + ∘ₗ ((lT _ (m A)) + ∘ₗ (ϰ _ _ _).toLinearMap + ∘ₗ (rT _ comul)) := by + rw [rTensor_comp_lTensor', h] + simp_rw [comp_assoc] + _ = (τ (A ⊗[R] A)).toLinearMap + ∘ₗ ((lT _ (comul ∘ₗ (m A))) + ∘ₗ (rT _ counit)) + ∘ₗ (ϰ _ _ _).toLinearMap + ∘ₗ (rT _ comul) := by + rw [← rTensor_comp_lTensor', ← lTensor_comp_lTensor] + simp_rw [comp_assoc] + _ = (τ (A ⊗[R] A)).toLinearMap + ∘ₗ (lT _ (comul ∘ₗ (m A))) + ∘ₗ ((rT _ counit) + ∘ₗ (ϰ _ _ _).toLinearMap) + ∘ₗ (rT _ comul) := by + simp_rw [comp_assoc] + _ = (τ (A ⊗[R] A)).toLinearMap + ∘ₗ (lT _ (comul ∘ₗ (m A))) + ∘ₗ ((ϰ _ _ _).toLinearMap + ∘ₗ (rT _ (rT _ counit))) + ∘ₗ (rT _ comul) := by + simp_rw [assoc_comp_rTensor_rTensor] + _ = (τ (A ⊗[R] A)).toLinearMap + ∘ₗ (lT _ (comul ∘ₗ (m A))) + ∘ₗ (ϰ _ _ _).toLinearMap + ∘ₗ (rT _ (τ A).symm.toLinearMap) := by + rw [← rTensor_counit_comp_comul', ← rTensor_comp_rTensor] + simp_rw [comp_assoc] + _ = comul ∘ₗ (m A) := by + apply ext' + intro a b + simp only [coe_comp, LinearEquiv.coe_coe, Function.comp_apply, rTensor_tmul, lid_symm_apply, + assoc_tmul, lTensor_tmul, mul'_apply, lid_tmul, one_smul] + +theorem counit_comp_mul_comp_rTensor_unit_eq_counit : + counit ∘ₗ (m A) ∘ₗ (rT _ (Algebra.linearMap R A)) = counit ∘ₗ (τ _).toLinearMap := +by + rw [Algebra.mul_comp_rTensor_unit] +theorem counit_comp_mul_comp_lTensor_unit_eq_counit : + counit ∘ₗ (m A) ∘ₗ (lT _ (Algebra.linearMap R A)) + = counit ∘ₗ (TensorProduct.rid _ _).toLinearMap := +by + rw [Algebra.mul_comp_lTensor_unit] +theorem rTensor_counit_comp_comul_comp_unit_eq_unit : + (rT _ counit) ∘ₗ comul ∘ₗ Algebra.linearMap R A + = (τ _).symm.toLinearMap ∘ₗ Algebra.linearMap R A := +by + rw [← LinearMap.comp_assoc, rTensor_counit_comp_comul] + rfl +theorem lTensor_counit_comp_comul_comp_unit_eq_unit : + (lT _ counit) ∘ₗ comul ∘ₗ Algebra.linearMap R A + = (TensorProduct.rid _ _).symm.toLinearMap ∘ₗ Algebra.linearMap R A := +by + rw [← LinearMap.comp_assoc, lTensor_counit_comp_comul] + rfl + +/-- An algebra and coalgebra with the Frobenius tensor compatibility law. -/ +class FrobeniusAlgebra (R A : Type*) [CommSemiring R] [Semiring A] extends + Algebra R A, Coalgebra R A where + lTensor_mul_comp_rTensor_comul_commute : + (lT A (LinearMap.mul' R A)) + ∘ₗ (TensorProduct.assoc _ _ _ _).toLinearMap + ∘ₗ (rT A comul) + = (rT A (LinearMap.mul' R A)) + ∘ₗ (TensorProduct.assoc _ _ _ _).symm.toLinearMap + ∘ₗ (lT A comul) + +attribute [instance] FrobeniusAlgebra.toAlgebra +attribute [instance] FrobeniusAlgebra.toCoalgebra + +variable {R A : Type*} [CommSemiring R] [Semiring A] [FrobeniusAlgebra R A] +theorem FrobeniusAlgebra.lTensor_mul_comp_rTensor_comul_eq_comul_comp_mul : + (lT A (LinearMap.mul' R A)) + ∘ₗ (TensorProduct.assoc _ _ _ _).toLinearMap + ∘ₗ (rT A comul) = comul ∘ₗ LinearMap.mul' R A := +lTensor_mul_comp_rTensor_comul_of FrobeniusAlgebra.lTensor_mul_comp_rTensor_comul_commute + +theorem FrobeniusAlgebra.rTensor_mul_comp_lTensor_comul_eq_comul_comp_mul : + (rT A (LinearMap.mul' R A)) + ∘ₗ (TensorProduct.assoc _ _ _ _).symm.toLinearMap + ∘ₗ (lT A comul) = comul ∘ₗ LinearMap.mul' R A := +by rw [← lTensor_mul_comp_rTensor_comul_commute, lTensor_mul_comp_rTensor_comul_eq_comul_comp_mul] + +theorem FrobeniusAlgebra.rTensor_mul_comp_lTensor_comul_unit_eq_comul : + (rT A (LinearMap.mul' R A)) + ∘ₗ (TensorProduct.assoc _ _ _ _).symm.toLinearMap + ∘ₗ (lT A (comul ∘ₗ Algebra.linearMap R A)) + = comul ∘ₗ (TensorProduct.rid R _).toLinearMap := +by + simp_rw [← lTensor_comp_lTensor, ← LinearMap.comp_assoc] + rw [LinearMap.comp_assoc (lT A comul), rTensor_mul_comp_lTensor_comul_eq_comul_comp_mul, + LinearMap.comp_assoc, Algebra.mul_comp_lTensor_unit] + +theorem FrobeniusAlgebra.lTensor_mul_comp_rTensor_comul_unit : + (lT A (LinearMap.mul' R A)) + ∘ₗ (TensorProduct.assoc R _ _ _).toLinearMap + ∘ₗ (rT A (comul ∘ₗ Algebra.linearMap R A)) + = comul ∘ₗ (TensorProduct.lid _ _).toLinearMap := +by + simp_rw [← rTensor_comp_rTensor, ← LinearMap.comp_assoc] + rw [LinearMap.comp_assoc (rT A comul), lTensor_mul_comp_rTensor_comul_eq_comul_comp_mul, + LinearMap.comp_assoc, Algebra.mul_comp_rTensor_unit] + +theorem FrobeniusAlgebra.rTensor_counit_mul_comp_lTensor_comul : + (rT A (counit ∘ₗ LinearMap.mul' R A)) + ∘ₗ (TensorProduct.assoc _ _ _ _).symm.toLinearMap + ∘ₗ (lT A comul) + = (TensorProduct.lid _ _).symm.toLinearMap ∘ₗ LinearMap.mul' R A := +by + rw [← rTensor_comp_rTensor, LinearMap.comp_assoc, + rTensor_mul_comp_lTensor_comul_eq_comul_comp_mul, + ← LinearMap.comp_assoc, rTensor_counit_comp_comul] + rfl + +theorem FrobeniusAlgebra.lTensor_counit_mul_comp_rTensor_comul : + (lT A (counit ∘ₗ LinearMap.mul' R A)) + ∘ₗ (TensorProduct.assoc _ _ _ _).toLinearMap + ∘ₗ (rT A comul) + = (TensorProduct.rid _ _).symm.toLinearMap ∘ₗ LinearMap.mul' R A := +by + rw [← lTensor_comp_lTensor, LinearMap.comp_assoc, + lTensor_mul_comp_rTensor_comul_eq_comul_comp_mul, + ← LinearMap.comp_assoc, lTensor_counit_comp_comul] + rfl + +/-- "snake equations" v1 -/ +theorem FrobeniusAlgebra.rTensor_counit_mul_comp_lTensor_comul_unit : + (rT A (counit ∘ₗ LinearMap.mul' R A)) + ∘ₗ (TensorProduct.assoc _ _ _ _).symm.toLinearMap + ∘ₗ (lT A (comul ∘ₗ Algebra.linearMap R A)) + = (TensorProduct.comm _ _ _).toLinearMap := +by + rw [← lTensor_comp_lTensor] + simp_rw [← LinearMap.comp_assoc (lT A (Algebra.linearMap R A)), + rTensor_counit_mul_comp_lTensor_comul, LinearMap.comp_assoc, Algebra.mul_comp_lTensor_unit] + apply TensorProduct.ext' + intro a b + simp only [LinearMap.coe_comp, Function.comp_apply, LinearEquiv.coe_coe, + TensorProduct.rid_tmul, TensorProduct.lid_symm_apply, TensorProduct.comm_tmul] + simpa using + (TensorProduct.smul_tmul (R := R) (R' := R) (M := R) (N := A) b (1 : R) a).symm + +/-- "snake equations" v2 -/ +theorem FrobeniusAlgebra.lTensor_counit_mul_comp_rTensor_comul_unit : + (lT A (counit ∘ₗ LinearMap.mul' R A)) + ∘ₗ (TensorProduct.assoc _ _ _ _).toLinearMap + ∘ₗ (rT A (comul ∘ₗ Algebra.linearMap R A)) + = (TensorProduct.comm _ _ _).toLinearMap := +by + rw [← rTensor_comp_rTensor] + simp_rw [← LinearMap.comp_assoc (rT A (Algebra.linearMap R A)), + lTensor_counit_mul_comp_rTensor_comul, LinearMap.comp_assoc, Algebra.mul_comp_rTensor_unit] + apply TensorProduct.ext' + intro r a + simp only [LinearMap.coe_comp, Function.comp_apply, LinearEquiv.coe_coe, + TensorProduct.lid_tmul, TensorProduct.rid_symm_apply, TensorProduct.comm_tmul] + simpa using + (TensorProduct.tmul_smul (R := R) (R' := R) (M := A) (N := R) r a (1 : R)).symm diff --git a/LeanPool/Monlib4/LinearAlgebra/Coalgebra/MulOpposite.lean b/LeanPool/Monlib4/LinearAlgebra/Coalgebra/MulOpposite.lean new file mode 100644 index 0000000000..0e97c4c254 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Coalgebra/MulOpposite.lean @@ -0,0 +1,230 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.Lemmas +import LeanPool.Monlib4.LinearAlgebra.LinearMapOp +import LeanPool.Monlib4.LinearAlgebra.Coalgebra.Lemmas +import Mathlib.LinearAlgebra.TensorProduct.Opposite + +open scoped TensorProduct + +/-- The tensor product of multiplicative opposites as the opposite of a tensor product. -/ +noncomputable def TensorProduct.opLinearEquiv + {R A B : Type*} [CommSemiring R] + [AddCommMonoid A] [AddCommMonoid B] + [Module R A] [Module R B] : + (A ⊗[R] B)ᵐᵒᵖ ≃ₗ[R] Aᵐᵒᵖ ⊗[R] Bᵐᵒᵖ := +(MulOpposite.opLinearEquiv R).symm.trans +(LinearEquiv.TensorProduct.map + (MulOpposite.opLinearEquiv R) + (MulOpposite.opLinearEquiv R)) + +@[simp] +lemma TensorProduct.opLinearEquiv_tmul + {R A B : Type*} [CommSemiring R] + [AddCommMonoid A] [AddCommMonoid B] + [Module R A] [Module R B] + (x : A) (y : B) : + opLinearEquiv (MulOpposite.op (x ⊗ₜ[R] y)) + = MulOpposite.op x ⊗ₜ[R] MulOpposite.op y := +rfl +@[simp] +lemma TensorProduct.opLinearEquiv_symm_tmul + {R A B : Type*} [CommSemiring R] + [AddCommMonoid A] [AddCommMonoid B] + [Module R A] [Module R B] + (x : Aᵐᵒᵖ) (y : Bᵐᵒᵖ) : + opLinearEquiv.symm (x ⊗ₜ[R] y) + = MulOpposite.op (x.unop ⊗ₜ[R] y.unop) := +rfl + +noncomputable instance MulOpposite.coalgebraStruct + {R A : Type*} [CommSemiring R] + [AddCommMonoid A] [Module R A] + [CoalgebraStruct R A] : + CoalgebraStruct R Aᵐᵒᵖ where + comul := TensorProduct.opLinearEquiv.toLinearMap ∘ₗ Coalgebra.comul.op + counit := Coalgebra.counit ∘ₗ (MulOpposite.opLinearEquiv R).symm.toLinearMap + +lemma MulOpposite.comul_def + {R A : Type*} [CommSemiring R] + [AddCommMonoid A] [Module R A] + [CoalgebraStruct R A] : + (CoalgebraStruct.comul (R := R) (A := Aᵐᵒᵖ)) = + TensorProduct.opLinearEquiv.toLinearMap ∘ₗ CoalgebraStruct.comul.op := +rfl +lemma MulOpposite.comul_def' + {R A : Type*} [CommSemiring R] + [AddCommMonoid A] [Module R A] + [CoalgebraStruct R A] : + (CoalgebraStruct.comul (R := R) (A := Aᵐᵒᵖ)) = + (TensorProduct.map (MulOpposite.opLinearEquiv R).toLinearMap + (MulOpposite.opLinearEquiv R).toLinearMap) ∘ₗ + CoalgebraStruct.comul ∘ₗ (MulOpposite.opLinearEquiv R).symm.toLinearMap := +rfl +lemma MulOpposite.counit_def + {R A : Type*} [CommSemiring R] + [AddCommMonoid A] [Module R A] + [CoalgebraStruct R A] : + (CoalgebraStruct.counit (R := R) (A := Aᵐᵒᵖ)) = + CoalgebraStruct.counit ∘ₗ (MulOpposite.opLinearEquiv R).symm.toLinearMap := +rfl + +private lemma coassoc_aux_1 + {R A : Type*} [CommSemiring R] + [AddCommMonoid A] + [Module R A] : + (TensorProduct.assoc R Aᵐᵒᵖ Aᵐᵒᵖ Aᵐᵒᵖ).toLinearMap ∘ₗ + (TensorProduct.opLinearEquiv.toLinearMap + ∘ₗ (MulOpposite.opLinearEquiv R).toLinearMap).rTensor Aᵐᵒᵖ + -- = 0:= + -- ((TensorProduct.map (MulOpposite.opLinearEquiv R).toLinearMap + -- (MulOpposite.opLinearEquiv R).toLinearMap)).rTensor A + = (TensorProduct.map (MulOpposite.opLinearEquiv R).toLinearMap + (((MulOpposite.opLinearEquiv R).toLinearMap.rTensor _))) + ∘ₗ (TensorProduct.assoc R A A _).toLinearMap := + -- ∘ₗ ((CoalgebraStruct.comul (R:=R) (A:=A)).rTensor A)) + -- ∘ₗ ((MulOpposite.opLinearEquiv R).symm.rTensor Aᵐᵒᵖ).toLinearMap := +by + apply TensorProduct.ext_threefold + intro x y z + simp + +private lemma coassoc_aux_2 + {R A : Type*} [CommSemiring R] + [AddCommMonoid A] + [Module R A] : + (MulOpposite.opLinearEquiv R).symm.toLinearMap.rTensor _ + ∘ₗ ((TensorProduct.opLinearEquiv (A := A) (B := A)).toLinearMap) + ∘ₗ (MulOpposite.opLinearEquiv R).toLinearMap + = (MulOpposite.opLinearEquiv R).toLinearMap.lTensor A := +by + apply TensorProduct.ext' + intro x y + simp + +private lemma coassoc_aux_3 + {R A : Type*} [CommSemiring R] + [AddCommMonoid A] + [Module R A] : + (TensorProduct.map (MulOpposite.opLinearEquiv R (M:=A)).toLinearMap + (((MulOpposite.opLinearEquiv R (M:=A)).toLinearMap.rTensor Aᵐᵒᵖ))) + ∘ₗ ((TensorProduct.assoc R A A Aᵐᵒᵖ).toLinearMap) + ∘ₗ (MulOpposite.opLinearEquiv R (M:=A)).toLinearMap.lTensor _ + = + TensorProduct.map (MulOpposite.opLinearEquiv R).toLinearMap + ((TensorProduct.map (MulOpposite.opLinearEquiv R).toLinearMap + (MulOpposite.opLinearEquiv R).toLinearMap)) + ∘ₗ (TensorProduct.assoc R _ _ _).toLinearMap := +by + apply TensorProduct.ext_threefold + intro x y z + simp + +lemma LinearMap.op_eq + {R A B : Type*} [CommSemiring R] + [AddCommMonoid A] [AddCommMonoid B] + [Module R A] [Module R B] + (f : A →ₗ[R] B) : + f.op = + (MulOpposite.opLinearEquiv R).toLinearMap ∘ₗ + f ∘ₗ (MulOpposite.opLinearEquiv R).symm.toLinearMap := +rfl + +open CoalgebraStruct in +private lemma MulOpposite_coassoc + {R A : Type*} [CommSemiring R] + [AddCommMonoid A] [Module R A] + [Coalgebra R A] : + (TensorProduct.assoc R Aᵐᵒᵖ Aᵐᵒᵖ Aᵐᵒᵖ) ∘ₗ + (comul (R := R) (A := Aᵐᵒᵖ)).rTensor Aᵐᵒᵖ ∘ₗ + (comul (R := R) (A := Aᵐᵒᵖ)) = + (comul (R := R) (A := Aᵐᵒᵖ)).lTensor Aᵐᵒᵖ ∘ₗ + (comul (R := R) (A := Aᵐᵒᵖ)) := +by + calc + (TensorProduct.assoc R Aᵐᵒᵖ Aᵐᵒᵖ Aᵐᵒᵖ).toLinearMap ∘ₗ + (comul (R := R) (A := Aᵐᵒᵖ)).rTensor Aᵐᵒᵖ ∘ₗ + (comul (R := R) (A := Aᵐᵒᵖ)) + = ((TensorProduct.assoc R Aᵐᵒᵖ Aᵐᵒᵖ Aᵐᵒᵖ).toLinearMap ∘ₗ + (TensorProduct.opLinearEquiv.toLinearMap + ∘ₗ (MulOpposite.opLinearEquiv R).toLinearMap).rTensor _) + ∘ₗ (comul (R := R) (A := A)).rTensor _ + ∘ₗ ((MulOpposite.opLinearEquiv R).symm.toLinearMap.rTensor _ + ∘ₗ (TensorProduct.opLinearEquiv.toLinearMap) + ∘ₗ (MulOpposite.opLinearEquiv R).toLinearMap) + ∘ₗ (comul (R:=R) (A:=A)) ∘ₗ (MulOpposite.opLinearEquiv R).symm.toLinearMap := by + simp only [comul, LinearMap.comp_assoc, LinearMap.op_eq] + congr 1 + simp only [LinearMap.rTensor_comp, LinearMap.comp_assoc] + _ = ((TensorProduct.map (MulOpposite.opLinearEquiv R).toLinearMap + (((MulOpposite.opLinearEquiv R).toLinearMap.rTensor _))) + ∘ₗ (TensorProduct.assoc R A A _).toLinearMap) + ∘ₗ ((comul (R:=R) (A:=A)).rTensor _ + ∘ₗ (MulOpposite.opLinearEquiv R).toLinearMap.lTensor A) + ∘ₗ (comul (R:=R) (A:=A)) ∘ₗ (MulOpposite.opLinearEquiv R).symm.toLinearMap := by + rw [coassoc_aux_1, coassoc_aux_2] + simp only [LinearMap.comp_assoc] + _ = ((TensorProduct.map (MulOpposite.opLinearEquiv R).toLinearMap + (((MulOpposite.opLinearEquiv R).toLinearMap.rTensor _))) + ∘ₗ ((TensorProduct.assoc R A A _).toLinearMap) + ∘ₗ (MulOpposite.opLinearEquiv R).toLinearMap.lTensor _) + ∘ₗ (comul (R:=R) (A:=A)).rTensor _ + ∘ₗ (comul (R:=R) (A:=A)) ∘ₗ (MulOpposite.opLinearEquiv R).symm.toLinearMap := by + rw [rTensor_comp_lTensor'] + simp only [LinearMap.comp_assoc] + _ = TensorProduct.map (MulOpposite.opLinearEquiv R).toLinearMap + ((TensorProduct.map (MulOpposite.opLinearEquiv R).toLinearMap + (MulOpposite.opLinearEquiv R).toLinearMap)) + ∘ₗ ((TensorProduct.assoc R _ _ _).toLinearMap + ∘ₗ (comul (R:=R) (A:=A)).rTensor _ + ∘ₗ (comul (R:=R) (A:=A))) ∘ₗ (MulOpposite.opLinearEquiv R).symm.toLinearMap := by + rw [coassoc_aux_3] + simp only [LinearMap.comp_assoc] + _ = TensorProduct.map (MulOpposite.opLinearEquiv R).toLinearMap + ((TensorProduct.map (MulOpposite.opLinearEquiv R).toLinearMap + (MulOpposite.opLinearEquiv R).toLinearMap)) + ∘ₗ (comul (R:=R) (A:=A)).lTensor A ∘ₗ (comul (R:=R) (A:=A)) + ∘ₗ (MulOpposite.opLinearEquiv R).symm.toLinearMap := by + rw [Coalgebra.coassoc] + simp only [LinearMap.comp_assoc] + _ = TensorProduct.map (MulOpposite.opLinearEquiv R).toLinearMap + ((comul (R := R) (A := Aᵐᵒᵖ)) ∘ₗ (MulOpposite.opLinearEquiv R).toLinearMap) + ∘ₗ (comul (R:=R) (A:=A)) ∘ₗ (MulOpposite.opLinearEquiv R).symm.toLinearMap := by + nth_rw 1 [MulOpposite.comul_def] + rw [← LinearMap.comp_assoc, LinearMap.map_comp_lTensor] + simp only [LinearMap.comp_assoc] + rfl + _ = (comul (R := R) (A := Aᵐᵒᵖ)).lTensor _ + ∘ₗ (TensorProduct.map (MulOpposite.opLinearEquiv R).toLinearMap + ((MulOpposite.opLinearEquiv R).toLinearMap) + ∘ₗ (comul (R:=R) (A:=A)) ∘ₗ (MulOpposite.opLinearEquiv R).symm.toLinearMap) := by + simp only [← LinearMap.comp_assoc, + LinearMap.lTensor_comp_map] + _ = comul.lTensor _ ∘ₗ comul := rfl + +@[reducible, instance] +noncomputable def MulOpposite.coalgebra + {R A : Type*} [CommSemiring R] + [AddCommMonoid A] [Module R A] + [Coalgebra R A] : Coalgebra R Aᵐᵒᵖ where + coassoc := MulOpposite_coassoc + rTensor_counit_comp_comul := by + rw [comul_def', counit_def, ← LinearMap.comp_assoc, + LinearMap.rTensor_comp_map, LinearMap.comp_assoc, + LinearEquiv.symm_comp, LinearMap.comp_id, + ← LinearMap.lTensor_comp_rTensor, LinearMap.comp_assoc] + nth_rw 2 [← LinearMap.comp_assoc] + rw [Coalgebra.rTensor_counit_comp_comul] + rfl + lTensor_counit_comp_comul := by + rw [comul_def', counit_def, ← LinearMap.comp_assoc, + LinearMap.lTensor_comp_map, LinearMap.comp_assoc, + LinearEquiv.symm_comp, LinearMap.comp_id, + ← LinearMap.rTensor_comp_lTensor, LinearMap.comp_assoc] + nth_rw 2 [← LinearMap.comp_assoc] + rw [Coalgebra.lTensor_counit_comp_comul] + rfl diff --git a/LeanPool/Monlib4/LinearAlgebra/DirectSumFromTo.lean b/LeanPool/Monlib4/LinearAlgebra/DirectSumFromTo.lean new file mode 100644 index 0000000000..2d7fe153a1 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/DirectSumFromTo.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Algebra.Algebra.Pi +import Mathlib.LinearAlgebra.Pi +-- import Mathlib.LinearAlgebra.ProjectiveSpace.Basic +import LeanPool.Monlib4.Preq.Ites + +/-! + +# Direct sum from _ to _ + + This file includes the definition of `direct_sum_from_to`, a linear map from `M i` to `M j`. + +-/ + + +/-- Composition of the `i`-th injection and the `j`-th projection of a dependent +direct sum, giving a linear map `M₁ i →ₗ[R] M₁ j`. -/ +def directSumFromTo {R : Type*} [Semiring R] {ι₁ : Type*} [DecidableEq ι₁] {M₁ : ι₁ → Type*} + [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] [∀ i₁ : ι₁, Module R (M₁ i₁)] (i j : ι₁) : M₁ i →ₗ[R] M₁ j := + LinearMap.proj j ∘ₗ LinearMap.single _ _ i + +theorem directSumFromTo_apply_same {R : Type _} [Semiring R] {ι₁ : Type _} [DecidableEq ι₁] + {M₁ : ι₁ → Type _} [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] [∀ i₁ : ι₁, Module R (M₁ i₁)] (i : ι₁) : + directSumFromTo i i = (1 : M₁ i →ₗ[R] M₁ i) := + by + ext1 x + simp only [directSumFromTo, LinearMap.comp_apply] + simp + +theorem directSumFromTo_apply_ne_same {R : Type _} [Semiring R] {ι₁ : Type _} [DecidableEq ι₁] + {M₁ : ι₁ → Type _} [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] [∀ i₁ : ι₁, Module R (M₁ i₁)] {i j : ι₁} + (h : j ≠ i) : directSumFromTo i j = (0 : M₁ i →ₗ[R] M₁ j) := + by + ext1 x + simp only [directSumFromTo, LinearMap.comp_apply] + simp [h] diff --git a/LeanPool/Monlib4/LinearAlgebra/End.lean b/LeanPool/Monlib4/LinearAlgebra/End.lean new file mode 100644 index 0000000000..ef54cfac35 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/End.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.LinearAlgebra.Eigenspace.Basic + +/-! + # Some obvious lemmas on module.End + +This file contains some obvious lemmas on `module.End`. +-/ + + +open scoped BigOperators + +theorem LinearMap.comp_one {R E F : Type _} [Semiring R] [AddCommMonoid E] [AddCommMonoid F] + [Module R F] [Module R E] (f : E →ₗ[R] F) : f ∘ₗ (1 : E →ₗ[R] E) = f := rfl + +theorem LinearMap.one_comp {R E F : Type _} [Semiring R] [AddCommMonoid E] [AddCommMonoid F] + [Module R F] [Module R E] (f : E →ₗ[R] F) : (1 : F →ₗ[R] F) ∘ₗ f = f := rfl + +theorem LinearMap.comp_sum {R M M₂ M₃ : Type _} [Semiring R] [AddCommMonoid M] [AddCommMonoid M₂] + [AddCommMonoid M₃] [Module R M] [Module R M₂] [Module R M₃] (g : M₃ →ₗ[R] M₂) {α : Type _} + (s : Finset α) (f : α → M →ₗ[R] M₃) : g ∘ₗ ∑ a ∈ s, f a = ∑ a ∈ s, g ∘ₗ f a := by + simp_rw [LinearMap.ext_iff, LinearMap.sum_apply, LinearMap.comp_apply, LinearMap.sum_apply, + map_sum, forall_true_iff] + +theorem LinearMap.sum_comp {R M M₂ M₃ : Type _} [Semiring R] [AddCommMonoid M] [AddCommMonoid M₂] + [AddCommMonoid M₃] [Module R M] [Module R M₂] [Module R M₃] (f : M →ₗ[R] M₃) {α : Type _} + (s : Finset α) (g : α → M₃ →ₗ[R] M₂) : (∑ a ∈ s, g a) ∘ₗ f = ∑ a ∈ s, g a ∘ₗ f := by + simp_rw [LinearMap.ext_iff, LinearMap.sum_apply, LinearMap.comp_apply, LinearMap.sum_apply, + forall_true_iff] + +theorem Module.End.has_eigenvector_iff_hasEigenvalue {R M : Type _} [CommRing R] [AddCommGroup M] + [Module R M] {T : Module.End R M} {α : R} : + (∃ v : M, T v = α • v ∧ v ≠ 0) ↔ Module.End.HasEigenvalue T α := + by + constructor + · rintro ⟨v, hv⟩ + apply Module.End.hasEigenvalue_of_hasEigenvector (x := v) + rw [Module.End.hasEigenvector_iff, Module.End.mem_eigenspace_iff] + exact hv + · intro h + simp only [Module.End.HasEigenvalue, Module.End.HasUnifEigenvalue] at h + simp_rw [Submodule.ne_bot_iff] at h + rcases h with ⟨x, Hx, hx⟩ + use x + rw [← Module.End.mem_eigenspace_iff] + exact ⟨Hx, hx⟩ diff --git a/LeanPool/Monlib4/LinearAlgebra/InnerAut.lean b/LeanPool/Monlib4/LinearAlgebra/InnerAut.lean new file mode 100644 index 0000000000..1b5370db27 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/InnerAut.lean @@ -0,0 +1,748 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.MySpec +import LeanPool.Monlib4.LinearAlgebra.Matrix.Basic +import LeanPool.Monlib4.LinearAlgebra.Matrix.IsAlmostHermitian +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.BasicLemmas +import LeanPool.Monlib4.RepTheory.AutMat +import Mathlib.Algebra.Star.Pi +import Mathlib.Algebra.Star.UnitaryStarAlgAut +import Mathlib.Analysis.Matrix.Order +import Mathlib.LinearAlgebra.Matrix.Hermitian +import Mathlib.LinearAlgebra.UnitaryGroup + +/-! +# Inner Automorphisms + +This file ports the upstream monlib4 unitary inner-automorphism interface. In +current Mathlib the general star-algebra automorphism by unitary conjugation is +available as `Unitary.conjStarAlgAut`; the declarations here keep monlib4's +names for the matrix-algebra specialization and its trace, spectrum, and +Hermitian-preservation lemmas. +-/ + +open scoped ComplexOrder + +lemma RCLike.neg_ofReal {𝕜 : Type*} [RCLike 𝕜] (a : ℝ) : + (a : 𝕜) < 0 ↔ a < 0 := by + exact RCLike.ofReal_lt_zero + +instance Pi.coe {k : Type _} {s r : k → Type _} [∀ i, CoeTC (s i) (r i)] : + CoeTC (Π i, s i) (Π i, r i) := + ⟨fun U i => U i⟩ + +lemma Pi.coe_eq {k : Type _} {s r : k → Type _} [∀ i, CoeTC (s i) (r i)] + (U : Π i, s i) : + HEq (fun i => (U i : r i)) (↑U : Π i, r i) := + HEq.rfl + +section + +variable {n 𝕜 : Type _} [Fintype n] [Field 𝕜] [StarRing 𝕜] + +@[simp] +theorem StarAlgEquiv.trace_preserving (f : Matrix n n 𝕜 ≃⋆ₐ[𝕜] Matrix n n 𝕜) + (x : Matrix n n 𝕜) : (f x).trace = x.trace := by + classical + exact Matrix.aut_mat_inner_trace_preserving f.toAlgEquiv x + +end + +namespace unitary + +/-- The star-algebra automorphism given by conjugation with a unitary element. -/ +abbrev innerAutStarAlg (K : Type _) {R : Type _} [Semiring R] [StarMul R] + [SMul K R] [IsScalarTower K R R] [SMulCommClass K R R] (a : unitary R) : + R ≃⋆ₐ[K] R := + Unitary.conjStarAlgAut K R a + +theorem innerAutStarAlg_apply {K R : Type _} [Semiring R] [StarMul R] + [SMul K R] [IsScalarTower K R R] [SMulCommClass K R R] (U : unitary R) (x : R) : + innerAutStarAlg K U x = U * x * (star U : unitary R) := + rfl + +theorem innerAutStarAlg_apply' {K R : Type _} [Semiring R] [StarMul R] + [SMul K R] [IsScalarTower K R R] [SMulCommClass K R R] (U : unitary R) (x : R) : + innerAutStarAlg K U x = U * x * (U⁻¹ : unitary R) := by + rfl + +theorem innerAutStarAlg_apply'' {K R : Type _} [Semiring R] [StarMul R] + [SMul K R] [IsScalarTower K R R] [SMulCommClass K R R] (U : unitary R) (x : R) : + innerAutStarAlg K U x = U * x * star (U : R) := + rfl + +theorem innerAutStarAlg_symm_apply {K R : Type _} [Semiring R] [StarMul R] + [SMul K R] [IsScalarTower K R R] [SMulCommClass K R R] (U : unitary R) (x : R) : + (innerAutStarAlg K U).symm x = (star U : unitary R) * x * U := + rfl + +theorem innerAutStarAlg_symm_apply' {K R : Type _} [Semiring R] [StarMul R] + [SMul K R] [IsScalarTower K R R] [SMulCommClass K R R] (U : unitary R) (x : R) : + (innerAutStarAlg K U).symm x = (U⁻¹ : unitary R) * x * U := by + rfl + +theorem innerAutStarAlg_symm_apply'' {K R : Type _} [Semiring R] [StarMul R] + [SMul K R] [IsScalarTower K R R] [SMulCommClass K R R] (U : unitary R) (x : R) : + (innerAutStarAlg K U).symm x = star (U : R) * x * U := + rfl + +theorem innerAutStarAlg_symm {K R : Type _} [Semiring R] [StarMul R] + [SMul K R] [IsScalarTower K R R] [SMulCommClass K R R] (U : unitary R) : + (innerAutStarAlg K U).symm = innerAutStarAlg K (star U) := + Unitary.conjStarAlgAut_symm U + +theorem innerAutStarAlg_symm' {K R : Type _} [Semiring R] [StarMul R] + [SMul K R] [IsScalarTower K R R] [SMulCommClass K R R] (U : unitary R) : + (innerAutStarAlg K U).symm = innerAutStarAlg K U⁻¹ := by + rw [innerAutStarAlg_symm] + rfl + +instance (R : Type*) [Monoid R] [StarMul R] : + CoeTC (unitary R) R := + ⟨fun x => x⟩ + +theorem pi_mem {k : Type _} {s : k → Type _} [∀ i, Semiring (s i)] + [∀ i, StarMul (s i)] (U : Π i, unitary (s i)) : + (fun i => (U i : s i)) ∈ unitary (∀ i, s i) := by + rw [Unitary.mem_iff] + simp only [Pi.mul_def, Pi.star_apply, Unitary.coe_star_mul_self] + simp only [← Unitary.coe_star, Unitary.coe_mul_star_self, and_self] + rfl + +/-- Build a unitary element of a dependent function type from pointwise unitaries. -/ +@[inline] +abbrev pi {k : Type _} {s : k → Type _} [∀ i, Semiring (s i)] + [∀ i, StarMul (s i)] (U : ∀ i, unitary (s i)) : + unitary (∀ i, s i) := + ⟨fun i => U i, pi_mem U⟩ + +theorem pi_apply {k : Type _} {s : k → Type _} [∀ i, Semiring (s i)] + [∀ i, StarMul (s i)] (U : ∀ i, unitary (s i)) {i : k} : + (pi U : ∀ i, s i) i = U i := + rfl + +end unitary + +namespace Matrix + +variable {n 𝕜 : Type _} [Fintype n] + +section + +variable [Field 𝕜] [StarRing 𝕜] + +theorem _root_.Matrix.unitaryGroup.coe_hMul_star_self [DecidableEq n] + (a : Matrix.unitaryGroup n 𝕜) : + (HMul.hMul a (star a) : Matrix n n 𝕜) = (1 : Matrix n n 𝕜) := by + simp only [Unitary.mul_star_self] + rfl + +theorem _root_.Matrix.unitaryGroup.star_coe_eq_coe_star [DecidableEq n] + (U : unitaryGroup n 𝕜) : + (star (U : unitaryGroup n 𝕜) : Matrix n n 𝕜) = (star U : unitaryGroup n 𝕜) := + rfl + +/-- The star-algebra automorphism `x ↦ U * x * U⁻¹`. -/ +@[inline] +abbrev innerAutStarAlg [DecidableEq n] (a : unitaryGroup n 𝕜) : + Matrix n n 𝕜 ≃⋆ₐ[𝕜] Matrix n n 𝕜 := + unitary.innerAutStarAlg 𝕜 a + +open scoped Matrix + +theorem innerAutStarAlg_apply [DecidableEq n] (U : unitaryGroup n 𝕜) (x : Matrix n n 𝕜) : + innerAutStarAlg U x = U * x * (star U : unitaryGroup n 𝕜) := + rfl + +theorem innerAutStarAlg_apply' [DecidableEq n] (U : unitaryGroup n 𝕜) (x : Matrix n n 𝕜) : + innerAutStarAlg U x = U * x * (U⁻¹ : unitaryGroup n 𝕜) := + rfl + +theorem innerAutStarAlg_symm_apply [DecidableEq n] (U : unitaryGroup n 𝕜) + (x : Matrix n n 𝕜) : + (innerAutStarAlg U).symm x = (star U : unitaryGroup n 𝕜) * x * U := + rfl + +theorem innerAutStarAlg_symm_apply' [DecidableEq n] (U : unitaryGroup n 𝕜) + (x : Matrix n n 𝕜) : + (innerAutStarAlg U).symm x = (U⁻¹ : unitaryGroup n 𝕜) * x * U := + rfl + +theorem innerAutStarAlg_symm [DecidableEq n] (U : unitaryGroup n 𝕜) : + (innerAutStarAlg U).symm = innerAutStarAlg U⁻¹ := + unitary.innerAutStarAlg_symm' U + +/-- The unitary inner automorphism as a linear map. -/ +abbrev innerAut [DecidableEq n] (U : unitaryGroup n 𝕜) : + Matrix n n 𝕜 →ₗ[𝕜] Matrix n n 𝕜 := + (innerAutStarAlg U).toAlgEquiv.toLinearMap + +@[simp] +theorem innerAut_coe [DecidableEq n] (U : unitaryGroup n 𝕜) : + ⇑(innerAut U) = innerAutStarAlg U := + rfl + +theorem innerAut_inv_coe [DecidableEq n] (U : unitaryGroup n 𝕜) : + ⇑(innerAut U⁻¹) = (innerAutStarAlg U).symm := by + simp_rw [innerAutStarAlg_symm] + rfl + +theorem innerAut_apply [DecidableEq n] (U : unitaryGroup n 𝕜) (x : Matrix n n 𝕜) : + innerAut U x = U * x * (U⁻¹ : unitaryGroup n 𝕜) := + rfl + +theorem innerAut_apply' [DecidableEq n] (U : unitaryGroup n 𝕜) (x : Matrix n n 𝕜) : + innerAut U x = U * x * (star U : unitaryGroup n 𝕜) := + rfl + +theorem innerAut_inv_apply [DecidableEq n] (U : unitaryGroup n 𝕜) (x : Matrix n n 𝕜) : + innerAut U⁻¹ x = (U⁻¹ : unitaryGroup n 𝕜) * x * U := by + simp only [innerAut_apply, inv_inv _] + +theorem innerAut_star_apply [DecidableEq n] (U : unitaryGroup n 𝕜) (x : Matrix n n 𝕜) : + innerAut (star U) x = (star U : unitaryGroup n 𝕜) * x * U := by + simp_rw [innerAut_apply', star_star] + +theorem innerAut_conjTranspose [DecidableEq n] (U : unitaryGroup n 𝕜) + (x : Matrix n n 𝕜) : + (innerAut U x)ᴴ = innerAut U xᴴ := by + simpa only [innerAut_coe] using (map_star (innerAutStarAlg U) x).symm + +theorem innerAut_comp_innerAut [DecidableEq n] (U₁ U₂ : unitaryGroup n 𝕜) : + innerAut U₁ ∘ₗ innerAut U₂ = innerAut (U₁ * U₂) := by + simp_rw [LinearMap.ext_iff, LinearMap.comp_apply, innerAut_apply, UnitaryGroup.inv_apply, + UnitaryGroup.mul_apply, Matrix.star_mul, Matrix.mul_assoc, forall_true_iff] + +theorem innerAut_apply_innerAut [DecidableEq n] (U₁ U₂ : unitaryGroup n 𝕜) + (x : Matrix n n 𝕜) : + innerAut U₁ (innerAut U₂ x) = innerAut (U₁ * U₂) x := by + rw [← innerAut_comp_innerAut, LinearMap.comp_apply] + +theorem innerAut_eq_iff [DecidableEq n] (U : unitaryGroup n 𝕜) (x y : Matrix n n 𝕜) : + innerAut U x = y ↔ x = innerAut U⁻¹ y := by + rw [innerAut_coe, innerAut_inv_coe] + exact (innerAutStarAlg U).toEquiv.apply_eq_iff_eq_symm_apply + +theorem _root_.Matrix.unitaryGroup.toLinearEquiv_apply [DecidableEq n] (U : unitaryGroup n 𝕜) + (x : n → 𝕜) : + (UnitaryGroup.toLinearEquiv U) x = (↑(U : unitaryGroup n 𝕜) : Matrix n n 𝕜).mulVec x := + rfl + +theorem _root_.Matrix.unitaryGroup.toLinearEquiv_eq [DecidableEq n] + (U : unitaryGroup n 𝕜) (x : n → 𝕜) : + (UnitaryGroup.toLinearEquiv U) x = (UnitaryGroup.toLin' U) x := + rfl + +theorem _root_.Matrix.unitaryGroup.toLin'_apply [DecidableEq n] (U : unitaryGroup n 𝕜) + (x : n → 𝕜) : + (UnitaryGroup.toLin' U) x = (↑(U : unitaryGroup n 𝕜) : Matrix n n 𝕜).mulVec x := + rfl + +theorem _root_.Matrix.unitaryGroup.toLin'_eq [DecidableEq n] (U : unitaryGroup n 𝕜) + (x : n → 𝕜) : + (UnitaryGroup.toLin' U) x = (toLin' U) x := + rfl + +omit [StarRing 𝕜] in +theorem toLinAlgEquiv'_apply' [DecidableEq n] (x : Matrix n n 𝕜) : + toLinAlgEquiv' x = + (toLin' : Matrix n n 𝕜 ≃ₗ[𝕜] (n → 𝕜) →ₗ[𝕜] (n → 𝕜)) x := + rfl + +/-- The spectrum of `U * x * U⁻¹` is the spectrum of `x`. -/ +theorem _root_.Matrix.innerAut.spectrum_eq [DecidableEq n] (U : unitaryGroup n 𝕜) + (x : Matrix n n 𝕜) : + spectrum 𝕜 (toLin' (innerAut U x)) = spectrum 𝕜 (toLin' x) := by + simp_rw [← toLinAlgEquiv'_apply', AlgEquiv.spectrum_eq, innerAut_coe, + AlgEquiv.spectrum_eq] + +theorem innerAut_one [DecidableEq n] : innerAut (1 : unitaryGroup n 𝕜) = 1 := by + simp_rw [LinearMap.ext_iff, innerAut_apply, UnitaryGroup.inv_apply, UnitaryGroup.one_apply, + star_one, Matrix.mul_one, Matrix.one_mul, Module.End.one_apply, forall_true_iff] + +theorem innerAut_comp_innerAut_inv [DecidableEq n] (U : unitaryGroup n 𝕜) : + innerAut U ∘ₗ innerAut U⁻¹ = 1 := by + rw [LinearMap.ext_iff] + intro x + rw [LinearMap.comp_apply, innerAut_coe, innerAut_inv_coe, StarAlgEquiv.apply_symm_apply] + rfl + +theorem innerAut_apply_innerAut_inv [DecidableEq n] (U₁ U₂ : unitaryGroup n 𝕜) + (x : Matrix n n 𝕜) : + innerAut U₁ (innerAut U₂⁻¹ x) = innerAut (U₁ * U₂⁻¹) x := by + rw [innerAut_apply_innerAut] + +theorem innerAut_apply_innerAut_inv_self [DecidableEq n] (U : unitaryGroup n 𝕜) + (x : Matrix n n 𝕜) : + innerAut U (innerAut U⁻¹ x) = x := by + rw [innerAut_apply_innerAut_inv, mul_inv_cancel, innerAut_one, Module.End.one_apply] + +theorem innerAut_inv_apply_innerAut_self [DecidableEq n] (U : unitaryGroup n 𝕜) + (x : Matrix n n 𝕜) : + innerAut U⁻¹ (innerAut U x) = x := by + rw [innerAut_inv_coe, innerAut_coe] + exact StarAlgEquiv.symm_apply_apply _ _ + +theorem innerAut_apply_zero [DecidableEq n] (U : unitaryGroup n 𝕜) : + innerAut U 0 = 0 := + map_zero _ + +theorem innerAut_conj_spectrum_eq [DecidableEq n] (U : unitaryGroup n 𝕜) + (x : Matrix n n 𝕜 →ₗ[𝕜] Matrix n n 𝕜) : + spectrum 𝕜 (innerAut U⁻¹ ∘ₗ x ∘ₗ innerAut U) = spectrum 𝕜 x := by + rw [spectrum.comm, LinearMap.comp_assoc, innerAut_comp_innerAut_inv, LinearMap.comp_one] + +theorem innerAut_apply_one [DecidableEq n] (U : unitaryGroup n 𝕜) : + innerAut U 1 = 1 := by + rw [innerAut_coe, _root_.map_one] + +theorem innerAutStarAlg_apply_eq_innerAut_apply [DecidableEq n] (U : unitaryGroup n 𝕜) + (x : Matrix n n 𝕜) : innerAutStarAlg U x = innerAut U x := + rfl + +theorem _root_.Matrix.innerAut.map_mul [DecidableEq n] (U : unitaryGroup n 𝕜) + (x y : Matrix n n 𝕜) : + innerAut U (x * y) = innerAut U x * innerAut U y := by + rw [innerAut_coe, _root_.map_mul (innerAutStarAlg U)] + +theorem _root_.Matrix.innerAut.map_star [DecidableEq n] (U : unitaryGroup n 𝕜) + (x : Matrix n n 𝕜) : + star (innerAut U x) = innerAut U (star x) := + innerAut_conjTranspose _ _ + +theorem innerAut_inv_eq_star [DecidableEq n] {x : unitaryGroup n 𝕜} : + innerAut x⁻¹ = innerAut (star x) := + rfl + +theorem _root_.Matrix.unitaryGroup.coe_inv [DecidableEq n] (U : unitaryGroup n 𝕜) : + ⇑(U⁻¹ : unitaryGroup n 𝕜) = ((U : Matrix n n 𝕜)⁻¹ : Matrix n n 𝕜) := by + symm + apply inv_eq_left_inv + simp_rw [UnitaryGroup.inv_apply, UnitaryGroup.star_mul_self] + +theorem _root_.Matrix.innerAut.map_inv [DecidableEq n] (U : unitaryGroup n 𝕜) + (x : Matrix n n 𝕜) : + (innerAut U x)⁻¹ = innerAut U x⁻¹ := by + simp_rw [innerAut_apply, Matrix.mul_inv_rev, ← unitaryGroup.coe_inv, inv_inv, Matrix.mul_assoc] + +/-- The trace of `U * x * U⁻¹` is the trace of `x`. -/ +theorem innerAut_apply_trace_eq [DecidableEq n] (U : unitaryGroup n 𝕜) + (x : Matrix n n 𝕜) : + (innerAut U x).trace = x.trace := by + rw [innerAut_coe, StarAlgEquiv.trace_preserving] + +variable [DecidableEq n] + +theorem exists_innerAut_iff_exists_innerAut_inv {P : Matrix n n 𝕜 → Prop} + (x : Matrix n n 𝕜) : + (∃ U : unitaryGroup n 𝕜, P (innerAut U x)) ↔ + ∃ U : unitaryGroup n 𝕜, P (innerAut U⁻¹ x) := by + constructor <;> rintro ⟨U, hU⟩ <;> use U⁻¹ + simp_rw [inv_inv] + exact hU + +theorem _root_.Matrix.innerAut.is_injective (U : unitaryGroup n 𝕜) : + Function.Injective (innerAut U) := by + intro u v huv + rw [← innerAut_inv_apply_innerAut_self U u, huv, innerAut_inv_apply_innerAut_self] + +/-- A matrix is Hermitian iff its image under a unitary inner automorphism is Hermitian. -/ +theorem innerAut_isHermitian_iff (U : unitaryGroup n 𝕜) (x : Matrix n n 𝕜) : + x.IsHermitian ↔ (innerAut U x).IsHermitian := by + simp_rw [IsHermitian, innerAut_conjTranspose, + Function.Injective.eq_iff (innerAut.is_injective U)] + +theorem _root_.Matrix.unitaryGroup.injective_hMul (U : unitaryGroup n 𝕜) (x y : Matrix n n 𝕜) : + x = y ↔ x * (U : Matrix n n 𝕜) = y * (U : Matrix n n 𝕜) := by + constructor + · intro h + rw [h] + · intro h + have h' : x * (U : Matrix n n 𝕜) * (U⁻¹ : unitaryGroup n 𝕜) = + y * (U : Matrix n n 𝕜) * (U⁻¹ : unitaryGroup n 𝕜) := + congrArg (fun z : Matrix n n 𝕜 => z * (U⁻¹ : unitaryGroup n 𝕜)) h + simpa [Matrix.mul_assoc, UnitaryGroup.inv_apply] using h' + +lemma unitaryGroup_conjTranspose (U : unitaryGroup n 𝕜) : + (↑U)ᴴ = (↑(U⁻¹ : unitaryGroup n 𝕜) : Matrix n n 𝕜) := + rfl + +end + +section Positivity + +variable [RCLike 𝕜] [DecidableEq n] + +open scoped ComplexOrder MatrixOrder + +/-- A unitary inner automorphism preserves positive semidefinite matrices. -/ +theorem _root_.Matrix.innerAut_posSemidef_iff (U : unitaryGroup n 𝕜) {a : Matrix n n 𝕜} : + (innerAut U a).PosSemidef ↔ a.PosSemidef := by + constructor + · intro h + rw [← Matrix.nonneg_iff_posSemidef] at h ⊢ + rcases CStarAlgebra.nonneg_iff_eq_star_mul_self.mp h with ⟨b, hb⟩ + rw [← innerAut_inv_apply_innerAut_self U a, hb, Matrix.innerAut.map_mul] + rw [← Matrix.innerAut.map_star] + exact CStarAlgebra.nonneg_iff_eq_star_mul_self.mpr ⟨innerAut U⁻¹ b, rfl⟩ + · intro h + rw [← Matrix.nonneg_iff_posSemidef] at h ⊢ + rcases CStarAlgebra.nonneg_iff_eq_star_mul_self.mp h with ⟨b, hb⟩ + rw [hb, Matrix.innerAut.map_mul] + rw [← Matrix.innerAut.map_star] + exact CStarAlgebra.nonneg_iff_eq_star_mul_self.mpr ⟨innerAut U b, rfl⟩ + +theorem _root_.Matrix.posSemidef_innerAut {a : Matrix n n 𝕜} (ha : a.PosSemidef) + (U : unitaryGroup n 𝕜) : + (innerAut U a).PosSemidef := + (innerAut_posSemidef_iff U).mpr ha + +theorem _root_.Matrix.PosSemidef.innerAut {a : Matrix n n 𝕜} + (ha : a.PosSemidef) (U : unitaryGroup n 𝕜) : + (innerAut U a).PosSemidef := + Matrix.posSemidef_innerAut ha U + +theorem _root_.Matrix.innerAut_isUnit_iff (U : unitaryGroup n 𝕜) {x : Matrix n n 𝕜} : + IsUnit (innerAut U x) ↔ IsUnit x := by + simpa [innerAut_coe] using (isUnit_map_iff (innerAutStarAlg U).toAlgEquiv.toMulEquiv x) + +/-- A unitary inner automorphism preserves positive definite matrices. -/ +theorem _root_.Matrix.innerAut_posDef_iff (U : unitaryGroup n 𝕜) {x : Matrix n n 𝕜} : + (innerAut U x).PosDef ↔ x.PosDef := by + constructor + · intro h + exact ((innerAut_posSemidef_iff U).mp h.posSemidef).posDef_iff_isUnit.mpr + ((innerAut_isUnit_iff U).mp h.isUnit) + · intro h + exact ((innerAut_posSemidef_iff U).mpr h.posSemidef).posDef_iff_isUnit.mpr + ((innerAut_isUnit_iff U).mpr h.isUnit) + +theorem _root_.Matrix.posDef_innerAut {a : Matrix n n 𝕜} (ha : a.PosDef) + (U : unitaryGroup n 𝕜) : + (innerAut U a).PosDef := + (innerAut_posDef_iff U).mpr ha + +theorem _root_.Matrix.PosDef.innerAut {a : Matrix n n 𝕜} + (ha : a.PosDef) (U : unitaryGroup n 𝕜) : + (innerAut U a).PosDef := + Matrix.posDef_innerAut ha U + +open scoped BigOperators + +/-- Every star-algebra equivalence of `Mₙ` is implemented by a unitary conjugation. -/ +theorem _root_.StarAlgEquiv.of_matrix_is_inner + (f : Matrix n n 𝕜 ≃⋆ₐ[𝕜] Matrix n n 𝕜) : + ∃ U : unitaryGroup n 𝕜, innerAutStarAlg U = f := by + by_cases h : IsEmpty n + · haveI := h + use 1 + ext a + have : a = 0 := by simp only [eq_iff_true_of_subsingleton] + simp_rw [this, map_zero] + rw [not_isEmpty_iff] at h + haveI := h + let f' := f.toAlgEquiv + obtain ⟨y', hy⟩ := aut_mat_inner f' + let y := LinearMap.toMatrix' (y'.toLinearMap) + let yinv := LinearMap.toMatrix' y'.symm.toLinearMap + have Hy : y * yinv = 1 ∧ yinv * y = 1 := by + simp_rw [y, yinv, ← LinearMap.toMatrix'_comp, + LinearEquiv.comp_coe, LinearEquiv.symm_trans_self, LinearEquiv.self_trans_symm, + LinearEquiv.refl_toLinearMap, LinearMap.toMatrix'_id, and_self_iff] + have H : y⁻¹ = yinv := inv_eq_left_inv Hy.2 + have hf' : ∀ x : Matrix n n 𝕜, f' x = y * x * y⁻¹ := by + intro x + simp_rw [hy, Algebra.autInner_apply, H] + rfl + have hf : ∀ x : Matrix n n 𝕜, f x = y * x * y⁻¹ := by + intro x + rw [← hf'] + rfl + have hstar : ∀ x : Matrix n n 𝕜, (f x)ᴴ = f xᴴ := + fun _ => (map_star f _).symm + simp_rw [hf, conjTranspose_mul, conjTranspose_nonsing_inv] at hstar + have hcomm_aux : ∀ x : Matrix n n 𝕜, yᴴ * y * xᴴ * y⁻¹ = xᴴ * yᴴ := by + intro x + simp_rw [Matrix.mul_assoc, ← Matrix.mul_assoc y, ← hstar, ← Matrix.mul_assoc, ← + conjTranspose_nonsing_inv, ← conjTranspose_mul, H, Hy.2, Matrix.mul_one] + have hcomm_star : ∀ x : Matrix n n 𝕜, Commute xᴴ (yᴴ * y) := by + intro x + simp_rw [Commute, SemiconjBy, ← Matrix.mul_assoc, ← hcomm_aux, Matrix.mul_assoc, H, + Hy.2, Matrix.mul_one] + have hcomm : ∀ x : Matrix n n 𝕜, Commute x (yᴴ * y) := by + intro x + specialize hcomm_star xᴴ + simp_rw [conjTranspose_conjTranspose] at hcomm_star + exact hcomm_star + obtain ⟨α, hα⟩ := commutes_with_all_iff.mp hcomm + have hpos_semidef : (yᴴ * y).PosSemidef := Matrix.posSemidef_conjTranspose_mul_self y + have hy_unit : IsUnit y := ⟨⟨y, yinv, Hy.1, Hy.2⟩, rfl⟩ + have hunit_yhy : IsUnit (yᴴ * y) := by + simpa [star_eq_conjTranspose] using (isUnit_star.mpr hy_unit).mul hy_unit + have hpos_def := hpos_semidef.posDef_iff_isUnit.mpr hunit_yhy + have hα_re : α = RCLike.re α := by + have hdiag := IsHermitian.coe_re_diag hpos_semidef.1 + simp_rw [hα, diag_smul, diag_one, Pi.smul_apply, Pi.one_apply, smul_eq_mul, mul_one] at hdiag + have hone_ne_zero : (1 : n → 𝕜) ≠ 0 := by + simp_rw [ne_eq, funext_iff, Pi.one_apply, Pi.zero_apply, one_ne_zero] + simp only [Classical.not_forall, not_false_iff, exists_const] + have hsmul : (RCLike.re α : 𝕜) • (1 : n → 𝕜) = α • 1 := by + rw [← hdiag] + ext1 + simp only [Pi.smul_apply, Pi.one_apply, smul_eq_mul, mul_one] + rw [(smul_left_injective _ hone_ne_zero).eq_iff] at hsmul + rw [hsmul] + have hdiag_pos : (diagonal fun _ : n => α).PosDef := by + rw [← Matrix.smul_one_eq_diagonal α, ← hα] + exact hpos_def + have hpositive : 0 < RCLike.re α := by + have hαpos : 0 < α := (Matrix.posDef_diagonal_iff.mp hdiag_pos) h.some + rw [hα_re, RCLike.ofReal_pos] at hαpos + exact hαpos + have hunitary : + (((RCLike.re α : ℝ) ^ (-(1 / 2 : ℝ)) : ℝ) : 𝕜) • y ∈ unitaryGroup n 𝕜 := by + rw [mem_unitaryGroup_iff', star_eq_conjTranspose] + simp_rw [conjTranspose_smul, RCLike.star_def, Matrix.smul_mul, Matrix.mul_smul, + RCLike.conj_ofReal, smul_smul, ← RCLike.ofReal_mul] + rw [← Real.rpow_add hpositive, hα, hα_re, smul_smul, ← RCLike.ofReal_mul, + RCLike.ofReal_re, ← Real.rpow_add_one (NeZero.of_pos hpositive).out] + norm_num + let U : unitaryGroup n 𝕜 := ⟨_, hunitary⟩ + have hU : (U : Matrix n n 𝕜) = + (((RCLike.re α : ℝ) ^ (-(1 / 2 : ℝ)) : ℝ) : 𝕜) • y := rfl + have hU_inv : + ((((RCLike.re α : ℝ) ^ (-(1 / 2 : ℝ)) : ℝ) : 𝕜) • y)⁻¹ = + ((U⁻¹ : _) : Matrix n n 𝕜) := by + apply inv_eq_left_inv + rw [← hU, UnitaryGroup.inv_apply, UnitaryGroup.star_mul_self] + have hscalar_inv : + ((((RCLike.re α : ℝ) ^ (-(1 / 2 : ℝ)) : ℝ) : 𝕜) • y)⁻¹ = + (((RCLike.re α : ℝ) ^ (-(1 / 2 : ℝ)) : ℝ) : 𝕜)⁻¹ • y⁻¹ := by + apply inv_eq_left_inv + simp_rw [Matrix.smul_mul, Matrix.mul_smul, smul_smul] + rw [inv_mul_cancel₀, one_smul, H, Hy.2] + · simp_rw [ne_eq, RCLike.ofReal_eq_zero, Real.rpow_eq_zero_iff_of_nonneg (le_of_lt hpositive), + (NeZero.of_pos hpositive).out, false_and] + exact not_false + use U + ext1 x + simp_rw [innerAutStarAlg_apply_eq_innerAut_apply, innerAut_apply, ← hU_inv, hscalar_inv, hf, + hU, Matrix.smul_mul, Matrix.mul_smul, smul_smul, ← RCLike.ofReal_inv, ← + RCLike.ofReal_mul, ← Real.rpow_neg_one, ← Real.rpow_mul (le_of_lt hpositive), + ← Real.rpow_add hpositive] + norm_num + +/-- A unitary matrix implementing a star-algebra equivalence of full matrix algebras. -/ +noncomputable def _root_.StarAlgEquiv.of_matrix_unitary + (f : Matrix n n 𝕜 ≃⋆ₐ[𝕜] Matrix n n 𝕜) : unitaryGroup n 𝕜 := by + choose U _ using f.of_matrix_is_inner + exact U + +lemma _root_.StarAlgEquiv.eq_innerAut + (f : Matrix n n 𝕜 ≃⋆ₐ[𝕜] Matrix n n 𝕜) : + innerAutStarAlg f.of_matrix_unitary = f := by + rw [StarAlgEquiv.of_matrix_unitary] + generalize_proofs + expose_names + exact pf_1 + +/-- Spectral theorem in Monlib's inner-automorphism notation. -/ +theorem _root_.Matrix.IsHermitian.spectral_theorem'' {x : Matrix n n 𝕜} + (hx : x.IsHermitian) : + x = innerAut hx.eigenvectorUnitary (diagonal (RCLike.ofReal ∘ hx.eigenvalues)) := by + simpa [innerAut, innerAutStarAlg] using hx.spectral_theorem + +theorem _root_.Matrix.diagonal.spectrum {𝕜 n : Type _} [Field 𝕜] [Fintype n] + [DecidableEq n] (A : n → 𝕜) : + spectrum 𝕜 (toLin' (diagonal A : Matrix n n 𝕜)) = {x : 𝕜 | ∃ i : n, A i = x} := by + simp_rw [Set.ext_iff, ← Module.End.hasEigenvalue_iff_mem_spectrum, ← + Module.End.has_eigenvector_iff_hasEigenvalue, toLin'_apply, funext_iff, mulVec, + diagonal_dotProduct, Pi.smul_apply, smul_eq_mul, mul_eq_mul_right_iff, ne_eq, + Set.mem_setOf_eq, funext_iff, Pi.zero_apply, Classical.not_forall] + intro x + constructor + · rintro ⟨v, ⟨h, ⟨j, hj⟩⟩⟩ + specialize h j + rcases h with (h | h) + · exact ⟨j, h⟩ + · contradiction + · rintro ⟨i, hi⟩ + let v : n → 𝕜 := fun j => if j = i then 1 else 0 + use v + simp_rw [v, ite_eq_right_iff, one_ne_zero, imp_false, Classical.not_not] + constructor + · intro j + by_cases h : j = i + · left + rw [h, hi] + · right + exact h + · use i + +theorem _root_.Matrix.IsHermitian.spectrum {x : Matrix n n 𝕜} + (hx : x.IsHermitian) : + spectrum 𝕜 (toLin' x) = {x : 𝕜 | ∃ i : n, (hx.eigenvalues i : 𝕜) = x} := by + nth_rw 1 [Matrix.IsHermitian.spectral_theorem'' hx] + simp_rw [innerAut.spectrum_eq, diagonal.spectrum] + rfl + +theorem _root_.Matrix.IsHermitian.hasEigenvalue_iff {x : Matrix n n 𝕜} + (hx : x.IsHermitian) (α : 𝕜) : + Module.End.HasEigenvalue (toLin' x) α ↔ ∃ i, (hx.eigenvalues i : 𝕜) = α := by + rw [Module.End.hasEigenvalue_iff_mem_spectrum, hx.spectrum, Set.mem_setOf] + +theorem _root_.Matrix.IsAlmostHermitian.schur_decomp {A : Matrix n n 𝕜} + (hA : A.IsAlmostHermitian) : + ∃ (D : n → 𝕜) (U : unitaryGroup n 𝕜), innerAut U (diagonal D) = A := by + rcases hA with ⟨α, B, ⟨rfl, hB⟩⟩ + use α • RCLike.ofReal ∘ hB.eigenvalues, hB.eigenvectorUnitary + simp_rw [diagonal_smul, _root_.map_smul, innerAut_apply, UnitaryGroup.inv_apply] + change α • innerAut hB.eigenvectorUnitary + (diagonal (RCLike.ofReal ∘ hB.eigenvalues)) = α • B + rw [← Matrix.IsHermitian.spectral_theorem'' hB] + +lemma _root_.toEuclideanLin_one : + Matrix.toEuclideanLin (1 : Matrix n n 𝕜) = 1 := by + simp_rw [Matrix.toLpLin_eq_toLin, Matrix.toLin_one] + rfl + +end Positivity + +variable [Field 𝕜] [StarRing 𝕜] [DecidableEq n] + +theorem _root_.Matrix.coe_diagonal_eq_diagonal_coe {n 𝕜 : Type _} [RCLike 𝕜] + [DecidableEq n] (x : n → ℝ) : + (diagonal (RCLike.ofReal ∘ x) : Matrix n n 𝕜) = CoeTC.coe ∘ diagonal x := by + ext i j + change (if i = j then (x i : 𝕜) else 0) = ((if i = j then x i else 0 : ℝ) : 𝕜) + by_cases h : i = j <;> simp [h] + +theorem _root_.Matrix.innerAutStarAlg_equiv_toLinearMap (U : unitaryGroup n 𝕜) : + (innerAutStarAlg U).toAlgEquiv.toLinearMap = innerAut U := + rfl + +theorem _root_.Matrix.innerAutStarAlg_equiv_symm_toLinearMap (U : unitaryGroup n 𝕜) : + (innerAutStarAlg U).symm.toAlgEquiv.toLinearMap = innerAut U⁻¹ := by + ext1 + simp only [innerAut_apply, inv_inv] + rw [UnitaryGroup.inv_apply] + rfl + +theorem _root_.Matrix.innerAut_commutes_with_map_lid_symm (U : Matrix.unitaryGroup n 𝕜) : + TensorProduct.map 1 (innerAut U) ∘ₗ + (TensorProduct.lid 𝕜 (Matrix n n 𝕜)).symm.toLinearMap = + (TensorProduct.lid 𝕜 (Matrix n n 𝕜)).symm.toLinearMap ∘ₗ innerAut U := by + simp_rw [LinearMap.ext_iff, LinearMap.comp_apply, + LinearEquiv.coe_coe, TensorProduct.lid_symm_apply, TensorProduct.map_tmul, + Module.End.one_apply, forall_const] + +theorem _root_.Matrix.innerAut_commutes_with_lid_comm (U : Matrix.unitaryGroup n 𝕜) : + (TensorProduct.lid 𝕜 (Matrix n n 𝕜)).toLinearMap ∘ₗ + (TensorProduct.comm 𝕜 (Matrix n n 𝕜) 𝕜).toLinearMap ∘ₗ + TensorProduct.map (innerAut U) 1 = + innerAut U ∘ₗ + (TensorProduct.lid 𝕜 (Matrix n n 𝕜)).toLinearMap ∘ₗ + (TensorProduct.comm 𝕜 (Matrix n n 𝕜) 𝕜).toLinearMap := by + simp_rw [TensorProduct.ext_iff', LinearMap.comp_apply, TensorProduct.map_apply, + LinearEquiv.coe_coe, TensorProduct.comm_tmul, TensorProduct.lid_tmul, + Module.End.one_apply, _root_.map_smul, forall₂_true_iff] + +theorem _root_.Matrix.innerAut_comp_inj (U : Matrix.unitaryGroup n 𝕜) + (S T : Matrix n n 𝕜 →ₗ[𝕜] Matrix n n 𝕜) : + S = T ↔ innerAut U ∘ₗ S = innerAut U ∘ₗ T := by + simp_rw [LinearMap.ext_iff, LinearMap.comp_apply, innerAut_eq_iff, + innerAut_inv_apply_innerAut_self] + +theorem _root_.Matrix.innerAut_inj_comp (U : unitaryGroup n 𝕜) + (S T : Matrix n n 𝕜 →ₗ[𝕜] Matrix n n 𝕜) : + S = T ↔ S ∘ₗ innerAut U = T ∘ₗ innerAut U := by + refine ⟨fun h => by rw [h], fun h => ?_⟩ + simp_rw [LinearMap.ext_iff, LinearMap.comp_apply] at h ⊢ + intro x + nth_rw 1 [← innerAut_apply_innerAut_inv_self U x] + rw [h, innerAut_apply_innerAut_inv_self] + +theorem _root_.Matrix.innerAut.comp_inj (U : Matrix.unitaryGroup n 𝕜) + (S T : Matrix n n 𝕜 →ₗ[𝕜] Matrix n n 𝕜) : + S = T ↔ innerAut U ∘ₗ S = innerAut U ∘ₗ T := + Matrix.innerAut_comp_inj U S T + +theorem _root_.Matrix.innerAut.inj_comp (U : unitaryGroup n 𝕜) + (S T : Matrix n n 𝕜 →ₗ[𝕜] Matrix n n 𝕜) : + S = T ↔ S ∘ₗ innerAut U = T ∘ₗ innerAut U := + Matrix.innerAut_inj_comp U S T + +section ConjKronecker + +variable {n p 𝕜 : Type _} [RCLike 𝕜] + +theorem _root_.Matrix.unitaryGroup.conj_mem [Fintype n] [DecidableEq n] + (U : unitaryGroup n 𝕜) : + (U : Matrix n n 𝕜)ᴴᵀ ∈ unitaryGroup n 𝕜 := by + rw [Matrix.mem_unitaryGroup_iff] + calc (U : Matrix n n 𝕜)ᴴᵀ * star ((U : Matrix n n 𝕜)ᴴᵀ) + = ((U : Matrix n n 𝕜) * star (U : Matrix n n 𝕜))ᴴᵀ := by + rw [Matrix.conj_mul] + rfl + _ = 1 := by + rw [U.2.2] + simp [Matrix.conj_one] + +/-- Entrywise conjugate of a unitary matrix as a unitary. -/ +def _root_.Matrix.unitaryGroup.conj [Fintype n] [DecidableEq n] + (U : unitaryGroup n 𝕜) : + unitaryGroup n 𝕜 := + ⟨(U : Matrix n n 𝕜)ᴴᵀ, Matrix.unitaryGroup.conj_mem U⟩ + +@[norm_cast] +theorem _root_.Matrix.unitaryGroup.conj_coe [Fintype n] [DecidableEq n] + (U : unitaryGroup n 𝕜) : + (unitaryGroup.conj U : Matrix n n 𝕜) = (U : Matrix n n 𝕜)ᴴᵀ := + rfl + +theorem _root_.Matrix.innerAut.conj [Fintype n] [DecidableEq n] + (U : unitaryGroup n 𝕜) (x : Matrix n n 𝕜) : + (innerAut U x)ᴴᵀ = innerAut (unitaryGroup.conj U) xᴴᵀ := by + simp_rw [innerAut_apply, Matrix.conj_mul, UnitaryGroup.inv_apply, unitaryGroup.conj_coe] + rfl + +theorem _root_.Matrix.UnitaryGroup.mul_star_self [Fintype n] [DecidableEq n] + (U : unitaryGroup n 𝕜) : + (U : Matrix n n 𝕜) * star (U : Matrix n n 𝕜) = 1 := + Matrix.mem_unitaryGroup_iff.mp (SetLike.coe_mem U) + +open scoped Kronecker + +theorem _root_.Matrix.kronecker_mem_unitaryGroup [Fintype n] [DecidableEq n] + [Fintype p] [DecidableEq p] (U₁ : unitaryGroup n 𝕜) (U₂ : unitaryGroup p 𝕜) : + (U₁ : Matrix n n 𝕜) ⊗ₖ (U₂ : Matrix p p 𝕜) ∈ unitaryGroup (n × p) 𝕜 := by + simp_rw [mem_unitaryGroup_iff, star_eq_conjTranspose, kronecker_conjTranspose, ← + mul_kronecker_mul, ← star_eq_conjTranspose, Matrix.UnitaryGroup.mul_star_self, + one_kronecker_one] + +/-- The Kronecker product of two unitary matrices as a unitary matrix. -/ +def _root_.Matrix.unitaryGroup.kronecker [Fintype n] [DecidableEq n] + [Fintype p] [DecidableEq p] (U₁ : unitaryGroup n 𝕜) (U₂ : unitaryGroup p 𝕜) : + unitaryGroup (n × p) 𝕜 := + ⟨(U₁ : Matrix n n 𝕜) ⊗ₖ (U₂ : Matrix p p 𝕜), kronecker_mem_unitaryGroup U₁ U₂⟩ + +theorem _root_.Matrix.unitaryGroup.kronecker_coe [Fintype n] [DecidableEq n] + [Fintype p] [DecidableEq p] (U₁ : unitaryGroup n 𝕜) (U₂ : unitaryGroup p 𝕜) : + (unitaryGroup.kronecker U₁ U₂ : Matrix (n × p) (n × p) 𝕜) = + (U₁ : Matrix n n 𝕜) ⊗ₖ (U₂ : Matrix p p 𝕜) := + rfl + +theorem _root_.Matrix.innerAut_kronecker [Fintype n] [DecidableEq n] + [Fintype p] [DecidableEq p] (U₁ : unitaryGroup n 𝕜) (U₂ : unitaryGroup p 𝕜) + (x : Matrix n n 𝕜) (y : Matrix p p 𝕜) : + innerAut U₁ x ⊗ₖ innerAut U₂ y = innerAut (unitaryGroup.kronecker U₁ U₂) (x ⊗ₖ y) := by + simp_rw [innerAut_apply, UnitaryGroup.inv_apply, unitaryGroup.kronecker_coe, + star_eq_conjTranspose, kronecker_conjTranspose, ← mul_kronecker_mul] + +end ConjKronecker + +end Matrix diff --git a/LeanPool/Monlib4/LinearAlgebra/InvariantSubmodule.lean b/LeanPool/Monlib4/LinearAlgebra/InvariantSubmodule.lean new file mode 100644 index 0000000000..e5bd7f61fb --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/InvariantSubmodule.lean @@ -0,0 +1,202 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import Mathlib.Data.Complex.Basic +import Mathlib.LinearAlgebra.Projection +import Mathlib.LinearAlgebra.TensorProduct.Basic +import Mathlib.Topology.Algebra.StarSubalgebra + +/-! +# Invariant submodules + +This file defines and proves basic results on invariant submodules. +-/ + +namespace Submodule + +variable {E R : Type _} [Ring R] [AddCommGroup E] [Module R E] + +/-- `U` is `T` invariant: `U ≤ U.comap T`. -/ +def InvariantUnder (U : Submodule R E) (T : E →ₗ[R] E) : Prop := + U ≤ U.comap T + +/-- `U` is `T` invariant if and only if `U.map T ≤ U`. -/ +@[simp] +theorem invariantUnder_iff_map (U : Submodule R E) (T : E →ₗ[R] E) : + U.InvariantUnder T ↔ U.map T ≤ U := + Submodule.map_le_iff_le_comap.symm + +/-- `U` is `T` invariant if and only if `Set.MapsTo T U U`. -/ +theorem invariantUnder_iff_mapsTo (U : Submodule R E) (T : E →ₗ[R] E) : + Set.MapsTo T U U ↔ U.InvariantUnder T := + Iff.rfl + +/-- `U` is `T` invariant is equivalent to saying `T(U) ⊆ U`. -/ +theorem invariantUnder_iff (U : Submodule R E) (T : E →ₗ[R] E) : U.InvariantUnder T ↔ T '' U ⊆ U := + by rw [← Set.mapsTo_iff_image_subset, U.invariantUnder_iff_mapsTo] + +variable (U V : Submodule R E) (hUV : IsCompl U V) (T : E →ₗ[R] E) + +local notation "pᵤ" => Submodule.linearProjOfIsCompl U V hUV + +local notation "pᵥ" => Submodule.linearProjOfIsCompl V U hUV.symm + +/-- Projection to `p` along `q` of `x` equals `x` if and only if `x ∈ p`. -/ +theorem linearProjOfIsCompl_eq_self_iff {p q : Submodule R E} (hpq : IsCompl p q) (x : E) : + (p.linearProjOfIsCompl q hpq x : E) = x ↔ x ∈ p := + by + constructor <;> intro H + · rw [← H]; exact Submodule.coe_mem _ + · exact congr_arg _ (Submodule.linearProjOfIsCompl_apply_left hpq ⟨x, H⟩) + +namespace InvariantUnder + +theorem linear_proj_comp_self_eq (h : U.InvariantUnder T) (x : U) : + (pᵤ (T x) : E) = T x := + (linearProjOfIsCompl_eq_self_iff _ _).mpr <| h (coe_mem _) + +end InvariantUnder + +theorem invariantUnderOfLinearProjCompSelfEq (h : ∀ x : U, (pᵤ (T x) : E) = T x) : + U.InvariantUnder T := fun u hu => by + rw [mem_comap, ← linearProjOfIsCompl_eq_self_iff hUV _, ← + (linearProjOfIsCompl_eq_self_iff hUV u).mpr hu, h] + +/-- `U` is invariant under `T` iff `pᵤ ∘ₗ T = T` on `U`. -/ +theorem invariantUnder_iff_linear_proj_comp_self_eq : + U.InvariantUnder T ↔ ∀ x : U, (pᵤ (T x) : E) = T x := + ⟨InvariantUnder.linear_proj_comp_self_eq U V hUV T, + invariantUnderOfLinearProjCompSelfEq U V hUV T⟩ + +theorem linearProjOfIsCompl_eq_self_sub_linear_proj {p q : Submodule R E} (hpq : IsCompl p q) + (x : E) : (q.linearProjOfIsCompl p hpq.symm x : E) = x - (p.linearProjOfIsCompl q hpq x : E) := + by + change Submodule.IsCompl.projection hpq.symm x = x - Submodule.IsCompl.projection hpq x + exact Submodule.IsCompl.projection_eq_self_sub_projection hpq x + +theorem linear_proj_add_linearProjOfIsCompl_eq_self {p q : Submodule R E} (hpq : IsCompl p q) + (x : E) : + (p.linearProjOfIsCompl q hpq x : E) + (q.linearProjOfIsCompl p hpq.symm x : E) = x := by + rw [linearProjOfIsCompl_eq_self_sub_linear_proj hpq, add_comm, sub_add_cancel] + +theorem linearProjOfIsCompl_idempotent {p q : Submodule R E} (hpq : IsCompl p q) : + (p.subtype.comp (p.linearProjOfIsCompl q hpq)) * + (p.subtype.comp (p.linearProjOfIsCompl q hpq)) = + p.subtype.comp (p.linearProjOfIsCompl q hpq) := + IsIdempotentElem.eq (Submodule.IsCompl.projection_isIdempotentElem hpq) + +/-- `V` is invariant under `T` iff `pᵤ ∘ₗ (T ∘ₗ pᵤ) = pᵤ ∘ₗ T`. -/ +theorem invariant_under'_iff_linear_proj_comp_self_comp_linear_proj_eq : + V.InvariantUnder T ↔ ∀ x : E, (pᵤ (T (pᵤ x)) : E) = pᵤ (T x) := by + simp_rw [invariantUnder_iff_linear_proj_comp_self_eq _ _ hUV.symm, + (LinearMap.range_eq_top.1 (linearProjOfIsCompl_range hUV.symm)).forall, + linearProjOfIsCompl_eq_self_sub_linear_proj hUV, map_sub, sub_eq_self, Submodule.coe_sub, + sub_eq_zero, eq_comm] + +/-- Both `U` and `V` are invariant under `T` iff `T` commutes with `pᵤ`. -/ +theorem isCompl_invariantUnder_iff_linear_proj_and_self_commute : + U.InvariantUnder T ∧ V.InvariantUnder T ↔ Commute (U.subtype ∘ₗ pᵤ) T := + by + simp_rw [Commute, SemiconjBy, LinearMap.ext_iff, Module.End.mul_apply, LinearMap.comp_apply, + U.subtype_apply] + constructor + · rintro ⟨h1, h2⟩ x + rw [← (U.invariant_under'_iff_linear_proj_comp_self_comp_linear_proj_eq V _ _).mp h2 x] + exact (linearProjOfIsCompl_eq_self_iff hUV _).mpr (h1 (coe_mem (pᵤ x))) + · intro h + constructor + · rw [U.invariantUnder_iff_linear_proj_comp_self_eq V hUV] + intro x + calc + (pᵤ (T x) : E) = T (pᵤ (x : E)) := h x + _ = T x := by rw [(linearProjOfIsCompl_eq_self_iff hUV _).mpr (SetLike.coe_mem x)] + · rw [U.invariant_under'_iff_linear_proj_comp_self_comp_linear_proj_eq V hUV] + intro x + calc + (pᵤ (T (pᵤ x)) : E) = T (pᵤ (pᵤ x : E)) := h (pᵤ x) + _ = T (pᵤ x) := by + rw [(linearProjOfIsCompl_eq_self_iff hUV _).mpr (SetLike.coe_mem (pᵤ x))] + _ = (pᵤ (T x) : E) := (h x).symm + +/-- `U` is invariant under `T.symm` iff `U ⊆ T(U)`. -/ +theorem invariantUnder_symm_iff_le_map (T : E ≃ₗ[R] E) : + U.InvariantUnder (T.symm : E →ₗ[R] E) ↔ U ≤ U.map (T : E →ₗ[R] E) := by + constructor + · intro h x hx + exact Submodule.mem_map.mpr ⟨T.symm x, h hx, by simp⟩ + · intro h x hx + rcases Submodule.mem_map.mp (h hx) with ⟨y, hy, hyx⟩ + change T.symm x ∈ U + rw [← hyx] + simpa using hy + +theorem commutes_with_linear_proj_iff_linear_proj_eq [Invertible T] : + Commute (U.subtype.comp pᵤ) T ↔ (⅟ T).comp ((U.subtype.comp pᵤ).comp T) = U.subtype.comp pᵤ := + by + rw [Commute, SemiconjBy] + simp_rw [Module.End.mul_eq_comp] + constructor + · intro h + simp_rw [h, ← Module.End.mul_eq_comp, ← mul_assoc, invOf_mul_self, one_mul] + · intro h + rw [← h]; simp_rw [← Module.End.mul_eq_comp, ← mul_assoc, mul_invOf_self] + rw [mul_assoc (⅟ T) _ _] + simp_rw [Module.End.mul_eq_comp, h]; rfl + +theorem invariantUnder_inv_iff_U_subset_image [Invertible T] : + U.InvariantUnder (⅟ T) ↔ ↑U ⊆ T '' U := by + constructor + · intro h x hx + simp only [Set.mem_image, SetLike.mem_coe] + use (⅟ T) x + rw [← LinearMap.comp_apply, ← Module.End.mul_eq_comp, mul_invOf_self, Module.End.one_apply, + eq_self_iff_true, and_true] + exact h hx + · intro h x hx + rw [Submodule.mem_comap] + simp only [Set.subset_def, Set.mem_image] at h + obtain ⟨y, hy⟩ := h x hx + rw [← hy.2, ← LinearMap.comp_apply, ← Module.End.mul_eq_comp, invOf_mul_self] + exact hy.1 + +theorem inv_linear_proj_comp_map_eq_linear_proj_iff_images_eq [Invertible T] : + (⅟ T).comp ((U.subtype.comp pᵤ).comp T) = U.subtype.comp pᵤ ↔ T '' U = U ∧ T '' V = V := + by + simp_rw [← Submodule.commutes_with_linear_proj_iff_linear_proj_eq, ← + isCompl_invariantUnder_iff_linear_proj_and_self_commute, Set.Subset.antisymm_iff] + have Hu : ∀ p q r s, ((p ∧ q) ∧ r ∧ s) = ((p ∧ r) ∧ q ∧ s) := fun _ _ _ _ => + by + simp only [and_assoc, eq_iff_iff, and_congr_right_iff] + simp only [← and_assoc, and_congr_left_iff] + simp only [and_comm]; simp only [imp_true_iff] + rw [Hu] + clear Hu + simp_rw [← Submodule.invariantUnder_iff _ _, iff_self_and, ← + Submodule.invariantUnder_inv_iff_U_subset_image, + isCompl_invariantUnder_iff_linear_proj_and_self_commute U V hUV] + rw [Submodule.commutes_with_linear_proj_iff_linear_proj_eq, Commute, SemiconjBy] + simp_rw [← Module.End.mul_eq_comp] + intro h + rw [← h] + simp_rw [mul_assoc _ _ (⅟ T), mul_invOf_self, h] + rfl + +end Submodule + +namespace StarAlgebra + +theorem centralizer_prod {M : Type _} [AddCommGroup M] [Module ℂ M] + [StarRing (M →ₗ[ℂ] M)] [StarModule ℂ (M →ₗ[ℂ] M)] (A B : StarSubalgebra ℂ (M →ₗ[ℂ] M)) : + (A.carrier ×ˢ B.carrier).centralizer = A.carrier.centralizer ×ˢ B.carrier.centralizer := + by + ext + simp_rw [Set.mem_prod, Set.mem_centralizer_iff, ← forall_and, Set.mem_prod, and_imp, Prod.forall, + Prod.mul_def, Prod.eq_iff_fst_eq_snd_eq, StarSubalgebra.mem_carrier] + exact + ⟨fun h y => ⟨fun hy => (h y 0 hy B.zero_mem').1, fun hy => (h 0 y A.zero_mem' hy).2⟩, + fun h y z hy hz => ⟨(h y).1 hy, (h z).2 hz⟩⟩ + +end StarAlgebra diff --git a/LeanPool/Monlib4/LinearAlgebra/Ips.lean b/LeanPool/Monlib4/LinearAlgebra/Ips.lean new file mode 100644 index 0000000000..cc30bc7fcd --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Ips.lean @@ -0,0 +1,20 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.LinearAlgebra.Ips.Basic +import LeanPool.Monlib4.LinearAlgebra.Ips.Frob +import LeanPool.Monlib4.LinearAlgebra.Ips.Functional +import LeanPool.Monlib4.LinearAlgebra.Ips.Ips +import LeanPool.Monlib4.LinearAlgebra.Ips.MatIps +import LeanPool.Monlib4.LinearAlgebra.Ips.MinimalProj +import LeanPool.Monlib4.LinearAlgebra.Ips.MulOp +import LeanPool.Monlib4.LinearAlgebra.Ips.Nontracial +import LeanPool.Monlib4.LinearAlgebra.Ips.OpUnop +import LeanPool.Monlib4.LinearAlgebra.Ips.Pos +import LeanPool.Monlib4.LinearAlgebra.Ips.RankOne +import LeanPool.Monlib4.LinearAlgebra.Ips.Strict +import LeanPool.Monlib4.LinearAlgebra.Ips.Symm +import LeanPool.Monlib4.LinearAlgebra.Ips.TensorHilbert +import LeanPool.Monlib4.LinearAlgebra.Ips.Vn diff --git a/LeanPool/Monlib4/LinearAlgebra/Ips/Basic.lean b/LeanPool/Monlib4/LinearAlgebra/Ips/Basic.lean new file mode 100644 index 0000000000..b6eadc5878 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Ips/Basic.lean @@ -0,0 +1,205 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.LinearAlgebra.Ips.Symm +import LeanPool.Monlib4.Preq.RCLikeLe + +/-! + +# Some obvious basic properties on inner product space + +This files provides some useful and obvious results for linear maps and continuous linear maps. + +-/ + +theorem _root_.ext_inner_left_iff {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] (x y : E) : + x = y ↔ ∀ v : E, inner 𝕜 x v = inner 𝕜 y v := + by + constructor + · intro h v + simp_rw [h] + · rw [← sub_eq_zero, ← @inner_self_eq_zero 𝕜, inner_sub_left, sub_eq_zero] + intro h; exact h _ + +theorem inner_self_re {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] + (x : E) : (RCLike.re (inner 𝕜 x x) : 𝕜) = inner 𝕜 x x := by simp only [inner_self_ofReal_re] + +theorem forall_inner_eq_zero_iff {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] (x : E) : (∀ y, inner 𝕜 x y = 0) ↔ x = 0 := + by + refine ⟨fun h => ?_, fun h y => by rw [h, inner_zero_left]⟩ + specialize h x + rw [inner_self_eq_zero] at h + exact h + +open RCLike ContinuousLinearMap +open scoped InnerProductSpace + +variable {E : Type*} [NormedAddCommGroup E] + +/-- linear maps $p,q$ are equal if and only if + $\langle p x, x \rangle = \langle q x, x \rangle$ for any $x$. -/ +theorem LinearMap.ext_iff_inner_map [InnerProductSpace ℂ E] (p q : E →ₗ[ℂ] E) : + p = q ↔ ∀ x : E, inner ℂ (p x) x = inner ℂ (q x) x := + by + constructor + · intro h + simp_rw [h, forall_const] + · intro h + rw [← sub_eq_zero, ← inner_map_self_eq_zero] + simp_rw [LinearMap.sub_apply, inner_sub_left, h, sub_self, forall_const] + +/-- copy of `linear_map.ext_iff_inner_map` but for continuous linear maps -/ +theorem ContinuousLinearMap.ext_iff_inner_map [InnerProductSpace ℂ E] (p q : E →L[ℂ] E) : + p = q ↔ ∀ x : E, ⟪p x, x⟫_ℂ = ⟪q x, x⟫_ℂ := by + simp_rw [← ContinuousLinearMap.coe_coe, ← LinearMap.ext_iff_inner_map, coe_inj] + +/-- Self-adjoint linear operators $p,q$ are equal if and only if + $\langle p x, x \rangle_\mathbb{k} = \langle q x, x \rangle_\mathbb{k}$. -/ +theorem ContinuousLinearMap.IsSelfAdjoint.ext_iff_inner_map {E 𝕜 : Type _} [RCLike 𝕜] + [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] [CompleteSpace E] {p q : E →L[𝕜] E} + (hp : IsSelfAdjoint p) (hq : IsSelfAdjoint q) : + p = q ↔ ∀ x : E, @inner 𝕜 _ _ (p x) x = @inner 𝕜 _ _ (q x) x := + by + rw [← sub_eq_zero, ← IsSelfAdjoint.inner_map_self_eq_zero (hp.sub hq)] + simp_rw [sub_apply, inner_sub_left, sub_eq_zero] + +section RCLike + +variable {𝕜 : Type _} [RCLike 𝕜] + +/-- in a complex inner product space, we have + that an operator $a$ is self-adjoint if and only if + $\langle a x, x \rangle_\mathbb{C}$ is real for all $x \in E$ -/ +theorem isSelfAdjoint_iff_complex_inner_re_eq [InnerProductSpace ℂ E] [CompleteSpace E] + {a : E →L[ℂ] E} : IsSelfAdjoint a ↔ ∀ x : E, (re ⟪a x, x⟫_ℂ : ℂ) = ⟪a x, x⟫_ℂ := by + simp_rw [re_to_complex, ← Complex.conj_eq_iff_re, inner_conj_symm, isSelfAdjoint_iff', + ContinuousLinearMap.ext_iff_inner_map (adjoint a) a, adjoint_inner_left] + +local notation "⟪" x "," y "⟫" => @inner 𝕜 _ _ x y + +/-- the adjoint of a self-adjoint operator is self-adjoint -/ +theorem IsSelfAdjoint.adjoint [InnerProductSpace 𝕜 E] [CompleteSpace E] {a : E →L[𝕜] E} + (ha : IsSelfAdjoint a) : IsSelfAdjoint (adjoint a) := + congr_arg star ha + +/-- for a self-adjoint operator $a$, we have $\langle a x, x \rangle_\mathbb{k}$ is real -/ +theorem IsSelfAdjoint.inner_re_eq {E : Type _} [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] [CompleteSpace E] {a : E →L[𝕜] E} + (ha : IsSelfAdjoint a) (x : E) : + (re ⟪a x,x⟫ : 𝕜) = ⟪a x,x⟫ := + by + rcases@I_mul_I_ax 𝕜 _ with (h | _) + · rw [← re_add_im ⟪a x,x⟫] + simp_rw [h, MulZeroClass.mul_zero, add_zero] + norm_cast + · simp_rw [← conj_eq_iff_re, inner_conj_symm] + have ha' := ha + simp_rw [isSelfAdjoint_iff', + ContinuousLinearMap.IsSelfAdjoint.ext_iff_inner_map ha.adjoint ha, adjoint_inner_left] at ha' + exact ha' x + +end RCLike + +/-- copy of `inner_map_self_eq_zero` for bounded linear maps -/ +theorem ContinuousLinearMap.inner_map_self_eq_zero [InnerProductSpace ℂ E] {p : E →L[ℂ] E} : + (∀ x : E, ⟪p x, x⟫_ℂ = 0) ↔ p = 0 := + by + simp_rw [ContinuousLinearMap.ext_iff, ← ContinuousLinearMap.coe_coe, + ← LinearMap.ext_iff, coe_zero] + exact @_root_.inner_map_self_eq_zero E _ _ _ + +theorem ContinuousLinearMap.adjoint_smul {K E₁ E₂ : Type _} [RCLike K] [NormedAddCommGroup E₁] + [NormedAddCommGroup E₂] + [InnerProductSpace K E₁] [InnerProductSpace K E₂] [CompleteSpace E₁] [CompleteSpace E₂] + (φ : E₁ →L[K] E₂) (a : K) : + adjoint (a • φ) = starRingEnd K a • adjoint φ := by + ext x + apply ext_inner_left K + intro y + simp_rw [adjoint_inner_right, smul_apply, inner_smul_left, inner_smul_right, adjoint_inner_right] + +theorem LinearMap.adjoint_smul {K E₁ E₂ : Type _} [RCLike K] [NormedAddCommGroup E₁] + [NormedAddCommGroup E₂] + [InnerProductSpace K E₁] [InnerProductSpace K E₂] [FiniteDimensional K E₁] + [FiniteDimensional K E₂] (φ : E₁ →ₗ[K] E₂) (a : K) : + adjoint (a • φ) = starRingEnd K a • adjoint φ := + by + have := + @ContinuousLinearMap.adjoint_smul K E₁ E₂ _ _ _ _ _ + (FiniteDimensional.complete K E₁) (FiniteDimensional.complete K E₂) + (toContinuousLinearMap φ) a + simp_rw [← LinearMap.adjoint_toContinuousLinearMap] at this + rw [LinearMap.adjoint_eq_toCLM_adjoint, _root_.map_smul, this] + rfl + +theorem LinearMap.adjoint_one {K E : Type _} [RCLike K] [NormedAddCommGroup E] + [InnerProductSpace K E] [FiniteDimensional K E] : adjoint (1 : E →ₗ[K] E) = 1 := + star_one _ + + +variable {𝕜 : Type*} [RCLike 𝕜] +open scoped ComplexOrder +lemma inner_self_nonneg' {E : Type _} [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] {x : E} : + 0 ≤ ⟪x, x⟫_𝕜 := +by +simp_rw [@RCLike.nonneg_def 𝕜, inner_self_nonneg, true_and, inner_self_im] + +lemma inner_self_nonpos' {E : Type _} [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] {x : E} : + ⟪x, x⟫_𝕜 ≤ 0 ↔ x = 0 := +by +simp_rw [@RCLike.nonpos_def 𝕜, re_inner_self_nonpos, inner_self_im, and_true] + + +lemma _root_.isometry_iff_norm {E F : Type _} [SeminormedAddCommGroup E] + [SeminormedAddCommGroup F] + {e : Type*} [FunLike e E F] + [AddMonoidHomClass e E F] + (f : e) : + Isometry f ↔ ∀ x, ‖f x‖ = ‖x‖ := +by + rw [isometry_iff_dist_eq] + simp_rw [dist_eq_norm, ← map_sub] + constructor + · intro h x + specialize h x 0 + simp_rw [sub_zero] at h + exact h + · intro h x y + exact h _ +lemma _root_.isometry_iff_norm' {E F : Type _} [_root_.NormedAddCommGroup E] + [_root_.NormedAddCommGroup F] {e : Type*} [FunLike e E F] + [AddMonoidHomClass e E F] (f : e) : + Isometry f ↔ ∀ x, ‖f x‖ = ‖x‖ := +isometry_iff_norm _ +lemma _root_.isometry_iff_inner {R E F : Type _} [RCLike R] + [_root_.NormedAddCommGroup E] [_root_.NormedAddCommGroup F] + [_root_.InnerProductSpace R E] [_root_.InnerProductSpace R F] + {M : Type*} [FunLike M E F] [LinearMapClass M R E F] + (f : M) : + Isometry f ↔ ∀ x y, ⟪f x, f y⟫_R = ⟪x, y⟫_R := +by + rw [isometry_iff_dist_eq] + simp_rw [dist_eq_norm, ← map_sub] + constructor + · simp_rw [inner_eq_sum_norm_sq_div_four, ← _root_.map_smul, ← map_add, ← map_sub] + intro h x y + have := fun x => h x 0 + simp_rw [sub_zero] at this + simp_rw [this] + · intro h x y + simp_rw [@norm_eq_sqrt_re_inner R, h] +lemma _root_.isometry_iff_inner_norm' + {R E F : Type _} [RCLike R] [_root_.NormedAddCommGroup E] [_root_.NormedAddCommGroup F] + [_root_.InnerProductSpace R E] [_root_.InnerProductSpace R F] + {M : Type*} [FunLike M E F] [LinearMapClass M R E F] (f : M) : + (∀ x, ‖f x‖ = ‖x‖) ↔ ∀ x y, ⟪f x, f y⟫_R = ⟪x, y⟫_R := +by rw [← isometry_iff_inner, isometry_iff_norm] + +lemma _root_.seminormedAddGroup_norm_eq_norm_NormedAddCommGroup + {E : Type _} [_root_.NormedAddCommGroup E] (x : E) : + @norm E SeminormedAddGroup.toNorm x = @norm E _root_.NormedAddCommGroup.toNorm x := +rfl diff --git a/LeanPool/Monlib4/LinearAlgebra/Ips/Frob.lean b/LeanPool/Monlib4/LinearAlgebra/Ips/Frob.lean new file mode 100644 index 0000000000..fafb2d3fd5 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Ips/Frob.lean @@ -0,0 +1,433 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.LinearAlgebra.Ips.TensorHilbert +import LeanPool.Monlib4.LinearAlgebra.Ips.Nontracial +import LeanPool.Monlib4.LinearAlgebra.DirectSumFromTo +import LeanPool.Monlib4.LinearAlgebra.PiDirectSum +import LeanPool.Monlib4.LinearAlgebra.Coalgebra.FiniteDimensional + +/-! + # Frobenius equations + + This file contains the proof of the Frobenius equations. +-/ + + +variable {n p : Type _} [Fintype n] [Fintype p] [DecidableEq n] [DecidableEq p] + {φ : Module.Dual ℂ (Matrix n n ℂ)} (hφ : φ.IsFaithfulPosMap) {ψ : Module.Dual ℂ (Matrix p p ℂ)} + (hψ : ψ.IsFaithfulPosMap) {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Fintype (s i)] [∀ i, DecidableEq (s i)] {θ : ∀ i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} + [hθ : ∀ i, (θ i).IsFaithfulPosMap] + +open scoped Matrix Kronecker TensorProduct BigOperators Functional InnerProductSpace + +open Matrix + +-- def linear_map.is_faithful_pos_map.tensor_pow (x : ℕ) : +-- ⨂[ℂ]^x (matrix n n ℂ) →ₗ[ℂ] ℂ := +-- { to_fun := fun a, by { simp only [tensor_algebra] } } +/-- Tensor product of two matrix-valued module dual functionals. -/ +noncomputable def Module.Dual.tensorMul {n p : Type _} (φ₁ : Module.Dual ℂ (Matrix n n ℂ)) + (φ₂ : Module.Dual ℂ (Matrix p p ℂ)) : Module.Dual ℂ (Matrix n n ℂ ⊗[ℂ] Matrix p p ℂ) := + (TensorProduct.lid ℂ ℂ : ℂ ⊗[ℂ] ℂ →ₗ[ℂ] ℂ) ∘ₗ TensorProduct.map φ₁ φ₂ + +omit [Fintype n] [Fintype p] [DecidableEq n] [DecidableEq p] in +theorem Module.Dual.tensorMul_apply (φ₁ : Module.Dual ℂ (Matrix n n ℂ)) + (φ₂ : Module.Dual ℂ (Matrix p p ℂ)) (x : Matrix n n ℂ) (y : Matrix p p ℂ) : + (φ₁.tensorMul φ₂) (x ⊗ₜ[ℂ] y) = φ₁ x * φ₂ y := + rfl + +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j k l) -/ +theorem Module.Dual.tensorMul_apply' (φ₁ : Module.Dual ℂ (Matrix n n ℂ)) + (φ₂ : Module.Dual ℂ (Matrix p p ℂ)) (x : Matrix n n ℂ ⊗[ℂ] Matrix p p ℂ) : + φ₁.tensorMul φ₂ x = + ∑ i, ∑ j, ∑ k, ∑ l, + (TensorProduct.toKronecker x) (i, k) (j, l) * + (φ₁ (stdBasisMatrix i j (1 : ℂ)) * φ₂ (stdBasisMatrix k l (1 : ℂ))) := + by + simp_rw [← Module.Dual.tensorMul_apply, ← smul_eq_mul, ← _root_.map_smul, ← map_sum] + rw [← x.matrix_eq_sum_std_basis] + +theorem Module.Dual.tensorMul_apply'' (φ₁ : Module.Dual ℂ (Matrix n n ℂ)) + (φ₂ : Module.Dual ℂ (Matrix p p ℂ)) (a : Matrix (n × p) (n × p) ℂ) : + ((φ₁.tensorMul φ₂).comp kroneckerToTensorProduct) a = (φ₁.matrix ⊗ₖ φ₂.matrix * a).trace := + by + have : + (φ₁.matrix ⊗ₖ φ₂.matrix * a).trace = + ((traceLinearMap _ ℂ ℂ).comp (LinearMap.mulLeft ℂ (φ₁.matrix ⊗ₖ φ₂.matrix))) a := + rfl + simp_rw [this] + clear this + revert a + rw [← LinearMap.ext_iff, KroneckerProduct.ext_iff] + intro x y + simp_rw [LinearMap.comp_apply, kroneckerToTensorProduct_apply, Module.Dual.tensorMul_apply, + LinearMap.mulLeft_apply, traceLinearMap_apply, ← mul_kronecker_mul, + trace_kronecker, Module.Dual.apply] + +theorem Module.Dual.tensorMul_matrix (φ₁ : Module.Dual ℂ (Matrix n n ℂ)) + (φ₂ : Module.Dual ℂ (Matrix p p ℂ)) : + Module.Dual.matrix ((φ₁.tensorMul φ₂).comp kroneckerToTensorProduct) = φ₁.matrix ⊗ₖ φ₂.matrix := + by + symm + apply Module.Dual.apply_eq_of + simp_rw [← Module.Dual.tensorMul_apply'' φ₁ φ₂] + intros + trivial + +/-- Tensor products of faithful positive matrix functionals are faithful and positive. -/ +theorem Module.Dual.IsFaithfulPosMap.tensorMul {φ₁ : Module.Dual ℂ (Matrix n n ℂ)} + {φ₂ : Module.Dual ℂ (Matrix p p ℂ)} [hφ₁ : φ₁.IsFaithfulPosMap] + [hφ₂ : φ₂.IsFaithfulPosMap] : + (Module.Dual.IsFaithfulPosMap ((φ₁.tensorMul φ₂).comp kroneckerToTensorProduct)) := + by + rw [Module.Dual.isFaithfulPosMap_iff_of_matrix, Module.Dual.tensorMul_matrix] + exact PosDef.kronecker hφ₁.matrixIsPosDef hφ₂.matrixIsPosDef + +attribute [instance] Module.Dual.IsFaithfulPosMap.tensorMul + +theorem Matrix.kroneckerToTensorProduct_adjoint [hφ : φ.IsFaithfulPosMap] + [hψ : ψ.IsFaithfulPosMap] :-- = + -- @linear_map.adjoint ℂ (matrix (n × p) (n × p) ℂ) (matrix n n ℂ ⊗[ℂ] matrix p p ℂ) _ + -- (nacg_th hφ hψ) (nacg_tt hφ hψ) (ips_th hφ hψ) (ips_tt hφ hψ) _ _ + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup φ + letI : _root_.SeminormedAddCommGroup (Matrix n n ℂ) := + (Module.Dual.NormedAddCommGroup φ).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := Module.Dual.InnerProductSpace φ + letI : _root_.NormedAddCommGroup (Matrix p p ℂ) := Module.Dual.NormedAddCommGroup ψ + letI : _root_.SeminormedAddCommGroup (Matrix p p ℂ) := + (Module.Dual.NormedAddCommGroup ψ).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (Matrix p p ℂ) := Module.Dual.InnerProductSpace ψ + letI : _root_.NormedAddCommGroup (Matrix (n × p) (n × p) ℂ) := + Module.Dual.NormedAddCommGroup ((φ.tensorMul ψ).comp kroneckerToTensorProduct) + letI : _root_.SeminormedAddCommGroup (Matrix (n × p) (n × p) ℂ) := + (Module.Dual.NormedAddCommGroup + ((φ.tensorMul ψ).comp kroneckerToTensorProduct)).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (Matrix (n × p) (n × p) ℂ) := + Module.Dual.InnerProductSpace ((φ.tensorMul ψ).comp kroneckerToTensorProduct) + (@TensorProduct.toKronecker ℂ n p _ _ _ _ _ : + Matrix n n ℂ ⊗[ℂ] Matrix p p ℂ →ₗ[ℂ] Matrix (n × p) (n × p) ℂ) = + LinearMap.adjoint (kroneckerToTensorProduct : + Matrix (n × p) (n × p) ℂ →ₗ[ℂ] Matrix n n ℂ ⊗[ℂ] Matrix p p ℂ) := + by + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup φ + letI : _root_.SeminormedAddCommGroup (Matrix n n ℂ) := + (Module.Dual.NormedAddCommGroup φ).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := Module.Dual.InnerProductSpace φ + letI : _root_.NormedAddCommGroup (Matrix p p ℂ) := Module.Dual.NormedAddCommGroup ψ + letI : _root_.SeminormedAddCommGroup (Matrix p p ℂ) := + (Module.Dual.NormedAddCommGroup ψ).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (Matrix p p ℂ) := Module.Dual.InnerProductSpace ψ + letI : _root_.NormedAddCommGroup (Matrix (n × p) (n × p) ℂ) := + Module.Dual.NormedAddCommGroup ((φ.tensorMul ψ).comp kroneckerToTensorProduct) + letI : _root_.SeminormedAddCommGroup (Matrix (n × p) (n × p) ℂ) := + (Module.Dual.NormedAddCommGroup + ((φ.tensorMul ψ).comp kroneckerToTensorProduct)).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (Matrix (n × p) (n × p) ℂ) := + Module.Dual.InnerProductSpace ((φ.tensorMul ψ).comp kroneckerToTensorProduct) + rw [TensorProduct.ext_iff'] + intro x y + apply @ext_inner_left ℂ _ _ + intro a + rw [TensorProduct.toKronecker_apply, LinearMap.adjoint_inner_right, Matrix.kmul_representation a] + simp_rw [map_sum, _root_.map_smul, sum_inner, inner_smul_left] + apply Finset.sum_congr rfl + intros x_1 _ + apply Finset.sum_congr rfl + intros x_2 _ + apply Finset.sum_congr rfl + intros x_3 _ + apply Finset.sum_congr rfl + intros x_4 _ + symm + calc + (starRingEnd ℂ) (a (x_1, x_3) (x_2, x_4)) * + (⟪(kroneckerToTensorProduct + (stdBasisMatrix x_1 x_2 (1 : ℂ) ⊗ₖ stdBasisMatrix x_3 x_4 (1 : ℂ))), + x ⊗ₜ[ℂ] y⟫_ℂ) = + (starRingEnd ℂ) (a (x_1, x_3) (x_2, x_4)) * + (⟪(stdBasisMatrix x_1 x_2 (1 : ℂ) ⊗ₜ[ℂ] stdBasisMatrix x_3 x_4 (1 : ℂ)), + x ⊗ₜ[ℂ] y⟫_ℂ) := + by rw [kroneckerToTensorProduct_apply] + _ = + (starRingEnd ℂ) (a (x_1, x_3) (x_2, x_4)) * + (⟪stdBasisMatrix x_1 x_2 (1 : ℂ), x⟫_ℂ * + ⟪stdBasisMatrix x_3 x_4 (1 : ℂ), y⟫_ℂ) := + by rw [TensorProduct.inner_tmul] + _ = + (starRingEnd ℂ) (a (x_1, x_3) (x_2, x_4)) * + (⟪(stdBasisMatrix x_1 x_2 (1 : ℂ) ⊗ₖ stdBasisMatrix x_3 x_4 (1 : ℂ)), + x ⊗ₖ y⟫_ℂ) := + by + rw [Module.Dual.IsFaithfulPosMap.inner_eq' _ + ((stdBasisMatrix x_1 x_2 (1 : ℂ)) ⊗ₖ (stdBasisMatrix x_3 x_4 (1 : ℂ))) (x ⊗ₖ y), + Module.Dual.tensorMul_matrix, kronecker_conjTranspose, ← mul_kronecker_mul, + ← mul_kronecker_mul, trace_kronecker, + Module.Dual.IsFaithfulPosMap.inner_eq', Module.Dual.IsFaithfulPosMap.inner_eq'] + +theorem TensorProduct.toKronecker_adjoint [hφ : φ.IsFaithfulPosMap] + [hψ : ψ.IsFaithfulPosMap] : + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup φ + letI : _root_.SeminormedAddCommGroup (Matrix n n ℂ) := + (Module.Dual.NormedAddCommGroup φ).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := Module.Dual.InnerProductSpace φ + letI : _root_.NormedAddCommGroup (Matrix p p ℂ) := Module.Dual.NormedAddCommGroup ψ + letI : _root_.SeminormedAddCommGroup (Matrix p p ℂ) := + (Module.Dual.NormedAddCommGroup ψ).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (Matrix p p ℂ) := Module.Dual.InnerProductSpace ψ + letI : _root_.NormedAddCommGroup (Matrix (n × p) (n × p) ℂ) := + Module.Dual.NormedAddCommGroup ((φ.tensorMul ψ).comp kroneckerToTensorProduct) + letI : _root_.SeminormedAddCommGroup (Matrix (n × p) (n × p) ℂ) := + (Module.Dual.NormedAddCommGroup + ((φ.tensorMul ψ).comp kroneckerToTensorProduct)).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (Matrix (n × p) (n × p) ℂ) := + Module.Dual.InnerProductSpace ((φ.tensorMul ψ).comp kroneckerToTensorProduct) + (kroneckerToTensorProduct : Matrix (n × p) (n × p) ℂ →ₗ[ℂ] Matrix n n ℂ ⊗[ℂ] Matrix p p ℂ) = + LinearMap.adjoint (@TensorProduct.toKronecker ℂ n p _ _ _ _ _ : + Matrix n n ℂ ⊗[ℂ] Matrix p p ℂ →ₗ[ℂ] Matrix (n × p) (n × p) ℂ) := + by + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup φ + letI : _root_.SeminormedAddCommGroup (Matrix n n ℂ) := + (Module.Dual.NormedAddCommGroup φ).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := Module.Dual.InnerProductSpace φ + letI : _root_.NormedAddCommGroup (Matrix p p ℂ) := Module.Dual.NormedAddCommGroup ψ + letI : _root_.SeminormedAddCommGroup (Matrix p p ℂ) := + (Module.Dual.NormedAddCommGroup ψ).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (Matrix p p ℂ) := Module.Dual.InnerProductSpace ψ + letI : _root_.NormedAddCommGroup (Matrix (n × p) (n × p) ℂ) := + Module.Dual.NormedAddCommGroup ((φ.tensorMul ψ).comp kroneckerToTensorProduct) + letI : _root_.SeminormedAddCommGroup (Matrix (n × p) (n × p) ℂ) := + (Module.Dual.NormedAddCommGroup + ((φ.tensorMul ψ).comp kroneckerToTensorProduct)).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (Matrix (n × p) (n × p) ℂ) := + Module.Dual.InnerProductSpace ((φ.tensorMul ψ).comp kroneckerToTensorProduct) + rw [@Matrix.kroneckerToTensorProduct_adjoint n p _ _ _ _ φ ψ hφ hψ, LinearMap.adjoint_adjoint] + +theorem Matrix.kroneckerToTensorProduct_comp_toKronecker : + (kroneckerToTensorProduct : Matrix (n × p) (n × p) ℂ →ₗ[ℂ] _).comp + (TensorProduct.toKronecker : Matrix n n ℂ ⊗[ℂ] Matrix p p ℂ →ₗ[ℂ] _) = + 1 := + by + rw [TensorProduct.ext_iff'] + intro x y + simp_rw [LinearMap.comp_apply, TensorProduct.toKronecker_to_tensorProduct, Module.End.one_apply] + +local notation "ℍ" => Matrix n n ℂ + +local notation "ℍ_" i => Matrix (s i) (s i) ℂ + +local notation x " ⊗ₘ " y => TensorProduct.map x y + +local notation "id" => (1 : Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ) + +-- @[default_instance] +/-- The normed additive group of matrices induced by a faithful positive functional. -/ +@[reducible] +noncomputable def Module.Dual.isNormedAddCommGroupOfRing {n : Type _} [Fintype n] + [DecidableEq n] (ψ : Module.Dual ℂ (Matrix n n ℂ)) [ψ.IsFaithfulPosMap] : + NormedAddCommGroupOfRing (Matrix n n ℂ) + where + toNorm := (Module.Dual.NormedAddCommGroup ψ).toNorm + toMetricSpace := (Module.Dual.NormedAddCommGroup ψ).toMetricSpace + dist_eq := (Module.Dual.NormedAddCommGroup ψ).dist_eq + +-- @[default_instance] +/-- The normed additive commutative group structure induced by faithful block functionals. -/ +@[reducible] +noncomputable def Pi.module.Dual.isNormedAddCommGroupOfRing + (ψ : ∀ i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)) [∀ i, (ψ i).IsFaithfulPosMap] : + NormedAddCommGroupOfRing (PiMat ℂ k s) + where + toNorm := (Module.Dual.PiNormedAddCommGroup (φ := ψ)).toNorm + toMetricSpace := (Module.Dual.PiNormedAddCommGroup (φ := ψ)).toMetricSpace + dist_eq := (Module.Dual.PiNormedAddCommGroup (φ := ψ)).dist_eq + +-- @[default_instance] +-- noncomputable +-- def Pi.module.Dual.isNormedAddCommGroupOfStarRing +-- {ψ : ∀ i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} [∀ i, (ψ i).IsFaithfulPosMap] : +-- NormedAddCommGroupOfStarRing (PiMat ℂ k s) where +-- toNormedAddCommGroupOfRing := Pi.module.Dual.isNormedAddCommGroupOfRing ψ +-- set_option synthInstance.checkSynthOrder false in +-- scoped[Functional] attribute [instance] Module.Dual.isNormedAddCommGroupOfStarRing + +-- theorem Module.Dual.inner_eq_counit (φ : Module.Dual ℂ (Matrix n n ℂ)) [hφ : φ.IsFaithfulPosMap] +-- (x y : ℍ) : +-- ⟪x, y⟫_ℂ = Coalgebra.counit (star x * y) := +-- by +-- simp_rw [Coalgebra.counit, Module.Dual.IsFaithfulPosMap.inner_eq, +-- ← Nontracial.unit_adjoint_eq, star_eq_conjTranspose] +-- congr 2 +-- rw [LinearMap.ext_iff] +-- intro +-- simp_rw [Algebra.linearMap_apply, Algebra.algebraMap_eq_smul_one] +-- theorem Module.Dual.pi.inner_eq_counit (ψ : Π i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)) +-- [hψ : ∀ i, (ψ i).IsFaithfulPosMap] (x y : PiMat ℂ k s) : +-- ⟪x, y⟫_ℂ = Coalgebra.counit (star x * y) := +-- by +-- simp_rw [Coalgebra.counit, Module.Dual.pi.IsFaithfulPosMap.inner_eq, +-- ← Nontracial.Pi.unit_adjoint_eq] +-- congr 2 +-- rw [LinearMap.ext_iff] +-- intro +-- simp_rw [Algebra.linearMap_apply, Algebra.algebraMap_eq_smul_one] + +-- set_option maxHeartbeats 400000 in +-- -- set_option synthInstance.maxHeartbeats 0 in +-- theorem frobenius_equation [hφ : φ.IsFaithfulPosMap] : +-- (LinearMap.mul' ℂ ℍ ⊗ₘ id) ∘ₗ (υ⁻¹) ∘ₗ (id ⊗ₘ (LinearMap.adjoint (LinearMap.mul' ℂ ℍ))) = +-- (LinearMap.adjoint (LinearMap.mul' ℂ ℍ)) ∘ₗ LinearMap.mul' ℂ ℍ := +-- by +-- apply Coalgebra.rTensor_mul_comp_lTensor_mul_adjoint +-- (Module.Dual.inner_eq_counit φ) + +local notation "l(" x ")" => x →ₗ[ℂ] x + +open scoped BigOperators + +/-- Linear map from one matrix summand to another in a direct product of matrix blocks. -/ +noncomputable def matrixDirectSumFromTo + (i j : k) :-- {k : Type*} [decidable_eq k] {s : k → Type*} + -- [Π i, fintype (s i)] [Π i, decidable_eq (s i)] + -- (i j : k) : + Matrix + (s i) (s i) ℂ →ₗ[ℂ] + Matrix (s j) (s j) ℂ := + @directSumFromTo ℂ _ k _ (fun a => Matrix (s a) (s a) ℂ) _ (fun _ => Matrix.module) i j + +omit [Fintype k] [(i : k) → Fintype (s i)] [(i : k) → DecidableEq (s i)] in +theorem matrixDirectSumFromTo_same (i : k) : + (matrixDirectSumFromTo i i : Matrix (s i) (s i) ℂ →ₗ[ℂ] _) = 1 := + directSumFromTo_apply_same _ + +-- set_option maxHeartbeats 0 in +-- set_option synthInstance.maxHeartbeats 0 in +open scoped Classical in +omit [Fintype k] [(i : k) → DecidableEq (s i)] in +theorem LinearMap.pi_mul'_apply_includeBlock' {i j : k} : + letI : ∀ i, DecidableEq (s i) := fun i => Classical.decEq (s i) + (LinearMap.mul' ℂ (PiMat ℂ k s)) ∘ₗ + (TensorProduct.map (includeBlock : (ℍ_ i) →ₗ[ℂ] (PiMat ℂ k s)) (includeBlock : + (ℍ_ j) →ₗ[ℂ] (PiMat ℂ k s))) = + if i = j then + (includeBlock : (ℍ_ j) →ₗ[ℂ] (PiMat ℂ k s)) ∘ₗ + (LinearMap.mul' ℂ (ℍ_ j)) ∘ₗ + (TensorProduct.map (matrixDirectSumFromTo i j) (1 : (ℍ_ j) →ₗ[ℂ] ℍ_ j)) + else 0 := + by + classical + rw [TensorProduct.ext_iff'] + intro x y + rw [funext_iff] + intro a + simp only [LinearMap.comp_apply, TensorProduct.map_tmul, LinearMap.mul'_apply, + includeBlock_apply, Pi.mul_apply, dite_hMul, hMul_dite, MulZeroClass.mul_zero, + MulZeroClass.zero_mul, ite_apply_lm, LinearMap.zero_apply, ite_apply, Pi.zero_apply, + Module.End.one_apply] + by_cases h : j = a + · simp_rw [matrixDirectSumFromTo, directSumFromTo, LinearMap.comp_apply] + simp [Pi.single, Function.update, h] + split_ifs <;> aesop + · simp [h] + +/-- Linear equivalence splitting the tensor product of matrix-block products into block tensor + products. -/ +noncomputable def directSumTensorMatrix : + ((PiMat ℂ k s) ⊗[ℂ] PiMat ℂ k s) ≃ₗ[ℂ] + Π i : k × k, (ℍ_ i.1) ⊗[ℂ] ℍ_ i.2 := + @directSumTensor ℂ _ k k _ _ _ _ (fun i => Matrix (s i) (s i) ℂ) (fun i => Matrix (s i) (s i) ℂ) _ + _ (fun _ => Matrix.module) fun _ => Matrix.module + +@[simp] +theorem Module.Dual.IsFaithfulPosMap.sig_apply' [hφ : φ.IsFaithfulPosMap] {r : ℝ} + {x : ℍ} : hφ.sig r x = hφ.matrixIsPosDef.rpow (-r) * x * hφ.matrixIsPosDef.rpow r := +rfl + +-- theorem frobenius_equation' [hφ : φ.IsFaithfulPosMap] : +-- ((id ⊗ₘ LinearMap.mul' ℂ ℍ) ∘ₗ υ ∘ₗ LinearMap.adjoint (LinearMap.mul' ℂ ℍ) ⊗ₘ id) = +-- LinearMap.adjoint (LinearMap.mul' ℂ ℍ) ∘ₗ LinearMap.mul' ℂ ℍ := +-- by +-- apply Coalgebra.lTensor_mul_comp_rTensor_mul_adjoint_of +-- let σ : ℍ ≃ₐ[ℂ] ℍ := (hφ.sig (-1 : ℝ)) +-- refine ⟨σ, fun _ _ _ => ?_⟩ +-- simp only [σ, hφ.sig_apply', neg_neg, Matrix.PosDef.rpow_one_eq_self, +-- Matrix.PosDef.rpow_neg_one_eq_inv_self, star_eq_conjTranspose, hφ.inner_right_conj] + +-- theorem LinearMap.mul'_assoc : +-- (LinearMap.mul' ℂ (Matrix n n ℂ) ∘ₗ LinearMap.mul' ℂ (Matrix n n ℂ) ⊗ₘ id) = +-- LinearMap.mul' ℂ (Matrix n n ℂ) ∘ₗ +-- (id ⊗ₘ LinearMap.mul' ℂ (Matrix n n ℂ)) ∘ₗ +-- (↑(TensorProduct.assoc ℂ (Matrix n n ℂ) (Matrix n n ℂ) (Matrix n n ℂ) : _ ≃ₗ[ℂ] _) : +-- _ →ₗ[ℂ] _) := +-- Algebra.assoc + +-- noncomputable +-- def Matrix.Coalgebra [hφ : φ.IsFaithfulPosMap] : +-- Coalgebra ℂ (Matrix n n ℂ) := +-- by infer_instance + +-- section + +-- set_option synthInstance.checkSynthOrder false in +-- attribute [local instance] Matrix.Coalgebra +-- theorem LinearMap.mul'_coassoc [hφ : φ.IsFaithfulPosMap] : +-- rTensor ℍ (LinearMap.adjoint (LinearMap.mul' ℂ ℍ)) ∘ₗ LinearMap.adjoint (LinearMap.mul' ℂ ℍ) +-- = +-- υ⁻¹ ∘ₗ lTensor ℍ (LinearMap.adjoint (LinearMap.mul' ℂ ℍ)) ∘ₗ LinearMap.adjoint +-- (LinearMap.mul' ℂ ℍ) := +-- by simp_rw [← Coalgebra.comul_eq_mul_adjoint, Coalgebra.coassoc_symm.symm] + +-- end + +-- m(η ⊗ id) = τ +-- theorem LinearMap.mul'_comp_unit_map_id_eq_lid : LinearMap.mul' ℂ ℍ ∘ₗ (η ⊗ₘ id) = τ := +-- Algebra.mul_comp_rTensor_unit + +-- m(id ⊗ η)κ⁻¹ = τ +-- theorem LinearMap.mul'_comp_id_map_unit_assoc_eq_lid : +-- LinearMap.mul' ℂ ℍ ∘ₗ (id ⊗ₘ η) = TensorProduct.rid ℂ ℍ := +-- Algebra.mul_comp_lTensor_unit + +-- set_option synthInstance.maxHeartbeats 0 in +-- private theorem linear_map.id_map_mul'_comp_unit_eq [hφ : φ.IsFaithfulPosMap] : +-- ((1 : ℍ →ₗ[ℂ] ℍ) ⊗ₘ ((LinearMap.adjoint (LinearMap.mul' ℂ ℍ)) ∘ₗ η)) +-- = ((1 : ℍ →ₗ[ℂ] ℍ) ⊗ₘ (LinearMap.adjoint (LinearMap.mul' ℂ ℍ))) ∘ₗ ((1 : ℍ →ₗ[ℂ] ℍ) ⊗ₘ η) +-- := +-- by rw [← TensorProduct.map_comp, LinearMap.comp_one] + +-- (m ⊗ id)υ⁻¹(id ⊗ m⋆η)κ⁻¹τ⁻¹ = m⋆ +-- theorem LinearMap.mul'_adjoint_eq' [hφ : φ.IsFaithfulPosMap] : +-- (LinearMap.mul' ℂ ℍ ⊗ₘ id) ∘ₗ υ⁻¹ ∘ₗ (id ⊗ₘ (LinearMap.adjoint (LinearMap.mul' ℂ ℍ) ∘ₗ η)) +-- ∘ₗ (TensorProduct.rid ℂ ℍ).symm = +-- (LinearMap.adjoint (LinearMap.mul' ℂ ℍ)) := +-- by +-- rw [linear_map.id_map_mul'_comp_unit_eq] +-- have := @frobenius_equation n _ _ φ _ +-- simp_rw [← LinearMap.comp_assoc] at this ⊢ +-- rw [this] +-- simp_rw [LinearMap.comp_assoc, ← LinearMap.comp_assoc (TensorProduct.rid ℂ ℍ).symm.toLinearMap, +-- LinearMap.mul'_comp_id_map_unit_assoc_eq_lid, LinearMap.comp_assoc, +-- LinearEquiv.comp_coe, LinearEquiv.symm_trans_self, +-- LinearEquiv.refl_toLinearMap, LinearMap.comp_id] + +-- private theorem linear_map.mul'_comp_unit_map_id_eq [hφ : φ.IsFaithfulPosMap] : +-- ((LinearMap.adjoint (LinearMap.mul' ℂ ℍ) ∘ₗ η) ⊗ₘ id) = (LinearMap.adjoint (LinearMap.mul' ℂ +-- ℍ) ⊗ₘ id) ∘ₗ η ⊗ₘ id := +-- by rw [← TensorProduct.map_comp, LinearMap.comp_one] + +-- (id ⊗ m)υ(m∗η ⊗ id) τ⁻¹ = m⋆ +-- theorem LinearMap.mul'_adjoint_eq'' [hφ : φ.IsFaithfulPosMap] : +-- (id ⊗ₘ LinearMap.mul' ℂ ℍ) ∘ₗ υ ∘ₗ ((LinearMap.adjoint (LinearMap.mul' ℂ ℍ) ∘ₗ η) ⊗ₘ id) ∘ₗ +-- τ⁻¹ = +-- LinearMap.adjoint (LinearMap.mul' ℂ ℍ) := +-- by +-- rw [linear_map.mul'_comp_unit_map_id_eq] +-- have := @frobenius_equation' n _ _ φ _ +-- simp_rw [← LinearMap.comp_assoc] at this ⊢ +-- rw [this] +-- simp_rw [LinearMap.comp_assoc, ← LinearMap.comp_assoc _ (_ ⊗ₘ _), +-- LinearMap.mul'_comp_unit_map_id_eq_lid, LinearEquiv.comp_coe, LinearEquiv.symm_trans_self, +-- LinearEquiv.refl_toLinearMap, LinearMap.comp_id] diff --git a/LeanPool/Monlib4/LinearAlgebra/Ips/Functional.lean b/LeanPool/Monlib4/LinearAlgebra/Ips/Functional.lean new file mode 100644 index 0000000000..64a6285f07 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Ips/Functional.lean @@ -0,0 +1,1005 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.LinearAlgebra.Matrix.PosEqLinearMapIsPositive +import LeanPool.Monlib4.Preq.RCLikeLe +import LeanPool.Monlib4.LinearAlgebra.IsReal +import LeanPool.Monlib4.LinearAlgebra.Matrix.IncludeBlock +import LeanPool.Monlib4.LinearAlgebra.PosMapIsReal +import LeanPool.Monlib4.LinearAlgebra.Matrix.Cast + +/-! + +# Linear functionals + +This file contains results for linear functionals on the set of $n \times n$ matrices $M_n$ + over $\mathbb{C}$. + +## Main results +- `module.dual.apply` +- `module.dual.is_pos_map_iff` +- `module.dual.is_faithful_pos_map_iff` +- `module.dual.is_tracial_faithful_pos_map_iff` +- `module.dual.is_faithful_pos_map_iff_is_inner` + +-/ + + +open scoped Matrix BigOperators + +section + +variable {R k : Type _} {s : k → Type _} + +open Matrix in +lemma includeBlock_apply_mul [CommSemiring R] [DecidableEq k] [Π i, + Fintype (s i)] {i j : k} (x : Matrix (s i) (s i) R) + (y : Matrix (s j) (s j) R) (p q : s j) : + (includeBlock x j * y) p q + = if i = j then (includeBlock x j * y) p q else 0 := +by simp_rw [includeBlock_apply, dite_hMul, zero_mul]; aesop +open Matrix in +lemma includeBlock_mul_apply [CommSemiring R] [DecidableEq k] + [Π i, Fintype (s i)] {i j : k} (x : Matrix (s j) (s j) R) + (y : Matrix (s i) (s i) R) (p q : s j) : + (x * includeBlock y j) p q + = if i = j then (x * includeBlock y j) p q else 0 := +by simp_rw [includeBlock_apply, hMul_dite, mul_zero]; aesop + +end + +section +variable {n : Type _} [Fintype n] [DecidableEq n] +variable {𝕜 R : Type _} [RCLike 𝕜] [CommSemiring R] + +open Matrix + +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/ +/-- the matrix of a linear map `φ : M_n →ₗ[R] R` is given by + `∑ i j, single j i (φ (single i j 1))`. -/ +def Module.Dual.matrix (φ : Module.Dual R (Matrix n n R)) := +∑ i : n, ∑ j : n, Matrix.single j i (φ (Matrix.single i j 1)) + +/-- given any linear functional `φ : M_n →ₗ[R] R`, we get `φ a = (φ.matrix ⬝ a).trace`. -/ +theorem Module.Dual.apply (φ : Module.Dual R (Matrix n n R)) (a : Matrix n n R) : + φ a = (φ.matrix * a).trace := + by + simp_rw [Module.Dual.matrix, smul_single' _ _ (φ _)] + simp_rw [Matrix.sum_mul, Matrix.smul_mul, trace_sum, trace_smul, Matrix.trace, Matrix.diag, + mul_apply, single_eq, boole_mul, ite_and, Finset.sum_ite_irrel, Finset.sum_const_zero, + Finset.sum_ite_eq, Finset.mem_univ, if_true, ← ite_and, smul_eq_mul, mul_comm (φ _) _, ← + smul_eq_mul, ← _root_.map_smul, ← map_sum] + have : + ∀ ⦃i : n⦄ ⦃j : n⦄ ⦃a : R⦄, + single i j (a : R) = fun k l => ite (i = k ∧ j = l) (a : R) (0 : R) := + fun i j a => rfl + simp_rw [← this, smul_single, smul_eq_mul, mul_one] + rw [← matrix_eq_sum_single a] + +/-- +we linear maps `φ_i : M_[n_i] →ₗ[R] R`, we define its direct sum as the linear map `(Π i, M_[n_i]) + →ₗ[R] R`. -/ +@[simps] +def Module.Dual.pi {k : Type _} [Fintype k] {s : k → Type _} + (φ : ∀ i, Module.Dual R (Matrix (s i) (s i) R)) : Module.Dual R (PiMat R k s) + where + toFun a := ∑ i : k, φ i (a i) + map_add' x y := by simp only [map_add, Pi.add_apply, Finset.sum_add_distrib] + map_smul' r x := by + simp only [_root_.map_smul, Pi.smul_apply, Finset.smul_sum, RingHom.id_apply] + +/-- Restrict a linear functional on a product of matrix algebras to each block. -/ +@[simps!] +def Module.Dual.pi_of {k : Type _} [DecidableEq k] {s : k → Type _} + (φ : Module.Dual R (PiMat R k s)) : + Π i, Module.Dual R (Matrix (s i) (s i) R) := +fun _ => φ ∘ₗ includeBlock + +/-- for direct sums, we get `φ x = ∑ i, ((φ i).matrix ⬝ x i).trace` -/ +theorem Module.Dual.pi.apply {k : Type _} [Fintype k] {s : k → Type _} [∀ i, Fintype (s i)] + [∀ i, DecidableEq (s i)] (φ : ∀ i, Module.Dual R (Matrix (s i) (s i) R)) + (x : PiMat R k s) : Module.Dual.pi φ x = ∑ i, ((φ i).matrix * x i).trace := by + simp_rw [Module.Dual.pi_apply, Module.Dual.apply] + +lemma Module.Dual.eq_pi_of_pi {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Finite (s i)] + (φ : Π i, Module.Dual R (Matrix (s i) (s i) R)) : + φ = pi_of (pi φ) := + by + classical + letI : ∀ i, Fintype (s i) := fun i => Fintype.ofFinite (s i) + ext i y + simp_rw [Module.Dual.pi_of_apply, pi_apply, + Module.Dual.apply] + symm + calc ∑ j : k, trace (matrix (φ j) * includeBlock y j) + = ∑ j : k, trace (if i = j then (matrix (φ j) * includeBlock y j) else 0) := + by congr; ext; congr; simp only [includeBlock_apply, hMul_dite, mul_zero]; aesop + _ = ∑ j : k, if i = j then trace (matrix (φ j) * includeBlock y j) else 0 := + by congr; ext; aesop + _ = trace (matrix (φ i) * includeBlock y i) := + by simp only [Finset.sum_ite_eq, Finset.mem_univ, if_true] + _ = trace (matrix (φ i) * y) := by simp only [includeBlock_apply_same] + +lemma Module.Dual.eq_pi_pi_of {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Finite (s i)] + (φ : Module.Dual R (PiMat R k s)) : + φ = pi (pi_of φ) := + by + classical + letI : ∀ i, Fintype (s i) := fun i => Fintype.ofFinite (s i) + rw [LinearMap.ext_iff] + intro x + simp_rw [Module.Dual.pi_apply, Module.Dual.pi_of_apply, ← map_sum, + sum_includeBlock] + +theorem Module.Dual.pi.apply' {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Fintype (s i)] [∀ i, DecidableEq (s i)] (φ : ∀ i, Module.Dual R (Matrix (s i) (s i) R)) + (x : PiMat R k s) : + Module.Dual.pi φ x + = ∑ i, (blockDiagonal' (includeBlock (φ i).matrix) * blockDiagonal' x).trace := + by + symm + simp_rw [← blockDiagonal'_mul] + calc + ∑ x_1 : k, (blockDiagonal' fun k_1 : k => includeBlock (φ x_1).matrix k_1 * x k_1).trace = + ∑ x_1 : k, (blockDiagonal' fun k_1 => (includeBlock (φ x_1).matrix * x) k_1).trace := + rfl + _ = ∑ x_1 : k, (blockDiagonal' fun k_1 => + ((includeBlock ((φ x_1).matrix * x x_1)) k_1)).trace := + by + congr + ext + congr + ext + simp only [includeBlock_hMul] + _ = ∑ x_1 : k, (blockDiagonal' (includeBlock + ((φ x_1).matrix * x x_1))).trace := rfl + _ = ∑ x_1 : k, (blockDiagonal' (includeBlock + ((fun i => (φ i).matrix * x i) x_1))).trace := rfl + _ = ∑ x_1, ((φ x_1).matrix * x x_1).trace := + by + congr + ext i + rw [blockDiagonal'_includeBlock_trace (fun i => (φ i).matrix * x i) i] + _ = pi φ x := (Module.Dual.pi.apply _ _).symm + +theorem Module.Dual.pi_apply'' {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Fintype (s i)] [∀ i, DecidableEq (s i)] + (φ : Module.Dual R (PiMat R k s)) + (x : PiMat R k s) : + φ x = ∑ i, ((pi_of φ i).matrix * x i).trace := +by simp_rw [← Module.Dual.apply, ← pi_apply, ← eq_pi_pi_of] + +theorem Module.Dual.apply_eq_of (φ : Module.Dual R (Matrix n n R)) (x : Matrix n n R) + (h : ∀ a, φ a = (x * a).trace) : x = φ.matrix := + by + simp_rw [Module.Dual.apply, ← Matrix.ext_iff_trace] at h + exact h.symm + +omit [DecidableEq n] in +/-- +Any linear functional $f$ on $M_n$ is given by a unique matrix $Q \in M_n$ such that + $f(x)=\operatorname{Tr}(Qx)$ for any $x \in M_n$. -/ +theorem Module.Dual.eq_trace_unique (φ : Module.Dual R (Matrix n n R)) : + ∃! Q : Matrix n n R, ∀ a : Matrix n n R, φ a = (Q * a).trace := + by + classical + use φ.matrix + simp_rw [Module.Dual.apply, forall_true_iff, true_and, ← + Matrix.ext_iff_trace, eq_comm, imp_self, forall_true_iff] + +/-- Direct sum of matrix functionals as a functional on the block-diagonal subalgebra. -/ +def Module.Dual.pi' {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Fintype (s i)] [∀ i, DecidableEq (s i)] + (φ : ∀ i, Module.Dual R (Matrix (s i) (s i) R)) : + Module.Dual R (BlockDiagonals R k s) := +Module.Dual.pi φ ∘ₗ isBlockDiagonalPiAlgEquiv.toLinearMap + +/-- `⨁_i φ_i ι_i (x_i) = φ_i (x_i)` -/ +theorem Module.Dual.pi.apply_single_block {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Finite (s i)] (φ : Π i, Matrix (s i) (s i) R →ₗ[R] R) + (x : Π i, Matrix (s i) (s i) R) (i : k) : + (Module.Dual.pi φ) (includeBlock (x i)) = φ i (x i) := + by + classical + letI : ∀ i, Fintype (s i) := fun i => Fintype.ofFinite (s i) + simp_rw [Module.Dual.pi_apply, Module.Dual.apply] + calc ∑ x_1 : k, trace (matrix (φ x_1) * includeBlock (x i) x_1) + = ∑ x_1 : k, trace (if i = x_1 then matrix (φ x_1) * x x_1 else 0) := + by + congr; ext; congr + simp_rw [includeBlock_apply, hMul_dite, mul_zero] + aesop + _ = ∑ x_1 : k, ∑ x_2 : s x_1, (if i = x_1 then matrix (φ x_1) * x x_1 else 0) x_2 x_2 := rfl + _ = ∑ x_1 : k, ∑ x_2 : s x_1, (if i = x_1 then (matrix (φ x_1) * x x_1) x_2 x_2 else 0) := by + congr 1 with x_1 + congr 1 with x_2 + split_ifs <;> rfl + _ = trace (matrix (φ i) * x i) := ?_ + simp_rw [Finset.sum_ite_irrel, Finset.sum_const_zero, Finset.sum_ite_eq, + Finset.mem_univ, if_true] + rfl + +theorem Module.Dual.pi.apply_single_block' {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Finite (s i)] (φ : Π i, Matrix (s i) (s i) R →ₗ[R] R) + {i : k} (x : Matrix (s i) (s i) R) : + (Module.Dual.pi φ) (includeBlock x) = φ i x := +by + classical + letI : ∀ i, Fintype (s i) := fun i => Fintype.ofFinite (s i) + let x' := includeBlock x + have hx : includeBlock x = includeBlock (x' i) := by simp_rw [x', includeBlock_apply_same] + rw [hx, apply_single_block] + simp_rw [x', includeBlock_apply_same] + +open scoped ComplexOrder + +open scoped DirectSum + +/-- A linear functional $φ$ on $M_n$ is positive if $0 ≤ φ (x^*x)$ for all $x \in M_n$. -/ +def Module.Dual.IsPosMap {A : Type _} [NonUnitalSemiring A] [StarRing A] [Module 𝕜 A] + (φ : Module.Dual 𝕜 A) : Prop := + ∀ a : A, 0 ≤ φ (star a * a) + +open scoped MatrixOrder +lemma Matrix.nonneg_iff {k : Type*} [Fintype k] {x : Matrix k k ℂ} : + 0 ≤ x ↔ ∃ y : Matrix k k ℂ, x = star y * y := +by + classical + rw [Matrix.nonneg_def] + simpa [Matrix.star_eq_conjTranspose] using (Matrix.posSemidef_iff x) +lemma PiMat.nonneg_iff {k : Type _} [Finite k] + {s : k → Type _} [Π i, Fintype (s i)] + {x : PiMat ℂ k s} : + 0 ≤ x ↔ ∃ y : PiMat ℂ k s, x = star y * y := +by + classical + letI : Fintype k := Fintype.ofFinite k + simp_rw [Pi.le_def, Pi.zero_apply, Pi.mul_def, Pi.star_apply, Matrix.nonneg_iff, + funext_iff] + exact ⟨fun h => ⟨(fun i => (h i).choose), fun _ => (h _).choose_spec⟩, + fun h a => ⟨h.choose a, h.choose_spec _⟩⟩ + +lemma dual_isPosMap_of_linearMap_isPosMap {A : + Type _} [NonUnitalSemiring A] [StarRing A] [Module 𝕜 A] + [PartialOrder A] [StarOrderedRing A] {φ : Module.Dual 𝕜 A} (h : LinearMap.IsPosMap φ) : + φ.IsPosMap := +fun _ => h (star_mul_self_nonneg _) + +lemma Module.Dual.piIsPosMap_iff {k : Type _} [Finite k] + [DecidableEq k] {s : k → Type _} [∀ i, Fintype (s i)] + (φ : Module.Dual 𝕜 (PiMat 𝕜 k s)) : + φ.IsPosMap ↔ ∀ i, (pi_of φ i).IsPosMap := +by + classical + letI : Fintype k := Fintype.ofFinite k + constructor + · intro h i x + specialize h (includeBlock x) + simp_rw [includeBlock_conjTranspose, includeBlock_hMul_same] at h + exact h + · intro h x + simp_rw [IsPosMap, pi_of_apply] at h + nth_rw 1 [← sum_includeBlock x] + simp_rw [star_sum, Finset.sum_mul, includeBlock_conjTranspose, + includeBlock_hMul, map_sum] + exact Finset.sum_nonneg (fun _ _ => h _ _) + +lemma Module.Dual.pi_isPosMap_iff {k : Type _} [Fintype k] + {s : k → Type _} [∀ i, Fintype (s i)] + (φ : Π i, Module.Dual 𝕜 (Matrix (s i) (s i) 𝕜)) : + (pi φ).IsPosMap ↔ ∀ i, (φ i).IsPosMap := +by + classical + rw [Module.Dual.piIsPosMap_iff] + simp_rw [← eq_pi_of_pi] + +/-- A linear functional $φ$ on $M_n$ is unital if $φ(1) = 1$. -/ +def Module.Dual.IsUnital {A : Type _} [AddCommMonoid A] [Module R A] [One A] (φ : Module.Dual R A) : + Prop := + φ (1 : A) = 1 + +/-- A linear functional is called a state if it is positive and unital -/ +class Module.Dual.IsState {A : Type _} [Semiring A] [StarRing A] [Module 𝕜 A] (φ : + Module.Dual 𝕜 A) : + Prop where +toIsPosMap : φ.IsPosMap +toIsUnital : φ.IsUnital + +lemma Module.Dual.IsState_iff {A : Type _} [Semiring A] [StarRing A] [Module 𝕜 A] + (φ : Module.Dual 𝕜 A) : φ.IsState ↔ φ.IsPosMap ∧ φ.IsUnital := +⟨fun h => ⟨h.toIsPosMap, h.toIsUnital⟩, fun h => ⟨h.1, h.2⟩⟩ + +omit [DecidableEq n] in +theorem Module.Dual.isPosMap_of_matrix (φ : Module.Dual 𝕜 (Matrix n n 𝕜)) : + φ.IsPosMap ↔ ∀ a : Matrix n n 𝕜, a.PosSemidef → 0 ≤ φ a := by + simp_rw [posSemidef_iff, exists_imp, Module.Dual.IsPosMap, forall_eq_apply_imp_iff, + star_eq_conjTranspose] + +/-- +A linear functional $f$ on $M_n$ is said to be faithful if $f(x^*x)=0$ if and only if $x=0$ for any + $x \in M_n$. -/ +def Module.Dual.IsFaithful {A : Type _} [NonUnitalSemiring A] [StarRing A] [Module 𝕜 A] + (φ : Module.Dual 𝕜 A) : Prop := + ∀ a : A, φ (star a * a) = 0 ↔ a = 0 + +lemma Matrix.includeBlock_eq_zero {k : Type _} [Finite k] [DecidableEq k] {s : k → Type _} + [∀ i, Finite (s i)] {i : k} + {x : Matrix (s i) (s i) R} : + includeBlock x = 0 ↔ x = 0 := +by + classical + letI : Fintype k := Fintype.ofFinite k + letI : ∀ i, Fintype (s i) := fun i => Fintype.ofFinite (s i) + simp_rw [funext_iff, Pi.zero_apply, includeBlock_apply, + dite_eq_right_iff, eq_mp_eq_cast] + exact ⟨fun h => (h i rfl), by rintro rfl a rfl; rfl⟩ + +lemma Module.Dual.piIsFaithful_iff {k : Type _} [Finite k] + [DecidableEq k] {s : k → Type _} [∀ i, Fintype (s i)] + {φ : Module.Dual 𝕜 (PiMat 𝕜 k s)} (hφ : φ.IsPosMap) : + φ.IsFaithful ↔ ∀ i, (pi_of φ i).IsFaithful := +by + classical + letI : Fintype k := Fintype.ofFinite k + constructor + · intro h i x + specialize h (includeBlock x) + simp_rw [includeBlock_conjTranspose, includeBlock_hMul_same, + includeBlock_eq_zero] at h + exact h + · intro h x + simp_rw [IsFaithful, pi_of_apply] at h + nth_rw 1 [← sum_includeBlock x] + simp_rw [star_sum, Finset.sum_mul, includeBlock_conjTranspose, + includeBlock_hMul, map_sum] + refine ⟨fun h1 => ?_, fun h => by simp_rw [h, Pi.zero_apply, mul_zero, map_zero, + Finset.sum_const_zero]⟩ + ext1 i + rw [Pi.zero_apply] + rw [Finset.sum_eq_zero_iff_of_nonneg] at h1 + · simp only [Finset.mem_univ, forall_true_left, ← star_eq_conjTranspose, h] at h1 + exact h1 i + · intro i hi + rw [piIsPosMap_iff] at hφ + exact hφ _ _ + +omit [DecidableEq n] in +theorem Module.Dual.isFaithful_of_matrix (φ : Module.Dual 𝕜 (Matrix n n 𝕜)) : + φ.IsFaithful ↔ ∀ a : Matrix n n 𝕜, a.PosSemidef → (φ a = 0 ↔ a = 0) := by + simp_rw [posSemidef_iff, exists_imp, Module.Dual.IsFaithful, forall_eq_apply_imp_iff, + conjTranspose_mul_self_eq_zero, star_eq_conjTranspose] + +/-- +A linear functional $f$ is positive if and only if there exists a unique positive semi-definite +matrix $Q\in M_n$ such that $f(x)=\operatorname{Tr}(Qx)$ for all $x\in M_n$. +-/ +theorem Module.Dual.isPosMap_iff_of_matrix (φ : Module.Dual ℂ (Matrix n n ℂ)) : + φ.IsPosMap ↔ φ.matrix.PosSemidef := by + constructor + · intro hs + rw [Module.Dual.isPosMap_of_matrix] at hs + simp only [Module.Dual.apply] at hs + have thiseq : ∀ y, star y ⬝ᵥ φ.matrix *ᵥ y = (φ.matrix * vecMulVec y (star y)).trace := + by + intro y + rw [vecMulVec_eq Unit, trace_mul_cycle', ← replicateCol_mulVec] + simp_rw [Matrix.trace_iff', replicateRow_mul_replicateCol_apply, Fintype.univ_punit, + Finset.sum_const, + Finset.card_singleton, nsmul_eq_mul, Nat.cast_one, one_mul] + simp_rw [PosSemidef.complex, thiseq] + intro y + exact hs (vecMulVec y (star y)) (vecMulVec_posSemidef _) + · intro hy y + rw [φ.apply, ← Matrix.mul_assoc] + exact hy.trace_conjTranspose_hMul_self_nonneg _ + +/-- +A linear functional $f$ is a state if and only if there exists a unique positive semi-definite + matrix $Q\in M_n$ such that its trace equals $1$ and $f(x)=\operatorname{Tr}(Qx)$ for all $x\in + M_n$. -/ +theorem Module.Dual.isState_iff_of_matrix (φ : Module.Dual ℂ (Matrix n n ℂ)) : + φ.IsState ↔ φ.matrix.PosSemidef ∧ φ.matrix.trace = 1 := by + simp_rw [Module.Dual.IsState_iff, Module.Dual.isPosMap_iff_of_matrix, Module.Dual.IsUnital, + Module.Dual.apply, Matrix.mul_one] + +/-- +A positive linear functional $f$ is faithful if and only if there exists a positive definite matrix + such that $f(x)=\operatorname{Tr}(Qx)$ for all $x\in M_n$. -/ +theorem Module.Dual.IsPosMap.isFaithful_iff_of_matrix {φ : Module.Dual ℂ (Matrix n n ℂ)} + (hs : φ.IsPosMap) : φ.IsFaithful ↔ φ.matrix.PosDef := + by + have hs' := hs + rw [Module.Dual.isPosMap_of_matrix] at hs' + rw [Module.Dual.isFaithful_of_matrix] + constructor + · rw [Module.Dual.isPosMap_iff_of_matrix] at hs + intro HHH + · refine Matrix.PosDef.of_dotProduct_mulVec_pos hs.1 ?_ + intro x hx + have : star x ⬝ᵥ φ.matrix.mulVec x = (φ.matrix * vecMulVec x (star x)).trace := + by + rw [vecMulVec_eq Unit, trace_mul_cycle', ← replicateCol_mulVec] + simp_rw [Matrix.trace_iff', replicateRow_mul_replicateCol_apply, Fintype.univ_punit, + Finset.sum_const, + Finset.card_singleton, nsmul_eq_mul, Nat.cast_one, one_mul] + rw [this] + have this2 := HHH (vecMulVec x (star x)) (vecMulVec_posSemidef _) + have this3 := hs' (vecMulVec x (star x)) (vecMulVec_posSemidef _) + rw [le_iff_eq_or_lt] at this3 + rcases this3 with (this3 | this32) + · rw [eq_comm, this2, vecMulVec_eq_zero_iff] at this3 + contradiction + · rw [← Module.Dual.apply] + exact this32 + · intro hQ a ha + exact ⟨fun h => by + obtain ⟨b, rfl⟩ := (posSemidef_iff _).mp ha + rw [Module.Dual.apply, ← Matrix.mul_assoc, + Nontracial.trace_conjTranspose_hMul_self_eq_zero hQ] at h + rw [h, Matrix.mul_zero], fun h => by rw [h, map_zero]⟩ + +-- def Module.Dual.IsFaithfulPosMap {A : Type _} [NonUnitalSemiring A] [StarRing A] [Module 𝕜 A] +-- (φ : Module.Dual 𝕜 A) : Prop := +-- φ.IsPosMap ∧ φ.IsFaithful +/-- A linear functional that is both positive and faithful on positive elements. -/ +@[class] +structure Module.Dual.IsFaithfulPosMap {A : Type _} [NonUnitalSemiring A] [StarRing A] + [Module 𝕜 A] (φ : Module.Dual 𝕜 A) : Prop where + /-- The functional is positive on all `star a * a`. -/ + toIsPosMap : φ.IsPosMap + /-- The functional detects zero positive elements. -/ + toIsFaithful : φ.IsFaithful + +lemma Module.Dual.IsFaithfulPosMap_iff {A : Type _} [NonUnitalSemiring A] [StarRing A] [Module 𝕜 A] + (φ : Module.Dual 𝕜 A) : φ.IsFaithfulPosMap ↔ φ.IsPosMap ∧ φ.IsFaithful := +⟨fun h => ⟨h.toIsPosMap, h.toIsFaithful⟩, fun h => ⟨h.1, h.2⟩⟩ + +/-- +A linear functional $φ$ is a faithful and positive if and only if there exists a unique positive + definite matrix $Q$ such that $φ(x)=\operatorname{Tr}(Qx)$ for all $x\in M_n$. -/ +theorem Module.Dual.isFaithfulPosMap_iff_of_matrix (φ : Module.Dual ℂ (Matrix n n ℂ)) : + φ.IsFaithfulPosMap ↔ φ.matrix.PosDef := + by + constructor + · intro h + exact h.1.isFaithful_iff_of_matrix.mp h.2 + intro hQ + simp_rw [Module.Dual.IsFaithfulPosMap_iff, Module.Dual.IsFaithful, + Module.Dual.isPosMap_iff_of_matrix, + hQ.posSemidef, true_and, Module.Dual.apply, star_eq_conjTranspose, + ← Matrix.mul_assoc, Nontracial.trace_conjTranspose_hMul_self_eq_zero hQ, + forall_const] + +/-- +A state is faithful $f$ if and only if there exists a unique positive definite matrix $Q\in M_n$ + with trace equal to $1$ and $f(x)=\operatorname{Tr}(Qx)$ for all $x \in M_n$. -/ +theorem Module.Dual.IsState.isFaithful_iff_of_matrix {φ : Module.Dual ℂ (Matrix n n ℂ)} + (hs : φ.IsState) : φ.IsFaithful ↔ φ.matrix.PosDef ∧ φ.matrix.trace = 1 := + by + rw [hs.1.isFaithful_iff_of_matrix] + constructor + · intro hQ + constructor + · exact hQ + rw [Module.Dual.isState_iff_of_matrix] at hs + exact hs.2 + · intro hQ + exact hQ.1 + +theorem Module.Dual.isFaithful_state_iff_of_matrix (φ : Module.Dual ℂ (Matrix n n ℂ)) : + φ.IsState ∧ φ.IsFaithful ↔ φ.matrix.PosDef ∧ φ.matrix.trace = 1 := + by + constructor + · intro h + exact h.1.isFaithful_iff_of_matrix.mp h.2 + intro hQ + simp_rw [Module.Dual.IsFaithful, Module.Dual.isState_iff_of_matrix, hQ.2, hQ.1.posSemidef, + true_and] + rw [← Module.Dual.isFaithfulPosMap_iff_of_matrix] at hQ + exact hQ.1.2 + +/-- A linear functional $f$ is tracial if and only if $f(xy)=f(yx)$ for all $x,y$. -/ +def Module.Dual.IsTracial {A : Type _} [NonUnitalSemiring A] [Module 𝕜 A] (φ : Module.Dual 𝕜 A) : + Prop := + ∀ x y : A, φ (x * y) = φ (y * x) + +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/ +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/ +/-- +A linear functional is tracial and positive if and only if there exists a non-negative real $α$ + such that $f\colon x \mapsto \alpha \operatorname{Tr}(x)$. -/ +theorem Module.Dual.isTracial_pos_map_iff_of_matrix (φ : Module.Dual ℂ (Matrix n n ℂ)) : + φ.IsPosMap ∧ φ.IsTracial ↔ ∃ α : NNReal, φ.matrix = ((α : ℝ) : ℂ) • 1 := + by + constructor + · simp_rw [Module.Dual.isPosMap_iff_of_matrix] + rintro ⟨hQ, h2⟩ + simp_rw [Module.Dual.IsTracial, Module.Dual.apply, Matrix.trace, Matrix.diag, + mul_apply] at h2 + let Q := φ.matrix + have : ∀ p q r : n, Q p q = ite (p = q) (Q r r) 0 := fun p q r => + calc + Q p q = + ∑ i, ∑ j, Q i j * ∑ k, (single q r 1) j k * (single r p 1) k i := + by + simp only [single, of_apply, ite_and, Finset.sum_ite_irrel, + Finset.sum_const_zero, Finset.sum_ite_eq, Finset.mem_univ, if_true, + mul_ite, MulZeroClass.mul_zero, mul_one] + _ = ∑ i, ∑ j, Q i j * ∑ k, (single r p 1) j k * (single q r 1) k i := + by rw [h2] + _ = ite (p = q) (Q r r) 0 := by + simp only [single, of_apply, ite_and, Finset.sum_ite_irrel, + Finset.sum_const_zero, Finset.sum_ite_eq, Finset.mem_univ, if_true, mul_ite, + MulZeroClass.mul_zero, mul_one] + by_cases h : IsEmpty n + · use 1 + haveI := h + simp only [eq_iff_true_of_subsingleton] + rw [not_isEmpty_iff] at h + let i : n := h.some + have HH : Q = diagonal fun _ : n => Q i i := + by + ext + exact this _ _ i + have this' : ∀ p, Q p p = RCLike.re (Q p p) := + by + intro p + rw [eq_comm] + simp_rw [RCLike.re_eq_complex_re, ← Complex.conj_eq_iff_re, ← RCLike.star_def, + ← Matrix.star_apply, + star_eq_conjTranspose] + rw [hQ.1.eq] + have : 0 ≤ Q i i := by + rw [PosSemidef.complex] at hQ + specialize hQ fun j => ite (i = j) 1 0 + simp_rw [dotProduct, mulVec, dotProduct, Pi.star_apply, star_ite, star_zero, star_one, + boole_mul, mul_boole, Finset.sum_ite_eq, Finset.mem_univ, if_true] at hQ + exact hQ + have thisthis : 0 ≤ RCLike.re (Q i i) := + by + rw [RCLike.nonneg_def'] at this + exact this.2 + let α : NNReal := ⟨RCLike.re (Q i i), thisthis⟩ + have hα' : RCLike.re (Q i i) = α := rfl + exact ⟨α, by + simp only [smul_eq_diagonal_mul, ← hα', Matrix.mul_one] + rw [← this'] + exact HH⟩ + · rintro ⟨α, hα1⟩ + simp_rw [Module.Dual.IsPosMap, Module.Dual.IsTracial, Module.Dual.apply, hα1, + smul_mul, one_mul, trace_smul, smul_eq_mul, star_eq_conjTranspose] + exact ⟨fun _ => mul_nonneg (RCLike.zero_le_real.mpr (NNReal.coe_nonneg α)) + (Matrix.trace_conjTranspose_hMul_self_nonneg _), + fun _ _ => by rw [trace_mul_comm]⟩ + +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/ +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/ +/-- +A linear functional is tracial and positive if and only if there exists a unique non-negative real + $α$ such that $f\colon x \mapsto \alpha \operatorname{Tr}(x)$. -/ +theorem Module.Dual.isTracial_pos_map_iff'_of_matrix [Nonempty n] + (φ : Module.Dual ℂ (Matrix n n ℂ)) : + φ.IsPosMap ∧ φ.IsTracial ↔ ∃! α : NNReal, φ.matrix = ((α : ℝ) : ℂ) • 1 := + by + constructor + · simp_rw [Module.Dual.isPosMap_iff_of_matrix] + rintro ⟨hQ, h2⟩ + simp_rw [Module.Dual.IsTracial, Module.Dual.apply, Matrix.trace, Matrix.diag, + mul_apply] at h2 + let Q := φ.matrix + have : ∀ p q r : n, Q p q = ite (p = q) (Q r r) 0 := fun p q r => + calc + Q p q = + ∑ i, ∑ j, Q i j * ∑ k, (single q r 1) j k * (single r p 1) k i := + by + simp only [single, of_apply, ite_and, Finset.sum_ite_irrel, + Finset.sum_const_zero, Finset.sum_ite_eq, Finset.mem_univ, if_true, + mul_ite, MulZeroClass.mul_zero, mul_one] + _ = ∑ i, ∑ j, Q i j * ∑ k, (single r p 1) j k * (single q r 1) k i := + by rw [h2] + _ = ite (p = q) (Q r r) 0 := by + simp only [single, of_apply, ite_and, Finset.sum_ite_irrel, + Finset.sum_const_zero, Finset.sum_ite_eq, Finset.mem_univ, if_true, mul_ite, + MulZeroClass.mul_zero, mul_one] + let i : n := Nonempty.some (by infer_instance) + have HH : Q = diagonal fun _ : n => Q i i := + by + ext + exact this _ _ i + have this' : ∀ p, Q p p = RCLike.re (Q p p) := + by + intro p + rw [eq_comm] + simp_rw [RCLike.re_eq_complex_re, ← Complex.conj_eq_iff_re, ← RCLike.star_def, + ← Matrix.star_apply, + star_eq_conjTranspose] + rw [hQ.1.eq] + have : 0 ≤ Q i i := by + rw [PosSemidef.complex] at hQ + specialize hQ fun j => ite (i = j) 1 0 + simp_rw [dotProduct, mulVec, dotProduct, Pi.star_apply, star_ite, star_zero, star_one, + boole_mul, mul_boole, Finset.sum_ite_eq, Finset.mem_univ, if_true] at hQ + exact hQ + have thisthis : 0 ≤ RCLike.re (Q i i) := + by + rw [RCLike.nonneg_def'] at this + exact this.2 + let α : NNReal := ⟨RCLike.re (Q i i), thisthis⟩ + have hα' : RCLike.re (Q i i) = α := rfl + use α + constructor + · simp only [smul_eq_diagonal_mul, ← hα', Matrix.mul_one] + rw [← this'] + exact HH + · intro y hy + simp only [Q] at * + simp only [smul_eq_diagonal_mul, Matrix.mul_one] at hy + rw [HH, diagonal_eq_diagonal_iff, this'] at hy + specialize hy i + norm_cast at hy + simp_rw [α, Q, hy] + rfl + · rintro ⟨α, ⟨hα1, _⟩⟩ + simp_rw [Module.Dual.IsPosMap, Module.Dual.IsTracial, Module.Dual.apply, hα1, + smul_mul, one_mul, trace_smul] + exact ⟨fun _ => mul_nonneg (RCLike.zero_le_real.mpr (NNReal.coe_nonneg α)) + (Matrix.trace_conjTranspose_hMul_self_nonneg _), + fun _ _ => by rw [trace_mul_comm]⟩ + +/-- +A linear functional $f$ is tracial positive and faithful if and only if there exists a positive + real number $\alpha$ such that $f\colon x\mapsto \alpha \operatorname{Tr}(x)$. -/ +theorem Module.Dual.isTracial_faithful_pos_map_iff_of_matrix [Nonempty n] + (φ : Module.Dual ℂ (Matrix n n ℂ)) : + φ.IsFaithfulPosMap ∧ φ.IsTracial ↔ + ∃! α : { x : NNReal // 0 < x }, φ.matrix = (((α : NNReal) : ℝ) : ℂ) • 1 := + by + rw [Module.Dual.IsFaithfulPosMap_iff, @and_comm φ.IsPosMap, and_assoc, + Module.Dual.isTracial_pos_map_iff'_of_matrix] + constructor + · rintro ⟨h1, ⟨α, hα, h⟩⟩ + have : 0 < (α : ℝ) := by + rw [NNReal.coe_pos, pos_iff_ne_zero] + intro HH + rw [Module.Dual.IsFaithful] at h1 + specialize h1 ((1 : Matrix n n ℂ)ᴴ * (1 : Matrix n n ℂ)) + simp only [Matrix.conjTranspose_one, Matrix.mul_one, Module.Dual.apply, + star_eq_conjTranspose] at h1 + simp_rw [HH, NNReal.coe_zero, Complex.ofReal_zero, zero_smul] at hα + rw [hα, trace_zero, eq_self_iff_true, true_iff] at h1 + simp only [one_ne_zero'] at h1 + let α' : { x : NNReal // 0 < x } := ⟨α, this⟩ + have : α = α' := rfl + use α' + constructor + · exact hα + · intro y hy + simp_rw [← Subtype.coe_inj] at hy ⊢ + exact h _ hy + · rintro ⟨α, ⟨h1, _⟩⟩ + have : 0 < (α : NNReal) := Subtype.mem α + constructor + · simp_rw [Module.Dual.IsFaithful, Module.Dual.apply, h1, Matrix.smul_mul, Matrix.one_mul, + trace_smul, smul_eq_zero, Complex.ofReal_eq_zero, NNReal.coe_eq_zero, ne_zero_of_lt this, + false_or, star_eq_conjTranspose, + trace_conjTranspose_hMul_self_eq_zero, forall_true_iff] + · use α + constructor + · exact h1 + · intro y hy + rw [h1, ← sub_eq_zero, ← sub_smul, smul_eq_zero, sub_eq_zero] at hy + simp only [one_ne_zero', or_false, NNReal.coe_inj, + Complex.ofReal_inj, NNReal.coe_inj] at hy + exact hy.symm + +-- lemma linear_map.is_tracial_state_iff [nonempty n] (φ : matrix n n ℂ →ₗ[ℂ] ℂ) : +-- (φ.is_state ∧ φ.is_tracial) ↔ ∃ α : ℂ, φ.matrix = α • 1 ∧ α * (1 : matrix n n ℂ).trace = 1 := +-- begin +-- split, +-- { simp_rw [linear_map.is_state_iff], +-- -- rintros ⟨⟨Q, ⟨hQ1, hQ2, hQ3⟩, h1⟩, h2⟩, +-- simp_rw [linear_map.is_tracial, hQ3, matrix.trace, matrix.diag, mul_apply] at h2, +-- have : ∀ p q r : n, Q p q = ite (p = q) (Q r r) 0 := +-- fun p q r, calc Q p q = ∑ i j, Q i j +-- * ∑ k, (single q r 1) j k * (single r p 1) k i : +-- by { simp only [single, boole_mul, ite_and, finset.sum_ite_irrel, +-- finset.sum_const_zero, finset.sum_ite_eq, finset.mem_univ, eq_self_iff_true, if_true, +-- mul_ite, mul_zero, mul_one], } +-- ... = ∑ i j, Q i j +-- * ∑ k, (single r p 1) j k * (single q r 1) k i : by rw h2 +-- ... = ite (p = q) (Q r r) 0 : +-- by { simp only [single, boole_mul, ite_and, finset.sum_ite_irrel, +-- finset.sum_const_zero, finset.sum_ite_eq, finset.mem_univ, if_true, mul_ite, +-- mul_zero, mul_one], }, +-- let i : n := _inst_5.some, +-- use Q i i, +-- simp_rw [trace_one, ← hQ2], +-- split, +-- { intros x, +-- simp_rw [hQ3, matrix.trace, matrix.diag, mul_apply], +-- calc ∑ k j, Q k j * x j k = ∑ k j, ite (k = j) (Q i i) 0 * x j k : by simp_rw ← this _ _ i +-- ... = Q i i * ∑ k, x k k : _, +-- simp_rw [ite_mul, zero_mul, finset.sum_ite_eq, finset.mem_univ, if_true, +-- finset.mul_sum], }, +-- { rw eq_comm, +-- calc ∑ k, Q k k = ∑ k : n, ite (k = k) (Q i i) 0 : by simp_rw ← this _ _ i +-- ... = ∑ k : n, Q i i : by simp_rw [eq_self_iff_true, if_true] +-- ... = Q i i * ↑(fintype.card n) : _, +-- simp_rw [finset.sum_const, nsmul_eq_mul, mul_comm], +-- refl, }, }, +-- { rintros ⟨α, ⟨hα1, hα2⟩⟩, +-- simp_rw [linear_map.is_state_iff, hα1], +-- split, +-- { use α • 1, +-- split, +-- { simp only [matrix.smul_mul, trace_smul, smul_eq_mul, matrix.one_mul], +-- refine ⟨_, hα2, fun _, rfl⟩, +-- simp only [← diagonal_one, ← diagonal_smul, posSemidef.diagonal], +-- intros i, +-- simp_rw [pi.smul_apply, ← is_R_or_C.conj_eq_iff_re, star_ring_end_apply, +-- smul_eq_mul, mul_one], +-- have : α = 1 / (1 : matrix n n ℂ).trace, +-- { rw [← hα2, trace_one, ← mul_div, div_self, mul_one], +-- { simp only [ne.def, nat.cast_eq_zero], +-- exact fintype.card_ne_zero, }, }, +-- simp_rw [this, trace_one, star_div', star_one, star_nat_cast, eq_self_iff_true, +-- and_true], +-- simp only [one_div, is_R_or_C.re_to_complex, complex.inv_re, complex.nat_cast_re], +-- apply div_nonneg, +-- { exact (nat.cast_nonneg _), }, +-- { simp_rw [complex.norm_sq_nonneg], }, }, +-- { simp only, +-- rintros y ⟨hy1, hy2, hy3⟩, +-- ext1 i j, +-- simp_rw [pi.smul_apply, one_apply, smul_eq_mul, mul_boole], +-- specialize hy3 (single j i (1 : ℂ)), +-- simp_rw [single.trace, matrix.trace, matrix.diag, mul_apply, +-- single, mul_boole, ite_and] at hy3, +-- simp only [finset.sum_ite_eq, finset.mem_univ, if_true] at hy3, +-- simp_rw @eq_comm _ j i at hy3, +-- exact hy3.symm, }, }, +-- { intros x y, +-- rw [hα1, trace_mul_comm, ← hα1], }, }, +-- end +theorem Matrix.ext_iff_trace' {R m n : Type _} [Semiring R] [StarRing R] [Fintype n] [Fintype m] + (A B : Matrix m n R) : + (∀ x, (xᴴ * A).trace = (xᴴ * B).trace) ↔ A = B := + by + classical + constructor + · intro h + ext i j + specialize h (single i j (1 : R)) + simp_rw [single_conjTranspose, star_one, Matrix.single_hMul_trace] at h + exact h + · intro h x + rw [h] + +theorem Module.Dual.isReal_iff {φ : Module.Dual ℂ (Matrix n n ℂ)} : + LinearMap.IsReal φ ↔ φ.matrix.IsHermitian := by + simp_rw [LinearMap.IsReal, Module.Dual.apply, trace_star, conjTranspose_mul, + star_eq_conjTranspose, trace_mul_comm φ.matrix, Matrix.ext_iff_trace', IsHermitian, eq_comm] + +omit [DecidableEq n] in +theorem Module.Dual.IsPosMap.isReal {φ : Module.Dual ℂ (Matrix n n ℂ)} (hφ : φ.IsPosMap) : + LinearMap.IsReal φ := by + classical + rw [Module.Dual.isPosMap_iff_of_matrix] at hφ + rw [Module.Dual.isReal_iff] + exact hφ.1 + +theorem Module.Dual.pi.IsPosMap.isReal {k : Type _} [Fintype k] {s : k → Type _} + [∀ i, Fintype (s i)] {ψ : ∀ i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} + (hψ : ∀ i, (ψ i).IsPosMap) : LinearMap.IsReal (Module.Dual.pi ψ) := by + classical + simp_rw [LinearMap.IsReal, Module.Dual.pi_apply, star_sum, Pi.star_apply, (hψ _).isReal _, + forall_true_iff] + +/-- A function $H \times H \to 𝕜$ defines an inner product if it satisfies the following. -/ +def IsInner {H : Type _} [AddCommMonoid H] [Module 𝕜 H] (φ : H × H → 𝕜) : Prop := + (∀ x y : H, φ (x, y) = star (φ (y, x))) ∧ + (∀ x : H, 0 ≤ RCLike.re (φ (x, x))) ∧ + (∀ x : H, φ (x, x) = 0 ↔ x = 0) ∧ + (∀ x y z : H, φ (x + y, z) = φ (x, z) + φ (y, z)) ∧ + ∀ (x y : H) (α : 𝕜), φ (α • x, y) = starRingEnd 𝕜 α * φ (x, y) + +omit [DecidableEq n] in +/-- +A linear functional $f$ on $M_n$ is positive and faithful if and only if $(x,y)\mapsto f(x^*y)$ + defines an inner product on $M_n$. -/ +theorem Module.Dual.isFaithfulPosMap_iff_isInner_of_matrix (φ : Module.Dual ℂ (Matrix n n ℂ)) : + φ.IsFaithfulPosMap ↔ IsInner fun xy : Matrix n n ℂ × Matrix n n ℂ => φ (xy.1ᴴ * xy.2) := + by + classical + let ip := fun xy : Matrix n n ℂ × Matrix n n ℂ => φ (xy.1ᴴ * xy.2) + have hip : ∀ x y, ip (x, y) = φ (xᴴ * y) := fun x y => rfl + have Hip : + (∀ x y z, ip (x + y, z) = ip (x, z) + ip (y, z)) ∧ + ∀ (x y) (α : ℂ), ip (α • x, y) = starRingEnd ℂ α * ip (x, y) := + by + simp only [ip] + simp_rw [conjTranspose_add, Matrix.add_mul, map_add, conjTranspose_smul, Matrix.smul_mul, + _root_.map_smul, Complex.star_def, smul_eq_mul, forall₃_true_iff, + true_and] + simp_rw [IsInner, ← hip, Hip, forall₃_true_iff, true_and, and_true] + constructor + · intro h + simp_rw [hip, ← h.1.isReal _, star_eq_conjTranspose, conjTranspose_mul, + conjTranspose_conjTranspose] + have := fun x => h.1 x + simp only [@RCLike.nonneg_def' ℂ] at this + exact ⟨fun _ _ => trivial, ⟨fun x => (this x).2, h.2⟩⟩ + · intro h + constructor + · simp_rw [Module.Dual.IsPosMap, star_eq_conjTranspose, ← hip, @RCLike.nonneg_def' ℂ, + ← @RCLike.conj_eq_iff_re ℂ _ (ip (_,_)), + starRingEnd_apply, ← h.1, true_and] + exact h.2.1 + · exact h.2.2 + +theorem Module.Dual.isFaithfulPosMap_of_matrix_tfae (φ : Module.Dual ℂ (Matrix n n ℂ)) : + List.TFAE + [φ.IsFaithfulPosMap, φ.matrix.PosDef, + IsInner fun xy : Matrix n n ℂ × Matrix n n ℂ => φ (xy.1ᴴ * xy.2)] := + by + tfae_have 1 ↔ 2 := φ.isFaithfulPosMap_iff_of_matrix + tfae_have 1 ↔ 3 := φ.isFaithfulPosMap_iff_isInner_of_matrix + tfae_finish + +end +section + +variable {n : Type _} [Fintype n] [DecidableEq n] (φ : Module.Dual ℂ (Matrix n n ℂ)) + +/-- The normed additive group structure induced by a faithful positive functional on matrices. -/ +@[reducible] +noncomputable def Module.Dual.NormedAddCommGroup [hφ : φ.IsFaithfulPosMap] : + _root_.NormedAddCommGroup (Matrix n n ℂ) := + -- have := φ.isFaithfulPosMap_iff_isInner_of_matrix.mp hφ + @InnerProductSpace.Core.toNormedAddCommGroup ℂ (Matrix n n ℂ) _ _ _ + { inner := fun x y => φ (xᴴ * y) + conj_inner_symm := fun _ _ => ((φ.isFaithfulPosMap_iff_isInner_of_matrix.mp hφ).1 _ _).symm + re_inner_nonneg := fun _ => (φ.isFaithfulPosMap_iff_isInner_of_matrix.mp hφ).2.1 _ + definite := fun _ hx => ((φ.isFaithfulPosMap_iff_isInner_of_matrix.mp hφ).2.2.1 _).mp hx + add_left := fun _ _ _ => (φ.isFaithfulPosMap_iff_isInner_of_matrix.mp hφ).2.2.2.1 _ _ _ + smul_left := fun _ _ _ => (φ.isFaithfulPosMap_iff_isInner_of_matrix.mp hφ).2.2.2.2 _ _ _ } + + +-- set_option trace.Meta.synthInstance true +-- set_option pp.all true +-- set_option trace.Meta.isDefEq true +-- set_option trace.Meta.isLevelDefEq true +-- set_option synthInstance.maxHeartbeats 100000 +-- set_option synthInstance.maxSize 100000 + +variable [hφ : φ.IsFaithfulPosMap] + +-- #synth _root_.NormedAddCommGroup (Matrix n n ℂ) +-- #check inferInstanceAs (NormedAddCommGroup (Matrix n n ℂ)) +-- #check @inferInstance _ (hφ) + +/-- The inner product space structure induced by a faithful positive functional on matrices. -/ +@[reducible] +noncomputable def Module.Dual.InnerProductSpace : + -- letI := hφ.NormedAddCommGroup + @_root_.InnerProductSpace ℂ (Matrix n n ℂ) _ + ((Module.Dual.NormedAddCommGroup φ).toSeminormedAddCommGroup) := +by + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := + Module.Dual.NormedAddCommGroup φ + exact InnerProductSpace.ofCore _ + +scoped[Functional] attribute [instance] Module.Dual.InnerProductSpace + +end + +open scoped Functional + +variable {k : Type _} [Fintype k] {s : k → Type _} + [Π i, Fintype (s i)] [Π i, DecidableEq (s i)] + +/-- The finite product inner-product core induced by faithful positive matrix functionals. -/ +@[reducible] +noncomputable def Module.Dual.PiInnerProductCore + {φ : Π i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} + [hφ : Π i, (φ i).IsFaithfulPosMap] : + InnerProductSpace.Core ℂ (PiMat ℂ k s) := by + letI : Π i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (φ i) + letI : Π i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ i) + exact + { inner := fun x y => ∑ i, @inner ℂ (Matrix (s i) (s i) ℂ) _ (x i) (y i) + conj_inner_symm := fun x y => by + simp_rw [map_sum] + apply Finset.sum_congr rfl + intro i _ + exact inner_conj_symm _ _ + re_inner_nonneg := fun x => by + simp_rw [map_sum] + exact Finset.sum_nonneg fun i _ => inner_self_nonneg + definite := fun x hx => by + apply PiMat.ext + intro i + have hsum : + ∑ j, RCLike.re (@inner ℂ (Matrix (s j) (s j) ℂ) _ (x j) (x j)) = 0 := by + have hcongr := congrArg RCLike.re hx + simpa [map_sum] using hcongr + have hnonneg : + ∀ j ∈ Finset.univ, + 0 ≤ RCLike.re (@inner ℂ (Matrix (s j) (s j) ℂ) _ (x j) (x j)) := + fun j _ => inner_self_nonneg + have hi : RCLike.re (@inner ℂ (Matrix (s i) (s i) ℂ) _ (x i) (x i)) = 0 := + (Finset.sum_eq_zero_iff_of_nonneg hnonneg).mp hsum i (Finset.mem_univ i) + have hnorm : ‖x i‖ ^ 2 = 0 := by + exact + (inner_self_eq_norm_sq (𝕜 := ℂ) (E := Matrix (s i) (s i) ℂ) + (x := x i)).symm.trans hi + exact norm_eq_zero.mp (sq_eq_zero_iff.mp hnorm) + add_left := fun x y z => by + simp_rw [Pi.add_apply, inner_add_left, Finset.sum_add_distrib] + smul_left := fun x y r => by + simp_rw [Pi.smul_apply, inner_smul_left, Finset.mul_sum] } + +/-- +The normed additive group on a finite product induced by faithful positive matrix functionals. +-/ +@[reducible] +noncomputable def Module.Dual.PiNormedAddCommGroup + {φ : Π i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} + [_hφ : Π i, (φ i).IsFaithfulPosMap] : + _root_.NormedAddCommGroup (PiMat ℂ k s) := +(Module.Dual.PiInnerProductCore (φ := φ)).toNormedAddCommGroup +-- -- by +-- -- letI := fun i => (hφ i).NormedAddCommGroup + -- letI := fun i => (hφ i).InnerProductSpace + -- @InnerProductSpace.Core.toNormedAddCommGroup ℂ (Π i, Matrix (s i) (s i) ℂ) _ _ _ + -- { inner := fun x y => ∑ i, inner (x i) (y i) + -- conj_symm := fun x y => by + -- simp_rw [map_sum] + -- congr; ext + -- rw [inner_conj_symm] + -- nonneg_re := fun x => by + -- simp only [inner, map_sum] + -- apply Finset.sum_nonneg + -- intro i hi + -- exact inner_self_nonneg + -- definite := fun x hx => by + -- simp_rw [inner] at hx + -- rw [Finset.sum_eq_zero_iff_of_nonneg] at hx + -- simp_rw [Finset.mem_univ, true_imp_iff, inner_self_eq_zero] at hx + -- ext1 i + -- exact hx i + -- · intro i hi + -- rw [RCLike.nonneg_def', ← RCLike.conj_eq_iff_re] + -- exact ⟨inner_self_conj _, inner_self_nonneg⟩ + -- add_left := fun x y z => by + -- simp_rw [inner, Pi.add_apply, inner_add_left, Finset.sum_add_distrib] + -- smul_left := fun x y r => by simp_rw [inner, Pi.smul_apply, inner_smul_left, + -- Finset.mul_sum] } + +/-- The inner product space on a finite product induced by faithful positive matrix functionals. -/ +@[reducible] +noncomputable def Module.Dual.pi.InnerProductSpace + {φ : Π i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} + [hφ : Π i, (φ i).IsFaithfulPosMap] : + -- letI := Module.Dual.PiNormedAddCommGroup hφ + @_root_.InnerProductSpace ℂ (PiMat ℂ k s) _ + ((Module.Dual.PiNormedAddCommGroup (_hφ := hφ)).toSeminormedAddCommGroup) + := + -- letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := PiLp.normedAddCommGroup 2 _ + -- letI this : Π i : k, + -- _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + -- -- fun i => (φ i).NormedAddCommGroup +by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := + Module.Dual.PiNormedAddCommGroup (_hφ := hφ) + letI : InnerProductSpace.Core ℂ (PiMat ℂ k s) := + Module.Dual.PiInnerProductCore (φ := φ) + exact InnerProductSpace.ofCore _ + +scoped[Functional] attribute [instance high] Module.Dual.pi.InnerProductSpace diff --git a/LeanPool/Monlib4/LinearAlgebra/Ips/Ips.lean b/LeanPool/Monlib4/LinearAlgebra/Ips/Ips.lean new file mode 100644 index 0000000000..fca19ef6b7 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Ips/Ips.lean @@ -0,0 +1,357 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.LinearAlgebra.InvariantSubmodule +import Mathlib.Analysis.InnerProductSpace.Adjoint +import Mathlib.Analysis.InnerProductSpace.Spectrum +import LeanPool.Monlib4.LinearAlgebra.Ips.Symm + +/-! +# Finite-dimensional inner product spaces + +In this file, we prove some results in finite-dimensional inner product spaces. + +## Notation + +This file uses the local notation `P _` for `orthogonal_projection _` +and `↥P _` for the extended orthogonal projection `orthogonal_projection' _`. + +We let $V$ be an inner product space over $\mathbb{k}$. +-/ + + +variable {V 𝕜 : Type _} [RCLike 𝕜] [NormedAddCommGroup V] [InnerProductSpace 𝕜 V] + +local notation "P" => Submodule.orthogonalProjection + +-- local notation `↥P` := orthogonal_projection' + +open LinearMap in +/-- $U$ is $T$-invariant if and only if $U^\bot$ is $T^*$ invariant -/ +theorem Submodule.invariantUnder_iff_ortho_adjoint_invariant [FiniteDimensional 𝕜 V] + (U : Submodule 𝕜 V) (T : V →ₗ[𝕜] V) : + Submodule.InvariantUnder U T ↔ Submodule.InvariantUnder Uᗮ (adjoint T) := + by + suffices + ∀ U : Submodule 𝕜 V, + ∀ T : V →ₗ[𝕜] V, Submodule.InvariantUnder U T → Submodule.InvariantUnder Uᗮ (adjoint T) + by + refine ⟨this U T, ?_⟩ + intro h + rw [← LinearMap.adjoint_adjoint T, ← Submodule.orthogonal_orthogonal U] + apply this + exact h + clear U T + simp only [Submodule.invariantUnder_iff, SetLike.mem_coe, Set.subset_def, + Set.mem_image, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂] + intro U T h x hx y hy + rw [LinearMap.adjoint_inner_right] + apply (Submodule.mem_orthogonal U x).mp hx + apply h y hy + +open ContinuousLinearMap in +theorem Submodule.invariantUnder_iff_ortho_adjoint_invariant' (U : Submodule 𝕜 V) [CompleteSpace V] + [hU : CompleteSpace U] (T : V →L[𝕜] V) : U.InvariantUnder T ↔ Uᗮ.InvariantUnder (adjoint T) := + by + suffices + ∀ U : Submodule 𝕜 V, + ∀ T : V →L[𝕜] V, CompleteSpace U → U.InvariantUnder T → Uᗮ.InvariantUnder (adjoint T) + by + refine ⟨this U T hU, fun h => ?_⟩ + rw [← adjoint_adjoint T, ← U.orthogonal_orthogonal] + exact this _ _ (Submodule.instOrthogonalCompleteSpace U) h + clear hU U T + simp_rw [Submodule.invariantUnder_iff, ContinuousLinearMap.coe_coe, + Set.image_subset_iff, Set.subset_def, Set.mem_preimage] + intro U T _inst_4 h x hx y hy + rw [ContinuousLinearMap.adjoint_inner_right] + apply (U.mem_orthogonal x).mp hx + apply h y hy + +/-- $T$ is self adjoint implies + $U$ is $T$-invariant if and only if $U^\bot$ is $T$-invariant -/ +theorem IsSelfAdjoint.submodule_invariant_iff_ortho_submodule_invariant [FiniteDimensional 𝕜 V] + (U : Submodule 𝕜 V) (T : V →ₗ[𝕜] V) (h : IsSelfAdjoint T) : + Submodule.InvariantUnder U T ↔ Submodule.InvariantUnder Uᗮ T := by + rw [Submodule.invariantUnder_iff_ortho_adjoint_invariant, LinearMap.isSelfAdjoint_iff'.mp h] + +open LinearMap in +/-- $\textnormal{ker}(T) = \textnormal{range}(T^*)^\bot$ -/ +theorem ker_ortho_adjoint_range {W : Type _} [FiniteDimensional 𝕜 V] [NormedAddCommGroup W] + [InnerProductSpace 𝕜 W] [FiniteDimensional 𝕜 W] (T : V →ₗ[𝕜] W) : + ker T = (range (adjoint T))ᗮ := + by + ext x + simp_rw [LinearMap.mem_ker, Submodule.mem_orthogonal, LinearMap.mem_range, forall_exists_index, + forall_apply_eq_imp_iff, LinearMap.adjoint_inner_left] + exact + ⟨fun h => by simp only [h, inner_zero_right, forall_const], fun h => + inner_self_eq_zero.mp (h (T x))⟩ + +/-- given any idempotent operator $T \in L(V)$, then `is_compl T.ker T.range`; +in other words, there exists unique $v \in \textnormal{ker}(T)$ and +$w \in \textnormal{range}(T)$ such that $x = v + w$ -/ +theorem LinearMap.IsProj.isCompl_range_ker {V R : Type _} [Ring R] [AddCommGroup V] [Module R V] + (U : Submodule R V) (T : V →ₗ[R] V) (h : LinearMap.IsProj U T) : IsCompl (ker T) (range T) := + by + have : IsIdempotentElem T := T.isProj_iff_isIdempotentElem.mp ⟨U, h⟩ + constructor + · rw [disjoint_iff] + ext x + simp only [Submodule.mem_bot, Submodule.mem_inf, LinearMap.mem_ker, LinearMap.mem_range] + constructor + · intro h' + rcases h'.2 with ⟨y, hy⟩ + rw [← hy, ← IsIdempotentElem.eq this, Module.End.mul_apply, hy] + exact h'.1 + · intro h' + rw [h', map_zero] + simp only [true_and] + use x + simp only [h', map_zero] + · suffices ∀ x : V, ∃ v : ker T, ∃ w : range T, x = v + w + by + rw [codisjoint_iff, ← Submodule.add_eq_sup] + ext x + rcases this x with ⟨v, w, hvw⟩ + simp only [Submodule.mem_top, iff_true, hvw] + apply Submodule.add_mem_sup (SetLike.coe_mem v) (SetLike.coe_mem w) + intro x + use ⟨x - T x, ?_⟩, ⟨T x, ?_⟩ + · simp only [sub_add_cancel] + · rw [LinearMap.mem_ker, map_sub, ← Module.End.mul_apply, IsIdempotentElem.eq this, sub_self] + · rw [LinearMap.mem_range] + simp only [exists_apply_eq_apply] + +/-- +idempotent $T$ is self-adjoint if and only if $\textnormal{ker}(T)^\bot=\textnormal{range}(T)$ -/ +theorem LinearMap.is_idempotent_isSelfAdjoint_iff_ker_ortho_range [InnerProductSpace ℂ V] + [FiniteDimensional ℂ V] (T : V →ₗ[ℂ] V) (h : IsIdempotentElem T) : + IsSelfAdjoint T ↔ (ker T)ᗮ = range T := + by + rw [LinearMap.isSelfAdjoint_iff'] + constructor + · intro l; rw [ker_ortho_adjoint_range, Submodule.orthogonal_orthogonal] + revert l; exact congr_arg LinearMap.range + · intro h1; apply eq_of_sub_eq_zero + simp only [← inner_map_self_eq_zero] + intro x + obtain ⟨U, hT⟩ := T.isProj_iff_isIdempotentElem.mpr h + obtain ⟨v, w, hvw, _⟩ := + Submodule.existsUnique_add_of_isCompl (LinearMap.IsProj.isCompl_range_ker U T hT) x + simp only [LinearMap.sub_apply, inner_sub_left, LinearMap.adjoint_inner_left] + rcases SetLike.coe_mem w with ⟨y, hy⟩ + rw [← hvw, map_add, LinearMap.mem_ker.mp (SetLike.coe_mem v), ← hy, + ← Module.End.mul_apply, IsIdempotentElem.eq h, zero_add, hy, inner_add_left, + inner_add_right, ← inner_conj_symm (w : V) (v : V), + (Submodule.mem_orthogonal (ker T) (w : V)).mp (by rw [h1]; exact SetLike.coe_mem w) v + (SetLike.coe_mem v), + map_zero, zero_add, sub_self] + +section IsStarNormal + +open LinearMap + +/-- linear map `is_star_normal` if and only if it commutes with its adjoint -/ +theorem LinearMap.isStarNormal_iff_adjoint [FiniteDimensional 𝕜 V] (T : V →ₗ[𝕜] V) : + IsStarNormal T ↔ Commute T (adjoint T) := +by rw [Commute.symm_iff]; exact ⟨fun hT => hT.star_comm_self, IsStarNormal.mk⟩ + +theorem ContinuousLinearMap.isStarNormal_iff_adjoint [CompleteSpace V] (T : V →L[𝕜] V) : + IsStarNormal T ↔ Commute T (adjoint T) := +by rw [Commute.symm_iff]; exact ⟨fun hT => hT.star_comm_self, IsStarNormal.mk⟩ + +theorem isSymmetric_hMul_adjoint_self [FiniteDimensional 𝕜 V] (T : V →ₗ[𝕜] V) : + IsSymmetric (T * (adjoint T)) := fun u v => by + simp_rw [Module.End.mul_apply, ← adjoint_inner_left T, ← adjoint_inner_right T] + +theorem IsSymmetric.neg (T : V →ₗ[𝕜] V) (hT : T.IsSymmetric) : IsSymmetric (-T) := + by + intro u v + simp_rw [neg_apply, inner_neg_left, inner_neg_right, neg_inj] + exact hT u v + +theorem IsSymmetric.sub {T S : V →ₗ[𝕜] V} (hT : T.IsSymmetric) (hS : S.IsSymmetric) : + (T - S).IsSymmetric := by + rw [sub_eq_add_neg] + exact IsSymmetric.add hT (IsSymmetric.neg S hS) + +/-- $T$ is normal if and only if $\forall v, \|T v\| = \|T^* v\|$ -/ +theorem LinearMap.IsStarNormal.norm_eq_adjoint [FiniteDimensional 𝕜 V] (T : V →ₗ[𝕜] V) : + IsStarNormal T ↔ ∀ v : V, ‖T v‖ = ‖adjoint T v‖ := + by + rw [T.isStarNormal_iff_adjoint, Commute, SemiconjBy, ← sub_eq_zero] + simp_rw [← + IsSymmetric.inner_map_self_eq_zero + (IsSymmetric.sub (isSymmetric_hMul_adjoint_self T) (isSymmetric_adjoint_mul_self T)), + sub_apply, inner_sub_left, Module.End.mul_apply, adjoint_inner_left, + inner_self_eq_norm_sq_to_K, ← adjoint_inner_right T, inner_self_eq_norm_sq_to_K, sub_eq_zero, ← + sq_eq_sq₀ (norm_nonneg _) (norm_nonneg _)] + norm_cast + simp_rw [eq_comm] + +theorem ContinuousLinearMap.IsStarNormal.norm_eq_adjoint [CompleteSpace V] (T : V →L[𝕜] V) : + IsStarNormal T ↔ ∀ v : V, ‖T v‖ = ‖adjoint T v‖ := + by + rw [T.isStarNormal_iff_adjoint, Commute, SemiconjBy, ← sub_eq_zero] + simp_rw [ContinuousLinearMap.ext_iff, ← ContinuousLinearMap.coe_coe, ContinuousLinearMap.coe_sub, + ← LinearMap.ext_iff, ContinuousLinearMap.coe_zero] + have : IsSymmetric ((T.comp (adjoint T) : V →ₗ[𝕜] V) - ((adjoint T).comp T : V →ₗ[𝕜] V)) := + fun u v => by + simp_rw [← ContinuousLinearMap.mul_def, LinearMap.sub_apply, + ContinuousLinearMap.coe_coe, + ContinuousLinearMap.mul_apply, inner_sub_left, inner_sub_right, + ContinuousLinearMap.adjoint_inner_left, ContinuousLinearMap.adjoint_inner_right, sub_left_inj, + ← ContinuousLinearMap.adjoint_inner_left T, ← ContinuousLinearMap.adjoint_inner_right T] + simp_rw [← ContinuousLinearMap.mul_def] at this + rw [← IsSymmetric.inner_map_self_eq_zero this] + simp_rw [LinearMap.sub_apply, inner_sub_left, ContinuousLinearMap.coe_coe, + ContinuousLinearMap.mul_apply, ContinuousLinearMap.adjoint_inner_left, + inner_self_eq_norm_sq_to_K, ← ContinuousLinearMap.adjoint_inner_right T, + inner_self_eq_norm_sq_to_K, sub_eq_zero, ← + sq_eq_sq₀ (norm_nonneg _) (norm_nonneg _), eq_comm] + norm_cast + +/-- if $T$ is normal, then $\textnormal{ker}(T) = \textnormal{ker}(T^*)$ -/ +theorem LinearMap.IsStarNormal.ker_eq_ker_adjoint [InnerProductSpace ℂ V] [FiniteDimensional ℂ V] + (T : V →ₗ[ℂ] V) (h : IsStarNormal T) : ker T = ker (adjoint T) := by + ext + rw [mem_ker, mem_ker, ← norm_eq_zero, Iff.comm, ← norm_eq_zero, + ← (LinearMap.IsStarNormal.norm_eq_adjoint T).mp h] + +/-- if $T$ is normal, then $\textnormal{range}(T)=\textnormal{range}(T^*)$ -/ +theorem LinearMap.IsStarNormal.range_eq_range_adjoint [InnerProductSpace ℂ V] + [FiniteDimensional ℂ V] (T : V →ₗ[ℂ] V) (h : IsStarNormal T) : range T = range (adjoint T) := by + rw [← Submodule.orthogonal_orthogonal (range (adjoint T)), ← ker_ortho_adjoint_range, + LinearMap.IsStarNormal.ker_eq_ker_adjoint T h, ker_ortho_adjoint_range, adjoint_adjoint, + Submodule.orthogonal_orthogonal] + +theorem ContinuousLinearMap.IsStarNormal.ker_eq_ker_adjoint [CompleteSpace V] {T : V →L[𝕜] V} + (h : IsStarNormal T) : T.ker = (adjoint T).ker := by + exact (ContinuousLinearMap.IsStarNormal.ker_adjoint_eq_ker h).symm + + +theorem ContinuousLinearMap.ker_eq_ortho_adjoint_range {W : Type _} [NormedAddCommGroup W] + [InnerProductSpace 𝕜 W] [CompleteSpace V] [CompleteSpace W] (T : V →L[𝕜] W) : + T.ker = (adjoint T).rangeᗮ := by + simpa [ContinuousLinearMap.adjoint_adjoint] using + (ContinuousLinearMap.orthogonal_range (adjoint T)).symm + +theorem ContinuousLinearMap.ker_adjoint_eq_ortho_range {W : Type _} [NormedAddCommGroup W] + [InnerProductSpace 𝕜 W] [CompleteSpace V] [CompleteSpace W] (T : V →L[𝕜] W) : + (adjoint T).ker = T.rangeᗮ := by + simpa using (ContinuousLinearMap.orthogonal_range T).symm + +theorem ContinuousLinearMap.ker_adjoint_ortho_eq_range {W : Type _} [NormedAddCommGroup W] + [InnerProductSpace 𝕜 W] [CompleteSpace V] [CompleteSpace W] (T : V →L[𝕜] W) + [T.range.HasOrthogonalProjection] : + ((adjoint T).ker)ᗮ = T.range := by + rw [ker_adjoint_eq_ortho_range, Submodule.orthogonal_orthogonal] + +theorem ContinuousLinearMap.IsStarNormal.isCompl_ker_range (T : V →L[𝕜] V) + [CompleteSpace V] + [T.range.HasOrthogonalProjection] + (h : IsStarNormal T) : IsCompl T.ker T.range := by + simpa [ContinuousLinearMap.IsStarNormal.orthogonal_range h] using + (Submodule.isCompl_orthogonal_of_hasOrthogonalProjection (K := T.range)).symm + +theorem ContinuousLinearMap.IsIdempotentElem.isSelfAdjoint_iff_ker_isOrtho_to_range + [InnerProductSpace ℂ V] [CompleteSpace V] (T : V →L[ℂ] V) (h : IsIdempotentElem T) : + IsSelfAdjoint T ↔ T.ker = T.rangeᗮ := by + constructor + · intro hT; + rw [← ContinuousLinearMap.adjoint_adjoint T, ← + ContinuousLinearMap.ker_eq_ortho_adjoint_range, ContinuousLinearMap.adjoint_adjoint] + exact ContinuousLinearMap.IsStarNormal.ker_eq_ker_adjoint hT.isStarNormal + · intro h1 + rw [ContinuousLinearMap.isSelfAdjoint_iff'] + apply eq_of_sub_eq_zero + simp_rw [ContinuousLinearMap.ext_iff, ← ContinuousLinearMap.coe_coe, + ContinuousLinearMap.coe_sub, ContinuousLinearMap.coe_zero, + ← LinearMap.ext_iff, ← inner_map_self_eq_zero] + intro x + have h_toLinearMap : IsIdempotentElem T.toLinearMap := + ContinuousLinearMap.IsIdempotentElem.toLinearMap h + have h_idempotent := IsIdempotentElem.eq h_toLinearMap + rw [Module.End.mul_eq_comp] at h_idempotent + obtain ⟨U, hT⟩ := T.toLinearMap.isProj_iff_isIdempotentElem.mpr h_idempotent + obtain ⟨v, w, hvw, _⟩ := + Submodule.existsUnique_add_of_isCompl (LinearMap.IsProj.isCompl_range_ker U (↑T) hT) x + simp only [LinearMap.sub_apply, inner_sub_left] + rcases SetLike.coe_mem w with ⟨y, hy⟩ + simp_rw [ContinuousLinearMap.coe_coe, ContinuousLinearMap.adjoint_inner_left, ← + ContinuousLinearMap.coe_coe, ← hvw, map_add, LinearMap.mem_ker.mp (SetLike.coe_mem v), ← hy, + ← Module.End.mul_apply, IsIdempotentElem.eq h_toLinearMap, zero_add, hy, + inner_add_left, inner_add_right, ← + inner_conj_symm (w : V) (v : V), + (Submodule.mem_orthogonal T.ker (w : V)).mp + (by rw [h1]; intro y hy; rw [inner_eq_zero_symm]; exact hy w (SetLike.coe_mem w)) v + (SetLike.coe_mem v), + map_zero, zero_add, sub_self] + +open scoped ComplexConjugate + +open Module.End + +/-- +If $T$ is normal, then $\forall x \in V$, +$x \in \textnormal{eigenspace}(T ,\mu) \iff x \in \textnormal{eigenspace}(T^* ,\bar{\mu})$. +-/ +theorem LinearMap.IsStarNormal.eigenvec_in_eigenspace_iff_eigenvec_in_adjoint_conj_eigenspace + [InnerProductSpace ℂ V] [FiniteDimensional ℂ V] (T : V →ₗ[ℂ] V) (h : IsStarNormal T) (μ : ℂ) : + ∀ x : V, x ∈ eigenspace T μ ↔ x ∈ eigenspace (adjoint T) (conj μ) := + by + suffices + ∀ T : V →ₗ[ℂ] V, + IsStarNormal T → ∀ μ : ℂ, ∀ v : V, v ∈ eigenspace T μ → v ∈ eigenspace (adjoint T) (conj μ) + by + intro v; refine ⟨this T h μ v, ?_⟩ + intro hv; rw [← adjoint_adjoint T, ← RCLike.conj_conj μ] + apply this _ _ _ _ hv; exact IsStarNormal.star + clear h μ T + intro T h μ v hv + have t1 : (T - μ • 1) v = 0 := + by + rw [sub_apply, smul_apply, one_apply, sub_eq_zero] + exact mem_eigenspace_iff.mp hv + suffices (adjoint T - conj μ • 1) v = 0 + by + rw [mem_eigenspace_iff, ← sub_eq_zero] + rw [sub_apply, smul_apply, one_apply] at this; exact this + rw [← norm_eq_zero] + have nh : IsStarNormal (T - μ • 1) := by + apply IsStarNormal.mk + rw [star_sub, star_smul, RCLike.star_def, star_one, Commute, SemiconjBy] + simp only [sub_mul, mul_sub, Commute.eq h.star_comm_self] + simp only [smul_one_mul, smul_smul, mul_smul_comm, mul_one] + rw [mul_comm, sub_sub_sub_comm] + have : adjoint (T - μ • 1) = adjoint T - conj μ • 1 := by + simp only [← star_eq_adjoint, star_sub, star_smul, RCLike.star_def, star_one] + rw [← this, ← (LinearMap.IsStarNormal.norm_eq_adjoint (T - μ • 1)).mp nh, t1, norm_zero] + +end IsStarNormal + +lemma ContinuousLinearMap.ker_to_linearMap_ker {W : Type _} [NormedAddCommGroup W] + [InnerProductSpace 𝕜 W] (T : V →L[𝕜] W) : + ∀ x, x ∈ LinearMap.ker (T : V →ₗ[𝕜] W) ↔ T x = 0 := by + intro x + rfl + +/-- $T$ is injective if and only if $T^*$ is surjective. -/ +theorem ContinuousLinearMap.adjoint_injective_iff_surjective {W : Type _} [NormedAddCommGroup W] + [InnerProductSpace 𝕜 W] [CompleteSpace W] [CompleteSpace V] (T : V →L[𝕜] W) + [T.range.HasOrthogonalProjection] : + Function.Injective (adjoint T) ↔ Function.Surjective T := by + change Function.Injective (adjoint T).toLinearMap ↔ Function.Surjective T.toLinearMap + rw [← LinearMap.ker_eq_bot, ← LinearMap.range_eq_top] + change (adjoint T).ker = ⊥ ↔ T.range = ⊤ + rw [ContinuousLinearMap.ker_adjoint_eq_ortho_range, Submodule.orthogonal_eq_bot_iff] + +/-- $T$ is injective if and only if $T^*$ is surjective. -/ +theorem LinearMap.injective_iff_adjoint_surjective {W : Type _} [NormedAddCommGroup W] + [InnerProductSpace 𝕜 W] [FiniteDimensional 𝕜 W] [FiniteDimensional 𝕜 V] (T : V →ₗ[𝕜] W) : + Function.Injective T ↔ Function.Surjective (adjoint T) := by + rw [← LinearMap.ker_eq_bot, ← LinearMap.range_eq_top, ker_ortho_adjoint_range, + Submodule.orthogonal_eq_bot_iff] diff --git a/LeanPool/Monlib4/LinearAlgebra/Ips/MatIps.lean b/LeanPool/Monlib4/LinearAlgebra/Ips/MatIps.lean new file mode 100644 index 0000000000..b14ebc8997 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Ips/MatIps.lean @@ -0,0 +1,1735 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.LinearAlgebra.Ips.Functional +import LeanPool.Monlib4.LinearAlgebra.Matrix.PosDefRpow +import LeanPool.Monlib4.LinearAlgebra.Mul'' +import LeanPool.Monlib4.LinearAlgebra.Ips.Basic +import LeanPool.Monlib4.LinearAlgebra.PiDirectSum +import LeanPool.Monlib4.LinearAlgebra.ToMatrixOfEquiv + +/-! + +# The inner product space on finite dimensional C*-algebras + +This file contains some basic results on the inner product space on finite dimensional C*-algebras. + +-/ + + +open scoped TensorProduct + +/-- Elaborate a term using the inner product induced by a matrix functional. -/ +syntax "withMatrixInner[" term "] " term : term +macro_rules + | `(withMatrixInner[$φ] $p) => + `(letI := Module.Dual.NormedAddCommGroup $φ + letI := (Module.Dual.NormedAddCommGroup + $φ).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI := (Module.Dual.NormedAddCommGroup $φ).toSeminormedAddCommGroup + letI := Module.Dual.InnerProductSpace (φ := $φ) + $p) + +/-- Elaborate a term using the inner product induced by a pi-family of functionals. -/ +syntax "withPiInner[" term "] " term : term +macro_rules + | `(withPiInner[$ψ] $p) => + `(letI := Module.Dual.PiNormedAddCommGroup (φ := $ψ) + letI := (Module.Dual.PiNormedAddCommGroup (φ := + $ψ)).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI := (Module.Dual.PiNormedAddCommGroup (φ := $ψ)).toSeminormedAddCommGroup + letI := Module.Dual.pi.InnerProductSpace (φ := $ψ) + letI := fun i => Module.Dual.NormedAddCommGroup ($ψ i) + letI := fun i => (Module.Dual.NormedAddCommGroup ($ψ + i)).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI := fun i => (Module.Dual.NormedAddCommGroup ($ψ i)).toSeminormedAddCommGroup + letI := fun i => Module.Dual.InnerProductSpace (φ := $ψ i) + $p) + +/-- A lemma that states the right multiplication property of a linear functional. -/ +theorem linear_functional_right_hMul {R A : Type _} [CommSemiring R] [Semiring A] [Algebra R A] + [StarMul A] {φ : A →ₗ[R] R} (x y z : A) : φ (star (x * y) * z) = φ (star y * (star x * z)) := by + rw [StarMul.star_mul, mul_assoc] + +/-- A lemma that states the left multiplication property of a linear functional. -/ +theorem linear_functional_left_hMul {R A : Type _} [CommSemiring R] [Semiring A] [Algebra R A] + [StarMul A] {φ : A →ₗ[R] R} (x y z : A) : φ (star x * (y * z)) = φ (star (star y * x) * z) := by + rw [StarMul.star_mul, star_star, mul_assoc] + +variable {k k₂ : Type _} [Fintype k] [Fintype k₂] [DecidableEq k] [DecidableEq k₂] + {s : k → Type _} {s₂ : k₂ → Type*} [∀ i, Fintype (s i)] [∀ i, Fintype (s₂ i)] + [∀ i, DecidableEq (s i)] [∀ i, DecidableEq (s₂ i)] + {ψ : ∀ i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} {φ : ∀ i, Module.Dual ℂ (Matrix (s₂ i) (s₂ i) ℂ)} + -- [hψ : ∀ i, Fact (ψ i).IsFaithfulPosMap] + +open Matrix + +open scoped Matrix BigOperators + +/-- A function that returns the direct sum of matrices for each index of type 'i'. -/ +noncomputable def Module.Dual.pi.matrixBlock (ψ : ∀ i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)) : + ∀ i, Matrix (s i) (s i) ℂ := +∑ i, includeBlock (ψ i).matrix + +-- /-- A function that returns a direct sum matrix. -/ +-- noncomputable def Module.Dual.pi.matrix (ψ : ∀ i, Matrix (s i) (s i) ℂ →ₗ[ℂ] ℂ) : +-- Matrix (Σ i, s i) (Σ i, s i) ℂ := +-- blockDiagonal' (Module.Dual.pi.matrixBlock ψ) + +open scoped InnerProductSpace + +open scoped Classical in +omit [DecidableEq k] [(i : k) → DecidableEq (s i)] in +/-- +A lemma that states the inner product of two direct sum matrices is the sum of the inner products + of their components. -/ +theorem inner_pi_eq_sum [∀ i, (ψ i).IsFaithfulPosMap] (x y : PiMat ℂ k s) : + withPiInner[ψ] (⟪x, y⟫_ℂ = ∑ i, ⟪x i, y i⟫_ℂ) := + rfl + +theorem blockDiagonal'_includeBlock_trace' {R k : Type _} [CommSemiring R] [Fintype k] + [DecidableEq k] {s : k → Type _} [∀ i, Fintype (s i)] + (j : k) (x : Matrix (s j) (s j) R) : + (blockDiagonal' (includeBlock x)).trace = x.trace := + by + classical + calc + (blockDiagonal' (includeBlock x)).trace + = ∑ i, (includeBlock x i).trace := + by simp_rw [Matrix.trace, Matrix.diag, blockDiagonal'_apply, dif_pos, + Finset.sum_sigma']; rfl + _ = ∑ i, ∑ a, includeBlock x i a a := rfl + _ = ∑ i, ∑ a, dite (j = i) (fun h => by rw [← h]; exact x) + (fun _ => (0 : Matrix (s i) (s i) R)) a a := + by simp_rw [includeBlock_apply]; rfl + _ = ∑ i, ∑ a, dite (j = i) (fun h => + (by rw [← h]; exact x : Matrix (s i) (s i) R) a a) + (fun _ => (0 : R)) := by congr; ext; congr; ext; aesop + _ = x.trace := by + simp_rw [Finset.sum_dite_irrel, Finset.sum_const_zero, + Finset.sum_dite_eq, Finset.mem_univ, if_true] + rfl + +theorem Module.Dual.pi.matrixBlock_apply {i : k} : Module.Dual.pi.matrixBlock ψ i = (ψ i).matrix := + by + simp only [Module.Dual.pi.matrixBlock, Finset.sum_apply, includeBlock_apply, Finset.sum_dite_eq', + Finset.mem_univ, if_true] + rfl + +-- /-- A function that returns a star algebra equivalence for each index of type 'i'. -/ +-- def StarAlgEquiv.pi {𝕜 : Type _} [RCLike 𝕜] {k : Type _} [Fintype k] [DecidableEq k] +-- {s : k → Type _} [∀ i : k, Fintype (s i)] [∀ i : k, DecidableEq (s i)] +-- (f : ∀ i, Matrix (s i) (s i) 𝕜 ≃⋆ₐ[𝕜] Matrix (s i) (s i) 𝕜) : +-- (PiMat 𝕜 k s) ≃⋆ₐ[𝕜] PiMat 𝕜 k s +-- where +-- toFun x i := f i (x i) +-- invFun x i := (f i).symm (x i) +-- left_inv a := by simp only [StarAlgEquiv.symm_apply_apply] +-- right_inv a := by simp only [StarAlgEquiv.apply_symm_apply] +-- map_add' a y := by +-- simp only [Pi.add_apply, map_add] +-- rfl +-- map_smul' r a := by +-- simp only [Pi.smul_apply, _root_.map_smul] +-- rfl +-- map_mul' a b := by +-- simp only [Pi.mul_apply, _root_.map_mul] +-- rfl +-- map_star' a := by +-- simp only [Pi.star_apply, map_star] +-- rfl + +-- theorem StarAlgEquiv.pi_apply {𝕜 : Type _} [RCLike 𝕜] {k : Type _} [Fintype k] [DecidableEq k] +-- {s : k → Type _} [∀ i : k, Fintype (s i)] [∀ i : k, DecidableEq (s i)] +-- (f : ∀ i, Matrix (s i) (s i) 𝕜 ≃⋆ₐ[𝕜] Matrix (s i) (s i) 𝕜) (x : PiMat 𝕜 k s) +-- (i : k) : StarAlgEquiv.pi f x i = f i (x i) := +-- rfl + +-- /-- the unitary element from the star algebraic equivalence -/ +-- noncomputable def StarAlgEquiv.pi.unitary {𝕜 : Type _} [RCLike 𝕜] {k : Type _} [Fintype k] +-- [DecidableEq k] {s : k → Type _} [∀ i : k, Fintype (s i)] [∀ i : k, DecidableEq (s i)] +-- (f : ∀ i, Matrix (s i) (s i) 𝕜 ≃⋆ₐ[𝕜] Matrix (s i) (s i) 𝕜) : ∀ i, unitaryGroup (s i) 𝕜 := +-- fun i => (f i).of_matrix_unitary + +-- theorem StarAlgEquiv.pi.unitary_apply {𝕜 : Type _} [RCLike 𝕜] {k : Type _} [Fintype k] +-- [DecidableEq k] {s : k → Type _} [∀ i : k, Fintype (s i)] [∀ i : k, DecidableEq (s i)] +-- (f : ∀ i, Matrix (s i) (s i) 𝕜 ≃⋆ₐ[𝕜] Matrix (s i) (s i) 𝕜) (a : k) : +-- (StarAlgEquiv.pi.unitary f) a = (f a).of_matrix_unitary := +-- rfl + +-- /-- any decomposable $^*$-isomorphism is an inner automorphism -/ +-- theorem StarAlgEquiv.of_pi_is_inner {𝕜 : Type _} [RCLike 𝕜] {k : Type _} [Fintype k] +-- [DecidableEq k] {s : k → Type _} [∀ i : k, Fintype (s i)] [∀ i : k, DecidableEq (s i)] +-- (f : ∀ i, Matrix (s i) (s i) 𝕜 ≃⋆ₐ[𝕜] Matrix (s i) (s i) 𝕜) : +-- unitary.innerAutStarAlg 𝕜 (unitary.pi (StarAlgEquiv.pi.unitary f)) = StarAlgEquiv.pi f := +-- by +-- simp_rw [StarAlgEquiv.ext_iff, unitary.innerAutStarAlg_apply, Function.funext_iff, +-- Pi.mul_apply] +-- simp only [unitary.pi_apply, Unitary.coe_star, Pi.star_apply, unitary.pi_apply, +-- StarAlgEquiv.pi_apply, +-- StarAlgEquiv.pi.unitary_apply] +-- intros a_1 i +-- rw [← Unitary.coe_star, ← @unitary.innerAutStarAlg_apply 𝕜 _ _ _ _ _ (f _).of_matrix_unitary +-- (a_1 _)] +-- congr +-- exact StarAlgEquiv.eq_innerAut _ + +/-- Include a component vector into a dependent sigma-indexed vector. -/ +def inclPi {i : k} (x : s i → ℂ) : (Σ j, s j) → ℂ := fun j => + dite (i = j.1) (fun h => x (by rw [h]; exact j.2)) fun _ => 0 + +/-- Restrict a dependent sigma-indexed vector to one component. -/ +def exclPi (x : (Σ j, s j) → ℂ) (i : k) : s i → ℂ := fun j => x ⟨i, j⟩ + +omit [Fintype k] [DecidableEq k] [(i : k) → DecidableEq (s i)] in +private theorem pi.forall_left_mul (x y : PiMat ℂ k s) : + (∀ a, a * x = a * y) ↔ x = y := by + classical + constructor + · intro h + specialize h 1 + simp_rw [one_mul] at h + exact h + · rintro rfl a + rfl + +theorem Module.Dual.pi.apply'' (ψ : ∀ i, Matrix (s i) (s i) ℂ →ₗ[ℂ] ℂ) + (x : PiMat ℂ k s) : + Module.Dual.pi ψ x = (blockDiagonal' (Module.Dual.pi.matrixBlock ψ) * blockDiagonal' x).trace := + by + simp_rw [Module.Dual.pi.apply', Module.Dual.pi.matrixBlock, ← blockDiagonal'AlgHom_apply, + map_sum, Finset.sum_mul, trace_sum] + +-- theorem StarAlgEquiv.pi_is_trace_preserving +-- (f : ∀ i, Matrix (s i) (s i) ℂ ≃⋆ₐ[ℂ] Matrix (s i) (s i) ℂ) (x : PiMat ℂ k s) : +-- (blockDiagonal'AlgHom ((StarAlgEquiv.pi f) x)).trace = (blockDiagonal'AlgHom x).trace := +-- by +-- rw [matrix_eq_sum_includeBlock ((StarAlgEquiv.pi f) x)] +-- nth_rw 2 [matrix_eq_sum_includeBlock x] +-- simp only [map_sum, trace_sum] +-- simp_rw [blockDiagonal'AlgHom_apply, blockDiagonal'_includeBlock_trace, +-- StarAlgEquiv.pi_apply, StarAlgEquiv.trace_preserving] + +-- theorem StarAlgEquiv.pi_symm_apply_apply (f : ∀ i, Matrix (s i) (s i) ℂ ≃⋆ₐ[ℂ] Matrix (s i) (s +-- i) ℂ) +-- (x : PiMat ℂ k s) : +-- (StarAlgEquiv.pi fun i => (f i).symm) ((StarAlgEquiv.pi f) x) = x := +-- by +-- ext1 +-- simp only [StarAlgEquiv.pi_apply, StarAlgEquiv.symm_apply_apply] + +theorem Module.Dual.pi.apply_eq_of (ψ : ∀ i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)) + (x : PiMat ℂ k s) + (h : ∀ a, Module.Dual.pi ψ a = (blockDiagonal' x * blockDiagonal' a).trace) : + x = Module.Dual.pi.matrixBlock ψ := by + ext1 x_1 + simp only [Module.Dual.pi.matrixBlock_apply] + apply Module.Dual.apply_eq_of + intro a + let a' := includeBlock a + have ha' : a = a' x_1 := by simp only [a', includeBlock_apply_same] + specialize h a' + simp_rw [ha', ← Module.Dual.pi.apply_single_block, ← Pi.mul_apply, ← + blockDiagonal'_includeBlock_trace, ← ha', Pi.mul_apply, ← ha'] + simp only [← blockDiagonal'AlgHom_apply, ← _root_.map_mul, a', hMul_includeBlock] at h + exact h + +-- theorem StarAlgEquiv.pi_symm_apply_eq (f : ∀ i, Matrix (s i) (s i) ℂ ≃⋆ₐ[ℂ] Matrix (s i) (s i) ℂ) +-- (x y : PiMat ℂ k s) : +-- StarAlgEquiv.pi (fun i => (f i).symm) x = y ↔ x = StarAlgEquiv.pi f y := +-- by +-- constructor <;> rintro rfl <;> ext1 <;> simp only [StarAlgEquiv.pi_apply] +-- · rw [StarAlgEquiv.apply_symm_apply] +-- · rw [StarAlgEquiv.symm_apply_apply] + +theorem unitary.inj_hMul {A : Type _} [Monoid A] [StarMul A] (U : unitary A) (x y : A) : + x = y ↔ x * U = y * U := by + rw [IsUnit.mul_left_inj] + · rw [← Unitary.val_toUnits_apply] + exact (Unitary.toUnits U).isUnit + +section SingleBlock + +/-! + ## Section `single_block` +-/ + + +variable {n n₂ : Type _} [DecidableEq n] [DecidableEq n₂] [Fintype n] [Fintype n₂] + {φ : Module.Dual ℂ (Matrix n n ℂ)} {ψ : Module.Dual ℂ (Matrix n₂ n₂ ℂ)} + +namespace Module.Dual.IsFaithfulPosMap + +open scoped ComplexOrder + +open scoped Classical in +omit [DecidableEq n] in +theorem inner_eq [φ.IsFaithfulPosMap] (x y : Matrix n n ℂ) : + withMatrixInner[φ] (⟪x, y⟫_ℂ = φ (xᴴ * y)) := +rfl + +theorem inner_eq' (hφ : φ.IsFaithfulPosMap) (x y : Matrix n n ℂ) : + withMatrixInner[φ] (⟪x, y⟫_ℂ = (φ.matrix * xᴴ * y).trace) := by +rw [inner_eq, φ.apply, Matrix.mul_assoc] + +/-- The density matrix of a faithful positive functional is positive definite. -/ +theorem matrixIsPosDef (hφ : φ.IsFaithfulPosMap) : PosDef φ.matrix := +φ.isFaithfulPosMap_iff_of_matrix.mp hφ + +/-- Modular automorphism associated to a faithful positive functional on matrices. -/ +@[simps] +noncomputable def _root_.sig (hφ : φ.IsFaithfulPosMap) (z : ℝ) : + Matrix n n ℂ ≃ₐ[ℂ] Matrix n n ℂ where + toFun a := hφ.matrixIsPosDef.rpow (-z) * a * hφ.matrixIsPosDef.rpow z + invFun a := hφ.matrixIsPosDef.rpow z * a * hφ.matrixIsPosDef.rpow (-z) + left_inv a := by + simp_rw [Matrix.mul_assoc, PosDef.rpow_mul_rpow, ← Matrix.mul_assoc, PosDef.rpow_mul_rpow, + add_neg_cancel, PosDef.rpow_zero, Matrix.one_mul, Matrix.mul_one] + right_inv a := by + simp_rw [Matrix.mul_assoc, PosDef.rpow_mul_rpow, ← Matrix.mul_assoc, PosDef.rpow_mul_rpow, + neg_add_cancel, PosDef.rpow_zero, Matrix.one_mul, Matrix.mul_one] + map_add' x y := by simp_rw [Matrix.mul_add, Matrix.add_mul] + commutes' r := by + simp_rw [Algebra.algebraMap_eq_smul_one, Matrix.mul_smul, Matrix.smul_mul, Matrix.mul_one, + PosDef.rpow_mul_rpow, neg_add_cancel, PosDef.rpow_zero] + map_mul' x y := by + simp_rw [Matrix.mul_assoc, ← Matrix.mul_assoc (hφ.matrixIsPosDef.rpow _), + PosDef.rpow_mul_rpow, add_neg_cancel, PosDef.rpow_zero, Matrix.one_mul] + +/-- The modular automorphism associated to a faithful positive matrix functional. -/ +@[reducible] +noncomputable def sig (hφ : φ.IsFaithfulPosMap) (z : ℝ) : + Matrix n n ℂ ≃ₐ[ℂ] Matrix n n ℂ := + _root_.sig hφ z + +theorem sig_apply (hφ : φ.IsFaithfulPosMap) (z : ℝ) (a : Matrix n n ℂ) : + hφ.sig z a = hφ.matrixIsPosDef.rpow (-z) * a * hφ.matrixIsPosDef.rpow z := + _root_.sig_apply hφ z a + +theorem sig_symm_apply (hφ : φ.IsFaithfulPosMap) (z : ℝ) (a : Matrix n n ℂ) : + (hφ.sig z).symm a = + hφ.matrixIsPosDef.rpow z * a * hφ.matrixIsPosDef.rpow (-z) := + _root_.sig_symm_apply hφ z a + +theorem sig_symm_eq (hφ : φ.IsFaithfulPosMap) (z : ℝ) : + (hφ.sig z).symm = hφ.sig (-z) := by + ext a + simp only [sig_apply, sig_symm_apply, neg_neg] + +theorem sig_apply_sig (hφ : φ.IsFaithfulPosMap) (t r : ℝ) (a : Matrix n n ℂ) : + hφ.sig t (hφ.sig r a) = hφ.sig (t + r) a := by + simp only [sig_apply] + simp_rw [← Matrix.mul_assoc, PosDef.rpow_mul_rpow, Matrix.mul_assoc, + PosDef.rpow_mul_rpow, neg_add, add_comm] + +theorem sig_conjTranspose (hφ : φ.IsFaithfulPosMap) (r : ℝ) (a : Matrix n n ℂ) : + (hφ.sig r a)ᴴ = hφ.sig (-r) aᴴ := by + simp only [sig_apply, Matrix.conjTranspose_mul, + (PosDef.rpow.isPosDef hφ.matrixIsPosDef r).1.eq, + (PosDef.rpow.isPosDef hφ.matrixIsPosDef (-r)).1.eq, neg_neg] + simp_rw [Matrix.mul_assoc] + +theorem sig_adjoint [hφ : φ.IsFaithfulPosMap] {t : ℝ} : + withMatrixInner[φ] + (LinearMap.adjoint (hφ.sig t).toLinearMap = (hφ.sig t).toLinearMap) := +by + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := Module.Dual.InnerProductSpace (φ := φ) + rw [LinearMap.ext_iff_inner_map] + intro x + simp_rw [LinearMap.adjoint_inner_left, Module.Dual.IsFaithfulPosMap.inner_eq', + AlgEquiv.toLinearMap_apply, Module.Dual.IsFaithfulPosMap.sig_conjTranspose, + Module.Dual.IsFaithfulPosMap.sig_apply, neg_neg] + let hQ := hφ.matrixIsPosDef + let Q := φ.matrix + calc + (Q * xᴴ * (hQ.rpow (-t) * x * hQ.rpow t)).trace = + (hQ.rpow t * Q * xᴴ * hQ.rpow (-t) * x).trace := by + rw [← Matrix.mul_assoc, trace_mul_cycle] + simp_rw [Matrix.mul_assoc] + _ = (hQ.rpow t * hQ.rpow 1 * xᴴ * hQ.rpow (-t) * x).trace := by + rw [PosDef.rpow_one_eq_self] + _ = (hQ.rpow 1 * hQ.rpow t * xᴴ * hQ.rpow (-t) * x).trace := by + simp_rw [PosDef.rpow_mul_rpow, add_comm] + _ = (Q * (hQ.rpow t * xᴴ * hQ.rpow (-t)) * x).trace := by + simp_rw [PosDef.rpow_one_eq_self, Matrix.mul_assoc] + rfl + +theorem hMul_right (hφ : φ.IsFaithfulPosMap) (x y z : Matrix n n ℂ) : + φ (xᴴ * (y * z)) = φ ((x * (φ.matrix * zᴴ * φ.matrix⁻¹))ᴴ * y) := + by + haveI := (hφ.matrixIsPosDef).invertible + simp_rw [φ.apply, Matrix.conjTranspose_mul, Matrix.conjTranspose_conjTranspose, + hφ.matrixIsPosDef.1.eq, hφ.matrixIsPosDef.inv.1.eq, ← Matrix.mul_assoc, Matrix.mul_assoc, + Matrix.mul_inv_cancel_left_of_invertible] + rw [Matrix.trace_mul_cycle', Matrix.mul_assoc, ← Matrix.trace_mul_cycle', Matrix.mul_assoc] + +open scoped Classical in +omit [DecidableEq n] in +theorem inner_left_hMul [φ.IsFaithfulPosMap] (x y z : Matrix n n ℂ) : + withMatrixInner[φ] (⟪x * y, z⟫_ℂ = ⟪y, xᴴ * z⟫_ℂ) := +linear_functional_right_hMul _ _ _ + +open scoped Classical in +omit [DecidableEq n] in +theorem inner_right_hMul [φ.IsFaithfulPosMap] (x y z : Matrix n n ℂ) : + withMatrixInner[φ] (⟪x, y * z⟫_ℂ = ⟪yᴴ * x, z⟫_ℂ) := +linear_functional_left_hMul _ _ _ + +theorem inner_left_conj (hφ : φ.IsFaithfulPosMap) (x y z : Matrix n n ℂ) : + withMatrixInner[φ] (⟪x, y * z⟫_ℂ = ⟪x * (φ.matrix * zᴴ * φ.matrix⁻¹), y⟫_ℂ) := +hφ.hMul_right _ _ _ + +theorem hMul_left (hφ : φ.IsFaithfulPosMap) (x y z : Matrix n n ℂ) : + φ ((x * y)ᴴ * z) = φ (xᴴ * (z * (φ.matrix * yᴴ * φ.matrix⁻¹))) := +by + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := Module.Dual.InnerProductSpace (φ := φ) + rw [← inner_eq, ← inner_conj_symm, inner_left_conj, inner_conj_symm] + rfl + +theorem inner_right_conj (hφ : φ.IsFaithfulPosMap) (x y z : Matrix n n ℂ) : + withMatrixInner[φ] (⟪x * y, z⟫_ℂ = ⟪x, z * (φ.matrix * yᴴ * φ.matrix⁻¹)⟫_ℂ) := +hφ.hMul_left _ _ _ + +theorem adjoint_eq (hφ : φ.IsFaithfulPosMap) : + withMatrixInner[φ] + (LinearMap.adjoint φ = (Algebra.linearMap ℂ (Matrix n n ℂ) : ℂ →ₗ[ℂ] Matrix n n ℂ)) := +by + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := Module.Dual.InnerProductSpace (φ := φ) + rw [LinearMap.ext_iff] + intro x + apply @ext_inner_right ℂ + intro y + rw [LinearMap.adjoint_inner_left, Algebra.linearMap_apply, Algebra.algebraMap_eq_smul_one, + inner_smul_left, inner_eq, conjTranspose_one, Matrix.one_mul] + rw [mul_comm] + rfl + +/-- The adjoint of a star-algebraic equivalence $f$ on matrix algebras is given by + $$f^*\colon x \mapsto f^{-1}(x Q) Q^{-1},$$ + where $Q$ is `hφ.matrix`. -/ +theorem starAlgEquiv_adjoint_eq (hφ : φ.IsFaithfulPosMap) + (f : Matrix n n ℂ ≃⋆ₐ[ℂ] Matrix n n ℂ) (x : Matrix n n ℂ) : + withMatrixInner[φ] + ((LinearMap.adjoint (f : Matrix n n ℂ ≃⋆ₐ[ℂ] Matrix n n ℂ).toLinearMap : + Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ) + x = + (f.symm (x * φ.matrix) : Matrix n n ℂ) * φ.matrix⁻¹) := +by + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := Module.Dual.InnerProductSpace (φ := φ) + haveI := hφ.matrixIsPosDef.invertible + apply @ext_inner_left ℂ + intro a + simp_rw [LinearMap.adjoint_inner_right, StarAlgEquiv.toLinearMap_apply] + obtain ⟨U, rfl⟩ := f.of_matrix_is_inner + simp_rw [innerAutStarAlg_apply, innerAutStarAlg_symm_apply, Matrix.mul_assoc] + nth_rw 1 [← Matrix.mul_assoc φ.matrix] + nth_rw 2 [← Matrix.mul_assoc] + rw [inner_left_conj, inner_right_hMul] + simp_rw [conjTranspose_mul, hφ.matrixIsPosDef.1.eq, hφ.matrixIsPosDef.inv.1.eq, ← + star_eq_conjTranspose, ← unitaryGroup.star_coe_eq_coe_star, star_star, + Matrix.mul_inv_cancel_left_of_invertible, Matrix.mul_assoc, mul_inv_of_invertible, + Matrix.mul_one] + +theorem starAlgEquiv_unitary_commute_iff [φ.IsFaithfulPosMap] + (f : Matrix n n ℂ ≃⋆ₐ[ℂ] Matrix n n ℂ) : + Commute φ.matrix f.of_matrix_unitary ↔ f φ.matrix = φ.matrix := + by + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := Module.Dual.InnerProductSpace (φ := φ) + rw [Commute, SemiconjBy] + nth_rw 3 [← StarAlgEquiv.eq_innerAut f] + rw [innerAutStarAlg_apply, ← unitaryGroup.star_coe_eq_coe_star] + nth_rw 2 [unitaryGroup.injective_hMul f.of_matrix_unitary] + simp_rw [Matrix.mul_assoc, UnitaryGroup.star_mul_self, Matrix.mul_one, eq_comm] + +/-- Let `f` be a star-algebraic equivalence on matrix algebras. Then tfae: + +* `f φ.matrix = φ.matrix`, +* `f.adjoint = f⁻¹`, +* `φ ∘ f = φ`, +* `∀ x y, ⟪f x, f y⟫_ℂ = ⟪x, y⟫_ℂ`, +* `∀ x, ‖f x‖ = ‖x‖`, +* `φ.matrix` commutes with `f.unitary`. +-/ +theorem starAlgEquiv_is_isometry_tFAE [hφ : φ.IsFaithfulPosMap] [Nontrivial n] + (f : Matrix n n ℂ ≃⋆ₐ[ℂ] Matrix n n ℂ) : + withMatrixInner[φ] + (List.TFAE + [f φ.matrix = φ.matrix, + (LinearMap.adjoint (f : Matrix n n ℂ ≃⋆ₐ[ℂ] Matrix n n ℂ).toLinearMap : + Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ) = + f.symm.toLinearMap, + φ ∘ₗ f.toLinearMap = φ, ∀ x y, ⟪f x, f y⟫_ℂ = ⟪x, y⟫_ℂ, + ∀ x : Matrix n n ℂ, ‖f x‖ = ‖x‖, Commute φ.matrix f.of_matrix_unitary]) := + by + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := Module.Dual.InnerProductSpace (φ := φ) + tfae_have 5 ↔ 2 := by + simp_rw [InnerProductSpace.Core.norm_eq_sqrt_re_inner, + Real.sqrt_inj inner_self_nonneg inner_self_nonneg, + ← Complex.ofReal_inj] + have : ∀ x : Matrix n n ℂ, (RCLike.re ⟪x, x⟫_ℂ : ℂ) = ⟪x, x⟫_ℂ := fun x => + inner_self_ofReal_re x + -- inner_self_ofReal_re (f ?_ : Matrix n n ℂ), + simp_rw [this, ← @sub_eq_zero _ _ _ (⟪_, _⟫_ℂ)] + have : + ∀ x y, + ⟪f x, f y⟫_ℂ - ⟪x, y⟫_ℂ = + ⟪(LinearMap.adjoint f.toLinearMap ∘ₗ f.toLinearMap - 1) x, y⟫_ℂ := + by + intro x y + simp only [LinearMap.sub_apply, Module.End.one_apply, inner_sub_left, LinearMap.comp_apply, + LinearMap.adjoint_inner_left, StarAlgEquiv.toLinearMap_apply] + simp_rw [this, inner_map_self_eq_zero, sub_eq_zero, StarAlgEquiv.comp_eq_iff, + LinearMap.one_comp] + rw [tfae_5_iff_2] + tfae_have 4 ↔ 3 := by + simp_rw [inner_eq, ← star_eq_conjTranspose, ← map_star f, ← _root_.map_mul f, + LinearMap.ext_iff, LinearMap.comp_apply, StarAlgEquiv.toLinearMap_apply] + constructor + · intro h x + rw [← Matrix.one_mul x, ← star_one] + exact h _ _ + · intro h x y + exact h _ + rw [tfae_4_iff_3] + haveI := hφ.matrixIsPosDef.invertible + simp_rw [LinearMap.ext_iff, starAlgEquiv_adjoint_eq, LinearMap.comp_apply, + StarAlgEquiv.toLinearMap_apply, mul_inv_eq_iff_eq_mul_of_invertible, + φ.apply, StarAlgEquiv.symm_apply_eq, _root_.map_mul, + StarAlgEquiv.apply_symm_apply, ← forall_left_hMul φ.matrix, @eq_comm _ φ.matrix] + tfae_have 1 ↔ 2 := by rw [iff_self]; trivial + tfae_have 1 → 3 := by + intro i x + nth_rw 1 [← i] + rw [← _root_.map_mul, f.trace_preserving] + tfae_have 3 → 1 := by + intro i + simp_rw [← f.symm.trace_preserving (φ.matrix * f _), _root_.map_mul, + StarAlgEquiv.symm_apply_apply, ← φ.apply, @eq_comm _ _ (φ _)] at i + -- obtain ⟨Q, hQ, h⟩ := Module.Dual.eq_trace_unique φ + -- have := h _ i + -- rw [StarAlgEquiv.symm_apply_eq] at this + have := Module.Dual.apply_eq_of φ _ i + rw [StarAlgEquiv.symm_apply_eq] at this + exact this.symm + rw [starAlgEquiv_unitary_commute_iff] + tfae_finish + +/-- The matrix-unit basis normalized by the square root of the density matrix. -/ +protected noncomputable def basis (hφ : φ.IsFaithfulPosMap) : Basis (n × n) ℂ (Matrix n n ℂ) := + by + let hQ := hφ.matrixIsPosDef + refine Basis.mk + (v := fun ij : n × n => single ij.1 ij.2 1 * hφ.matrixIsPosDef.rpow (-(1 / 2))) ?_ ?_ + · have := (stdBasis ℂ n n).linearIndependent + simp_rw [linearIndependent_iff_injective_finsuppLinearCombination, injective_iff_map_eq_zero, + Finsupp.linearCombination_apply, Finsupp.sum] at this ⊢ + simp_rw [← smul_mul_assoc, ← Finset.sum_mul] + by_cases h : IsEmpty n + · haveI := h + simp only [eq_iff_true_of_subsingleton, forall_const] + rw [not_isEmpty_iff] at h + have t1 : + ∀ a : n × n →₀ ℂ, + (∑ x ∈ a.support, a x • (single x.fst x.snd 1 : Matrix n n ℂ)) * + hQ.rpow (-(1 / 2)) = + 0 ↔ + (∑ x ∈ a.support, a x • (single x.fst x.snd 1 : Matrix n n ℂ)) * + hQ.rpow (-(1 / 2)) * + hQ.rpow (1 / 2) = + 0 * hQ.rpow (1 / 2) := + by + intro a + constructor <;> intro h + · rw [h] + · simp_rw [mul_assoc, Matrix.PosDef.rpow_mul_rpow, neg_add_cancel, + Matrix.PosDef.rpow_zero, Matrix.mul_one] at h + rw [h, Matrix.zero_mul, MulZeroClass.zero_mul] + simp_rw [t1, mul_assoc, Matrix.PosDef.rpow_mul_rpow, neg_add_cancel, + Matrix.PosDef.rpow_zero, Matrix.zero_mul, Matrix.mul_one, ← stdBasis_eq_single ℂ, + Prod.mk.eta] + exact this + · simp_rw [top_le_iff] + ext x + simp_rw [Submodule.mem_top, iff_true, Submodule.mem_span_range_iff_exists_fun, ← smul_mul, + ← Finset.sum_mul, ← Matrix.ext_iff, mul_apply, Matrix.sum_apply, + Matrix.smul_apply, single, of_apply, smul_ite, smul_zero, ← Prod.mk_inj, Prod.mk.eta, + Finset.sum_ite_eq', Finset.mem_univ, if_true, smul_mul_assoc, one_mul] + exists fun ij : n × n => (x * hQ.rpow (1 / 2) : Matrix n n ℂ) ij.1 ij.2 + simp_rw [smul_eq_mul, ← mul_apply, Matrix.mul_assoc, Matrix.PosDef.rpow_mul_rpow, + add_neg_cancel, + Matrix.PosDef.rpow_zero, Matrix.mul_one, forall₂_true_iff] + +protected theorem basis_apply (hφ : φ.IsFaithfulPosMap) (ij : n × n) : + hφ.basis ij = single ij.1 ij.2 (1 : ℂ) * hφ.matrixIsPosDef.rpow (-(1 / 2 : ℝ)) := by + rw [IsFaithfulPosMap.basis, Basis.mk_apply] + +local notation "|" x "⟩⟨" y "|" => @rankOne ℂ _ _ _ _ _ _ _ x y + +/-- Matrix representation of linear maps between two faithful matrix inner products. -/ +protected noncomputable def toMatrixLinEquiv (hφ : φ.IsFaithfulPosMap) (hψ : ψ.IsFaithfulPosMap) : + (Matrix n n ℂ →ₗ[ℂ] Matrix n₂ n₂ ℂ) ≃ₗ[ℂ] Matrix (n₂ × n₂) (n × n) ℂ := +LinearMap.toMatrix hφ.basis hψ.basis + +/-- Matrix representation of endomorphisms for a faithful matrix inner product. -/ +protected noncomputable def toMatrix (hφ : φ.IsFaithfulPosMap) : + (Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ) ≃ₐ[ℂ] Matrix (n × n) (n × n) ℂ := + LinearMap.toMatrixAlgEquiv hφ.basis + +theorem basis_is_orthonormal (hφ : φ.IsFaithfulPosMap) : + withMatrixInner[φ] (Orthonormal (𝕜 := ℂ) (E := Matrix n n ℂ) hφ.basis) := by + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := Module.Dual.InnerProductSpace (φ := φ) + rw [orthonormal_iff_ite] + simp_rw [Module.Dual.IsFaithfulPosMap.basis_apply] + simp_rw [inner_eq', conjTranspose_mul, (PosDef.rpow.isPosDef _ _).1.eq, + single.star_one, Matrix.mul_assoc, ← Matrix.mul_assoc _ (single _ _ _), + single_hMul, one_mul, Matrix.smul_mul, Matrix.mul_smul, trace_smul, smul_eq_mul, + boole_mul] + let Q := φ.matrix + let hQ := hφ.matrixIsPosDef + have : + ∀ i j : n, + (Q * (hQ.rpow (-(1 / 2) : ℝ) * (single i j 1 * hQ.rpow (-(1 / 2) : ℝ)))).trace = + ite (i = j) (1 : ℂ) (0 : ℂ) := + fun i j => + calc + trace (Q * (hQ.rpow (-(1 / 2) : ℝ) * (single i j 1 * hQ.rpow (-(1 / 2) : ℝ)))) = + trace (hQ.rpow (-(1 / 2) : ℝ) * hQ.rpow 1 * hQ.rpow (-(1 / 2) : ℝ) * + single i j 1) := by + simp_rw [PosDef.rpow_one_eq_self, Matrix.mul_assoc] + rw [← trace_mul_cycle', trace_mul_comm] + simp_rw [Matrix.mul_assoc] + rw [trace_mul_comm] + simp_rw [Matrix.mul_assoc] + rfl + _ = (hQ.rpow (-(1 / 2) + 1 + -(1 / 2) : ℝ) * single i j 1).trace := by + simp_rw [PosDef.rpow_mul_rpow] + _ = (hQ.rpow 0 * single i j 1).trace := by ring_nf + _ = ite (i = j) 1 0 := by simp_rw [PosDef.rpow_zero, Matrix.one_mul, single.trace] + simp only [Q, this, ← ite_and, ← Prod.eq_iff_fst_eq_snd_eq, forall₂_true_iff] + +/-- The normalized matrix basis as an orthonormal basis. -/ +protected noncomputable def orthonormalBasis (hφ : φ.IsFaithfulPosMap) : + withMatrixInner[φ] (OrthonormalBasis (n × n) ℂ (Matrix n n ℂ)) := +by + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := Module.Dual.InnerProductSpace (φ := φ) + exact hφ.basis.toOrthonormalBasis hφ.basis_is_orthonormal + +protected theorem orthonormalBasis_apply + (hφ : φ.IsFaithfulPosMap) (ij : n × n) : + withMatrixInner[φ] + ((hφ.orthonormalBasis : OrthonormalBasis (n × n) ℂ (Matrix n n ℂ)) ij = + single ij.1 ij.2 (1 : ℂ) * hφ.matrixIsPosDef.rpow (-(1 / 2 : ℝ))) := +by + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := Module.Dual.InnerProductSpace (φ := φ) + rw [← IsFaithfulPosMap.basis_apply, IsFaithfulPosMap.orthonormalBasis, + Basis.coe_toOrthonormalBasis] + +theorem inner_coord (hφ : φ.IsFaithfulPosMap) (ij : n × n) (y : Matrix n n ℂ) : + withMatrixInner[φ] + (⟪(hφ.orthonormalBasis : OrthonormalBasis _ _ _) ij, y⟫_ℂ = + (y * hφ.matrixIsPosDef.rpow (1 / 2)) ij.1 ij.2) := +by + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := Module.Dual.InnerProductSpace (φ := φ) + let Q := φ.matrix + let hQ := hφ.matrixIsPosDef + simp_rw [inner_eq', hφ.orthonormalBasis_apply, conjTranspose_mul, + (Matrix.PosDef.rpow.isPosDef hQ _).1.eq, ← Matrix.mul_assoc, single_conjTranspose, + star_one] + have := + calc + Q * hQ.rpow (-(1 / 2)) = hQ.rpow 1 * hQ.rpow (-(1 / 2)) := by + rw [Matrix.PosDef.rpow_one_eq_self] + _ = hQ.rpow (1 + -(1 / 2)) := by rw [Matrix.PosDef.rpow_mul_rpow] + _ = hQ.rpow (1 / 2) := by ring_nf + rw [this] + simp_rw [trace_iff, mul_apply, single, of_apply, mul_boole, ite_and] + simp only [Finset.sum_ite_eq, Finset.mem_univ, if_true, ite_mul, MulZeroClass.zero_mul] + simp_rw [mul_comm] + +theorem inner_coord' (hφ : φ.IsFaithfulPosMap) (ij : n × n) (y : Matrix n n ℂ) : + withMatrixInner[φ] + (⟪hφ.basis ij, y⟫_ℂ = (y * hφ.matrixIsPosDef.rpow (1 / 2)) ij.1 ij.2) := by + rw [hφ.basis_apply, ← hφ.orthonormalBasis_apply] + exact hφ.inner_coord ij y + +protected theorem basis_repr_apply (hφ : φ.IsFaithfulPosMap) (x : Matrix n n ℂ) (ij : n × n) : + withMatrixInner[φ] (hφ.basis.repr x ij = ⟪hφ.basis ij, x⟫_ℂ) := +by + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := Module.Dual.InnerProductSpace (φ := φ) + rw [hφ.basis_apply, ← hφ.orthonormalBasis_apply, ← + OrthonormalBasis.repr_apply_apply] + rfl + +protected theorem toMatrixLinEquiv_symm_apply (hφ : φ.IsFaithfulPosMap) (hψ : ψ.IsFaithfulPosMap) + (x : Matrix (n₂ × n₂) (n × n) ℂ) : + withMatrixInner[φ] (withMatrixInner[ψ] + ((hφ.toMatrixLinEquiv hψ).symm x = + ∑ i, ∑ j, ∑ k, ∑ l, + (x (i, j) (k, l) : ℂ) • | hψ.basis (i, j)⟩⟨ hφ.basis (k, l)|)) := + by + rw [IsFaithfulPosMap.toMatrixLinEquiv, LinearMap.ext_iff] + intro a + simp_rw [LinearMap.toMatrix_symm, toLin_apply, mulVec, dotProduct, + IsFaithfulPosMap.basis_repr_apply, + ContinuousLinearMap.coe_sum, + LinearMap.sum_apply, ContinuousLinearMap.coe_smul, + LinearMap.smul_apply, ContinuousLinearMap.coe_coe, rankOne_apply, + IsFaithfulPosMap.basis_apply, Finset.sum_smul] + symm + repeat' + nth_rw 1 [← Finset.sum_product'] + rw [Finset.univ_product_univ] + apply Finset.sum_congr rfl + intro ij _ + simp_rw [smul_smul] + +-- lemma toMatrixLinEquiv_eq_toMatrix (hφ : φ.IsFaithfulPosMap) : +-- hφ.toMatrixLinEquiv hφ = hφ.toMatrix := +-- rfl + +@[simp] +lemma _root_.AlgEquiv.toLinearEquiv_coe {R M₁ M₂ : Type*} [CommSemiring R] + [Semiring M₁] [Algebra R M₁] [Semiring M₂] [Algebra R M₂] + (φ : M₁ ≃ₐ[R] M₂) : + φ.toLinearEquiv = φ := +rfl + +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j k l) -/ +protected theorem toMatrix_symm_apply (hφ : φ.IsFaithfulPosMap) + (x : Matrix (n × n) (n × n) ℂ) : + withMatrixInner[φ] + (hφ.toMatrix.symm x = + ∑ i : n, ∑ j : n, ∑ k : n, ∑ l : n, + (x (i, j) (k, l) : ℂ) • | hφ.basis (i, j)⟩⟨ hφ.basis (k, l)|) := +hφ.toMatrixLinEquiv_symm_apply _ _ + +end Module.Dual.IsFaithfulPosMap + +local notation "|" x "⟩⟨" y "|" => @rankOne ℂ _ _ _ _ _ _ _ x y + +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j k l) -/ +theorem Module.Dual.eq_rankOne_of_faithful_pos_map (hφ : φ.IsFaithfulPosMap) + (hψ : ψ.IsFaithfulPosMap) + (x : Matrix n n ℂ →ₗ[ℂ] Matrix n₂ n₂ ℂ) : + withMatrixInner[φ] (withMatrixInner[ψ] + (x = + ∑ i, ∑ j, ∑ k, ∑ l, + hφ.toMatrixLinEquiv hψ x (i, j) (k, l) • |hψ.basis (i, j)⟩⟨ hφ.basis (k, l)|)) := +by rw [← Module.Dual.IsFaithfulPosMap.toMatrixLinEquiv_symm_apply, LinearEquiv.symm_apply_apply] + +end SingleBlock + +--------- +section DirectSum + +/-! # Section direct_sum -/ + + +theorem LinearMap.sum_single_comp_proj {R : Type _} {ι : Type _} [Fintype ι] [DecidableEq ι] + [Semiring R] {φ : ι → Type _} [∀ i : ι, AddCommMonoid (φ i)] [∀ i : ι, Module R (φ i)] : + ∑ i : ι, LinearMap.single _ _ i ∘ₗ LinearMap.proj i = (LinearMap.id : (∀ i, φ i) →ₗ[R] ∀ i, + φ i) := + by + simp_rw [LinearMap.ext_iff, LinearMap.sum_apply, LinearMap.id_apply, LinearMap.comp_apply, + LinearMap.proj_apply, LinearMap.coe_single, Pi.single, funext_iff, Finset.sum_apply, + Function.update, Pi.zero_apply, Finset.sum_dite_eq, Finset.mem_univ, if_true] + intro _ _; trivial + +omit [(i : k) → Fintype (s i)] [(i : k₂) → Fintype (s₂ i)] + [(i : k) → DecidableEq (s i)] [(i : k₂) → DecidableEq (s₂ i)] in +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (r p) -/ +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (r p) -/ +theorem LinearMap.lrsum_eq_single_proj_lrcomp + (f : (PiMat ℂ k s) →ₗ[ℂ] PiMat ℂ k₂ s₂) : + ∑ r, ∑ p, + LinearMap.single _ _ r ∘ₗ LinearMap.proj r ∘ₗ f ∘ₗ LinearMap.single _ _ p ∘ₗ + LinearMap.proj p = + f := + calc + ∑ r, ∑ p, + LinearMap.single _ _ r ∘ₗ LinearMap.proj r ∘ₗ f ∘ₗ LinearMap.single _ _ p ∘ₗ + LinearMap.proj p = + (∑ r, LinearMap.single _ _ r ∘ₗ LinearMap.proj r) ∘ₗ + f ∘ₗ ∑ p, LinearMap.single _ _ p ∘ₗ LinearMap.proj p := + by simp_rw [LinearMap.sum_comp, LinearMap.comp_sum, LinearMap.comp_assoc] + _ = LinearMap.id ∘ₗ f ∘ₗ LinearMap.id := by simp_rw [LinearMap.sum_single_comp_proj] + _ = f := by rw [LinearMap.id_comp, LinearMap.comp_id] + +namespace Module.Dual.pi.IsFaithfulPosMap + +open scoped Classical in +omit [DecidableEq k] [(i : k) → DecidableEq (s i)] in +theorem inner_eq [∀ i, (ψ i).IsFaithfulPosMap] (x y : PiMat ℂ k s) : + withPiInner[ψ] (⟪x, y⟫_ℂ = Module.Dual.pi ψ (star x * y)) := + rfl + +open scoped Classical in +omit [DecidableEq k] in +theorem inner_eq' [∀ i, (ψ i).IsFaithfulPosMap] (x y : PiMat ℂ k s) : + withPiInner[ψ] (⟪x, y⟫_ℂ = ∑ i, ((ψ i).matrix * (x i)ᴴ * y i).trace) := by + simp only [inner_eq, Module.Dual.pi.apply, Pi.mul_apply, + Matrix.star_eq_conjTranspose, Pi.star_apply, Matrix.mul_assoc] + +open scoped Classical in +omit [DecidableEq k] [(i : k) → DecidableEq (s i)] in +theorem inner_left_hMul [∀ i, (ψ i).IsFaithfulPosMap] + (x y z : PiMat ℂ k s) : + withPiInner[ψ] (⟪x * y, z⟫_ℂ = ⟪y, star x * z⟫_ℂ) := + @linear_functional_right_hMul _ _ _ _ _ _ (Module.Dual.pi ψ) _ _ _ + +theorem hMul_right (hψ : ∀ i, (ψ i).IsFaithfulPosMap) (x y z : PiMat ℂ k s) : + Module.Dual.pi ψ (star x * (y * z)) = + Module.Dual.pi ψ + (star (x * (Module.Dual.pi.matrixBlock ψ * star z * (Module.Dual.pi.matrixBlock ψ)⁻¹)) * + y) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + letI := fun i => Fact.mk (hψ i) + rw [← inner_eq] + simp only [inner_eq'] + simp_rw [← Module.Dual.IsFaithfulPosMap.inner_eq', Pi.mul_apply, + Module.Dual.IsFaithfulPosMap.inner_left_conj, ← inner_eq, inner_pi_eq_sum, Pi.mul_apply, + Pi.inv_apply, Pi.star_apply, Matrix.star_eq_conjTranspose, + Module.Dual.pi.matrixBlock_apply] + +theorem inner_left_conj [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + (x y z : PiMat ℂ k s) : + withPiInner[ψ] + (⟪x, y * z⟫_ℂ = + ⟪x * (Module.Dual.pi.matrixBlock ψ * star z * (Module.Dual.pi.matrixBlock ψ)⁻¹), y⟫_ℂ) := + hMul_right (fun i => (hψ i)) _ _ _ + +open scoped Classical in +omit [DecidableEq k] [(i : k) → DecidableEq (s i)] in +theorem inner_right_hMul [∀ i, (ψ i).IsFaithfulPosMap] + (x y z : PiMat ℂ k s) : + withPiInner[ψ] (⟪x, y * z⟫_ℂ = ⟪star y * x, z⟫_ℂ) := + @linear_functional_left_hMul _ _ _ _ _ _ (Module.Dual.pi ψ) _ _ _ + +omit [DecidableEq k] in +theorem adjoint_eq [hψ : ∀ i, (ψ i).IsFaithfulPosMap] : + withPiInner[ψ] + (LinearMap.adjoint (Module.Dual.pi ψ) = Algebra.linearMap ℂ (PiMat ℂ k s)) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + rw [LinearMap.ext_iff] + intro x + apply @ext_inner_right ℂ + intro y + rw [LinearMap.adjoint_inner_left, Algebra.linearMap_apply] + simp_rw [inner_pi_eq_sum, Pi.algebraMap_apply, Algebra.algebraMap_eq_smul_one, + InnerProductSpace.Core.inner_smul_left, Module.Dual.IsFaithfulPosMap.inner_eq, + conjTranspose_one, Matrix.one_mul, ← Finset.mul_sum] + rw [mul_comm] + rfl + +/-- The dependent pi basis obtained from the normalized bases of each block. -/ +protected noncomputable def basis (hψ : ∀ i, (ψ i).IsFaithfulPosMap) : + Basis (Σ i, s i × s i) ℂ (PiMat ℂ k s) := + Pi.basis fun i => (hψ i).basis + +protected theorem basis_apply (hψ : ∀ i, (ψ i).IsFaithfulPosMap) (ijk : Σ i, s i × s i) : + Module.Dual.pi.IsFaithfulPosMap.basis hψ ijk = + includeBlock + (single ijk.2.1 ijk.2.2 1 * (hψ ijk.1).matrixIsPosDef.rpow (-(1 / 2 : ℝ))) := + by + simp only [Module.Dual.pi.IsFaithfulPosMap.basis, Pi.basis_apply, funext_iff, ← Matrix.ext_iff] + intro i j k + simp only [Pi.single, includeBlock_apply, Pi.zero_apply, Function.update] + simp_rw [@eq_comm _ i] + split_ifs with h + · rw [← Module.Dual.IsFaithfulPosMap.basis_apply (hψ _)] + aesop + · simp only [zero_apply] + +protected theorem basis_apply' (hψ : ∀ i, (ψ i).IsFaithfulPosMap) (i : k) (j l : s i) : + Module.Dual.pi.IsFaithfulPosMap.basis hψ ⟨i, (j, l)⟩ = + includeBlock (single j l 1 * (hψ i).matrixIsPosDef.rpow (-(1 / 2 : ℝ))) := + Module.Dual.pi.IsFaithfulPosMap.basis_apply hψ _ + +open scoped Classical in +omit [(i : k) → DecidableEq (s i)] in +theorem includeBlock_left_inner (hψ : ∀ i, (ψ i).IsFaithfulPosMap) {i : k} + (x : Matrix (s i) (s i) ℂ) (y : PiMat ℂ k s) : + withPiInner[ψ] + (⟪includeBlock x, y⟫_ℂ = ⟪x, y i⟫_ℂ) := +by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + calc ⟪includeBlock x, y⟫_ℂ = pi ψ (star (includeBlock x) * y) := rfl + _ = pi ψ (includeBlock xᴴ * y) := by rw [includeBlock_conjTranspose] + _ = pi ψ (includeBlock (xᴴ * y i)) := by rw [includeBlock_hMul] + _ = ψ i (xᴴ * y i) := by rw [Module.Dual.pi.apply_single_block'] + _ = ⟪x, y i⟫_ℂ := rfl + +open scoped Classical in +omit [(i : k) → DecidableEq (s i)] in +theorem includeBlock_inner_same [hψ : ∀ i, (ψ i).IsFaithfulPosMap] {i : k} + {x y : Matrix (s i) (s i) ℂ} : + withPiInner[ψ] (⟪includeBlock x, includeBlock y⟫_ℂ = ⟪x, y⟫_ℂ) := by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + rw [includeBlock_left_inner, includeBlock_apply_same] + +open scoped Classical in +omit [(i : k) → DecidableEq (s i)] in +theorem includeBlock_inner_same' [hψ : ∀ i, (ψ i).IsFaithfulPosMap] {i j : k} + {x : Matrix (s i) (s i) ℂ} {y : Matrix (s j) (s j) ℂ} (h : i = j) : + withPiInner[ψ] + (⟪includeBlock x, includeBlock y⟫_ℂ = ⟪x, by rw [h]; exact y⟫_ℂ) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + simp_rw [includeBlock_left_inner, includeBlock_apply, h, dif_pos] + rfl +open scoped Classical in +omit [(i : k) → DecidableEq (s i)] in +theorem includeBlock_inner_block_left [hψ : ∀ i, (ψ i).IsFaithfulPosMap] {j : k} + {x : PiMat ℂ k s} {y : Matrix (s j) (s j) ℂ} {i : k} : + withPiInner[ψ] + (⟪includeBlock (x i), includeBlock y⟫_ℂ = if i = j then ⟪x j, y⟫_ℂ else 0) := +by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + simp_rw [includeBlock_left_inner, includeBlock_apply] + aesop + +open scoped Classical in +omit [(i : k) → DecidableEq (s i)] in +theorem includeBlock_inner_ne_same [hψ : ∀ i, (ψ i).IsFaithfulPosMap] {i j : k} + {x : Matrix (s i) (s i) ℂ} {y : Matrix (s j) (s j) ℂ} (h : i ≠ j) : + withPiInner[ψ] (⟪includeBlock x, includeBlock y⟫_ℂ = 0) := by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + simp only [includeBlock_left_inner, includeBlock_apply_ne_same _ h.symm] + simp + +omit [Fintype k] [DecidableEq k] in +theorem _root_.Module.Dual.pi.IsFaithfulPosMap.basis.apply_cast_eq_mpr + (hψ : ∀ i, (ψ i).IsFaithfulPosMap) {i j : k} + {a : s j × s j} (h : i = j) : + (hψ i).basis (by rw [h]; exact a) = by rw [h]; exact (hψ j).basis a := + by + simp only [eq_mpr_eq_cast]; aesop + + +open scoped Classical in +omit [DecidableEq k] in +protected theorem basis_is_orthonormal [hψ : ∀ i, (ψ i).IsFaithfulPosMap] : + @Orthonormal ℂ _ _ + (Module.Dual.PiNormedAddCommGroup (_hφ := hψ)).toSeminormedAddCommGroup + (Module.Dual.pi.InnerProductSpace (hφ := hψ)) _ + (Module.Dual.pi.IsFaithfulPosMap.basis hψ) := +by + letI : _root_.SeminormedAddCommGroup (PiMat ℂ k s) := + (Module.Dual.PiNormedAddCommGroup (_hφ := hψ)).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := + Module.Dual.pi.InnerProductSpace (hφ := hψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + rw [orthonormal_iff_ite] + simp_rw [Module.Dual.pi.IsFaithfulPosMap.basis_apply] + intro i j + rw [eq_comm, ite_eq_iff'] + constructor + · rintro rfl + simp_rw [includeBlock_inner_same, ← Module.Dual.IsFaithfulPosMap.basis_apply, + orthonormal_iff_ite.mp ((hψ i.1).basis_is_orthonormal) i.snd, + if_true] + · intro h + simp_rw [← Module.Dual.IsFaithfulPosMap.basis_apply] + by_cases h' : i.fst = j.fst + · simp_rw [Sigma.ext_iff, not_and_or, h', not_true, false_or] at h + rw [← Sigma.eta i, ← Sigma.eta j] + simp_rw [includeBlock_inner_same' h'] + rw [← Module.Dual.pi.IsFaithfulPosMap.basis.apply_cast_eq_mpr hψ h'] + simp only [orthonormal_iff_ite.mp (hψ _).basis_is_orthonormal i.snd] + simp only [eq_mpr_eq_cast] + rw [eq_comm, ite_eq_right_iff] + intro hh + simp only [hh, cast_heq, not_true_eq_false] at h + · simp only [includeBlock_inner_ne_same h'] + +/-- The dependent pi basis as an orthonormal basis. -/ +protected noncomputable def orthonormalBasis (hψ : ∀ i, (ψ i).IsFaithfulPosMap) : + withPiInner[ψ] (OrthonormalBasis (Σ i, s i × s i) ℂ (PiMat ℂ k s)) := +by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + exact Basis.toOrthonormalBasis (Module.Dual.pi.IsFaithfulPosMap.basis hψ) + (Module.Dual.pi.IsFaithfulPosMap.basis_is_orthonormal (hψ := hψ)) + +protected theorem orthonormalBasis_apply (hψ : ∀ i, (ψ i).IsFaithfulPosMap) + {ijk : Σ i, s i × s i} : + withPiInner[ψ] + ((Module.Dual.pi.IsFaithfulPosMap.orthonormalBasis hψ : OrthonormalBasis _ _ _) ijk = + includeBlock + (single ijk.2.1 ijk.2.2 1 * (hψ ijk.1).matrixIsPosDef.rpow (-(1 / 2 : ℝ)))) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + rw [← Module.Dual.pi.IsFaithfulPosMap.basis_apply hψ] + simp only [Module.Dual.pi.IsFaithfulPosMap.orthonormalBasis, Basis.coe_toOrthonormalBasis] + +protected theorem orthonormalBasis_apply' (hψ : ∀ i, (ψ i).IsFaithfulPosMap) {i : k} + {j l : s i} : + withPiInner[ψ] + ((Module.Dual.pi.IsFaithfulPosMap.orthonormalBasis hψ : OrthonormalBasis _ _ _) ⟨i, (j, l)⟩ = + includeBlock (single j l 1 * (hψ i).matrixIsPosDef.rpow (-(1 / 2 : ℝ)))) := + Module.Dual.pi.IsFaithfulPosMap.orthonormalBasis_apply hψ + +open scoped Classical in +omit [DecidableEq k] in +protected theorem inner_coord (hψ : ∀ i, (ψ i).IsFaithfulPosMap) + (ijk : Σ i, s i × s i) + (y : PiMat ℂ k s) : + withPiInner[ψ] + (⟪Module.Dual.pi.IsFaithfulPosMap.basis hψ ijk, y⟫_ℂ = + (y ijk.1 * (hψ ijk.1).matrixIsPosDef.rpow (1 / 2)) ijk.2.1 ijk.2.2) := +by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + simp_rw [Module.Dual.pi.IsFaithfulPosMap.basis_apply, includeBlock_left_inner, ← + Module.Dual.IsFaithfulPosMap.orthonormalBasis_apply, Module.Dual.IsFaithfulPosMap.inner_coord] + +omit [DecidableEq k] in +protected theorem basis_repr_apply [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + (x : PiMat ℂ k s) (ijk : Σ i, s i × s i) : + withPiInner[ψ] + ((Module.Dual.pi.IsFaithfulPosMap.basis hψ).repr x ijk = + ⟪(hψ ijk.1).basis ijk.2, x ijk.1⟫_ℂ) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + rw [Module.Dual.IsFaithfulPosMap.basis_apply, ← + Module.Dual.IsFaithfulPosMap.orthonormalBasis_apply, ← OrthonormalBasis.repr_apply_apply] + rfl + +theorem _root_.Module.Dual.pi.IsFaithfulPosMap.MatrixBlock.isSelfAdjoint + (hψ : ∀ i, (ψ i).IsFaithfulPosMap) : + IsSelfAdjoint (Module.Dual.pi.matrixBlock ψ) := + by + ext x + simp only [Pi.star_apply, Module.Dual.pi.matrixBlock_apply, star_eq_conjTranspose, + (hψ x).matrixIsPosDef.1.eq] + +/-- Invertibility of the block diagonal density matrix. -/ +@[reducible] +noncomputable def matrixBlockInvertible (hψ : ∀ i, (ψ i).IsFaithfulPosMap) : + Invertible (Module.Dual.pi.matrixBlock ψ) := + by + haveI := fun i => (hψ i).matrixIsPosDef.invertible + apply Invertible.mk (Module.Dual.pi.matrixBlock ψ)⁻¹ + all_goals + ext1 + simp_rw [Pi.mul_apply, Pi.inv_apply, Module.Dual.pi.matrixBlock_apply, Pi.one_apply] + on_goal 1 => rw [inv_mul_of_invertible] + rw [mul_inv_of_invertible] + +theorem matrixBlock_inv_hMul_self [hψ : ∀ i, (ψ i).IsFaithfulPosMap] : + (Module.Dual.pi.matrixBlock ψ)⁻¹ * Module.Dual.pi.matrixBlock ψ = 1 := + by + haveI := fun i => (hψ i).matrixIsPosDef.invertible + ext1 + simp_rw [Pi.mul_apply, Pi.inv_apply, Module.Dual.pi.matrixBlock_apply, Pi.one_apply, + inv_mul_of_invertible] + +theorem matrixBlock_self_hMul_inv (hψ : ∀ i, (ψ i).IsFaithfulPosMap) : + Module.Dual.pi.matrixBlock ψ * (Module.Dual.pi.matrixBlock ψ)⁻¹ = 1 := + by + haveI := fun i => (hψ i).matrixIsPosDef.invertible + ext ij kl + simp_rw [Pi.mul_apply, Pi.inv_apply, Module.Dual.pi.matrixBlock_apply, Pi.one_apply, + mul_inv_of_invertible] + +/-- Matrix representation of maps between two faithful pi inner products. -/ +noncomputable def toMatrixLinEquiv (hψ : ∀ i, (ψ i).IsFaithfulPosMap) + (hφ : ∀ i, (φ i).IsFaithfulPosMap) : + ((PiMat ℂ k s) →ₗ[ℂ] (PiMat ℂ k₂ s₂)) ≃ₗ[ℂ] + Matrix (Σ i, s₂ i × s₂ i) (Σ i, s i × s i) ℂ := +LinearMap.toMatrix (Module.Dual.pi.IsFaithfulPosMap.basis hψ) + (Module.Dual.pi.IsFaithfulPosMap.basis hφ) + +/-- Matrix representation of endomorphisms for a faithful pi inner product. -/ +noncomputable def toMatrix (hψ : ∀ i, (ψ i).IsFaithfulPosMap) : + ((PiMat ℂ k s) →ₗ[ℂ] PiMat ℂ k s) ≃ₐ[ℂ] + Matrix (Σ i, s i × s i) (Σ i, s i × s i) ℂ := + LinearMap.toMatrixAlgEquiv (Module.Dual.pi.IsFaithfulPosMap.basis hψ) + +lemma toMatrixLinEquiv_eq_toMatrix (hψ : ∀ i, (ψ i).IsFaithfulPosMap) : + toMatrixLinEquiv hψ hψ + = (Module.Dual.pi.IsFaithfulPosMap.toMatrix hψ).toLinearEquiv := +rfl + +/-- Basis for block diagonal matrices induced by the faithful pi basis. -/ +@[simps] +noncomputable def isBlockDiagonalBasis (hψ : ∀ i, (ψ i).IsFaithfulPosMap) : + Basis (Σ i, s i × s i) ℂ { x : Matrix (Σ i, s i) (Σ i, s i) ℂ // x.IsBlockDiagonal } + where repr := + isBlockDiagonalPiAlgEquiv.toLinearEquiv.trans (Module.Dual.pi.IsFaithfulPosMap.basis hψ).repr + +omit [DecidableEq k₂] in +theorem toMatrixLinEquiv_apply' [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + [hφ : ∀ i, (φ i).IsFaithfulPosMap] + (f : (PiMat ℂ k s) →ₗ[ℂ] PiMat ℂ k₂ s₂) (r : Σ r, s₂ r × s₂ r) (l : Σ r, s r × s r) : + (toMatrixLinEquiv hψ hφ) f r l = + (f (includeBlock ((hψ l.1).basis l.2)) r.1 * (hφ r.1).matrixIsPosDef.rpow (1 / 2)) + r.2.1 r.2.2 := +by + simp_rw [toMatrixLinEquiv, LinearMap.toMatrix_apply, IsFaithfulPosMap.basis_repr_apply, ← + Module.Dual.IsFaithfulPosMap.inner_coord, IsFaithfulPosMap.basis_apply, + Module.Dual.IsFaithfulPosMap.orthonormalBasis_apply, ← Module.Dual.IsFaithfulPosMap.basis_apply] + +theorem toMatrix_apply' [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + (f : (PiMat ℂ k s) →ₗ[ℂ] PiMat ℂ k s) (r l : Σ r, s r × s r) : + (toMatrix fun i => (hψ i)) f r l = + (f (includeBlock ((hψ l.1).basis l.2)) r.1 * (hψ r.1).matrixIsPosDef.rpow (1 / 2)) + r.2.1 r.2.2 := +toMatrixLinEquiv_apply' _ _ _ + +-- theorem starAlgEquiv_adjoint_eq [hψ : ∀ i, (ψ i).IsFaithfulPosMap] +-- (f : ∀ i, Matrix (s i) (s i) ℂ ≃⋆ₐ[ℂ] Matrix (s i) (s i) ℂ) (x : PiMat ℂ k s) : +-- LinearMap.adjoint (StarAlgEquiv.pi f).toLinearMap x = +-- (StarAlgEquiv.pi f).symm (x * Module.Dual.pi.matrixBlock ψ) * +-- (Module.Dual.pi.matrixBlock ψ)⁻¹ := +-- by +-- letI := @matrixBlockInvertible _ _ _ _ _ _ ψ hψ +-- letI := fun i => (hψ i).matrixIsPosDef.invertible +-- apply @ext_inner_left ℂ +-- intro a +-- simp_rw [LinearMap.adjoint_inner_right, StarAlgEquiv.toLinearMap_apply] +-- rw [← StarAlgEquiv.of_pi_is_inner] +-- simp_rw [unitary.innerAutStarAlg_apply, unitary.innerAutStarAlg_symm_apply, mul_assoc] +-- symm +-- nth_rw 1 [← mul_assoc (Module.Dual.pi.matrixBlock ψ)] +-- nth_rw 1 [← mul_assoc] +-- symm +-- rw [inner_left_conj, inner_right_hMul] +-- simp_rw [StarMul.star_mul, IsSelfAdjoint.star_eq (MatrixBlock.isSelfAdjoint hψ), mul_assoc] +-- have t1 : Module.Dual.pi.matrixBlock ψ * (Module.Dual.pi.matrixBlock ψ)⁻¹ = 1 := +-- by +-- ext1 +-- simp only [Pi.mul_apply, Pi.inv_apply, Module.Dual.pi.matrixBlock_apply, +-- mul_inv_of_invertible, Pi.one_apply] +-- have t2 := +-- calc +-- Module.Dual.pi.matrixBlock ψ * star (Module.Dual.pi.matrixBlock ψ)⁻¹ = +-- Module.Dual.pi.matrixBlock ψ * (Module.Dual.pi.matrixBlock ψ)⁻¹ := +-- by +-- congr +-- simp only [Pi.inv_def, Pi.star_def, Module.Dual.pi.matrixBlock_apply, +-- star_eq_conjTranspose, (hψ _).matrixIsPosDef.1.eq, +-- (hψ _).matrixIsPosDef.inv.1.eq] +-- _ = 1 := t1 +-- simp_rw [t1, ← mul_assoc (Module.Dual.pi.matrixBlock ψ), t2, mul_one, one_mul, +-- Unitary.coe_star, +-- star_star] + +private theorem mul_inv_eq_iff_eq_mul_aux [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + (b c : PiMat ℂ k s) : + b * (Module.Dual.pi.matrixBlock ψ)⁻¹ = c ↔ b = c * Module.Dual.pi.matrixBlock ψ := + by + constructor <;> rintro rfl <;> rw [mul_assoc] + · rw [matrixBlock_inv_hMul_self, mul_one] + · rw [matrixBlock_self_hMul_inv hψ, mul_one] + +-- theorem starAlgEquiv_commute_iff [∀ i, (ψ i).IsFaithfulPosMap] +-- (f : ∀ i, Matrix (s i) (s i) ℂ ≃⋆ₐ[ℂ] Matrix (s i) (s i) ℂ) : +-- (Commute (Module.Dual.pi.matrixBlock ψ) fun i => StarAlgEquiv.pi.unitary f i) ↔ +-- StarAlgEquiv.pi f (Module.Dual.pi.matrixBlock ψ) = Module.Dual.pi.matrixBlock ψ := +-- by +-- symm +-- nth_rw 1 [← StarAlgEquiv.of_pi_is_inner] +-- rw [unitary.innerAutStarAlg_apply, Unitary.coe_star] +-- rw [unitary.inj_hMul (unitary.pi (StarAlgEquiv.pi.unitary f))] +-- simp only [mul_assoc, Unitary.coe_star_mul_self, mul_one, eq_comm, Commute, SemiconjBy, +-- Pi.mul_def, Pi.star_def] + +-- theorem starAlgEquiv_is_isometry_tfae [hψ : ∀ i, (ψ i).IsFaithfulPosMap] +-- [∀ i, Nontrivial (s i)] (f : ∀ i, Matrix (s i) (s i) ℂ ≃⋆ₐ[ℂ] Matrix (s i) (s i) ℂ) : +-- List.TFAE +-- [(StarAlgEquiv.pi f) (Module.Dual.pi.matrixBlock ψ) = Module.Dual.pi.matrixBlock ψ, +-- LinearMap.adjoint (StarAlgEquiv.pi f).toLinearMap = +-- (StarAlgEquiv.pi f).symm.toLinearMap, +-- Module.Dual.pi ψ ∘ₗ (StarAlgEquiv.pi f).toLinearMap = Module.Dual.pi ψ, +-- ∀ x y, ⟪(StarAlgEquiv.pi f) x, (StarAlgEquiv.pi f) y⟫_ℂ = ⟪x, y⟫_ℂ, +-- ∀ x : ∀ i, Matrix (s i) (s i) ℂ, ‖(StarAlgEquiv.pi f) x‖ = ‖x‖, +-- Commute (Module.Dual.pi.matrixBlock ψ) fun i => StarAlgEquiv.pi.unitary f i] := +-- by +-- tfae_have 5 ↔ 2 +-- · --simp_rw [List.TFAE.out (@general_starAlgEquiv_is_isometry_tfae _ _ _ _ _ ψ hψ +-- (StarAlgEquiv.pi f)) 4 1] +-- have : ∀ x : PiMat ℂ k s, ‖x‖ = Real.sqrt (RCLike.re ⟪x, x⟫_ℂ) := +-- fun x => norm_eq_sqrt_inner _ +-- have this' : ∀ x : PiMat ℂ k s, (RCLike.re ⟪x, x⟫_ℂ : ℂ) = ⟪x, x⟫_ℂ := +-- fun x => inner_self_re _ +-- simp_rw [this, Real.sqrt_inj inner_self_nonneg inner_self_nonneg, +-- ← Complex.ofReal_inj, this', ← @sub_eq_zero _ _ _ ⟪_, _⟫_ℂ] +-- have : +-- ∀ x y, +-- ⟪(StarAlgEquiv.pi f) x, (StarAlgEquiv.pi f) y⟫_ℂ - ⟪x, y⟫_ℂ = +-- ⟪(LinearMap.adjoint (StarAlgEquiv.pi f).toLinearMap ∘ₗ +-- (StarAlgEquiv.pi f).toLinearMap - +-- 1) +-- x, +-- y⟫_ℂ := +-- by +-- intro x y +-- simp only [LinearMap.sub_apply, LinearMap.one_apply, inner_sub_left, LinearMap.comp_apply, +-- LinearMap.adjoint_inner_left, StarAlgEquiv.toLinearMap_apply] +-- simp_rw [this, inner_map_self_eq_zero, sub_eq_zero, StarAlgEquiv.comp_eq_iff, +-- LinearMap.one_comp] +-- rw [tfae_5_iff_2] +-- tfae_have 4 ↔ 3 +-- · simp_rw [inner_eq, ← map_star (StarAlgEquiv.pi f), ← _root_.map_mul (StarAlgEquiv.pi f), +-- LinearMap.ext_iff, LinearMap.comp_apply, StarAlgEquiv.toLinearMap_apply] +-- refine ⟨fun h x => _, fun h x y => h _⟩ +-- rw [← one_mul x, ← star_one] +-- exact h _ _ +-- rw [tfae_4_iff_3] +-- letI := @matrixBlockInvertible _ _ _ _ _ _ ψ hψ +-- simp_rw [LinearMap.ext_iff, starAlgEquiv_adjoint_eq f, LinearMap.comp_apply, +-- StarAlgEquiv.toLinearMap_apply, mul_inv_eq_iff_eq_mul_aux, +-- Module.Dual.pi.apply'', StarAlgEquiv.symm_apply_eq, _root_.map_mul, +-- StarAlgEquiv.apply_symm_apply, pi.forall_left_mul, @eq_comm _ (Module.Dual.pi.matrixBlock +-- ψ), ← +-- blockDiagonal'AlgHom_apply, ← _root_.map_mul] +-- tfae_have 1 ↔ 2 +-- · rw [iff_self_iff]; trivial +-- tfae_have 1 → 3 +-- · intro i x +-- nth_rw 1 [← i] +-- simp_rw [← _root_.map_mul, StarAlgEquiv.pi_is_trace_preserving] +-- tfae_have 3 → 1 +-- · intro i +-- simp_rw [← +-- StarAlgEquiv.pi_is_trace_preserving (fun i => (f i).symm) +-- (Module.Dual.pi.matrixBlock ψ * (StarAlgEquiv.pi f) _), +-- _root_.map_mul, StarAlgEquiv.pi_symm_apply_apply, blockDiagonal'AlgHom_apply, ← +-- Module.Dual.pi.apply'', @eq_comm _ _ (Module.Dual.pi ψ _)] at i +-- have := Module.Dual.pi.apply_eq_of ψ _ i +-- rw [StarAlgEquiv.pi_symm_apply_eq] at this +-- exact this.symm +-- tfae_have 5 ↔ 6 +-- · rw [starAlgEquiv_commute_iff] +-- tfae_finish + +end Module.Dual.pi.IsFaithfulPosMap + +end DirectSum + + +variable {n : Type _} [Fintype n] + +local notation "ℍ" => Matrix n n ℂ + +local notation "l(" x ")" => x →ₗ[ℂ] x + +local notation "L(" x ")" => x →L[ℂ] x + +local notation "e_{" i "," j "}" => Matrix.single i j (1 : ℂ) + +open scoped Matrix + +open Matrix + + +open scoped Kronecker Matrix BigOperators TensorProduct + +open Module.Dual +variable [DecidableEq n] {φ : Module.Dual ℂ (Matrix n n ℂ)} + {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} [∀ i, Fintype (s i)] + [∀ i, DecidableEq (s i)] {ψ : ∀ i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} + +theorem inner_single_left [hφ : φ.IsFaithfulPosMap] (i j : n) (x : Matrix n n ℂ) : + withMatrixInner[φ] + (⟪single i j (1 : ℂ), x⟫_ℂ = (x * φ.matrix) i j) := + by + simp only [IsFaithfulPosMap.inner_eq', single_conjTranspose, star_one] + rw [Matrix.mul_assoc, ← trace_mul_cycle', Matrix.single_hMul_trace] + +theorem inner_single_single [hφ : φ.IsFaithfulPosMap] (i j k l : n) : + withMatrixInner[φ] + (⟪single i j (1 : ℂ), single k l (1 : ℂ)⟫_ℂ = ite (i = k) (φ.matrix l j) 0) := + by + simp_rw [inner_single_left, mul_apply, single, of_apply, boole_mul, ite_and] + simp only [Finset.sum_ite_irrel, Finset.sum_const_zero, Finset.sum_ite_eq, Finset.mem_univ, + if_true, Finset.sum_ite_eq] + simp_rw [@eq_comm _ (k : n) (i : n)] + +-- $$m^*(x) = \sum_{i,j,k,l} x_{il}Q^{-1}_{kj}(e_{ij} \otimes_t e_{kl})$$ -/ +theorem LinearMap.mul'_adjoint [hφ : φ.IsFaithfulPosMap] (x : Matrix n n ℂ) : + withMatrixInner[φ] + (LinearMap.adjoint (LinearMap.mul' ℂ ℍ) x = + ∑ i : n, ∑ j : n, ∑ k : n, ∑ l : n, + (x i l * φ.matrix⁻¹ k j) • Matrix.single i j 1 ⊗ₜ[ℂ] Matrix.single k l 1) := +by + letI : _root_.NormedAddCommGroup ℍ := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ ℍ := Module.Dual.InnerProductSpace (φ := φ) + rw [TensorProduct.inner_ext_iff'] + intro a b + rw [LinearMap.adjoint_inner_left, LinearMap.mul'_apply] + have h_inv_star : (φ.matrix⁻¹)ᴴ = φ.matrix⁻¹ := by + rw [Matrix.conjTranspose_nonsing_inv, hφ.matrixIsPosDef.1.eq] + simp_rw [sum_inner, @inner_smul_left ℂ (ℍ ⊗[ℂ] ℍ) _ _ _, TensorProduct.inner_tmul, + inner_single_left, _root_.map_mul, starRingEnd_apply, + ← conjTranspose_apply, h_inv_star, + mul_assoc, ← mul_assoc (φ.matrix⁻¹ _ _)] + symm + calc ∑ x_1 : n, + ∑ x_2 : n, ∑ x_3 : n, ∑ x_4 : n, + xᴴ x_4 x_1 + * (φ.matrix⁻¹ x_2 x_3 * (a * φ.matrix) x_1 x_2 + * (b * φ.matrix) x_3 x_4) + = ∑ x_1 : n, + ∑ x_3 : n, (∑ x_4 : n, + (b * φ.matrix) x_3 x_4 * xᴴ x_4 x_1) + * (∑ x_2 : n, (a * φ.matrix) x_1 x_2 * φ.matrix⁻¹ x_2 x_3) := ?_ + _ = ∑ x_1, ∑ x_3, (a * (φ.matrix * φ.matrix⁻¹)) x_1 x_3 + * (b * φ.matrix * xᴴ) x_3 x_1 := ?_ + _ = ∑ x_1, (a * b * φ.matrix * xᴴ) x_1 x_1 := ?_ + _ = ⟪x, a * b⟫_ℂ := ?_ + · congr + ext + rw [Finset.sum_comm] + congr + ext + simp_rw [Finset.mul_sum, Finset.sum_mul] + repeat congr; ext + ring_nf + · repeat congr 1; ext1 + rw [← mul_assoc, Matrix.mul_apply, Matrix.mul_apply, mul_comm] + · congr; ext + letI := hφ.matrixIsPosDef.invertible + rw [← Matrix.mul_apply, mul_inv_of_invertible, mul_one] + simp_rw [← mul_assoc] + · rw [← Matrix.trace_iff, IsFaithfulPosMap.inner_eq', + Matrix.trace_mul_cycle, Matrix.trace_mul_comm, mul_assoc] + +open scoped Classical in +omit [DecidableEq n] in +theorem Matrix.linearMap_ext_iff_inner_map [hφ : φ.IsFaithfulPosMap] {x y : l(ℍ)} : + withMatrixInner[φ] + (x = y ↔ ∀ u v : ℍ, ⟪x u, v⟫_ℂ = ⟪y u, v⟫_ℂ) := + by + letI : _root_.NormedAddCommGroup ℍ := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ ℍ := Module.Dual.InnerProductSpace (φ := φ) + simp_rw [LinearMap.ext_iff] + constructor + · intro h u v + rw [h] + · intro h a + apply @_root_.ext_inner_right ℂ _ _ + exact h _ + +open scoped Classical in +omit [DecidableEq n] in +theorem Matrix.linearMap_ext_iff_map_inner [hφ : φ.IsFaithfulPosMap] {x y : l(ℍ)} : + withMatrixInner[φ] + (x = y ↔ ∀ u v : ℍ, ⟪v, x u⟫_ℂ = ⟪v, y u⟫_ℂ) := + by + letI : _root_.NormedAddCommGroup ℍ := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ ℍ := Module.Dual.InnerProductSpace (φ := φ) + rw [@Matrix.linearMap_ext_iff_inner_map n _ φ hφ x y] + simp_rw [← inner_conj_symm _ (x _), ← + inner_conj_symm (y _) _] + exact + ⟨fun h u v => by rw [h, starRingEnd_self_apply], fun h u v => by + rw [← h, starRingEnd_self_apply]⟩ + +theorem Matrix.inner_conj_Q [hφ : φ.IsFaithfulPosMap] (a x : ℍ) : + withMatrixInner[φ] + (⟪x, φ.matrix * a * φ.matrix⁻¹⟫_ℂ = ⟪x * aᴴ, 1⟫_ℂ) := + by + letI : _root_.NormedAddCommGroup ℍ := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ ℍ := Module.Dual.InnerProductSpace (φ := φ) + simp_rw [IsFaithfulPosMap.inner_eq', ← Matrix.mul_assoc] + rw [Matrix.trace_mul_cycle] + simp_rw [← Matrix.mul_assoc, + @inv_mul_of_invertible n ℂ _ _ _ φ.matrix hφ.matrixIsPosDef.invertible, Matrix.one_mul, + conjTranspose_mul, Matrix.mul_one, conjTranspose_conjTranspose] + rw [← Matrix.trace_mul_cycle, Matrix.mul_assoc] + +theorem Matrix.inner_star_right [hφ : φ.IsFaithfulPosMap] (b y : ℍ) : + withMatrixInner[φ] (⟪b, y⟫_ℂ = ⟪1, bᴴ * y⟫_ℂ) := by + letI : _root_.NormedAddCommGroup ℍ := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ ℍ := Module.Dual.InnerProductSpace (φ := φ) + simp_rw [IsFaithfulPosMap.inner_eq', ← Matrix.mul_assoc, conjTranspose_one, Matrix.mul_one] + +theorem Matrix.inner_star_left [hφ : φ.IsFaithfulPosMap] (a x : ℍ) : + withMatrixInner[φ] (⟪a, x⟫_ℂ = ⟪xᴴ * a, 1⟫_ℂ) := by + letI : _root_.NormedAddCommGroup ℍ := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ ℍ := Module.Dual.InnerProductSpace (φ := φ) + rw [← inner_conj_symm, Matrix.inner_star_right, inner_conj_symm] + +theorem one_inner [hφ : φ.IsFaithfulPosMap] (a : ℍ) : + withMatrixInner[φ] (⟪1, a⟫_ℂ = (φ.matrix * a).trace) := by + letI : _root_.NormedAddCommGroup ℍ := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ ℍ := Module.Dual.InnerProductSpace (φ := φ) + rw [IsFaithfulPosMap.inner_eq', conjTranspose_one, Matrix.mul_one] + +open scoped Classical in +omit [DecidableEq n] in +theorem Module.Dual.IsFaithfulPosMap.map_star (hφ : φ.IsFaithfulPosMap) (x : ℍ) : + φ (star x) = star (φ x) := + hφ.1.isReal x + +theorem Nontracial.unit_adjoint_eq [hφ : φ.IsFaithfulPosMap] : + withMatrixInner[φ] + (LinearMap.adjoint (Algebra.linearMap ℂ ℍ : ℂ →ₗ[ℂ] ℍ) = φ) := by + letI : _root_.NormedAddCommGroup ℍ := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ ℍ := Module.Dual.InnerProductSpace (φ := φ) + rw [← @IsFaithfulPosMap.adjoint_eq n _ _ φ, LinearMap.adjoint_adjoint] + +local notation "m" => LinearMap.mul' ℂ ℍ + +theorem Qam.Nontracial.mul_comp_mul_adjoint [hφ : φ.IsFaithfulPosMap] : + withMatrixInner[φ] + (LinearMap.mul' ℂ ℍ ∘ₗ LinearMap.adjoint (LinearMap.mul' ℂ ℍ) = trace (φ.matrix⁻¹) • 1) := + by + letI : _root_.NormedAddCommGroup ℍ := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ ℍ := Module.Dual.InnerProductSpace (φ := φ) + simp_rw [LinearMap.ext_iff, LinearMap.comp_apply] + intro x + simp_rw [← Matrix.ext_iff, LinearMap.mul'_adjoint, + map_sum, _root_.map_smul, LinearMap.mul'_apply, + Matrix.sum_apply, LinearMap.smul_apply, Matrix.smul_apply, + smul_eq_mul, Module.End.one_apply, mul_apply, single, of_apply, + boole_mul, Finset.mul_sum, mul_ite, MulZeroClass.mul_zero, mul_one, ite_and] + intro i j + simp only [Finset.sum_ite_irrel, Finset.sum_const_zero, Finset.sum_ite_eq, Finset.sum_ite_eq', + Finset.mem_univ, if_true] + simp_rw [← Finset.mul_sum, ← trace_iff φ.matrix⁻¹, mul_comm] + + +-- theorem Module.Dual.IsFaithfulPosMap.basis_op_repr_apply (hφ : φ.IsFaithfulPosMap) (x : ℍᵐᵒᵖ) +-- (ij : n × n) : +-- (hφ.basis.mulOpposite.repr x) ij = +-- ((unop : ℍᵐᵒᵖ →ₗ[ℂ] ℍ) x * hφ.matrixIsPosDef.rpow (1 / 2)) ij.1 ij.2 := +-- by +-- rw [Basis.mulOpposite_repr_apply, unop, LinearEquiv.coe_coe, +-- MulOpposite.coe_opLinearEquiv_symm] +-- letI := Fact.mk hφ +-- rw [Module.Dual.IsFaithfulPosMap.basis_repr_apply] +-- exact Module.Dual.IsFaithfulPosMap.inner_coord' _ _ + + +theorem LinearMap.mulLeft_toMatrix (hφ : φ.IsFaithfulPosMap) (x : Matrix n n ℂ) : + hφ.toMatrix (LinearMap.mulLeft ℂ x) = x ⊗ₖ 1 := + by + letI : _root_.NormedAddCommGroup ℍ := Module.Dual.NormedAddCommGroup φ + letI : _root_.TopologicalSpace ℍ := + (Module.Dual.NormedAddCommGroup φ).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI : _root_.SeminormedAddCommGroup ℍ := + (Module.Dual.NormedAddCommGroup φ).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ ℍ := Module.Dual.InnerProductSpace (φ := φ) + ext ij kl + simp_rw [Module.Dual.IsFaithfulPosMap.toMatrix, LinearMap.toMatrixAlgEquiv_apply, + LinearMap.mulLeft_apply, IsFaithfulPosMap.basis_repr_apply, + Module.Dual.IsFaithfulPosMap.inner_coord', IsFaithfulPosMap.basis_apply, Matrix.mul_assoc, + PosDef.rpow_mul_rpow, neg_add_cancel, PosDef.rpow_zero, Matrix.mul_one, Matrix.mul_apply, + Matrix.single_eq, kroneckerMap, of_apply, Matrix.one_apply, mul_boole, ite_and, + Finset.sum_ite_eq, + Finset.mem_univ, if_true, eq_comm] + +theorem LinearMap.mulRight_toMatrix [hφ : φ.IsFaithfulPosMap] (x : Matrix n n ℂ) : + hφ.toMatrix (LinearMap.mulRight ℂ x) = 1 ⊗ₖ (hφ.sig (1 / 2) x)ᵀ := + by + letI : _root_.NormedAddCommGroup ℍ := Module.Dual.NormedAddCommGroup φ + letI : _root_.TopologicalSpace ℍ := + (Module.Dual.NormedAddCommGroup φ).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI : _root_.SeminormedAddCommGroup ℍ := + (Module.Dual.NormedAddCommGroup φ).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ ℍ := Module.Dual.InnerProductSpace (φ := φ) + ext ij kl + simp_rw [Module.Dual.IsFaithfulPosMap.toMatrix, LinearMap.toMatrixAlgEquiv_apply, + LinearMap.mulRight_apply, Module.Dual.IsFaithfulPosMap.basis_repr_apply, + Module.Dual.IsFaithfulPosMap.inner_coord'] + simp only [Matrix.mul_apply, kroneckerMap, of_apply, Matrix.one_apply, + IsFaithfulPosMap.basis_apply, + Module.Dual.IsFaithfulPosMap.sig_apply, Matrix.mul_assoc, Matrix.single_eq, boole_mul, + Matrix.transpose_apply, ite_and, eq_comm] + by_cases h : ij.1 = kl.1 + · simp only [h, if_true] + simp only [ite_mul, one_mul, MulZeroClass.zero_mul, Finset.sum_ite_eq', + Finset.mem_univ, if_true] + simp_rw [← Matrix.mul_apply] + rw [Matrix.mul_assoc] + · simp [h] + + +local notation "ℍ_" i => Matrix (s i) (s i) ℂ + +open scoped Classical in +omit [(i : k) → DecidableEq (s i)] in +theorem includeBlock_adjoint [hψ : ∀ i, (ψ i).IsFaithfulPosMap] {i : k} + (x : PiMat ℂ k s) : + withPiInner[ψ] + (LinearMap.adjoint (includeBlock : (ℍ_ i) →ₗ[ℂ] PiMat ℂ k s) x = x i) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + apply @ext_inner_left ℂ _ _ + intro a + rw [LinearMap.adjoint_inner_right, pi.IsFaithfulPosMap.includeBlock_left_inner] + + +theorem pi_inner_single_left [hψ : ∀ i, (ψ i).IsFaithfulPosMap] (i : k) (j l : s i) + (x : PiMat ℂ k s) : + withPiInner[ψ] + (⟪blockDiag' (single (⟨i, j⟩ : Σ a, s a) (⟨i, l⟩ : Σ a, s a) (1 : ℂ)), x⟫_ℂ = + (x i * (ψ i).matrix) j l) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + simp only [← includeBlock_apply_single, + pi.IsFaithfulPosMap.includeBlock_left_inner, inner_single_left] + +theorem eq_mpr_single {k : Type _} {s : k → Type _} [∀ i, DecidableEq (s i)] {i j : k} + {b c : s j} (h₁ : i = j) : + (by rw [h₁]; exact single b c (1 : ℂ) : Matrix (s i) (s i) ℂ) = + single (by rw [h₁]; exact b) (by rw [h₁]; exact c) (1 : ℂ) := + by aesop + +theorem pi_inner_single_single [hψ : ∀ i, (ψ i).IsFaithfulPosMap] {i j : k} + (a b : s i) (c d : s j) : + withPiInner[ψ] + (⟪blockDiag' (single ⟨i, a⟩ ⟨i, b⟩ (1 : ℂ)), + blockDiag' (single ⟨j, c⟩ ⟨j, d⟩ (1 : ℂ))⟫_ℂ = + dite (i = j) + (fun h => ite (a = by rw [h]; exact c) ((ψ i).matrix (by rw [h]; exact d) b) 0) + fun _ => 0) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + simp only [← includeBlock_apply_single] + by_cases h : i = j + · simp only [h, dif_pos, pi.IsFaithfulPosMap.includeBlock_inner_same' h, + inner_single_single, eq_mpr_single h] + · simp only [h, dif_neg, not_false_iff, pi.IsFaithfulPosMap.includeBlock_inner_ne_same h] + +theorem pi_inner_single_single_same [hψ : ∀ i, (ψ i).IsFaithfulPosMap] {i : k} + (a b c d : s i) : + withPiInner[ψ] + (⟪blockDiag' (single ⟨i, a⟩ ⟨i, b⟩ (1 : ℂ)), + blockDiag' (single ⟨i, c⟩ ⟨i, d⟩ (1 : ℂ))⟫_ℂ = + ite (a = c) ((ψ i).matrix d b) 0) := + by rw [pi_inner_single_single]; aesop + +theorem pi_inner_single_single_ne [hψ : ∀ i, (ψ i).IsFaithfulPosMap] {i j : k} + (h : i ≠ j) (a b : s i) (c d : s j) : + withPiInner[ψ] + (⟪blockDiag' (single ⟨i, a⟩ ⟨i, b⟩ (1 : ℂ)), + blockDiag' (single ⟨j, c⟩ ⟨j, d⟩ (1 : ℂ))⟫_ℂ = + 0) := + by rw [pi_inner_single_single]; aesop + +omit [(i : k) → DecidableEq (s i)] in +theorem LinearMap.pi_mul'_adjoint_single_block [hψ : ∀ i, (ψ i).IsFaithfulPosMap] {i : k} + (x : Matrix (s i) (s i) ℂ) : + letI : ∀ i, DecidableEq (s i) := fun i => Classical.decEq (s i) + withPiInner[ψ] + ((LinearMap.adjoint (LinearMap.mul' ℂ (PiMat ℂ k s))) (includeBlock x) = + (TensorProduct.map includeBlock includeBlock) + (LinearMap.adjoint (LinearMap.mul' ℂ (ℍ_ i)) x)) := + by + classical + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + rw [TensorProduct.inner_ext_iff'] + intro a b + rw [LinearMap.adjoint_inner_left, LinearMap.mul'_apply, + pi.IsFaithfulPosMap.includeBlock_left_inner, ← LinearMap.adjoint_inner_right, + TensorProduct.map_adjoint, TensorProduct.map_tmul, LinearMap.adjoint_inner_left, + LinearMap.mul'_apply] + simp_rw [includeBlock_adjoint, Pi.mul_apply] + + +theorem LinearMap.pi_mul'_adjoint [hψ : ∀ i, (ψ i).IsFaithfulPosMap] (x : PiMat ℂ k s) : + withPiInner[ψ] + (LinearMap.adjoint (LinearMap.mul' ℂ (PiMat ℂ k s)) x = + ∑ r : k, ∑ a, ∑ b, ∑ c, ∑ d, + (x r a d * (pi.matrixBlock ψ r)⁻¹ c b) • + blockDiag' (Matrix.single (⟨r, a⟩ : Σ i, s i) (⟨r, b⟩ : Σ i, s i) (1 : ℂ)) ⊗ₜ[ℂ] + blockDiag' (Matrix.single (⟨r, c⟩ : Σ i, s i) (⟨r, d⟩ : Σ i, s i) (1 : ℂ))) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + nth_rw 1 [matrix_eq_sum_includeBlock x] + simp_rw [map_sum, LinearMap.pi_mul'_adjoint_single_block] + apply Finset.sum_congr rfl; intros + rw [LinearMap.mul'_adjoint] + simp_rw [map_sum, _root_.map_smul, TensorProduct.map_tmul, + includeBlock_apply_single, pi.matrixBlock_apply] + +open scoped Classical in +omit [Fintype k] [(i : k) → DecidableEq (s i)] in +theorem LinearMap.pi_mul'_apply_includeBlock {i : k} (x : (ℍ_ i) ⊗[ℂ] ℍ_ i) : + letI : ∀ i, DecidableEq (s i) := fun i => Classical.decEq (s i) + LinearMap.mul' ℂ (PiMat ℂ k s) ((TensorProduct.map includeBlock includeBlock) x) = + includeBlock (LinearMap.mul' ℂ (ℍ_ i) x) := + by + classical + simp_rw [← LinearMap.comp_apply] + revert x + rw [← LinearMap.ext_iff, TensorProduct.ext_iff'] + intro x y + simp only [LinearMap.comp_apply, TensorProduct.map_tmul, LinearMap.mul'_apply, + includeBlock_hMul_same] + +private theorem linear_map.pi_mul'_comp_mul_adjoint_aux [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + {i : k} (x : ℍ_ i) : + withPiInner[ψ] + (LinearMap.mul' ℂ (PiMat ℂ k s) (LinearMap.adjoint (LinearMap.mul' ℂ (PiMat ℂ k s)) + (includeBlock x)) = + trace ((ψ i).matrix⁻¹) • includeBlock x) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + rw [LinearMap.pi_mul'_adjoint_single_block, LinearMap.pi_mul'_apply_includeBlock] + simp_rw [← LinearMap.comp_apply, Qam.Nontracial.mul_comp_mul_adjoint, LinearMap.comp_apply, + LinearMap.smul_apply, _root_.map_smul, Module.End.one_apply] + +theorem LinearMap.pi_mul'_comp_mul'_adjoint [hψ : ∀ i, (ψ i).IsFaithfulPosMap] (x : PiMat ℂ k s) : + withPiInner[ψ] + (LinearMap.mul' ℂ (PiMat ℂ k s) (LinearMap.adjoint (LinearMap.mul' ℂ (PiMat ℂ k s)) x) = + ∑ i, Matrix.trace (((ψ i).matrix)⁻¹) • includeBlock (x i)) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + nth_rw 1 [matrix_eq_sum_includeBlock x] + simp_rw [_root_.map_sum, linear_map.pi_mul'_comp_mul_adjoint_aux] + + +lemma Matrix.smul_inj_mul_one {n : Type*} [DecidableEq n] + [Nonempty n] (x y : ℂ) : + x • (1 : Matrix n n ℂ) = y • (1 : Matrix n n ℂ) ↔ x = y := +by + simp_rw [← Matrix.ext_iff, Matrix.smul_apply, Matrix.one_apply, smul_ite, + smul_zero, smul_eq_mul, mul_one] + constructor + · intro h + let i : n := Nonempty.some ‹_› + specialize h i i + simp only [↓reduceIte] at h + exact h + · rintro rfl i j + rfl + +open scoped Classical in +omit [DecidableEq k] in +theorem LinearMap.pi_mul'_comp_mul'_adjoint_eq_smul_id_iff [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + [∀ i, Nontrivial (s i)] (α : ℂ) : + withPiInner[ψ] + (LinearMap.mul' ℂ (PiMat ℂ k s) ∘ₗ (LinearMap.adjoint (LinearMap.mul' ℂ (PiMat ℂ k s))) = + α • 1 ↔ ∀ i, Matrix.trace ((ψ i).matrix⁻¹) = α) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + simp_rw [LinearMap.ext_iff, LinearMap.comp_apply, LinearMap.pi_mul'_comp_mul'_adjoint, + funext_iff, Finset.sum_apply, ← LinearMap.map_smul, + includeBlock_apply, Finset.sum_dite_eq', Finset.mem_univ, if_true, + LinearMap.smul_apply, Module.End.one_apply, Pi.smul_apply] + simp only [eq_mp_eq_cast, cast_eq, ← Pi.smul_apply] + -- simp_rw [← @Function.funext_iff k] + constructor + · intro h + specialize h (1 : PiMat ℂ k s) + simp only [Pi.smul_apply, Pi.one_apply] at h + simp_rw [Matrix.smul_inj_mul_one] at h + exact h + · intro h i a + rw [h] diff --git a/LeanPool/Monlib4/LinearAlgebra/Ips/MinimalProj.lean b/LeanPool/Monlib4/LinearAlgebra/Ips/MinimalProj.lean new file mode 100644 index 0000000000..81cb03fe70 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Ips/MinimalProj.lean @@ -0,0 +1,1073 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.LinearAlgebra.Ips.Pos +import LeanPool.Monlib4.LinearAlgebra.Ips.Ips +import LeanPool.Monlib4.LinearAlgebra.Ips.Symm +import LeanPool.Monlib4.RepTheory.AutMat +import LeanPool.Monlib4.LinearAlgebra.KroneckerToTensor +import Mathlib.LinearAlgebra.Matrix.Hermitian +import LeanPool.Monlib4.LinearAlgebra.Ips.RankOne +import LeanPool.Monlib4.LinearAlgebra.Ips.Basic +import LeanPool.Monlib4.LinearAlgebra.IsProj' +import Mathlib.Analysis.InnerProductSpace.Orthogonal + +/-! + +# Minimal projections + +In this file we show some necessary results for positive operators on a Hilbert space. + +## main results + +**Theorem.** If $p,q$ are (orthogonal) projections on $E$, + then the following are equivalent: + - (i) $pq = p = qp$ + - (ii) $p(E) \subseteq q(E)$ + - (iii) $q - p$ is an (orthogonal) projection + - (iv) $q - p$ is positive + +for part (iii), it suffices to show that the element is an idempotent since + $q - p$ is self-adjoint + +it turns out that $qp = p$ (from (i)) if and only if (ii) and + (i) if and only if (iii) for idempotent operators on a module over a ring + (see `IsIdempotentElem.comp_idempotent_iff` and + `linear_map.commutes_iff_isIdempotent_elem`) + +obviously when $p,q$ are self-adjoint operators, then $pq = p$ iff $qp=p$ + (see `self_adjoint_commutes_iff`) + +so then, obviously, (ii) if and only if (iii) for idempotent self-adjoint operators as well + (see `continuous_linear_map.image_subset_iff_sub_of_is_idempotent`) + +we finally have (i) if and only if (iv) for idempotent self-adjoint operators on a + finite-dimensional complex-Hilbert space: + (see `orthogonal_projection_is_positive_iff_commutes`) + +## main definition + +* an operator is non-negative means that it is positive: + $0 \leq p$ if and only if $p$ is positive + (see `is_positive.is_nonneg`) + +-/ + +open Module.End + +section + +variable {R E : Type _} [Ring R] [AddCommGroup E] [Module R E] + +open Submodule LinearMap + +/-- given an idempotent linear operator $p$, we have + $x \in \textnormal{range}(p)$ if and only if $p(x) = x$ (for all $x \in E$) -/ +theorem IsIdempotentElem.mem_range_iff {p : E →ₗ[R] E} (hp : IsIdempotentElem p) {x : E} : + x ∈ range p ↔ p x = x := by + simp_rw [mem_range] + constructor + · rintro ⟨y, hy⟩ + nth_rw 1 [← hy] + rw [← mul_apply, hp.eq, hy] + · intro h + use x + +variable {U V : Submodule R E} {q : E →ₗ[R] E} (hq : IsIdempotentElem q) + +include hq in +/-- given idempotent linear operators $p,q$, + we have $qp = p$ iff $p(E) \subseteq q(E)$ -/ +theorem IsIdempotentElem.comp_idempotent_iff + {E₂ : Type*} [AddCommGroup E₂] [Module R E₂] (p : E₂ →ₗ[R] E) : + q.comp p = p ↔ LinearMap.range p ≤ LinearMap.range q := +by + simp_rw [LinearMap.ext_iff, comp_apply, ← IsIdempotentElem.mem_range_iff hq, + SetLike.le_def, mem_range, forall_exists_index, forall_apply_eq_imp_iff] +include hq in +theorem IsIdempotentElem.comp_idempotent_iff' + {E₂ : Type*} [AddCommGroup E₂] [Module R E₂] (p : E₂ →ₗ[R] E) : + q.comp p = p ↔ Submodule.map p ⊤ ≤ Submodule.map q ⊤ := +by simp_rw [IsIdempotentElem.comp_idempotent_iff hq, Submodule.map_top] + +variable {p : E →ₗ[R] E} (hp : IsIdempotentElem p) + +include hp hq in +/-- if $p,q$ are idempotent operators and $pq = p = qp$, + then $q - p$ is an idempotent operator -/ +theorem LinearMap.isIdempotentElem_sub_of (h : p.comp q = p ∧ q.comp p = p) : + IsIdempotentElem (q - p) := by + simp_rw [IsIdempotentElem, mul_eq_comp, sub_comp, comp_sub, h.1, h.2, ← mul_eq_comp, hp.eq, hq.eq, + sub_self, sub_zero] + +/-- if $p,q$ are idempotent operators and $q - p$ is also an idempotent + operator, then $pq = p = qp$ -/ +theorem LinearMap.commutes_of_isIdempotentElem {E 𝕜 : Type _} [RCLike 𝕜] [AddCommGroup E] + [Module 𝕜 E] {p q : E →ₗ[𝕜] E} (hp : IsIdempotentElem p) (hq : IsIdempotentElem q) + (h : IsIdempotentElem (q - p)) : p.comp q = p ∧ q.comp p = p := + by + simp_rw [IsIdempotentElem, mul_eq_comp, comp_sub, sub_comp, ← mul_eq_comp, hp.eq, hq.eq, ← + sub_add_eq_sub_sub, sub_right_inj, add_sub] at h + have h' : (2 : 𝕜) • p = q.comp p + p.comp q := + by + simp_rw [two_smul] + nth_rw 2 [← h] + simp_rw [mul_eq_comp, add_sub_cancel, add_comm] + have H : ((2 : 𝕜) • p).comp q = q.comp (p.comp q) + p.comp q := by + simp_rw [h', add_comp, comp_assoc, ← mul_eq_comp, hq.eq] + simp_rw [add_comm, two_smul, add_comp, add_right_inj] at H + have H' : q.comp ((2 : 𝕜) • p) = q.comp p + q.comp (p.comp q) := by + simp_rw [h', comp_add, ← comp_assoc, ← mul_eq_comp, hq.eq] + simp_rw [two_smul, comp_add, add_right_inj] at H' + have H'' : q.comp p = p.comp q := by + simp_rw [H'] + exact H.symm + rw [← H'', and_self_iff, ← smul_right_inj (two_ne_zero' 𝕜), h', ← H'', two_smul] + +/-- given idempotent operators $p,q$, + we have $pq = p = qp$ iff $q - p$ is an idempotent operator -/ +theorem LinearMap.commutes_iff_isIdempotentElem {E 𝕜 : Type _} [RCLike 𝕜] [AddCommGroup E] + [Module 𝕜 E] {p q : E →ₗ[𝕜] E} (hp : IsIdempotentElem p) (hq : IsIdempotentElem q) : + p.comp q = p ∧ q.comp p = p ↔ IsIdempotentElem (q - p) := + ⟨fun h => LinearMap.isIdempotentElem_sub_of hq hp h, fun h => + LinearMap.commutes_of_isIdempotentElem hp hq h⟩ + +end + +open ContinuousLinearMap + +variable {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] + +local notation "P" => Submodule.orthogonalProjection + +/-- given self-adjoint operators $p,q$, + we have $pq=p$ iff $qp=p$ -/ +theorem self_adjoint_proj_commutes [InnerProductSpace 𝕜 E] [CompleteSpace E] {p q : E →L[𝕜] E} + (hpa : IsSelfAdjoint p) (hqa : IsSelfAdjoint q) : p.comp q = p ↔ q.comp p = p := + by + constructor <;> intro h <;> + · apply_fun adjoint using star_injective + simp only [adjoint_comp, isSelfAdjoint_iff'.mp hpa, isSelfAdjoint_iff'.mp hqa, h] + +local notation "↥P" => orthogonalProjection' + +open Submodule + +theorem orthogonalProjection_isSelfAdjoint [InnerProductSpace 𝕜 E] [CompleteSpace E] + (U : Submodule 𝕜 E) [U.HasOrthogonalProjection] : + IsSelfAdjoint (↥P U) := + isSelfAdjoint_starProjection U + +theorem orthogonalProjection_eq_self_iff [InnerProductSpace 𝕜 E] + (U : Submodule 𝕜 E) [U.HasOrthogonalProjection] {x : E} : + (U.orthogonalProjection x : E) = x ↔ x ∈ U := + starProjection_eq_self_iff (K := U) + +theorem inner_orthogonalProjection_left_eq_right [InnerProductSpace 𝕜 E] + (U : Submodule 𝕜 E) [U.HasOrthogonalProjection] (x y : E) : + inner 𝕜 (U.orthogonalProjection x : E) y = + inner 𝕜 x (U.orthogonalProjection y : E) := + inner_starProjection_left_eq_right U x y + +theorem orthogonalProjection.isIdempotentElem [InnerProductSpace 𝕜 E] (U : Submodule 𝕜 E) + [U.HasOrthogonalProjection] : IsIdempotentElem (↥P U) := + by + rw [IsIdempotentElem] + ext + simp_rw [ContinuousLinearMap.mul_apply, orthogonalProjection'_eq, comp_apply, + Submodule.subtypeL_apply, + orthogonalProjection_mem_subspace_eq_self] + +/-- A continuous linear map is an orthogonal projection if it is idempotent and +its kernel is the orthogonal complement of its range. -/ +class ContinuousLinearMap.IsOrthogonalProjection [InnerProductSpace 𝕜 E] + (T : E →L[𝕜] E) : Prop where + isIdempotent : IsIdempotentElem T + kerEqRangeOrtho : T.ker = T.rangeᗮ + +lemma ContinuousLinearMap.IsOrthogonalProjection.eq [InnerProductSpace 𝕜 E] + {T : E →L[𝕜] E} (hT : T.IsOrthogonalProjection) : + IsIdempotentElem T ∧ T.ker = T.rangeᗮ := +⟨hT.1, hT.2⟩ + +theorem IsIdempotentElem.clm_to_lm [InnerProductSpace 𝕜 E] {T : E →L[𝕜] E} : + IsIdempotentElem T ↔ IsIdempotentElem (T : E →ₗ[𝕜] E) := + by + simp_rw [IsIdempotentElem, Module.End.mul_eq_comp, ← coe_comp, coe_inj] + rfl + +lemma ContinuousLinearMap.HasOrthogonalProjection_of_isOrthogonalProjection [InnerProductSpace 𝕜 E] + {T : E →L[𝕜] E} [h : T.IsOrthogonalProjection] : HasOrthogonalProjection T.range := +by + constructor + intro x + refine ⟨T x, ⟨x, rfl⟩, ?_⟩ + rw [← h.kerEqRangeOrtho] + change T (x - T x) = 0 + rw [map_sub, ← mul_apply, h.isIdempotent.eq, sub_self] + +lemma ker_to_clm + {R R₂ M M₂ : Type*} [Semiring R] + [Semiring R₂] [AddCommMonoid M] [AddCommMonoid M₂] + [TopologicalSpace M] [TopologicalSpace M₂] + [Module R M] [Module R₂ M₂] {τ₁₂ : R →+* R₂} (f : M →SL[τ₁₂] M₂) : + ∀ x, x ∈ LinearMap.ker (ContinuousLinearMap.toLinearMap f) ↔ f x = 0 := by + intro x + rfl + + +lemma subtype_compL_ker [InnerProductSpace 𝕜 E] (U : Submodule 𝕜 E) + (f : E →L[𝕜] U) : + (U.subtypeL ∘L f).ker = f.ker := + by + simp only [coe_comp, Submodule.coe_subtypeL, LinearMap.ker_comp, + Submodule.ker_subtype, Submodule.comap_bot] + + +lemma orthogonalProjection.isOrthogonalProjection [InnerProductSpace 𝕜 E] + (U : Submodule 𝕜 E) [h : HasOrthogonalProjection U] : + (↥P U).IsOrthogonalProjection := +by + refine ⟨orthogonalProjection.isIdempotentElem _, ?_⟩ + rw [orthogonalProjection.range, ← ker_orthogonalProjection, orthogonalProjection'_eq, + subtype_compL_ker] + +open LinearMap in +/-- given any idempotent operator $T ∈ L(V)$, then `is_compl T.ker T.range`, +in other words, there exists unique $v ∈ \textnormal{ker}(T)$ and $w ∈ \textnormal{range}(T)$ such + that $x = v + w$ -/ +theorem IsIdempotentElem.isCompl_range_ker {V R : Type _} [Semiring R] [AddCommGroup V] + [Module R V] {T : V →ₗ[R] V} (h : IsIdempotentElem T) : IsCompl (ker T) (range T) := + by + constructor + · rw [disjoint_iff] + ext x + simp only [Submodule.mem_bot, Submodule.mem_inf, LinearMap.mem_ker, LinearMap.mem_range] + constructor + · intro h' + rcases h'.2 with ⟨y, hy⟩ + rw [← hy, ← IsIdempotentElem.eq h, Module.End.mul_apply, hy] + exact h'.1 + · intro h' + rw [h', map_zero] + simp only [true_and] + use x + simp only [h', map_zero] + · suffices ∀ x : V, ∃ v : ker T, ∃ w : range T, x = v + w + by + rw [codisjoint_iff, ← Submodule.add_eq_sup] + ext x + rcases this x with ⟨v, w, hvw⟩ + simp only [Submodule.mem_top, iff_true, hvw] + apply Submodule.add_mem_sup (SetLike.coe_mem v) (SetLike.coe_mem w) + intro x + use ⟨x - T x, ?_⟩, ⟨T x, ?_⟩ + · simp only [sub_add_cancel] + · rw [LinearMap.mem_ker, map_sub, ← Module.End.mul_apply, IsIdempotentElem.eq h, sub_self] + · rw [LinearMap.mem_range]; simp only [exists_apply_eq_apply] + +theorem IsCompl.of_orthogonal_projection [InnerProductSpace 𝕜 E] {T : E →L[𝕜] E} + (h : T.IsOrthogonalProjection) : IsCompl T.ker T.range := +IsIdempotentElem.isCompl_range_ker (IsIdempotentElem.clm_to_lm.mp h.1) + +theorem orthogonalProjection.ker [InnerProductSpace 𝕜 E] + {K : Submodule 𝕜 E} [HasOrthogonalProjection K] : (↥P K).ker = Kᗮ := +by + rw [orthogonalProjection'] + exact Submodule.ker_starProjection K + +theorem _root_.LinearMap.isIdempotentElem_of_isProj {V R : Type _} [Semiring R] [AddCommGroup V] + [Module R V] {T : V →ₗ[R] V} {U : Submodule R V} + (h : LinearMap.IsProj U T) : + IsIdempotentElem T := +by ext; exact h.2 _ (h.1 _) + +/-- $P_V P_U = P_U$ if and only if $P_V - P_U$ is an orthogonal projection -/ +theorem sub_of_isOrthogonalProjection [InnerProductSpace ℂ E] [CompleteSpace E] + {U V : Submodule ℂ E} [CompleteSpace U] [CompleteSpace V] : + (↥P V).comp (↥P U) = ↥P U ↔ (↥P V - ↥P U).IsOrthogonalProjection := + by + let p := ↥P U + let q := ↥P V + have pp : p = U.subtypeL.comp (P U) := rfl + have qq : q = V.subtypeL.comp (P V) := rfl + have hp : IsIdempotentElem p := orthogonalProjection.isIdempotentElem U + have hq : IsIdempotentElem q := orthogonalProjection.isIdempotentElem V + have hpa := orthogonalProjection_isSelfAdjoint U + have hqa := orthogonalProjection_isSelfAdjoint V + have h2 := self_adjoint_proj_commutes hpa hqa + simp_rw [orthogonalProjection', ← pp, ← qq] at * + constructor + · intro h + have h_and : + (p : E →ₗ[ℂ] E) ∘ₗ (q : E →ₗ[ℂ] E) = p ∧ + (q : E →ₗ[ℂ] E) ∘ₗ (p : E →ₗ[ℂ] E) = p := by + constructor + · simpa [ContinuousLinearMap.coe_comp] using + congrArg ContinuousLinearMap.toLinearMap ((h2.mpr h)) + · simpa [ContinuousLinearMap.coe_comp] using + congrArg ContinuousLinearMap.toLinearMap h + rw [LinearMap.commutes_iff_isIdempotentElem (IsIdempotentElem.clm_to_lm.mp hp) + (IsIdempotentElem.clm_to_lm.mp hq), + ← coe_sub, ← IsIdempotentElem.clm_to_lm] at h_and + refine ⟨h_and, ?_⟩ + exact (IsIdempotentElem.isSelfAdjoint_iff_ker_isOrtho_to_range _ h_and).mp + (IsSelfAdjoint.sub hqa hpa) + · rintro ⟨h1, _⟩ + have hlin := + LinearMap.commutes_of_isIdempotentElem (IsIdempotentElem.clm_to_lm.mp hp) + (IsIdempotentElem.clm_to_lm.mp hq) (IsIdempotentElem.clm_to_lm.mp h1) + exact coe_inj.mp hlin.2 + +section + +/-- instance for `≤` on linear maps -/ +instance LinearMap.IsSymmetric.hasLe {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] : LE (E →ₗ[𝕜] E) := + by + exact { le := fun u v => (v - u : E →ₗ[𝕜] E).IsPositive' } + +/-- The subtype of symmetric linear endomorphisms of a complex inner product space. -/ +@[reducible] +def SymmetricLM (g : Type*) [NormedAddCommGroup g] [InnerProductSpace ℂ g] := +{x : g →ₗ[ℂ] g | LinearMap.IsSymmetric x} + +/-- The subtype of self-adjoint continuous linear endomorphisms of a complex Hilbert space. -/ +@[reducible] +def SelfAdjointCLM (g : Type*) [NormedAddCommGroup g] [InnerProductSpace ℂ g] + [CompleteSpace g] := +{x : g →L[ℂ] g | IsSelfAdjoint x} + +local notation "L(" x "," y ")" => x →L[y] x + +local notation "l(" x "," y ")" => x →ₗ[y] x + +open scoped ComplexOrder +instance {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] : + PartialOrder (E →ₗ[𝕜] E) where + le := fun u v => LinearMap.IsPositive' (v - u : E →ₗ[𝕜] E) + lt := fun u v => + LinearMap.IsPositive' (v - u : E →ₗ[𝕜] E) ∧ + ¬ LinearMap.IsPositive' (u - v : E →ₗ[𝕜] E) + lt_iff_le_not_ge := fun _ _ => Iff.rfl + le_refl := fun a => by + simp_rw [sub_self] + constructor + · intro u v + simp_rw [LinearMap.zero_apply, inner_zero_left, inner_zero_right] + · intro x + simp_rw [LinearMap.zero_apply, inner_zero_right, le_refl] + le_trans := by + intro a b c hab hbc + rw [← add_zero (c : E →ₗ[𝕜] E), ← sub_self ↑b, ← add_sub_assoc, add_sub_right_comm, + add_sub_assoc] + exact LinearMap.IsPositive'.add hbc hab + le_antisymm := by + rintro a b hba hab + rw [← sub_eq_zero] + rw [← LinearMap.IsSymmetric.inner_map_self_eq_zero hab.1] + intro x + have hba2 := hba.2 x + rw [← neg_le_neg_iff, ← inner_neg_right, ← LinearMap.neg_apply, neg_sub, neg_zero] at hba2 + rw [hab.1] + apply le_antisymm hba2 (hab.2 _) + +/-- `p ≤ q` means `q - p` is positive -/ +theorem LinearMap.IsPositive'.hasLe {E : Type _} [NormedAddCommGroup E] [InnerProductSpace ℂ E] + {p q : SymmetricLM E} : p ≤ q ↔ (q - p : l(E,ℂ)).IsPositive' := by rfl + +noncomputable instance IsSymmetric.hasZero {E : Type _} [NormedAddCommGroup E] + [InnerProductSpace ℂ E] : Zero ↥{x : E →ₗ[ℂ] E | x.IsSymmetric} := + by + fconstructor + fconstructor + · exact 0 + · simp_rw [Set.mem_setOf_eq, LinearMap.IsSymmetric, LinearMap.zero_apply, inner_zero_left, + inner_zero_right, forall_const] + +/-- saying `p` is positive is the same as saying `0 ≤ p` -/ +theorem LinearMap.IsPositive'.is_nonneg {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] {p : l(E,𝕜)} : p.IsPositive' ↔ 0 ≤ p := + by + nth_rw 1 [← sub_zero p] + rfl + +end + +/-- a self-adjoint idempotent operator is positive -/ +theorem SelfAdjointAndIdempotent.is_positive {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] [CompleteSpace E] {p : E →L[𝕜] E} (hp : IsIdempotentElem p) + (hpa : IsSelfAdjoint p) : 0 ≤ p := + by + rw [ContinuousLinearMap.nonneg_iff_isPositive] + exact hp.isPositive_iff_isSelfAdjoint.mpr hpa + +/-- an idempotent is positive if and only if it is self-adjoint -/ +theorem IsIdempotentElem.is_positive_iff_self_adjoint [InnerProductSpace 𝕜 E] [CompleteSpace E] + {p : E →L[𝕜] E} (hp : IsIdempotentElem p) : 0 ≤ p ↔ IsSelfAdjoint p := +by + rw [ContinuousLinearMap.nonneg_iff_isPositive] + exact hp.isPositive_iff_isSelfAdjoint + +theorem IsIdempotentElem.self_adjoint_is_positive_isOrthogonalProjection_tFAE {E : Type _} + [NormedAddCommGroup E] [InnerProductSpace ℂ E] [CompleteSpace E] {p : E →L[ℂ] E} + (hp : IsIdempotentElem p) : List.TFAE [IsSelfAdjoint p, p.IsOrthogonalProjection, 0 ≤ p] := + by + tfae_have 3 ↔ 1 := hp.is_positive_iff_self_adjoint + tfae_have 2 → 1 := by + intro h + rw [IsIdempotentElem.isSelfAdjoint_iff_ker_isOrtho_to_range _ hp] + exact h.2 + tfae_have 1 → 2 := by + intro h + rw [IsIdempotentElem.isSelfAdjoint_iff_ker_isOrtho_to_range _ hp] at h + exact ⟨hp, h⟩ + tfae_finish + +/-- orthogonal projections are obviously positive -/ +theorem orthogonalProjection.is_positive [InnerProductSpace ℂ E] {U : Submodule ℂ E} + [CompleteSpace E] [CompleteSpace U] : 0 ≤ U.subtypeL.comp (P U) := + SelfAdjointAndIdempotent.is_positive (orthogonalProjection.isIdempotentElem U) + (orthogonalProjection_isSelfAdjoint U) + +theorem SelfAdjointAndIdempotent.sub_is_positive_of [InnerProductSpace 𝕜 E] [CompleteSpace E] + {p q : E →L[𝕜] E} (hp : IsIdempotentElem p) (hq : IsIdempotentElem q) (hpa : IsSelfAdjoint p) + (hqa : IsSelfAdjoint q) (h : p.comp q = p) : 0 ≤ q - p := + SelfAdjointAndIdempotent.is_positive + (coe_inj.mp + ((LinearMap.commutes_iff_isIdempotentElem (IsIdempotentElem.clm_to_lm.mp hp) + (IsIdempotentElem.clm_to_lm.mp hq)).mp + ⟨coe_inj.mpr h, coe_inj.mpr ((self_adjoint_proj_commutes hpa hqa).mp h)⟩)) + (IsSelfAdjoint.sub hqa hpa) + +/-- given orthogonal projections `Pᵤ,Pᵥ`, + then `Pᵤ(Pᵥ)=Pᵤ` implies `Pᵥ-Pᵤ` is positive (i.e., `Pᵤ ≤ Pᵥ`) -/ +theorem orthogonalProjection.sub_is_positive_of [InnerProductSpace ℂ E] {U V : Submodule ℂ E} + [CompleteSpace U] [CompleteSpace V] [CompleteSpace E] (h : (↥P U).comp (↥P V) = ↥P U) : + 0 ≤ ↥P V - ↥P U := + SelfAdjointAndIdempotent.sub_is_positive_of (orthogonalProjection.isIdempotentElem U) + (orthogonalProjection.isIdempotentElem V) (orthogonalProjection_isSelfAdjoint U) + (orthogonalProjection_isSelfAdjoint V) h + +/-- given orthogonal projections `Pᵤ,Pᵥ`, + then if `Pᵥ - Pᵤ` is idempotent, then `Pᵤ Pᵥ = Pᵤ` -/ +theorem orthogonal_projection_commutes_of_is_idempotent [InnerProductSpace ℂ E] + {U V : Submodule ℂ E} [CompleteSpace U] [CompleteSpace V] [CompleteSpace E] + (h : IsIdempotentElem (↥P V - ↥P U)) : (↥P V).comp (↥P U) = ↥P U := + by + let p := ↥P U + let q := ↥P V + have pp : p = U.subtypeL.comp (P U) := rfl + have qq : q = V.subtypeL.comp (P V) := rfl + simp_rw [← pp, ← qq] at * + have hp : IsIdempotentElem p := orthogonalProjection.isIdempotentElem U + have hq : IsIdempotentElem q := orthogonalProjection.isIdempotentElem V + exact + coe_inj.mp + (LinearMap.commutes_of_isIdempotentElem (IsIdempotentElem.clm_to_lm.mp hp) + (IsIdempotentElem.clm_to_lm.mp hq) (IsIdempotentElem.clm_to_lm.mp h)).2 + +open scoped FiniteDimensional + +/-- copy of `linear_map.is_positive_iff_exists_adjoint_mul_self` -/ +theorem ContinuousLinearMap.isPositive_iff_exists_adjoint_hMul_self [InnerProductSpace 𝕜 E] + [FiniteDimensional 𝕜 E] [CompleteSpace E] (T : E →L[𝕜] E) : + T.IsPositive ↔ ∃ S : E →L[𝕜] E, T = adjoint S * S := + by + rw [IsPositive.toLinearMap', LinearMap.isPositive'_iff_exists_adjoint_hMul_self] + constructor + · rintro ⟨S, hS⟩ + use LinearMap.toContinuousLinearMap S + ext + rw [← ContinuousLinearMap.coe_coe T, hS] + rfl + · rintro ⟨S, hS⟩ + simp_rw [ContinuousLinearMap.ext_iff, ← ContinuousLinearMap.coe_coe, ← LinearMap.ext_iff] at * + exact ⟨S, hS⟩ + +open RCLike +open scoped InnerProductSpace + +/-- in a finite-dimensional complex Hilbert space `E`, + if `p,q` are self-adjoint operators, then + `p ≤ q` iff `∀ x ∈ E : ⟪x, p x⟫ ≤ ⟪x, q x⟫` -/ +theorem ContinuousLinearMap.is_positive_le_iff_inner [InnerProductSpace 𝕜 E] + [CompleteSpace E] + {p q : E →L[𝕜] E} (hpa : IsSelfAdjoint p) (hqa : IsSelfAdjoint q) : + p ≤ q ↔ ∀ x : E, re ⟪x, p x⟫_𝕜 ≤ re ⟪x, q x⟫_𝕜 := + by + rw [ContinuousLinearMap.le_def] + constructor + · intro h x + rw [← sub_nonneg, ← map_sub, ← inner_sub_right, ← sub_apply] + exact IsPositive.re_inner_nonneg_right h x + · intro h + rw [ContinuousLinearMap.isPositive_def'] + refine ⟨IsSelfAdjoint.sub hqa hpa, fun x => ?_⟩ + simp_rw [reApplyInnerSelf_apply, sub_apply, inner_sub_left, map_sub, sub_nonneg] + nth_rw 1 [inner_re_symm] + nth_rw 2 [inner_re_symm] + exact h x + +local notation "⟪" x "," y "⟫" => @inner 𝕜 _ _ x y + +/-- given self-adjoint idempotent operators `p,q`, we have + `∀ x ∈ E : ⟪x, p x⟫ ≤ ⟪x, q x⟫ ↔ ∀ x ∈ E, ‖p x‖ ≤ ‖q x‖` -/ +theorem ContinuousLinearMap.hasLe_norm [InnerProductSpace 𝕜 E] [CompleteSpace E] {p q : E →L[𝕜] E} + (hp : IsIdempotentElem p) (hq : IsIdempotentElem q) (hpa : IsSelfAdjoint p) + (hqa : IsSelfAdjoint q) : (∀ x : E, re ⟪x,p x⟫ ≤ re ⟪x,q x⟫) ↔ ∀ x : E, ‖p x‖ ≤ ‖q x‖ := + by + rw [← hp.eq, ← hq.eq] + simp_rw [mul_apply, ← adjoint_inner_left _ (q _) _, ← adjoint_inner_left _ (p _) _, + isSelfAdjoint_iff'.mp hpa, isSelfAdjoint_iff'.mp hqa, inner_self_eq_norm_sq, sq_le_sq, + abs_norm, ← mul_apply, hp.eq, hq.eq] + +theorem IsPositive.HasLe.sub [InnerProductSpace 𝕜 E] [CompleteSpace E] {p q : E →L[𝕜] E} : + p ≤ q ↔ 0 ≤ q - p := by simp only [LE.le, sub_zero] + +theorem self_adjoint_and_idempotent_is_positive_iff_commutes + [InnerProductSpace ℂ E] + [CompleteSpace E] {p q : E →L[ℂ] E} + (hp : IsIdempotentElem p) (hq : IsIdempotentElem q) (hpa : IsSelfAdjoint p) + (hqa : IsSelfAdjoint q) : p ≤ q ↔ q.comp p = p := + by + rw [← self_adjoint_proj_commutes hpa hqa, IsPositive.HasLe.sub] + constructor + · intro h + rw [← IsPositive.HasLe.sub, + ContinuousLinearMap.is_positive_le_iff_inner hpa hqa] at h + symm + rw [← sub_eq_zero] + nth_rw 1 [← mul_one p] + simp_rw [ContinuousLinearMap.mul_def, ← comp_sub, ← ContinuousLinearMap.inner_map_self_eq_zero, + comp_apply, sub_apply, + ContinuousLinearMap.one_apply] + intro x + specialize h ((1 - q) x) + simp_rw [sub_apply, map_sub, ← ContinuousLinearMap.mul_apply, mul_one, hq.eq, + sub_self, inner_zero_right, ContinuousLinearMap.one_apply, + ContinuousLinearMap.mul_apply, ← map_sub, zero_re] at h + rw [← hp.eq, ContinuousLinearMap.mul_apply, ← adjoint_inner_left, isSelfAdjoint_iff'.mp hpa, + re_inner_self_nonpos] at h + rw [h, inner_zero_left] + · intro h + exact SelfAdjointAndIdempotent.sub_is_positive_of hp hq hpa hqa h + +/-- in a complex-finite-dimensional Hilbert space `E`, we have + `Pᵤ ≤ Pᵤ` iff `PᵥPᵤ = Pᵤ` -/ +theorem orthogonal_projection_is_le_iff_commutes [InnerProductSpace ℂ E] + {U V : Submodule ℂ E} [CompleteSpace E] [CompleteSpace U] [CompleteSpace V] : + ↥P U ≤ ↥P V ↔ (↥P V).comp (↥P U) = ↥P U := + self_adjoint_and_idempotent_is_positive_iff_commutes (orthogonalProjection.isIdempotentElem U) + (orthogonalProjection.isIdempotentElem V) (orthogonalProjection_isSelfAdjoint U) + (orthogonalProjection_isSelfAdjoint V) + +theorem orthogonalProjection.is_le_iff_subset [InnerProductSpace ℂ E] {U V : Submodule ℂ E} + [CompleteSpace E] + [CompleteSpace U] [CompleteSpace V] : ↥P U ≤ ↥P V ↔ U ≤ V := by + exact Submodule.starProjection_le_starProjection_iff + +theorem Submodule.map_to_linearMap [Module 𝕜 E] {p : E →L[𝕜] E} {U : Submodule 𝕜 E} + {x : E} : + x ∈ Submodule.map (p : E →ₗ[𝕜] E) U ↔ ∃ y ∈ U, p y = x := by + rfl + +/-- given self-adjoint idempotent operators `p,q` we have, + `p(E) ⊆ q(E)` iff `q - p` is an idempotent operator -/ +theorem ContinuousLinearMap.image_subset_iff_sub_of_is_idempotent [InnerProductSpace 𝕜 E] + [CompleteSpace E] {p q : E →L[𝕜] E} (hp : IsIdempotentElem p) (hq : IsIdempotentElem q) + (hpa : IsSelfAdjoint p) (hqa : IsSelfAdjoint q) : + p.range ≤ q.range ↔ IsIdempotentElem (q - p) := by + simp_rw [IsIdempotentElem.clm_to_lm, coe_sub, ← + LinearMap.commutes_iff_isIdempotentElem (IsIdempotentElem.clm_to_lm.mp hp) + (IsIdempotentElem.clm_to_lm.mp hq), + ← coe_comp, coe_inj, self_adjoint_proj_commutes hpa hqa, and_self_iff, ← coe_inj, coe_comp, + IsIdempotentElem.comp_idempotent_iff (IsIdempotentElem.clm_to_lm.mp hq)] + +section MinProj + +/-- definition of a map being a minimal projection -/ +def ContinuousLinearMap.IsMinimalProjection [InnerProductSpace 𝕜 E] [CompleteSpace E] + (x : E →L[𝕜] E) (U : Submodule 𝕜 E) : Prop := + IsSelfAdjoint x ∧ Module.finrank 𝕜 U = 1 ∧ LinearMap.IsProj U x + +/-- definition of orthogonal projection being minimal + i.e., when the dimension of its space equals one -/ +def orthogonalProjection.IsMinimalProjection [InnerProductSpace 𝕜 E] (U : Submodule 𝕜 E) + : Prop := + Module.finrank 𝕜 U = 1 + +open FiniteDimensional + +/-- when a submodule `U` has dimension `1`, then + for any submodule `V`, we have `V ≤ U` if and only if `V = U` or `V = 0` -/ +theorem Submodule.le_finrank_one + {R M : Type*} [Field R] [AddCommGroup M] [Module R M] + (U V : Submodule R M) [Module.Finite R ↥U] [Module.Finite R ↥V] + (hU : Module.finrank R U = 1) : V ≤ U ↔ V = U ∨ V = 0 := + by + simp_rw [Submodule.zero_eq_bot] + constructor + · intro h + have : Module.finrank R V ≤ 1 := by + rw [← hU] + apply Submodule.finrank_mono h + have : Module.finrank R V = 0 ∨ Module.finrank R V = 1 := Order.le_succ_bot_iff.mp this + rcases this with (this_1 | this_1) + · simp only [Submodule.finrank_eq_zero] at this_1 + right + exact this_1 + · left + apply eq_of_le_of_finrank_eq h + simp_rw [this_1, hU] + · intro h + rcases h with (⟨rfl, rfl⟩ | h) + · exact le_refl U + · rw [h] + exact bot_le + +/-- for orthogonal projections `Pᵤ,Pᵥ`, + if `Pᵤ` is a minimal orthogonal projection, then + for any `Pᵥ` if `Pᵥ ≤ Pᵤ` and `Pᵥ ≠ 0`, then `Pᵥ = Pᵤ` -/ +theorem orthogonalProjection.isMinimalProjection_of + [InnerProductSpace ℂ E] + [CompleteSpace E] + (U W : Submodule ℂ E) [CompleteSpace U] [CompleteSpace W] + [Module.Finite ℂ ↥U] [Module.Finite ℂ ↥W] + (hU : orthogonalProjection.IsMinimalProjection U) + (hW : ↥P W ≤ ↥P U) (h : ↥P W ≠ 0) : + ↥P W = ↥P U := + by + refine le_antisymm hW ?_ + have hWU : W ≤ U := (orthogonalProjection.is_le_iff_subset).mp hW + have := Submodule.finrank_mono hWU + simp_rw [orthogonalProjection.IsMinimalProjection] at hU + have hcases := (Submodule.le_finrank_one U W hU).mp hWU + have hUW : U ≤ W := by + rcases hcases with hW1 | hW2 + · rw [hW1] + · exfalso + apply h + ext x + have hxmem : (↥P W x) ∈ W := Submodule.starProjection_apply_mem W x + have hxzero : (↥P W x) ∈ (0 : Submodule ℂ E) := hW2 ▸ hxmem + simpa using hxzero + exact (orthogonalProjection.is_le_iff_subset).mpr hUW + +/-- any rank one operator given by a norm one vector is a minimal projection -/ +theorem rankOne_self_isMinimalProjection [InnerProductSpace ℂ E] [CompleteSpace E] {x : E} + (h : ‖x‖ = 1) : (rankOne ℂ x x).IsMinimalProjection (Submodule.span ℂ {x}) := + by + refine ⟨rankOne_self_isSelfAdjoint (𝕜 := ℂ) (x := x), ?_, ?_⟩ + · rw [finrank_eq_one_iff'] + use ⟨x, Submodule.mem_span_singleton_self x⟩ + constructor + · intro hw + have hx : x ≠ 0 := norm_ne_zero_iff.mp (by rw [h]; exact one_ne_zero) + exact hx (congrArg Subtype.val hw) + · intro w + rcases Submodule.mem_span_singleton.mp (SetLike.coe_mem w) with ⟨r, hr⟩ + use r + ext + simp [hr] + · apply LinearMap.IsProj.mk + · intro z + rw [rankOne_apply] + exact Submodule.smul_mem _ _ (Submodule.mem_span_singleton_self x) + · intro z hz + rcases Submodule.mem_span_singleton.mp hz with ⟨r, rfl⟩ + simp [inner_self_eq_norm_sq_to_K, h] + +/-- if `x ∈ E` then we can normalize this (i.e., there exists `y ∈ E` + such that `∥y∥ = 1` where `x = r • y` for some `r ∈ ℝ`) unless `x = 0` -/ +theorem normalize_op [InnerProductSpace ℂ E] (x : E) : + (∃ (y : E) (r : ℝ), ‖y‖ = 1 ∧ x = (r : ℂ) • y) ∨ x = 0 := + by + by_cases A : x = 0 + · right + exact A + · have B : ‖x‖ ≠ 0 := by + simp only [ne_eq, norm_eq_zero] + exact A + left + use ((1 / ‖x‖) • x) + use‖x‖ + constructor + · simp_rw [norm_smul, one_div, norm_inv, norm_norm, mul_comm, mul_inv_cancel₀ B] + · simp_rw [one_div, Complex.coe_smul, smul_inv_smul₀ B] + +/-- given any non-zero `x ∈ E`, we have + `1 / ‖x‖ ^ 2 • |x⟩⟨x|` is a minimal projection -/ +theorem rankOne_self_isMinimalProjection' [InnerProductSpace ℂ E] [CompleteSpace E] {x : + E} (h : x ≠ 0) : + IsMinimalProjection ((1 / ‖x‖ ^ 2) • rankOne ℂ x x) (Submodule.span ℂ {x}) := + by + rcases normalize_op x with ⟨y, r, ⟨hy, hx⟩⟩ + · have : r ^ 2 ≠ 0 := by + intro d + rw [pow_eq_zero_iff two_ne_zero] at d + rw [d, Complex.coe_smul, zero_smul] at hx + contradiction + simp_rw [hx, Complex.coe_smul, one_div, ← Complex.coe_smul, map_smulₛₗ, LinearMap.smul_apply, + RingHom.id_apply, Complex.conj_ofReal, + norm_smul, mul_pow, Complex.norm_real, mul_inv, smul_smul, hy, + one_pow, inv_one, mul_one, Real.norm_eq_abs, ← abs_pow, pow_two, abs_mul_self, ← pow_two, + Complex.ofReal_inv, Complex.ofReal_pow, Complex.coe_smul] + norm_cast + rw [inv_mul_cancel₀ this, one_smul] + have : Submodule.span ℂ {((r : ℝ) : ℂ) • y} = Submodule.span ℂ {y} := + by + rw [Submodule.span_singleton_smul_eq _] + refine Ne.isUnit ?_ + rw [ne_eq] + rw [← pow_eq_zero_iff two_ne_zero] + norm_cast + rw [← Complex.coe_smul, this] + exact rankOne_self_isMinimalProjection hy + · contradiction + +lemma LinearMap.range_of_isProj {R M : Type*} [CommSemiring R] [AddCommGroup M] [Module R M] + {p : M →ₗ[R] M} {U : Submodule R M} + (hp : LinearMap.IsProj U p) : + LinearMap.range p = U := +by + ext x + rw [mem_range] + refine ⟨fun ⟨y, hy⟩ => ?_, fun h => ⟨x, hp.map_id _ h⟩⟩ + · rw [← hy] + exact hp.map_mem y + +open scoped FiniteDimensional +/-- a linear operator is an orthogonal projection onto a submodule, if and only if + it is self-adjoint and idempotent; + so it always suffices to say `p = p⋆ = p²` -/ +theorem orthogonal_projection_iff [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] + [CompleteSpace E] {p : E →L[𝕜] E} : (∃ (U : Submodule 𝕜 E), --(hU : CompleteSpace U) + ↥P U = p) + ↔ IsSelfAdjoint p ∧ IsIdempotentElem p := + by + constructor + · rintro ⟨U, rfl⟩ + exact ⟨orthogonalProjection_isSelfAdjoint _, orthogonalProjection.isIdempotentElem _⟩ + · rintro ⟨h1, h2⟩ + simp_rw [IsIdempotentElem, ContinuousLinearMap.mul_def, ContinuousLinearMap.ext_iff, + ← ContinuousLinearMap.coe_coe, + coe_comp, ← LinearMap.ext_iff] at h2 + rcases(LinearMap.isProj_iff_isIdempotentElem _).mpr h2 with ⟨W, hp⟩ + let p' := isProj' hp + have hp' : p' = isProj' hp := rfl + simp_rw [ContinuousLinearMap.ext_iff, ← ContinuousLinearMap.coe_coe, ← isProj'_apply hp, + orthogonalProjection'_eq_linear_proj', ← hp'] + rw [← LinearMap.linearProjOfIsCompl_of_proj p' (isProj'_eq hp)] + use W + · intro x + simp_rw [LinearMap.coe_comp, Submodule.coe_subtype] + suffices this : LinearMap.ker p' = Wᗮ + by simp_rw [this]; rfl + ext y + simp_rw [LinearMap.mem_ker, Submodule.mem_orthogonal] + constructor + · intro hp'y u hu + rw [← hp.2 u hu, ContinuousLinearMap.coe_coe, ← adjoint_inner_right, + IsSelfAdjoint.adjoint_eq h1, ← ContinuousLinearMap.coe_coe, ← isProj'_apply hp, ← hp', + hp'y, + Submodule.coe_zero, inner_zero_right] + · intro h + rw [← Submodule.coe_eq_zero, ← @inner_self_eq_zero 𝕜, isProj'_apply hp, + ContinuousLinearMap.coe_coe, ← adjoint_inner_left, IsSelfAdjoint.adjoint_eq h1, ← + ContinuousLinearMap.coe_coe, ← LinearMap.comp_apply, h2, + h _ (LinearMap.IsProj.map_mem hp _)] + -- . have : p = W.subtype ∘ₗ p' := by rfl + -- rw [← LinearMap.range_of_isProj hp] + -- simp only [range_toLinearMap] + +/-- a linear operator is an orthogonal projection onto a submodule, if and only if + it is a self-adjoint linear projection onto the submodule; + also see `orthogonal_projection_iff` -/ +theorem orthogonal_projection_iff' [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] + [CompleteSpace E] {p : E →L[𝕜] E} (U : Submodule 𝕜 E) : + ↥P U = p ↔ IsSelfAdjoint p ∧ LinearMap.IsProj U p := + by + constructor + · intro h + rw [← h] + refine ⟨orthogonalProjection_isSelfAdjoint _, ?_⟩ + apply LinearMap.IsProj.mk + · intro x + exact Submodule.starProjection_apply_mem U x + · intro x hx + exact Submodule.starProjection_eq_self_iff.mpr hx + · rintro ⟨h, h2⟩ + have hp : LinearMap.IsProj U (p : E →ₗ[𝕜] E) := + by + apply LinearMap.IsProj.mk + · intro x + exact h2.1 x + · intro x hx + exact h2.2 x hx + have : IsIdempotentElem p := + by + rw [IsIdempotentElem.clm_to_lm] + exact (LinearMap.isProj_iff_isIdempotentElem (p : E →ₗ[𝕜] E)).mp + ⟨U, hp⟩ + simp_rw [ContinuousLinearMap.ext_iff, ← ContinuousLinearMap.coe_coe, + orthogonalProjection'_eq_linear_proj'] + let p' := isProj' hp + have hp' : p' = isProj' hp := rfl + simp_rw [← isProj'_apply hp, ← hp'] + rw [← LinearMap.linearProjOfIsCompl_of_proj p' (isProj'_eq hp)] + simp_rw [LinearMap.coe_comp, Submodule.coe_subtype] + intro x + suffices this : LinearMap.ker p' = Uᗮ + by simp_rw [this]; rfl + ext y + simp_rw [LinearMap.mem_ker, Submodule.mem_orthogonal] + constructor + · intro hp'y u hu + rw [← hp.2 u hu, ContinuousLinearMap.coe_coe, ← adjoint_inner_right, + IsSelfAdjoint.adjoint_eq h, ← ContinuousLinearMap.coe_coe, ← isProj'_apply hp, ← hp', hp'y, + Submodule.coe_zero, inner_zero_right] + · intro h' + rw [← Submodule.coe_eq_zero, ← @inner_self_eq_zero 𝕜, isProj'_apply hp, + ContinuousLinearMap.coe_coe, ← adjoint_inner_left, IsSelfAdjoint.adjoint_eq h, ← + ContinuousLinearMap.mul_apply, this, h' _ (LinearMap.IsProj.map_mem h2 _)] + +theorem orthogonalProjection.isMinimalProjection_to_clm [InnerProductSpace 𝕜 E] + [FiniteDimensional 𝕜 E] [CompleteSpace E] (U : Submodule 𝕜 E) : + (↥P U).IsMinimalProjection U ↔ orthogonalProjection.IsMinimalProjection U := + by + constructor + · intro h + exact h.2.1 + · intro h + refine ⟨orthogonalProjection_isSelfAdjoint U, h, ?_⟩ + apply LinearMap.IsProj.mk + · intro x + exact Submodule.starProjection_apply_mem U x + · intro x hx + exact Submodule.starProjection_eq_self_iff.mpr hx + +theorem Submodule.isOrtho_iff_inner_eq' {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] {U W : Submodule 𝕜 E} : + U ⟂ W ↔ ∀ (u : ↥U) (w : ↥W), inner 𝕜 (u : E) (w : E) = 0 := + by + rw [Submodule.isOrtho_iff_inner_eq] + constructor + · intro h u w + exact h _ (SetLike.coe_mem _) _ (SetLike.coe_mem _) + · intro h x hx y hy + exact h ⟨x, hx⟩ ⟨y, hy⟩ + +-- moved from `ips.lean` +/-- `U` and `W` are mutually orthogonal if and only if `(P U).comp (P W) = 0`, +where `P U` is `orthogonal_projection U` -/ +theorem Submodule.is_pairwise_orthogonal_iff_orthogonal_projection_comp_eq_zero + [InnerProductSpace 𝕜 E] (U W : Submodule 𝕜 E) + [HasOrthogonalProjection U] [HasOrthogonalProjection W] : + U ⟂ W ↔ (↥P U).comp (↥P W) = 0 := + by + rw [Submodule.isOrtho_iff_inner_eq'] + constructor + · intro h + ext v + rw [ContinuousLinearMap.comp_apply, ContinuousLinearMap.zero_apply, ← @inner_self_eq_zero 𝕜, + orthogonalProjection'_apply, orthogonalProjection'_apply, ← + inner_orthogonalProjection_left_eq_right, orthogonalProjection_mem_subspace_eq_self] + exact h _ _ + · intro h x y + rw [← (orthogonalProjection_eq_self_iff U).mpr (SetLike.coe_mem x), ← + (orthogonalProjection_eq_self_iff W).mpr (SetLike.coe_mem y), + inner_orthogonalProjection_left_eq_right, ← orthogonalProjection'_apply, ← + orthogonalProjection'_apply, ← ContinuousLinearMap.comp_apply, h, + ContinuousLinearMap.zero_apply, inner_zero_right] + +-- +theorem orthogonalProjection.orthogonal_complement_eq [InnerProductSpace 𝕜 E] + (U : Submodule 𝕜 E) [HasOrthogonalProjection U] : ↥P Uᗮ = 1 - ↥P U := + by + exact Submodule.starProjection_orthogonal' U + +example [InnerProductSpace ℂ E] {U W : Submodule ℂ E} [CompleteSpace E] [CompleteSpace U] + [CompleteSpace W] : + (↥P U).comp (↥P W) = 0 ↔ ↥P U + ↥P W ≤ 1 := by + simp_rw [← Submodule.is_pairwise_orthogonal_iff_orthogonal_projection_comp_eq_zero, + Submodule.isOrtho_iff_le, ← orthogonalProjection.is_le_iff_subset, + orthogonalProjection.orthogonal_complement_eq, add_comm (↥P U) (↥P W), LE.le, + sub_add_eq_sub_sub] + +end MinProj + +section +lemma ContinuousLinearMap.isOrthogonalProjection_iff + {𝕜 E : Type*} [RCLike 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] + (T : E →L[𝕜] E) : + T.IsOrthogonalProjection ↔ IsIdempotentElem T ∧ T.ker = T.rangeᗮ := + ⟨fun h => ⟨h.1, h.2⟩, fun h => ⟨h.1, h.2⟩⟩ + +open scoped FiniteDimensional +theorem ContinuousLinearMap.isOrthogonalProjection_iff' + {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℂ E] + [FiniteDimensional ℂ E] [CompleteSpace E] {p : E →L[ℂ] E} : + p.IsOrthogonalProjection + ↔ IsIdempotentElem p ∧ IsSelfAdjoint p := + by + rw [isOrthogonalProjection_iff] + simp only [and_congr_right_iff] + intro h + have := List.TFAE.out (IsIdempotentElem.self_adjoint_is_positive_isOrthogonalProjection_tFAE + h) 0 1 + rw [this, isOrthogonalProjection_iff] + simp only [h, true_and] + +lemma LinearMap.isSelfAdjoint_toContinuousLinearMap + {𝕜 E : Type*} [RCLike 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] + [CompleteSpace E] + (f : E →ₗ[𝕜] E) : + _root_.IsSelfAdjoint (LinearMap.toContinuousLinearMap f) ↔ _root_.IsSelfAdjoint f := + by + simp_rw [ContinuousLinearMap.isSelfAdjoint_iff_isSymmetric, isSymmetric_iff_isSelfAdjoint] + rfl + +lemma LinearMap.isOrthogonalProjection_iff + {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℂ E] + [FiniteDimensional ℂ E] [CompleteSpace E] + (T : E →ₗ[ℂ] E) : + (LinearMap.toContinuousLinearMap T).IsOrthogonalProjection + ↔ IsIdempotentElem T ∧ IsSelfAdjoint T := + by + rw [ContinuousLinearMap.isOrthogonalProjection_iff', + isSelfAdjoint_toContinuousLinearMap] + constructor + · intro h + exact ⟨by simpa using (IsIdempotentElem.clm_to_lm.mp h.1), h.2⟩ + · intro h + exact ⟨by + rw [IsIdempotentElem.clm_to_lm] + simpa using h.1, h.2⟩ +end + +lemma lmul_isIdempotentElem_iff {R A : Type*} [CommSemiring R] + [Semiring A] [Module R A] [SMulCommClass R A A] [IsScalarTower R A A] (a : A) : + (IsIdempotentElem (lmul a : _ →ₗ[R] _)) ↔ (IsIdempotentElem a) := +by + simp_rw [IsIdempotentElem, mul_eq_comp, lmul_eq_mul, ← LinearMap.mulLeft_mul] + refine ⟨fun h => ?_, fun h => by rw [h]⟩ + rw [LinearMap.ext_iff] at h + specialize h 1 + simp_rw [LinearMap.mulLeft_apply, mul_one] at h + exact h + +lemma lmul_tmul {R A B : Type*} [CommSemiring R] + [Semiring A] [Semiring B] [Module R A] [Module R B] [SMulCommClass R A A] + [SMulCommClass R B B] [IsScalarTower R A A] [IsScalarTower R B B] (a : A) (b : B) : + lmul (a ⊗ₜ[R] b) = TensorProduct.map (lmul a) (lmul b) := +by + ext + simp only [TensorProduct.AlgebraTensorModule.curry_apply, TensorProduct.curry_apply, + LinearMap.coe_restrictScalars, TensorProduct.map_tmul, lmul_apply, + Algebra.TensorProduct.tmul_mul_tmul] + +lemma lmul_eq_lmul_iff {R A : Type*} [CommSemiring R] + [Semiring A] [Module R A] [SMulCommClass R A A] [IsScalarTower R A A] (a b : A) : + lmul a = (lmul b : _ →ₗ[R] _) ↔ a = b := +by + refine ⟨fun h => ?_, fun h => by rw [h]⟩ + rw [LinearMap.ext_iff] at h + specialize h 1 + simp_rw [lmul_apply, mul_one] at h + exact h + +lemma isIdempotentElem_algEquiv_iff {R A B : Type*} [CommSemiring R] + [Semiring A] [Semiring B] + [Algebra R A] [Algebra R B] + (φ : A ≃ₐ[R] B) + (a : A) : + IsIdempotentElem (φ a : B) ↔ IsIdempotentElem a := +by + simp_rw [IsIdempotentElem, ← map_mul, Function.Injective.eq_iff (AlgEquiv.injective _)] + +theorem orthogonalProjection'_isProj {R M : Type*} [RCLike R] [NormedAddCommGroup M] + [InnerProductSpace R M] (U : Submodule R M) [HasOrthogonalProjection U] : + LinearMap.IsProj U (orthogonalProjection' U) := +by + constructor <;> + simp only [orthogonalProjection'_eq, coe_comp', Submodule.coe_subtypeL', Submodule.coe_subtype, + Function.comp_apply, SetLike.coe_mem, implies_true, + orthogonalProjection_eq_self_iff, imp_self, implies_true] + +theorem LinearMap.isProj_iff {S M F : Type*} [Semiring S] [AddCommMonoid M] + [Module S M] (m : Submodule S M) [FunLike F M M] (f : F) : + LinearMap.IsProj m f ↔ (∀ x, f x ∈ m) ∧ (∀ x ∈ m, f x = x) := +⟨fun h => ⟨h.1, h.2⟩, fun h => ⟨h.1, h.2⟩⟩ + +theorem LinearMap.isProj_coe {R M : Type*} [RCLike R] [NormedAddCommGroup M] + [InnerProductSpace R M] (T : M →L[R] M) (U : Submodule R M) : + LinearMap.IsProj U T.toLinearMap ↔ LinearMap.IsProj U T := +by simp_rw [LinearMap.isProj_iff, ContinuousLinearMap.coe_coe] + +open LinearMap in +lemma orthogonalProjection_trace {R M : + Type*} [RCLike R] [NormedAddCommGroup M] [InnerProductSpace R M] + [FiniteDimensional R M] + (U : Submodule R M) : + (trace R M) (orthogonalProjection' U).toLinearMap = Module.finrank R U := +by + refine IsProj.trace ?_ + rw [isProj_coe] + exact orthogonalProjection'_isProj U + +lemma ContinuousLinearMap.eq_comp_orthogonalProjection_ker_ortho + {𝕜 M₁ M₂ : Type*} [RCLike 𝕜] [NormedAddCommGroup M₁] [InnerProductSpace 𝕜 M₁] + [NormedAddCommGroup M₂] [InnerProductSpace 𝕜 M₂] + {T : M₁ →L[𝕜] M₂} [HasOrthogonalProjection T.ker] + [HasOrthogonalProjection T.range] + [CompleteSpace M₁] [CompleteSpace M₂] : + T = T ∘L (orthogonalProjection' (T.ker)ᗮ) + ∧ + T = (orthogonalProjection' T.range) ∘L T := +by + constructor + · ext x + have hx : x - orthogonalProjection' ((T.ker)ᗮ) x ∈ T.ker := by + have hmem := Submodule.sub_starProjection_mem_orthogonal (K := (T.ker)ᗮ) x + change x - ((T.ker)ᗮ).starProjection x ∈ T.ker + rw [Submodule.orthogonal_orthogonal] at hmem + exact hmem + have hzero : T (x - orthogonalProjection' ((T.ker)ᗮ) x) = 0 := hx + rwa [map_sub, sub_eq_zero] at hzero + · ext x + exact ((Submodule.starProjection_eq_self_iff (K := T.range)).mpr + (LinearMap.mem_range_self (T : M₁ →ₗ[𝕜] M₂) x)).symm + +theorem orthogonalProjection_of_top {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] [CompleteSpace ↥(⊤ : Submodule 𝕜 E)] : + orthogonalProjection' (⊤ : Submodule 𝕜 E) = 1 := + by + ext1 + simp_rw [ContinuousLinearMap.one_apply, orthogonalProjection'_apply] + rw [orthogonalProjection_eq_self_iff] + simp only [Submodule.mem_top] + +theorem LinearMap.IsProj.codRestrict_of_top {S M : Type*} [Semiring S] [AddCommMonoid M] + [Module S M] : + (Submodule.subtype ⊤).comp (LinearMap.IsProj.top S M).codRestrict = LinearMap.id := +rfl + +theorem LinearMap.IsProj.codRestrict_eq_dim_iff {S M : Type*} + [Semiring S] [AddCommMonoid M] [Module S M] + {f : M →ₗ[S] M} {U : Submodule S M} (hf : LinearMap.IsProj U f) : + U = (⊤ : Submodule S M) + ↔ (Submodule.subtype _).comp hf.codRestrict = LinearMap.id := +by + rw[LinearMap.IsProj.subtype_comp_codRestrict] + constructor + · rintro rfl + ext + simp only [id_coe, id_eq, hf.2 _ Submodule.mem_top] + · rintro rfl + refine Submodule.eq_top_iff'.mpr ?mpr.a + intro x + rw [← id_apply (R := S) x] + exact hf.map_mem x diff --git a/LeanPool/Monlib4/LinearAlgebra/Ips/MulOp.lean b/LeanPool/Monlib4/LinearAlgebra/Ips/MulOp.lean new file mode 100644 index 0000000000..ac1362bd74 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Ips/MulOp.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Data.Opposite +import Mathlib.LinearAlgebra.FiniteDimensional.Basic +import Mathlib.Analysis.InnerProductSpace.Basic +import Mathlib.Analysis.InnerProductSpace.MulOpposite +import Mathlib.Analysis.InnerProductSpace.PiL2 +import Mathlib.Analysis.InnerProductSpace.Adjoint +import LeanPool.Monlib4.LinearAlgebra.LinearMapOp + +/-! + +# Some results on the opposite vector space + +This file contains the construction of the basis of an opposite space; and the construction of the +opposite inner product space. + +-/ + + +open Module + +variable {R H : Type _} [Ring R] [AddCommGroup H] [Module R H] {ι : Type _} + +namespace Basis + +/-- Compatibility alias for the basis on a multiplicative opposite space. -/ +noncomputable abbrev mulOpposite (b : Module.Basis ι R H) : + Module.Basis ι R Hᵐᵒᵖ := + Module.Basis.mulOpposite b + +theorem mulOpposite_apply (b : Module.Basis ι R H) (i : ι) : + b.mulOpposite i = MulOpposite.op (b i) := + Module.Basis.mulOpposite_apply b i + +theorem mulOpposite_repr_eq (b : Module.Basis ι R H) : + b.mulOpposite.repr = (MulOpposite.opLinearEquiv R).symm.trans b.repr := + Module.Basis.mulOpposite_repr_eq b + +end Basis + +theorem Basis.mulOpposite_repr_apply (b : Basis ι R H) (x : Hᵐᵒᵖ) : + b.mulOpposite.repr x = b.repr (MulOpposite.unop x) := + (Basis.repr_unop_eq_mulOpposite_repr b x).symm + +theorem mulOpposite_finiteDimensional {R H : Type _} [DivisionRing R] [AddCommGroup H] + [Module R H] [FiniteDimensional R H] : FiniteDimensional R Hᵐᵒᵖ := by + infer_instance + +/-- The named inner-product data on a multiplicative opposite space. -/ +abbrev MulOpposite.hasInner {𝕜 H : Type _} [RCLike 𝕜] [NormedAddCommGroup H] + [InnerProductSpace 𝕜 H] : Inner 𝕜 Hᵐᵒᵖ := + inferInstance + +theorem MulOpposite.inner_eq {𝕜 H : Type _} [RCLike 𝕜] [NormedAddCommGroup H] + [InnerProductSpace 𝕜 H] (x y : Hᵐᵒᵖ) : + inner 𝕜 x y = inner 𝕜 (MulOpposite.unop x) (MulOpposite.unop y) := + (MulOpposite.inner_unop x y).symm + +theorem MulOpposite.inner_eq' {𝕜 H : Type _} [RCLike 𝕜] [NormedAddCommGroup H] + [InnerProductSpace 𝕜 H] (x y : H) : + inner 𝕜 (MulOpposite.op x) (MulOpposite.op y) = inner 𝕜 x y := + MulOpposite.inner_op x y + +/-- The named inner-product-space structure on a multiplicative opposite space. -/ +abbrev MulOpposite.innerProductSpace {𝕜 H : Type _} [RCLike 𝕜] [NormedAddCommGroup H] + [InnerProductSpace 𝕜 H] : InnerProductSpace 𝕜 Hᵐᵒᵖ := + inferInstance + +theorem Basis.orthonormal_iff_mulOpposite {𝕜 H : Type _} [RCLike 𝕜] + [NormedAddCommGroup H] [InnerProductSpace 𝕜 H] {ι : Type _} (b : Basis ι 𝕜 H) : + Orthonormal 𝕜 b ↔ Orthonormal 𝕜 b.mulOpposite := + (Basis.mulOpposite_is_orthonormal_iff b).symm + +theorem Basis.mulOpposite_is_orthonormal_iff {𝕜 H : Type _} [RCLike 𝕜] + [NormedAddCommGroup H] [InnerProductSpace 𝕜 H] {ι : Type _} + (b : Module.Basis ι 𝕜 H) : + Orthonormal 𝕜 b ↔ Orthonormal 𝕜 b.mulOpposite := + (Module.Basis.mulOpposite_is_orthonormal_iff b).symm + +instance MulOpposite.starModule {R H : Type _} [Star R] [SMul R H] [Star H] [StarModule R H] : + StarModule R Hᵐᵒᵖ + where star_smul r a := by simp_rw [star, MulOpposite.unop_smul, star_smul, MulOpposite.op_smul] + +theorem MulOpposite.opContinuousLinearEquiv_adjoint {𝕜 A : Type*} + [RCLike 𝕜] [NormedAddCommGroup A] [InnerProductSpace 𝕜 A] [CompleteSpace A] : + ContinuousLinearMap.adjoint + (MulOpposite.opContinuousLinearEquiv 𝕜 (M:=A)).toContinuousLinearMap + = (MulOpposite.opContinuousLinearEquiv 𝕜 (M:=A)).symm.toContinuousLinearMap := +by + ext x + apply ext_inner_left 𝕜 + intro y + simp [ContinuousLinearMap.adjoint_inner_right] + rfl + +theorem MulOpposite.opLinearEquiv_adjoint {𝕜 A : Type*} [RCLike 𝕜] [NormedAddCommGroup A] + [InnerProductSpace 𝕜 A] [FiniteDimensional 𝕜 A] : + LinearMap.adjoint (MulOpposite.opLinearEquiv 𝕜 (M:=A)).toLinearMap + = (MulOpposite.opLinearEquiv 𝕜 (M:=A)).symm.toLinearMap := +by + haveI : CompleteSpace A := FiniteDimensional.complete 𝕜 A + calc LinearMap.adjoint (MulOpposite.opLinearEquiv 𝕜 (M:=A)).toLinearMap + = ContinuousLinearMap.adjoint + (MulOpposite.opContinuousLinearEquiv 𝕜 (M:=A)).toContinuousLinearMap := rfl + _ = (MulOpposite.opLinearEquiv 𝕜 (M:=A)).symm.toLinearMap := by + rw [MulOpposite.opContinuousLinearEquiv_adjoint]; rfl + +theorem LinearMap.op_adjoint {𝕜 A : Type*} [RCLike 𝕜] [NormedAddCommGroup A] + [InnerProductSpace 𝕜 A] [FiniteDimensional 𝕜 A] (x : A →ₗ[𝕜] A) : + LinearMap.adjoint x.op = (LinearMap.adjoint x).op := + calc LinearMap.adjoint x.op = LinearMap.adjoint ((MulOpposite.opLinearEquiv 𝕜 (M:=A)).toLinearMap + ∘ₗ x ∘ₗ (MulOpposite.opLinearEquiv 𝕜 (M:=A)).symm.toLinearMap) := rfl + _ = (LinearMap.adjoint x).op := by + simp [← MulOpposite.opLinearEquiv_adjoint] + simp [MulOpposite.opLinearEquiv_adjoint] + rfl diff --git a/LeanPool/Monlib4/LinearAlgebra/Ips/Nontracial.lean b/LeanPool/Monlib4/LinearAlgebra/Ips/Nontracial.lean new file mode 100644 index 0000000000..b9bbb5e107 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Ips/Nontracial.lean @@ -0,0 +1,1255 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.LinearAlgebra.Mul'' +import LeanPool.Monlib4.LinearAlgebra.Matrix.PosDefRpow +import LeanPool.Monlib4.LinearAlgebra.InnerAut +import LeanPool.Monlib4.LinearAlgebra.Matrix.Reshape +import LeanPool.Monlib4.LinearAlgebra.ToMatrixOfEquiv +import LeanPool.Monlib4.LinearAlgebra.Ips.TensorHilbert +import LeanPool.Monlib4.LinearAlgebra.Ips.Functional +import LeanPool.Monlib4.LinearAlgebra.Ips.MatIps +import LeanPool.Monlib4.LinearAlgebra.Ips.MulOp +import LeanPool.Monlib4.LinearAlgebra.Matrix.IncludeBlock +import LeanPool.Monlib4.LinearAlgebra.Ips.OpUnop +import LeanPool.Monlib4.LinearAlgebra.PiDirectSum +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.BasicLemmas +import LeanPool.Monlib4.Preq.Finset + +/-! + +# Some results on the Hilbert space on finite-dimensional C*-algebras + +This file contains some results on the Hilbert space on finite-dimensional C*-algebras + (so just a direct sum of matrix algebras over ℂ). + +-/ + + +variable {n : Type _} [Fintype n] + +local notation "ℍ" => Matrix n n ℂ + +local notation "l(" x ")" => x →ₗ[ℂ] x + +local notation "L(" x ")" => x →L[ℂ] x + +local notation "e_{" i "," j "}" => Matrix.single i j (1 : ℂ) + +open scoped Matrix + +open Matrix + +variable [DecidableEq n] {φ : Module.Dual ℂ (Matrix n n ℂ)} + {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} [∀ i, Fintype (s i)] + [∀ i, DecidableEq (s i)] {ψ : ∀ i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} + +open scoped Kronecker Matrix BigOperators TensorProduct Functional InnerProductSpace + +open Module.Dual + +local notation "ℍ_" i => Matrix (s i) (s i) ℂ + +private theorem add_neg_self {G : Type*} [AddGroup G] (a : G) : a + -a = 0 := + add_neg_cancel a + +private theorem neg_add_self {G : Type*} [AddGroup G] (a : G) : -a + a = 0 := + neg_add_cancel a + +section SingleBlock + +/-! # Section single_block -/ + +-- set_option trace.Meta.synthInstance true +-- set_option pp.all true +-- set_option trace.Meta.isDefEq true +-- set_option trace.Meta.isLevelDefEq true + +-- /- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (x_5 x_6) -/ +-- /- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j k l) -/ +-- set_option synthInstance.maxHeartbeats 300000 in +-- set_option maxHeartbeats 900000 in +-- /-- we can expres the nontracial adjoint of `linear_map.mul'` by + +local notation "|" x "⟩⟨" y "|" => + @rankOne ℂ _ _ _ _ _ _ _ x y + +-- set_option synthInstance.maxHeartbeats 60000 in +-- theorem Module.Dual.IsFaithfulPosMap.psi_0_0_eq [hφ : φ.IsFaithfulPosMap] (x : l(ℍ)) : +-- hφ.psi 0 0 x = (TensorProduct.map x op) (LinearMap.adjoint (LinearMap.mul' ℂ ℍ) (1 : ℍ)) := +-- by +-- suffices +-- ∀ a b : ℍ, +-- hφ.psi 0 0 |a⟩⟨b| = +-- (TensorProduct.map (↑|a⟩⟨b|) op) (LinearMap.adjoint (LinearMap.mul' ℂ ℍ) (1 : ℍ)) +-- by +-- obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne x +-- simp_rw [map_sum, this, TensorProduct.sum_map, LinearMap.sum_apply] +-- intro a b +-- simp_rw [LinearMap.mul'_adjoint, one_apply, ite_mul, one_mul, MulZeroClass.zero_mul, ite_smul, +-- zero_smul, Finset.sum_ite_eq, Finset.mem_univ, if_true, map_sum, _root_.map_smul, +-- TensorProduct.map_tmul, ContinuousLinearMap.coe_coe, rankOne_apply, ← inner_conj_symm b, +-- inner_stdBasisMatrix_left, starRingEnd_apply, ← conjTranspose_apply, conjTranspose_mul, ← +-- TensorProduct.smul_tmul', smul_smul] +-- rw [Finset.sum_rotate] +-- simp_rw [← Finset.sum_smul, ← mul_apply, hφ.matrixIsPosDef.1.eq, +-- @inv_mul_cancel_left_of_invertible n n ℂ _ _ _ φ.matrix bᴴ hφ.matrixIsPosDef.invertible, +-- ← TensorProduct.tmul_smul, ← TensorProduct.tmul_sum, ← _root_.map_smul, ← map_sum, ← +-- smul_stdBasisMatrix'] +-- rw [← matrix_eq_sum_std_basis bᴴ, Module.Dual.IsFaithfulPosMap.psi_apply, +-- Module.Dual.IsFaithfulPosMap.psiToFun'_apply] +-- simp_rw [Module.Dual.IsFaithfulPosMap.sig_zero] + +-- theorem Module.Dual.IsFaithfulPosMap.psi_eq [hφ : φ.IsFaithfulPosMap] +-- (t s : ℝ) (x : l(ℍ)) : +-- hφ.psi t s x = +-- (TensorProduct.map (hφ.sig t).toLinearMap (op ∘ₗ (hφ.sig (-s)).toLinearMap ∘ₗ unop)) +-- ((TensorProduct.map x op) (LinearMap.adjoint (LinearMap.mul' ℂ ℍ) (1 : ℍ))) := +-- by +-- simp_rw [← Module.Dual.IsFaithfulPosMap.psi_0_0_eq, Module.Dual.IsFaithfulPosMap.psi_apply, ← +-- LinearMap.comp_apply] +-- revert x +-- rw [← LinearMap.ext_iff] +-- apply LinearMap.ext_of_rank_one' +-- intro a b +-- simp_rw [LinearMap.comp_apply, Module.Dual.IsFaithfulPosMap.psiToFun'_apply, +-- TensorProduct.map_tmul, Module.Dual.IsFaithfulPosMap.sig_zero, LinearMap.comp_apply, unop_op, +-- Module.Dual.IsFaithfulPosMap.sig_conjTranspose] +-- rfl + +-- theorem Module.Dual.IsFaithfulPosMap.sig_adjoint [hφ : φ.IsFaithfulPosMap] {t : ℝ} : +-- LinearMap.adjoint (hφ.sig t).toLinearMap = (hφ.sig t).toLinearMap := +-- by +-- rw [LinearMap.ext_iff_inner_map] +-- intro x +-- simp_rw [LinearMap.adjoint_inner_left, Module.Dual.IsFaithfulPosMap.inner_eq', +-- AlgEquiv.toLinearMap_apply, Module.Dual.IsFaithfulPosMap.sig_conjTranspose, +-- Module.Dual.IsFaithfulPosMap.sig_apply, neg_neg] +-- let hQ := hφ.matrixIsPosDef +-- let Q := φ.matrix +-- calc +-- (Q * xᴴ * (hQ.rpow (-t) * x * hQ.rpow t)).trace = +-- (hQ.rpow t * Q * xᴴ * hQ.rpow (-t) * x).trace := +-- ?_ +-- _ = (hQ.rpow t * hQ.rpow 1 * xᴴ * hQ.rpow (-t) * x).trace := by rw [PosDef.rpow_one_eq_self] +-- _ = (hQ.rpow 1 * hQ.rpow t * xᴴ * hQ.rpow (-t) * x).trace := ?_ +-- _ = (Q * (hQ.rpow t * xᴴ * hQ.rpow (-t)) * x).trace := by +-- simp_rw [PosDef.rpow_one_eq_self, Matrix.mul_assoc] +-- · rw [← Matrix.mul_assoc, trace_mul_cycle] +-- simp_rw [Matrix.mul_assoc] +-- · simp_rw [PosDef.rpow_mul_rpow, add_comm] + +-- theorem Nontracial.inner_symm' [hφ : φ.IsFaithfulPosMap] (x y : ℍ) : +-- ⟪x, y⟫_ℂ = ⟪hφ.sig (-(1 / 2 : ℝ)) yᴴ, hφ.sig (-(1 / 2 : ℝ)) xᴴ⟫_ℂ := +-- by +-- simp_rw [← AlgEquiv.toLinearMap_apply, ← LinearMap.adjoint_inner_left, +-- Module.Dual.IsFaithfulPosMap.sig_adjoint, AlgEquiv.toLinearMap_apply, +-- Module.Dual.IsFaithfulPosMap.sig_apply_sig] +-- rw [Nontracial.inner_symm] +-- norm_num + +theorem Module.Dual.IsFaithfulPosMap.basis_apply' [hφ : Module.Dual.IsFaithfulPosMap φ] + (i j : n) : + hφ.basis (i, j) = Matrix.single i j 1 * hφ.matrixIsPosDef.rpow (-(1 / 2)) := + Module.Dual.IsFaithfulPosMap.basis_apply _ (i, j) + +theorem sig_apply_pos_def_matrix [hφ : Module.Dual.IsFaithfulPosMap φ] (t s : ℝ) : + hφ.sig t (hφ.matrixIsPosDef.rpow s) = hφ.matrixIsPosDef.rpow s := by + simp_rw [Module.Dual.IsFaithfulPosMap.sig_apply, PosDef.rpow_mul_rpow, neg_add_cancel_comm] + +theorem sig_apply_pos_def_matrix' [hφ : Module.Dual.IsFaithfulPosMap φ] (t : ℝ) : + hφ.sig t φ.matrix = φ.matrix := + by + nth_rw 2 [← PosDef.rpow_one_eq_self hφ.matrixIsPosDef] + rw [← sig_apply_pos_def_matrix t (1 : ℝ), PosDef.rpow_one_eq_self] + +theorem Nontracial.inner_symm [hφ : φ.IsFaithfulPosMap] (x y : ℍ) : + ⟪x, y⟫_ℂ = ⟪hφ.sig (-1) yᴴ, xᴴ⟫_ℂ := by + simp_rw [Module.Dual.IsFaithfulPosMap.inner_eq', + Module.Dual.IsFaithfulPosMap.sig_apply, neg_neg, Matrix.conjTranspose_mul, + (Matrix.PosDef.rpow.isPosDef hφ.matrixIsPosDef _).1.eq, + Matrix.conjTranspose_conjTranspose, PosDef.rpow_one_eq_self, + PosDef.rpow_neg_one_eq_inv_self] + haveI := hφ.matrixIsPosDef.invertible + calc + (φ.matrix * xᴴ * y).trace = (y * φ.matrix * xᴴ).trace := by + rw [Matrix.trace_mul_cycle] + _ = ((y * φ.matrix) * xᴴ).trace := by rw [Matrix.mul_assoc] + _ = (φ.matrix * (φ.matrix⁻¹ * (y * φ.matrix)) * xᴴ).trace := by + have h : + φ.matrix * (φ.matrix⁻¹ * (y * φ.matrix)) * xᴴ = + (y * φ.matrix) * xᴴ := by + rw [Matrix.mul_inv_cancel_left_of_invertible] + rw [h] + +end SingleBlock + +section DirectSum + +open Module.Dual + +/-! # Section direct_sum -/ + +open scoped ComplexOrder + +-- instance +-- Pi.tensorProduct_finiteDimensional : +-- FiniteDimensional ℂ (PiMat ℂ k s ⊗[ℂ] PiMat ℂ k s) := +-- by infer_instance + -- FiniteDimensional.of_finite_basis (Basis.ofVectorSpace ℂ _) + -- (Basis.ofVectorSpaceIndex ℂ _).toFinite + +open scoped Functional + +open scoped Classical in +omit [DecidableEq k] in +theorem Module.Dual.pi.IsFaithfulPosMap.inner_coord' [hψ : ∀ i, (ψ i).IsFaithfulPosMap] {i : k} + (ij : s i × s i) (x : PiMat ℂ k s) : + ⟪Module.Dual.pi.IsFaithfulPosMap.basis (fun i => (hψ i)) ⟨i, ij⟩, x⟫_ℂ = + (x * fun j => (hψ j).matrixIsPosDef.rpow (1 / 2)) i ij.1 ij.2 := + by + simp_rw [Module.Dual.pi.IsFaithfulPosMap.basis_apply, ← + Module.Dual.IsFaithfulPosMap.orthonormalBasis_apply, Pi.mul_apply, + Module.Dual.pi.IsFaithfulPosMap.includeBlock_left_inner, + Module.Dual.IsFaithfulPosMap.inner_coord] + +open scoped Classical in +omit [DecidableEq k] [(i : k) → DecidableEq (s i)] in +theorem Module.Dual.pi.IsFaithfulPosMap.map_star (hψ : ∀ i, + (ψ i).IsFaithfulPosMap) (x : PiMat ℂ k s) : + pi ψ (star x) = star (pi ψ x) := + pi.IsPosMap.isReal (fun i => (hψ i).1) x + +omit [DecidableEq k] in +theorem Nontracial.Pi.unit_adjoint_eq [hψ : ∀ i, (ψ i).IsFaithfulPosMap] : + withPiInner[ψ] + (LinearMap.adjoint (Algebra.linearMap ℂ (PiMat ℂ k s) : ℂ →ₗ[ℂ] PiMat ℂ k s) = pi ψ) := by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + rw [← pi.IsFaithfulPosMap.adjoint_eq, LinearMap.adjoint_adjoint] + +/-- The positive-definite matrices associated to a faithful positive functional on each block. -/ +theorem Module.Dual.pi.IsFaithfulPosMap.matrixIsPosDef {k : Type _} {s : k → Type _} + [∀ i, Fintype (s i)] [∀ i, DecidableEq (s i)] {ψ : ∀ i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} + (hψ : ∀ i, (ψ i).IsFaithfulPosMap) : ∀ i, (ψ i).matrix.PosDef := fun i => (hψ i).matrixIsPosDef + +/-- Pointwise real powers of a positive-definite element of `PiMat`. -/ +noncomputable def Pi.PosDef.rpow {k : Type _} {s : k → Type _} [∀ i, Fintype (s i)] + [∀ i, DecidableEq (s i)] {a : PiMat ℂ k s} (ha : ∀ i, (a i).PosDef) (r : ℝ) := + fun i => (ha i).rpow r + +omit [Fintype k] [DecidableEq k] in +theorem Pi.PosDef.rpow_hMul_rpow {a : PiMat ℂ k s} (ha : ∀ i, (a i).PosDef) (r₁ r₂ : ℝ) : + Pi.PosDef.rpow ha r₁ * Pi.PosDef.rpow ha r₂ = Pi.PosDef.rpow ha (r₁ + r₂) := + by + ext1 i + simp only [Pi.mul_apply, Pi.PosDef.rpow, PosDef.rpow_mul_rpow] + +omit [Fintype k] [DecidableEq k] in +theorem Pi.PosDef.rpow_zero {a : PiMat ℂ k s} (ha : ∀ i, (a i).PosDef) : Pi.PosDef.rpow ha 0 = 1 := + by + ext x i j + simp only [Pi.PosDef.rpow, Matrix.PosDef.rpow_zero, Pi.one_apply] + +omit [DecidableEq k] in +theorem basis_repr_apply' [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + (x : PiMat ℂ k s) (ijk : Σ i, s i × s i) : + let hQ := Module.Dual.pi.IsFaithfulPosMap.matrixIsPosDef hψ + (Module.Dual.pi.IsFaithfulPosMap.basis hψ).repr x ijk + = (x * (Pi.PosDef.rpow hQ (1/2))) ijk.1 ijk.2.1 ijk.2.2 := +by + rw [Module.Dual.pi.IsFaithfulPosMap.basis_repr_apply] + simp_rw [Pi.mul_apply, Pi.PosDef.rpow, Module.Dual.IsFaithfulPosMap.basis_apply, + ← Module.Dual.IsFaithfulPosMap.orthonormalBasis_apply] + rw [Module.Dual.IsFaithfulPosMap.inner_coord] + +open scoped Classical in +theorem Module.Dual.pi.IsFaithfulPosMap.includeBlock_right_inner {k : Type _} [Fintype k] + [DecidableEq k] {s : k → Type _} [∀ i : k, Fintype (s i)] + {ψ : ∀ i : k, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} [hψ : ∀ i : k, (ψ i).IsFaithfulPosMap] + {i : k} (y : ∀ j : k, Matrix (s j) (s j) ℂ) (x : Matrix (s i) (s i) ℂ) : + withPiInner[ψ] (⟪y, includeBlock x⟫_ℂ = ⟪y i, x⟫_ℂ) := by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.TopologicalSpace (PiMat ℂ k s) := + (Module.Dual.PiNormedAddCommGroup (φ := + ψ)).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI : _root_.SeminormedAddCommGroup (PiMat ℂ k s) := + (Module.Dual.PiNormedAddCommGroup (φ := ψ)).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.TopologicalSpace (Matrix (s i) (s i) ℂ) := + fun i => (Module.Dual.NormedAddCommGroup (ψ + i)).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI : ∀ i, _root_.SeminormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => (Module.Dual.NormedAddCommGroup (ψ i)).toSeminormedAddCommGroup + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + calc + ⟪y, includeBlock x⟫_ℂ = star ⟪includeBlock x, y⟫_ℂ := + (inner_conj_symm y (includeBlock x)).symm + _ = star ⟪x, y i⟫_ℂ := by rw [pi.IsFaithfulPosMap.includeBlock_left_inner] + _ = ⟪y i, x⟫_ℂ := inner_conj_symm (y i) x + +local notation "|" x "⟩⟨" y "|" => + @rankOne ℂ _ _ _ _ _ _ _ x y + +variable {k₂ : Type _} [Fintype k₂] [DecidableEq k₂] {s₂ : k₂ → Type _} [∀ i, Fintype (s₂ i)] + [∀ i, DecidableEq (s₂ i)] {ψ₂ : ∀ i, Module.Dual ℂ (Matrix (s₂ i) (s₂ i) ℂ)} + +open scoped Classical in +omit [DecidableEq k₂] [(i : k) → DecidableEq (s i)] [(i : k₂) → DecidableEq (s₂ i)] in +theorem pi_includeBlock_right_rankOne [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + [hψ₂ : ∀ i, (ψ₂ i).IsFaithfulPosMap] + (a : PiMat ℂ k₂ s₂) {i : k} + (b : ℍ_ i) (c : PiMat ℂ k s) (j : k₂) : + withPiInner[ψ] (withPiInner[ψ₂] + |a⟩⟨includeBlock b| c j = ⟪b, c i⟫_ℂ • a j) := by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : _root_.NormedAddCommGroup (PiMat ℂ k₂ s₂) := Module.Dual.PiNormedAddCommGroup (φ := ψ₂) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k₂ s₂) := Module.Dual.pi.InnerProductSpace (φ := ψ₂) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + simp only [rankOne_apply, pi.IsFaithfulPosMap.includeBlock_left_inner, Pi.smul_apply] + +open scoped Classical in +omit [DecidableEq k] [(i : k) → DecidableEq (s i)] [(i : k₂) → DecidableEq (s₂ i)] in +theorem pi_includeBlock_left_rankOne [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + [hψ₂ : ∀ i, (ψ₂ i).IsFaithfulPosMap] (b : PiMat ℂ k s) {i : k₂} + (a : Matrix (s₂ i) (s₂ i) ℂ) (c : PiMat ℂ k s) (j : k₂) : + withPiInner[ψ] (withPiInner[ψ₂] + |includeBlock a⟩⟨b| c j = + ⟪b, c⟫_ℂ • dite (i = j) (fun h => by rw [← h]; exact a) fun h => 0) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : _root_.NormedAddCommGroup (PiMat ℂ k₂ s₂) := Module.Dual.PiNormedAddCommGroup (φ := ψ₂) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k₂ s₂) := Module.Dual.pi.InnerProductSpace (φ := ψ₂) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s₂ i) (s₂ i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ₂ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s₂ i) (s₂ i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ₂ i) + simp only [rankOne_apply, Pi.smul_apply, + includeBlock_apply, smul_dite, smul_zero] + rfl + +/-- The modular automorphism on a direct product of matrix blocks. -/ +noncomputable def Module.Dual.pi.IsFaithfulPosMap.sig (hψ : ∀ i, (ψ i).IsFaithfulPosMap) + (z : ℝ) : PiMat ℂ k s ≃ₐ[ℂ] PiMat ℂ k s := + let hQ := Module.Dual.pi.IsFaithfulPosMap.matrixIsPosDef hψ + { toFun := fun x => Pi.PosDef.rpow hQ (-z) * x * Pi.PosDef.rpow hQ z + invFun := fun x => Pi.PosDef.rpow hQ z * x * Pi.PosDef.rpow hQ (-z) + left_inv := fun x => by + simp only [← mul_assoc, Pi.PosDef.rpow_hMul_rpow] + simp only [mul_assoc, Pi.PosDef.rpow_hMul_rpow] + simp only [add_neg_self, Pi.PosDef.rpow_zero, one_mul, mul_one] + right_inv := fun x => by + simp only [← mul_assoc, Pi.PosDef.rpow_hMul_rpow] + simp only [mul_assoc, Pi.PosDef.rpow_hMul_rpow] + simp only [Pi.PosDef.rpow_zero, one_mul, mul_one, neg_add_self] + map_add' := fun x y => by simp only [mul_add, add_mul] + map_mul' := fun x y => by + simp_rw [mul_assoc] + simp only [← mul_assoc (Pi.PosDef.rpow hQ z) (Pi.PosDef.rpow hQ (-z)), + Pi.PosDef.rpow_hMul_rpow, add_neg_self, Pi.PosDef.rpow_zero, one_mul] + -- map_smul' := fun r x => by + -- simp only [MulAction.mul_smul, smul_mul, RingHom.id_apply] + -- simp only [Algebra.mul_smul_comm, Algebra.smul_mul_assoc] + commutes' := fun r => by + simp only [Algebra.algebraMap_eq_smul_one, mul_smul_comm, smul_mul_assoc, mul_one, + Pi.PosDef.rpow_hMul_rpow, neg_add_self, Pi.PosDef.rpow_zero] + } + +omit [Fintype k] [DecidableEq k] in +@[simp] +theorem Module.Dual.pi.IsFaithfulPosMap.sig_apply [hψ : ∀ i, (ψ i).IsFaithfulPosMap] (z : ℝ) + (x : PiMat ℂ k s) : + (Module.Dual.pi.IsFaithfulPosMap.sig hψ z) x = + Pi.PosDef.rpow (Module.Dual.pi.IsFaithfulPosMap.matrixIsPosDef hψ) (-z) * x * + Pi.PosDef.rpow (Module.Dual.pi.IsFaithfulPosMap.matrixIsPosDef hψ) z := + rfl + +omit [Fintype k] [DecidableEq k] in +@[simp] +theorem Module.Dual.pi.IsFaithfulPosMap.sig_symm_apply [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + (z : ℝ) (x : PiMat ℂ k s) : + (Module.Dual.pi.IsFaithfulPosMap.sig hψ z).symm x = + Pi.PosDef.rpow (Module.Dual.pi.IsFaithfulPosMap.matrixIsPosDef hψ) z * x * + Pi.PosDef.rpow (Module.Dual.pi.IsFaithfulPosMap.matrixIsPosDef hψ) (-z) := + rfl + +omit [Fintype k] [DecidableEq k] in +@[simp] +theorem Module.Dual.pi.IsFaithfulPosMap.sig_symm_eq (hψ : ∀ i, (ψ i).IsFaithfulPosMap) + (z : ℝ) : + (Module.Dual.pi.IsFaithfulPosMap.sig hψ z).symm = Module.Dual.pi.IsFaithfulPosMap.sig hψ (-z) := + by + ext1 + simp only [Module.Dual.pi.IsFaithfulPosMap.sig_apply, + Module.Dual.pi.IsFaithfulPosMap.sig_symm_apply, neg_neg] + +omit [Fintype k] in +theorem Module.Dual.pi.IsFaithfulPosMap.sig_apply_single_block + (hψ : ∀ i, (ψ i).IsFaithfulPosMap) (z : ℝ) {i : k} (x : ℍ_ i) : + Module.Dual.pi.IsFaithfulPosMap.sig hψ z (includeBlock x) = + includeBlock ((hψ i).sig z x) := + by + simp only [Module.Dual.pi.IsFaithfulPosMap.sig_apply, Module.Dual.IsFaithfulPosMap.sig_apply] + simp_rw [hMul_includeBlock, includeBlock_hMul, includeBlock_inj, Pi.PosDef.rpow] + +omit [Fintype k] [DecidableEq k] in +theorem Module.Dual.pi.IsFaithfulPosMap.sig_eq_pi_blocks (hψ : ∀ i, (ψ i).IsFaithfulPosMap) + (z : ℝ) (x : PiMat ℂ k s) {i : k} : + (Module.Dual.pi.IsFaithfulPosMap.sig hψ z x) i = (hψ i).sig z (x i) := + rfl + +omit [Fintype k] [DecidableEq k] in +theorem Pi.PosDef.rpow.isPosDef {a : PiMat ℂ k s} (ha : ∀ i, (a i).PosDef) (r : ℝ) : + ∀ i, ((Pi.PosDef.rpow ha r) i).PosDef := by + intro i + simp only [Pi.PosDef.rpow] + exact Matrix.PosDef.rpow.isPosDef _ _ + +omit [Fintype k] [DecidableEq k] in +theorem Pi.PosDef.rpow.is_self_adjoint {a : PiMat ℂ k s} (ha : ∀ i, (a i).PosDef) (r : ℝ) : + star (Pi.PosDef.rpow ha r) = Pi.PosDef.rpow ha r := + by + ext1 i + simp only [Pi.PosDef.rpow, star_apply, Pi.star_apply] + exact (Matrix.PosDef.rpow.isPosDef (ha i) r).1.eq + +omit [Fintype k] [DecidableEq k] in +theorem Module.Dual.pi.IsFaithfulPosMap.sig_star (hψ : ∀ i, (ψ i).IsFaithfulPosMap) (z : ℝ) + (x : PiMat ℂ k s) : + star (Module.Dual.pi.IsFaithfulPosMap.sig hψ z x) = + Module.Dual.pi.IsFaithfulPosMap.sig hψ (-z) (star x) := + by + simp_rw [Module.Dual.pi.IsFaithfulPosMap.sig_apply, StarMul.star_mul, + Pi.PosDef.rpow.is_self_adjoint, mul_assoc, neg_neg] + +omit [Fintype k] [DecidableEq k] in +theorem Module.Dual.pi.IsFaithfulPosMap.sig_apply_sig (hψ : ∀ i, (ψ i).IsFaithfulPosMap) + (t r : ℝ) (x : PiMat ℂ k s) : + Module.Dual.pi.IsFaithfulPosMap.sig hψ t (Module.Dual.pi.IsFaithfulPosMap.sig hψ r x) = + Module.Dual.pi.IsFaithfulPosMap.sig hψ (t + r) x := + by + simp only [Module.Dual.pi.IsFaithfulPosMap.sig_apply] + simp_rw [← mul_assoc, Pi.PosDef.rpow_hMul_rpow, mul_assoc, Pi.PosDef.rpow_hMul_rpow, neg_add, + add_comm] + +omit [Fintype k] [DecidableEq k] in +theorem Module.Dual.pi.IsFaithfulPosMap.sig_zero (hψ : ∀ i, + (ψ i).IsFaithfulPosMap) (x : PiMat ℂ k s) : + Module.Dual.pi.IsFaithfulPosMap.sig hψ 0 x = x := by + simp only [Module.Dual.pi.IsFaithfulPosMap.sig_apply, Pi.PosDef.rpow_zero, one_mul, mul_one, + neg_zero] + +open scoped Classical in +omit [DecidableEq k₂] in +theorem Module.Dual.pi.IsFaithfulPosMap.toMatrixLinEquiv_apply'' [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + [hψ₂ : ∀ i, (ψ₂ i).IsFaithfulPosMap] + (f : (PiMat ℂ k s) →ₗ[ℂ] PiMat ℂ k₂ s₂) (r : Σ r, s₂ r × s₂ r) (l : Σ r, s r × s r) : + (Module.Dual.pi.IsFaithfulPosMap.toMatrixLinEquiv hψ hψ₂) f r l = + (f (includeBlock ((hψ l.1).basis l.2)) * + Pi.PosDef.rpow (Module.Dual.pi.IsFaithfulPosMap.matrixIsPosDef hψ₂) (1 / 2 : ℝ)) + r.1 r.2.1 r.2.2 := + by + rw [Module.Dual.pi.IsFaithfulPosMap.toMatrixLinEquiv_apply'] + rfl +theorem Module.Dual.pi.IsFaithfulPosMap.toMatrix_apply'' [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + (f : (PiMat ℂ k s) →ₗ[ℂ] PiMat ℂ k s) (r l : Σ r, s r × s r) : + (Module.Dual.pi.IsFaithfulPosMap.toMatrix hψ) f r l = + (f (includeBlock ((hψ l.1).basis l.2)) * + Pi.PosDef.rpow (Module.Dual.pi.IsFaithfulPosMap.matrixIsPosDef hψ) (1 / 2 : ℝ)) + r.1 r.2.1 r.2.2 := +toMatrixLinEquiv_apply'' _ _ _ + +open scoped Classical in +omit [DecidableEq k₂] in +theorem Module.Dual.pi.IsFaithfulPosMap.toMatrixLinEquiv_symm_apply' [hψ : ∀ i, + (ψ i).IsFaithfulPosMap] + [hψ₂ : ∀ i, (ψ₂ i).IsFaithfulPosMap] + (x : Matrix (Σ i, s₂ i × s₂ i) (Σ i, s i × s i) ℂ) : + withPiInner[ψ] (withPiInner[ψ₂] + (Module.Dual.pi.IsFaithfulPosMap.toMatrixLinEquiv hψ hψ₂).symm x = + ∑ a, ∑ i, ∑ j, ∑ b, ∑ c, ∑ d, + x ⟨a, (i, j)⟩ ⟨b, (c, d)⟩ • + (rankOne ℂ + (Module.Dual.pi.IsFaithfulPosMap.basis hψ₂ ⟨a, (i, j)⟩) + (Module.Dual.pi.IsFaithfulPosMap.basis hψ ⟨b, (c, d)⟩)).toLinearMap) := + by + rw [LinearMap.ext_iff] + intro y + rw [funext_iff] + intro a + simp_rw [Module.Dual.pi.IsFaithfulPosMap.toMatrixLinEquiv, LinearMap.toMatrix_symm, + toLin_apply, mulVec, dotProduct, pi.IsFaithfulPosMap.basis_repr_apply, + pi.IsFaithfulPosMap.basis_apply, ← Module.Dual.IsFaithfulPosMap.basis_apply', + Finset.sum_sigma_univ] + simp only [LinearMap.sum_apply, LinearMap.smul_apply, ContinuousLinearMap.coe_coe, rankOne_apply, + Finset.sum_apply, Pi.smul_apply, + pi.IsFaithfulPosMap.includeBlock_left_inner, Finset.sum_product_univ, Finset.sum_smul, + smul_smul] + +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (a i j b c d) -/ +theorem Module.Dual.pi.IsFaithfulPosMap.toMatrix_symm_apply' [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + (x : Matrix (Σ i, s i × s i) (Σ i, s i × s i) ℂ) : + withPiInner[ψ] + (Module.Dual.pi.IsFaithfulPosMap.toMatrix hψ).symm x = + ∑ a, ∑ i, ∑ j, ∑ b, ∑ c, ∑ d, + x ⟨a, (i, j)⟩ ⟨b, (c, d)⟩ • + (rankOne ℂ + (Module.Dual.pi.IsFaithfulPosMap.basis hψ ⟨a, (i, j)⟩) + (Module.Dual.pi.IsFaithfulPosMap.basis hψ ⟨b, (c, d)⟩)).toLinearMap := +toMatrixLinEquiv_symm_apply' _ + +theorem Module.Dual.pi.IsFaithfulPosMap.toMatrix_eq_orthonormalBasis_toMatrix + [hψ : ∀ i, (ψ i).IsFaithfulPosMap] (x : l(PiMat ℂ k s)) : + withPiInner[ψ] + (pi.IsFaithfulPosMap.toMatrix fun i => (hψ i)) x = + (pi.IsFaithfulPosMap.orthonormalBasis hψ).toMatrix x := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + ext + simp_rw [pi.IsFaithfulPosMap.toMatrix_apply', OrthonormalBasis.toMatrix_apply, + pi.IsFaithfulPosMap.orthonormalBasis_apply, pi.IsFaithfulPosMap.includeBlock_left_inner, + ← Module.Dual.IsFaithfulPosMap.basis_apply, + Module.Dual.IsFaithfulPosMap.inner_coord'] + +lemma _root_.Matrix.toLin_apply_rankOne {𝕜 H₁ H₂ : Type*} [RCLike 𝕜] + [_root_.NormedAddCommGroup H₁] [_root_.NormedAddCommGroup H₂] [_root_.InnerProductSpace 𝕜 H₁] + [_root_.InnerProductSpace 𝕜 H₂] {ι₁ ι₂ : Type*} [Fintype ι₁] [DecidableEq ι₁] [Fintype ι₂] + (b₁ : OrthonormalBasis ι₁ 𝕜 H₁) (b₂ : OrthonormalBasis ι₂ 𝕜 H₂) (x : Matrix ι₂ ι₁ 𝕜) : + Matrix.toLin b₁.toBasis b₂.toBasis x = + ∑ i, ∑ j, x i j • (rankOne 𝕜 (b₂ i) (b₁ j)).toLinearMap := +by + classical + ext1 + simp_rw [toLin_apply, mulVec, dotProduct, OrthonormalBasis.coe_toBasis_repr_apply, + OrthonormalBasis.repr_apply_apply, LinearMap.sum_apply, LinearMap.smul_apply, + ContinuousLinearMap.coe_coe, rankOne_apply, smul_smul, Finset.sum_smul] + rfl + +open scoped Classical in +omit [DecidableEq k] in +@[simp] +lemma Module.Dual.pi.IsFaithfulPosMap.orthonormalBasis_eq_toBasis + (hψ : ∀ i, (ψ i).IsFaithfulPosMap) : + withPiInner[ψ] + (IsFaithfulPosMap.orthonormalBasis hψ).toBasis = IsFaithfulPosMap.basis hψ := +by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + ext + simp_rw [OrthonormalBasis.coe_toBasis, pi.IsFaithfulPosMap.orthonormalBasis_apply, + pi.IsFaithfulPosMap.basis_apply] + +open scoped Classical in +omit [DecidableEq k₂] in +theorem Module.Dual.pi.IsFaithfulPosMap.linearMap_eq [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + [hψ₂ : ∀ i, (ψ₂ i).IsFaithfulPosMap] + (x : (PiMat ℂ k s) →ₗ[ℂ] PiMat ℂ k₂ s₂) : + withPiInner[ψ] (withPiInner[ψ₂] + x = + ∑ a, ∑ b, + (Module.Dual.pi.IsFaithfulPosMap.toMatrixLinEquiv hψ hψ₂) x a b • + (rankOne ℂ + (Module.Dual.pi.IsFaithfulPosMap.basis hψ₂ a) + (Module.Dual.pi.IsFaithfulPosMap.basis hψ b)).toLinearMap) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : _root_.NormedAddCommGroup (PiMat ℂ k₂ s₂) := Module.Dual.PiNormedAddCommGroup (φ := ψ₂) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k₂ s₂) := Module.Dual.pi.InnerProductSpace (φ := ψ₂) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s₂ i) (s₂ i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ₂ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s₂ i) (s₂ i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ₂ i) + simp_rw [pi.IsFaithfulPosMap.basis_apply, ← pi.IsFaithfulPosMap.orthonormalBasis_apply] + rw [← _root_.Matrix.toLin_apply_rankOne, ← LinearMap.toMatrix_symm] + simp only [orthonormalBasis_eq_toBasis, toMatrixLinEquiv, + LinearMap.toMatrix_symm, toLin_toMatrix] + +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (a b) -/ +/-- Forward map underlying `psi` for faithful positive functionals on matrix-block products. -/ +noncomputable def Module.Dual.pi.IsFaithfulPosMap.psiToFun' (hψ : ∀ i, (ψ i).IsFaithfulPosMap) + (hψ₂ : ∀ i, (ψ₂ i).IsFaithfulPosMap) + (t r : ℝ) : (PiMat ℂ k s →ₗ[ℂ] PiMat ℂ k₂ s₂) →ₗ[ℂ] PiMat ℂ k₂ s₂ ⊗[ℂ] (PiMat ℂ k s)ᵐᵒᵖ + where + toFun x := + ∑ a, ∑ b, + (Module.Dual.pi.IsFaithfulPosMap.toMatrixLinEquiv hψ hψ₂ x) a b • + Module.Dual.pi.IsFaithfulPosMap.sig hψ₂ t + ((Module.Dual.pi.IsFaithfulPosMap.basis hψ₂) a) ⊗ₜ[ℂ] + ((op ℂ).toLinearMap : PiMat ℂ k s →ₗ[ℂ] (PiMat ℂ k s)ᵐᵒᵖ) + (star + (Module.Dual.pi.IsFaithfulPosMap.sig hψ r + ((Module.Dual.pi.IsFaithfulPosMap.basis hψ) b))) + map_add' x y := by simp_rw [map_add, Matrix.add_apply, add_smul, Finset.sum_add_distrib] + map_smul' r x := by + simp_rw [_root_.map_smul, Matrix.smul_apply, smul_eq_mul, ← smul_smul, ← Finset.smul_sum, + RingHom.id_apply] + +omit [DecidableEq k₂] in +theorem Module.Dual.pi.IsFaithfulPosMap.toMatrixLinEquiv_rankOne_apply [hψ : ∀ i, + (ψ i).IsFaithfulPosMap] + [hψ₂ : ∀ i, (ψ₂ i).IsFaithfulPosMap] + (x : PiMat ℂ k₂ s₂) (y : PiMat ℂ k s) : + withPiInner[ψ] (withPiInner[ψ₂] + pi.IsFaithfulPosMap.toMatrixLinEquiv hψ hψ₂ (rankOne ℂ x y).toLinearMap = + fun (i : Σ i, s₂ i × s₂ i) (j : Σ i, s i × s i) => + (replicateCol (Fin 1) (reshape (x i.fst * (hψ₂ i.1).matrixIsPosDef.rpow (1 / 2 : ℝ))) * + (replicateCol (Fin 1) + (reshape (y j.fst * (hψ j.1).matrixIsPosDef.rpow (1 / 2 : ℝ))))ᴴ) + i.2 j.2) := +by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : _root_.NormedAddCommGroup (PiMat ℂ k₂ s₂) := Module.Dual.PiNormedAddCommGroup (φ := ψ₂) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k₂ s₂) := Module.Dual.pi.InnerProductSpace (φ := ψ₂) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s₂ i) (s₂ i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ₂ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s₂ i) (s₂ i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ₂ i) + ext + simp_rw [pi.IsFaithfulPosMap.toMatrixLinEquiv_apply', ContinuousLinearMap.coe_coe, + _root_.rankOne_apply, + Pi.smul_apply, Matrix.smul_mul, Matrix.smul_apply, + Module.Dual.pi.IsFaithfulPosMap.includeBlock_right_inner, ← inner_conj_symm (y _), + Module.Dual.IsFaithfulPosMap.inner_coord', smul_eq_mul, mul_comm, starRingEnd_apply, + conjTranspose_replicateCol, Matrix.mul_apply, Fin.sum_univ_one, replicateCol_apply, + replicateRow_apply, Pi.star_apply, reshape_apply, Matrix.mul_apply] + +theorem Pi.IsFaithfulPosMap.ToMatrix.rankOne_apply [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + (x y : PiMat ℂ k s) : + withPiInner[ψ] + pi.IsFaithfulPosMap.toMatrix hψ (rankOne ℂ x y).toLinearMap = + fun i j : Σ i, s i × s i => + (replicateCol (Fin 1) (reshape (x i.fst * (hψ i.1).matrixIsPosDef.rpow (1 / 2 : ℝ))) * + (replicateCol (Fin 1) + (reshape (y j.fst * (hψ j.1).matrixIsPosDef.rpow (1 / 2 : ℝ))))ᴴ) + i.2 j.2 := +Module.Dual.pi.IsFaithfulPosMap.toMatrixLinEquiv_rankOne_apply _ _ + +omit [DecidableEq k] in +theorem Module.Dual.pi.IsFaithfulPosMap.basis_repr_apply_apply + [hψ : ∀ i, (ψ i).IsFaithfulPosMap] (a : PiMat ℂ k s) (x : Σ i, s i × s i) : + (Module.Dual.pi.IsFaithfulPosMap.basis hψ).repr a x = + ((hψ x.1).basis.repr (a x.fst)) x.snd := + rfl + +omit [DecidableEq k₂] in +theorem Module.Dual.pi.IsFaithfulPosMap.psiToFun'_apply [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + [hψ₂ : ∀ i, (ψ₂ i).IsFaithfulPosMap] + (t r : ℝ) (b : PiMat ℂ k s) (a : PiMat ℂ k₂ s₂) : + withPiInner[ψ] (withPiInner[ψ₂] + Module.Dual.pi.IsFaithfulPosMap.psiToFun' hψ hψ₂ t r (rankOne ℂ a b).toLinearMap = + Module.Dual.pi.IsFaithfulPosMap.sig hψ₂ t a ⊗ₜ[ℂ] + ((op ℂ).toLinearMap : PiMat ℂ k s →ₗ[ℂ] (PiMat ℂ k s)ᵐᵒᵖ) + (star (Module.Dual.pi.IsFaithfulPosMap.sig hψ r b))) := + by + letI : ∀ i, StarModule ℂ (Matrix ((fun i : k => s i) i) ((fun i : k => s i) i) ℂ) := + by + intro i + infer_instance + simp_rw [Module.Dual.pi.IsFaithfulPosMap.psiToFun', LinearMap.coe_mk, + AddHom.coe_mk, + Module.Dual.pi.IsFaithfulPosMap.toMatrixLinEquiv_rankOne_apply, conjTranspose_replicateCol, + Matrix.mul_apply, Fin.sum_univ_one, replicateCol_apply, replicateRow_apply, + ← TensorProduct.smul_tmul_smul, ← _root_.map_smul, Pi.star_apply, ← + star_smul, ← _root_.map_smul, ← TensorProduct.tmul_sum, ← TensorProduct.sum_tmul, ← + map_sum, reshape_apply, ← star_sum, ← map_sum, + ← Module.Dual.IsFaithfulPosMap.inner_coord', ← + IsFaithfulPosMap.basis_repr_apply, + -- ← Module.Dual.pi.IsFaithfulPosMap.basis_repr_apply_apply, + Basis.sum_repr] + +-- @[instance] +-- private def pi_matrix_tensor_is_semiring : +-- Semiring (∀ i : k × k, Matrix (s i.1) (s i.1) ℂ ⊗[ℂ] Matrix (s i.2) (s i.2) ℂ) := +-- by +-- apply @Pi.semiring _ _ _ +-- intro i +-- infer_instance + +-- @[instance] +-- private def pi_matrix_tensor_is_algebra : +-- Algebra ℂ (∀ i : k × k, Matrix (s i.1) (s i.1) ℂ ⊗[ℂ] Matrix (s i.2) (s i.2) ℂ) := +-- by +-- apply @Pi.algebra _ _ _ _ _ _ +-- intro i +-- infer_instance + +/-- Transpose each matrix block of a product as an algebra equivalence to the opposite algebra. -/ +@[simps] +def Pi.transposeAlgEquiv (p : Type _) (n : p → Type _) + [∀ i, Fintype (n i)] [∀ i, DecidableEq (n i)] : + (PiMat ℂ p n) ≃ₐ[ℂ] (PiMat ℂ p n)ᵐᵒᵖ + where + toFun A := MulOpposite.op fun i => (A i)ᵀ + invFun A i := (MulOpposite.unop A i)ᵀ + left_inv A := by simp only [MulOpposite.unop_op, transpose_transpose] + right_inv A := by simp only [MulOpposite.op_unop, transpose_transpose] + map_add' A B := by + simp only [Pi.add_apply, transpose_add] + rfl + map_mul' A B := + by + simp only [Pi.mul_apply, transpose_mul, ← MulOpposite.op_mul] + rfl + commutes' c := + by + simp only [Algebra.algebraMap_eq_smul_one, Pi.smul_apply, Pi.one_apply, transpose_smul, + transpose_one] + rfl + +omit [Fintype k] [DecidableEq k] in +theorem Pi.transposeAlgEquiv_symm_op_apply (A : PiMat ℂ k s) : + (Pi.transposeAlgEquiv k s).symm (MulOpposite.op A) = fun i => (A i)ᵀ := + rfl + +private noncomputable def f₂_equiv : + (PiMat ℂ k s) ⊗[ℂ] (PiMat ℂ k s) ≃ₐ[ℂ] (Π i : k × k, + Matrix (s i.1) (s i.1) ℂ ⊗[ℂ] Matrix (s i.2) (s i.2) ℂ) := + by + let this := + @directSumTensorAlgEquiv ℂ _ _ _ _ _ _ _ (fun i => Matrix (s i) (s i) ℂ) + (fun i => Matrix (s i) (s i) ℂ) (fun i => Matrix.instRing) (fun i => Matrix.instRing) + (fun i => Matrix.instAlgebra) fun i => Matrix.instAlgebra + exact this + +private noncomputable def f₃_equiv : + (Π i : k × k, Matrix (s i.1) (s i.1) ℂ ⊗[ℂ] Matrix (s i.2) (s i.2) ℂ) ≃ₐ[ℂ] + (Π i : k × k, Matrix (s i.1 × s i.2) (s i.1 × s i.2) ℂ) := + by + apply AlgEquiv.piCongrRight + intro i + exact kroneckerToTensor.symm + +private def f₄_equiv : + (Π i : k × k, Matrix (s i.1 × s i.2) (s i.1 × s i.2) ℂ) ≃ₐ[ℂ] + { x : Matrix (Σ i : k × k, s i.1 × s i.2) (Σ i : k × k, s i.1 × s i.2) ℂ // + x.IsBlockDiagonal } := + isBlockDiagonalPiAlgEquiv.symm + +/-- The tensor-product equivalence used to pass from block products to block-diagonal matrices. -/ +noncomputable def tensorProductMulOpEquiv : + ((PiMat ℂ k s) ⊗[ℂ] (PiMat ℂ k s)ᵐᵒᵖ) ≃ₐ[ℂ] (Π i : k × k, + Matrix (s i.1 × s i.2) (s i.1 × s i.2) ℂ) := + (AlgEquiv.TensorProduct.map (1 : PiMat ℂ k s ≃ₐ[ℂ] PiMat ℂ k s) + (Pi.transposeAlgEquiv k s : PiMat ℂ k s ≃ₐ[ℂ] (PiMat ℂ k s)ᵐᵒᵖ).symm).trans + (f₂_equiv.trans f₃_equiv) + +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (a b) -/ +/-- Inverse map underlying `psi` for faithful positive functionals on matrix-block products. -/ +noncomputable def Module.Dual.pi.IsFaithfulPosMap.psiInvFun' + (hψ : ∀ i, (ψ i).IsFaithfulPosMap) (hψ₂ : ∀ i, (ψ₂ i).IsFaithfulPosMap) + (t r : ℝ) : PiMat ℂ k s ⊗[ℂ] (PiMat ℂ k₂ s₂)ᵐᵒᵖ →ₗ[ℂ] (PiMat ℂ k₂ s₂ →ₗ[ℂ] PiMat ℂ k s) + where + toFun x := + withPiInner[ψ] (withPiInner[ψ₂] + ∑ a : Σ i, s i × s i, ∑ b : Σ i, s₂ i × s₂ i, + (Basis.tensorProduct (pi.IsFaithfulPosMap.basis hψ) + (pi.IsFaithfulPosMap.basis hψ₂).mulOpposite).repr + x (a, b) • + (↑|Module.Dual.pi.IsFaithfulPosMap.sig hψ (-t) + (pi.IsFaithfulPosMap.basis hψ + a)⟩⟨Module.Dual.pi.IsFaithfulPosMap.sig hψ₂ (-r) + (star (pi.IsFaithfulPosMap.basis hψ₂ b))|)) + map_add' x y := by + simp_rw [LinearEquiv.map_add, Finsupp.add_apply, add_smul, Finset.sum_add_distrib] + map_smul' r x := by + simp_rw [LinearEquiv.map_smul, Finsupp.smul_apply, smul_eq_mul, ← smul_smul, ← Finset.smul_sum, + RingHom.id_apply] + +omit [DecidableEq k] [DecidableEq k₂] in +theorem Module.Dual.pi.IsFaithfulPosMap.psiInvFun'_apply [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + [hψ₂ : ∀ i, (ψ₂ i).IsFaithfulPosMap] + (t r : ℝ) (x : PiMat ℂ k s) (y : (PiMat ℂ k₂ s₂)ᵐᵒᵖ) : + withPiInner[ψ] (withPiInner[ψ₂] + Module.Dual.pi.IsFaithfulPosMap.psiInvFun' hψ hψ₂ t r (x ⊗ₜ[ℂ] y) = + |Module.Dual.pi.IsFaithfulPosMap.sig hψ (-t) + x⟩⟨Module.Dual.pi.IsFaithfulPosMap.sig hψ₂ (-r) (star (MulOpposite.unop y))|) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : _root_.NormedAddCommGroup (PiMat ℂ k₂ s₂) := Module.Dual.PiNormedAddCommGroup (φ := ψ₂) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k₂ s₂) := Module.Dual.pi.InnerProductSpace (φ := ψ₂) + -- letI : ∀ i, StarModule ℂ (Matrix ((fun i : k => s i) i) ((fun i : k => s i) i) ℂ) := + -- by + -- intro i + -- infer_instance + simp_rw [Module.Dual.pi.IsFaithfulPosMap.psiInvFun', LinearMap.coe_mk, + AddHom.coe_mk, + Basis.tensorProduct_repr_tmul_apply, smul_eq_mul, mul_comm, ← rankOne_lm_smul_smul, + ← rankOne_lm_sum_sum, ← + _root_.map_smul, ← star_smul, Basis.mulOpposite_repr_apply, ← map_sum, ← star_sum, + Basis.sum_repr] + +omit [DecidableEq k] in +theorem Module.Dual.pi.IsFaithfulPosMap.Psi_left_inv [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + [hψ₂ : ∀ i, (ψ₂ i).IsFaithfulPosMap] + (t r : ℝ) (x : PiMat ℂ k s) (y : PiMat ℂ k₂ s₂) : + withPiInner[ψ] (withPiInner[ψ₂] + Module.Dual.pi.IsFaithfulPosMap.psiInvFun' hψ hψ₂ t r + (Module.Dual.pi.IsFaithfulPosMap.psiToFun' hψ₂ hψ t r |x⟩⟨y|) = + |x⟩⟨y|) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : _root_.NormedAddCommGroup (PiMat ℂ k₂ s₂) := Module.Dual.PiNormedAddCommGroup (φ := ψ₂) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k₂ s₂) := Module.Dual.pi.InnerProductSpace (φ := ψ₂) + rw [Module.Dual.pi.IsFaithfulPosMap.psiToFun'_apply, + Module.Dual.pi.IsFaithfulPosMap.psiInvFun'_apply] + simp_rw [LinearEquiv.coe_coe, op_apply, MulOpposite.unop_op, star_star, + Module.Dual.pi.IsFaithfulPosMap.sig_apply_sig, neg_add_self, + Module.Dual.pi.IsFaithfulPosMap.sig_zero] + +omit [DecidableEq k] in +theorem Module.Dual.pi.IsFaithfulPosMap.Psi_right_inv [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + [hψ₂ : ∀ i, (ψ₂ i).IsFaithfulPosMap] + (t r : ℝ) (x : PiMat ℂ k s) (y : (PiMat ℂ k₂ s₂)ᵐᵒᵖ) : + withPiInner[ψ] (withPiInner[ψ₂] + Module.Dual.pi.IsFaithfulPosMap.psiToFun' hψ₂ hψ t r + (Module.Dual.pi.IsFaithfulPosMap.psiInvFun' hψ hψ₂ t r (x ⊗ₜ[ℂ] y)) = + x ⊗ₜ[ℂ] y) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : _root_.NormedAddCommGroup (PiMat ℂ k₂ s₂) := Module.Dual.PiNormedAddCommGroup (φ := ψ₂) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k₂ s₂) := Module.Dual.pi.InnerProductSpace (φ := ψ₂) + rw [Module.Dual.pi.IsFaithfulPosMap.psiInvFun'_apply, + Module.Dual.pi.IsFaithfulPosMap.psiToFun'_apply] + simp_rw [LinearEquiv.coe_coe, Module.Dual.pi.IsFaithfulPosMap.sig_apply_sig, add_neg_self, + Module.Dual.pi.IsFaithfulPosMap.sig_zero, star_star, op_apply, MulOpposite.op_unop] + +/-- Linear equivalence between linear maps and tensor products for faithful positive block + functionals. -/ +@[simps] +noncomputable def Module.Dual.pi.IsFaithfulPosMap.psi (hψ : ∀ i, (ψ i).IsFaithfulPosMap) + (hψ₂ : ∀ i, (ψ₂ i).IsFaithfulPosMap) + (t r : ℝ) : (PiMat ℂ k s →ₗ[ℂ] PiMat ℂ k₂ s₂) ≃ₗ[ℂ] ((PiMat ℂ k₂ s₂) ⊗[ℂ] (PiMat ℂ k s)ᵐᵒᵖ) := + letI := hψ + { toFun := fun x => Module.Dual.pi.IsFaithfulPosMap.psiToFun' hψ hψ₂ t r x + invFun := fun x => Module.Dual.pi.IsFaithfulPosMap.psiInvFun' hψ₂ hψ t r x + left_inv := fun x => by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : _root_.NormedAddCommGroup (PiMat ℂ k₂ s₂) := Module.Dual.PiNormedAddCommGroup (φ := ψ₂) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k₂ s₂) := Module.Dual.pi.InnerProductSpace (φ := + ψ₂) + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne x + simp only [map_sum, Module.Dual.pi.IsFaithfulPosMap.Psi_left_inv] + right_inv := fun x => by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : _root_.NormedAddCommGroup (PiMat ℂ k₂ s₂) := Module.Dual.PiNormedAddCommGroup (φ := ψ₂) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k₂ s₂) := Module.Dual.pi.InnerProductSpace (φ := + ψ₂) + obtain ⟨α, β, rfl⟩ := x.eq_span + simp only [Module.Dual.pi.IsFaithfulPosMap.Psi_right_inv, map_sum] + map_add' := fun x y => by simp_rw [map_add] + map_smul' := fun r x => by + simp_rw [_root_.map_smul] + rfl } + +omit [DecidableEq k] in +theorem Pi.inner_symm [hψ : ∀ i, (ψ i).IsFaithfulPosMap] (x y : PiMat ℂ k s) : + withPiInner[ψ] + (⟪x, y⟫_ℂ = ⟪Module.Dual.pi.IsFaithfulPosMap.sig hψ (-1) (star y), star x⟫_ℂ) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + simp_rw [Module.Dual.pi.IsFaithfulPosMap.inner_eq', ← Module.Dual.IsFaithfulPosMap.inner_eq', + Nontracial.inner_symm (x _)] + rfl + +omit [DecidableEq k] in +theorem Module.Dual.pi.IsFaithfulPosMap.sig_adjoint [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + {t : ℝ} : + withPiInner[ψ] + LinearMap.adjoint (Module.Dual.pi.IsFaithfulPosMap.sig hψ t : + PiMat ℂ k s ≃ₐ[ℂ] PiMat ℂ k s).toLinearMap = + (Module.Dual.pi.IsFaithfulPosMap.sig hψ t).toLinearMap := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + rw [LinearMap.ext_iff_inner_map] + intro x + simp_rw [LinearMap.adjoint_inner_left, AlgEquiv.toLinearMap_apply, + Module.Dual.pi.IsFaithfulPosMap.inner_eq', ← Module.Dual.IsFaithfulPosMap.inner_eq', + Module.Dual.pi.IsFaithfulPosMap.sig_eq_pi_blocks, ← AlgEquiv.toLinearMap_apply, ← + LinearMap.adjoint_inner_left, Module.Dual.IsFaithfulPosMap.sig_adjoint] + +open scoped Classical in +omit [DecidableEq n] in +theorem Module.Dual.IsFaithfulPosMap.norm_eq {ψ : Module.Dual ℂ (Matrix n n ℂ)} + [hψ : ψ.IsFaithfulPosMap] (x : Matrix n n ℂ) : + withMatrixInner[ψ] (‖x‖ = Real.sqrt (RCLike.re (ψ (xᴴ * x)))) := + by + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup ψ + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := Module.Dual.InnerProductSpace (φ := ψ) + simp_rw [norm_eq_sqrt_re_inner (𝕜 := ℂ), ← Module.Dual.IsFaithfulPosMap.inner_eq] + +open scoped Classical in +omit [DecidableEq k] [(i : k) → DecidableEq (s i)] in +theorem Module.Dual.pi.IsFaithfulPosMap.norm_eq {ψ : ∀ i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} + [hψ : Π i, (ψ i).IsFaithfulPosMap] (x : Π i, Matrix (s i) (s i) ℂ) : + withPiInner[ψ] (‖x‖ = Real.sqrt (RCLike.re (pi ψ (star x * x)))) := by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.TopologicalSpace (PiMat ℂ k s) := + (Module.Dual.PiNormedAddCommGroup (φ := + ψ)).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI : _root_.SeminormedAddCommGroup (PiMat ℂ k s) := + (Module.Dual.PiNormedAddCommGroup (φ := ψ)).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + simp_rw [← Module.Dual.pi.IsFaithfulPosMap.inner_eq] + exact norm_eq_sqrt_re_inner (𝕜 := ℂ) x + +-- instance Matrix.is_fd : FiniteDimensional ℂ (Matrix n n ℂ) := by infer_instance + +-- instance Matrix.is_starModule {n : Type _} [Fintype n] [DecidableEq n] : + -- StarModule ℂ (Matrix n n ℂ) := by infer_instance + +-- instance Pi.matrix.is_fd : FiniteDimensional ℂ PiMat ℂ k s := by infer_instance + +-- instance Pi.matrix.is_starModule : StarModule ℂ PiMat ℂ k s := by infer_instance + +-- instance Pi.matrix.is_topologicalAddGroup : TopologicalAddGroup (∀ i : k, Matrix (s i) (s i) ℂ) +-- := +-- by +-- apply @Pi.topologicalAddGroup _ _ _ _ _ + -- intro b + -- infer_instance + +-- instance Pi.matrix.continuousSMul : ContinuousSMul ℂ PiMat ℂ k s := by infer_instance + +open scoped Classical in +omit [DecidableEq k] [(i : k) → DecidableEq (s i)] in +theorem Pi.rankOneLm_real_apply {k₂ : Type*} [Fintype k₂] + {s₂ : k₂ → Type*} [Π i, Fintype (s₂ i)] [Π i, DecidableEq (s₂ i)] + {φ : Π i, Module.Dual ℂ (Matrix (s₂ i) (s₂ i) ℂ)} + [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + [hφ : ∀ i, (φ i).IsFaithfulPosMap] + (x : PiMat ℂ k s) (y : PiMat ℂ k₂ s₂) : + withPiInner[ψ] (withPiInner[φ] + LinearMap.real (rankOne ℂ x y : (PiMat ℂ k₂ s₂) →ₗ[ℂ] (PiMat ℂ k s)) = + rankOne ℂ (star x) (Module.Dual.pi.IsFaithfulPosMap.sig hφ (-1) (star y))) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.TopologicalSpace (PiMat ℂ k s) := + (Module.Dual.PiNormedAddCommGroup (φ := + ψ)).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI : _root_.SeminormedAddCommGroup (PiMat ℂ k s) := + (Module.Dual.PiNormedAddCommGroup (φ := ψ)).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : _root_.NormedAddCommGroup (PiMat ℂ k₂ s₂) := Module.Dual.PiNormedAddCommGroup (φ := φ) + letI : _root_.TopologicalSpace (PiMat ℂ k₂ s₂) := + (Module.Dual.PiNormedAddCommGroup (φ := + φ)).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI : _root_.SeminormedAddCommGroup (PiMat ℂ k₂ s₂) := + (Module.Dual.PiNormedAddCommGroup (φ := φ)).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k₂ s₂) := Module.Dual.pi.InnerProductSpace (φ := φ) + rw [LinearMap.ext_iff] + intro x_1 + simp only [LinearMap.real_apply, ContinuousLinearMap.coe_coe, rankOne_apply, + star_smul, ← starRingEnd_apply] + have := Pi.inner_symm (ψ := φ) (x := star x_1) (y := y) + rw [star_star] at this + rw [← this, inner_conj_symm] + +omit [Fintype k] [DecidableEq k] in +theorem Pi.PosDef.rpow_one_eq_self {Q : PiMat ℂ k s} (hQ : ∀ i, + (Q i).PosDef) : Pi.PosDef.rpow hQ 1 = Q := + by + ext i + simp only [Pi.PosDef.rpow, Matrix.PosDef.rpow_one_eq_self] + +omit [Fintype k] [DecidableEq k] in +theorem Pi.PosDef.rpow_neg_one_eq_inv_self {Q : PiMat ℂ k s} (hQ : ∀ i, (Q i).PosDef) : + Pi.PosDef.rpow hQ (-1) = Q⁻¹ := by + ext i + simp_rw [Pi.PosDef.rpow, Matrix.PosDef.rpow_neg_one_eq_inv_self (hQ _), Pi.inv_apply] + +open scoped Classical in +omit [DecidableEq k] in +theorem Module.Dual.pi.IsFaithfulPosMap.inner_left_conj' + {ψ : ∀ i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + (a b c : PiMat ℂ k s) : + withPiInner[ψ] + (⟪a, b * c⟫_ℂ = + ⟪a * Module.Dual.pi.IsFaithfulPosMap.sig hψ (-1) (star c), b⟫_ℂ) := by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.TopologicalSpace (PiMat ℂ k s) := + (Module.Dual.PiNormedAddCommGroup (φ := + ψ)).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI : _root_.SeminormedAddCommGroup (PiMat ℂ k s) := + (Module.Dual.PiNormedAddCommGroup (φ := ψ)).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + simp_rw [Module.Dual.pi.IsFaithfulPosMap.sig_apply, neg_neg, Pi.PosDef.rpow_one_eq_self, + Pi.PosDef.rpow_neg_one_eq_inv_self, ← Module.Dual.pi.matrixBlock_apply, ← + Module.Dual.pi.IsFaithfulPosMap.inner_left_conj] + +open scoped Classical in +omit [DecidableEq k] in +theorem Module.Dual.pi.IsFaithfulPosMap.inner_right_conj' + {ψ : ∀ i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + (a b c : PiMat ℂ k s) : + withPiInner[ψ] + (⟪a * c, b⟫_ℂ = + ⟪a, b * Module.Dual.pi.IsFaithfulPosMap.sig hψ (-1) (star c)⟫_ℂ) := by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.TopologicalSpace (PiMat ℂ k s) := + (Module.Dual.PiNormedAddCommGroup (φ := + ψ)).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI : _root_.SeminormedAddCommGroup (PiMat ℂ k s) := + (Module.Dual.PiNormedAddCommGroup (φ := ψ)).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + rw [← inner_conj_symm, Module.Dual.pi.IsFaithfulPosMap.inner_left_conj', inner_conj_symm] + +omit [Fintype k] [DecidableEq k] in +theorem Moudle.Dual.Pi.IsFaithfulPosMap.sig_trans_sig [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + (x y : ℝ) : + (Module.Dual.pi.IsFaithfulPosMap.sig hψ y).trans (Module.Dual.pi.IsFaithfulPosMap.sig hψ x) = + Module.Dual.pi.IsFaithfulPosMap.sig hψ (x + y) := + by + ext1 + simp_rw [AlgEquiv.trans_apply, Module.Dual.pi.IsFaithfulPosMap.sig_apply_sig] + +omit [Fintype k] [DecidableEq k] in +theorem Module.Dual.pi.IsFaithfulPosMap.sig_comp_sig [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + (x y : ℝ) : + (Module.Dual.pi.IsFaithfulPosMap.sig hψ x).toLinearMap.comp + (Module.Dual.pi.IsFaithfulPosMap.sig hψ y).toLinearMap = + (Module.Dual.pi.IsFaithfulPosMap.sig hψ (x + y)).toLinearMap := + by + rw [LinearMap.ext_iff] + intro x_1 + simp_rw [LinearMap.comp_apply, AlgEquiv.toLinearMap_apply, + Module.Dual.pi.IsFaithfulPosMap.sig_apply_sig] + +omit [Fintype k] [DecidableEq k] in +theorem Module.Dual.pi.IsFaithfulPosMap.sig_zero' [hψ : ∀ i, (ψ i).IsFaithfulPosMap] : + Module.Dual.pi.IsFaithfulPosMap.sig hψ 0 = 1 := + by + rw [AlgEquiv.ext_iff] + intros + rw [Module.Dual.pi.IsFaithfulPosMap.sig_zero] + rfl + +omit [Fintype k] [DecidableEq k] in +theorem Pi.comp_sig_eq_iff + {A : Type*} [AddCommMonoid A] [Module ℂ A] + [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + (t : ℝ) (f g : PiMat ℂ k s →ₗ[ℂ] A) : + f ∘ₗ (Module.Dual.pi.IsFaithfulPosMap.sig hψ t).toLinearMap = g ↔ + f = g ∘ₗ (Module.Dual.pi.IsFaithfulPosMap.sig hψ (-t)).toLinearMap := + by + constructor <;> rintro rfl + all_goals rw [LinearMap.comp_assoc, Module.Dual.pi.IsFaithfulPosMap.sig_comp_sig] + on_goal 1 => rw [add_neg_self] + on_goal 2 => rw [neg_add_self] + all_goals + rw [Module.Dual.pi.IsFaithfulPosMap.sig_zero', AlgEquiv.one_toLinearMap, LinearMap.comp_one] + +omit [Fintype k] [DecidableEq k] in +theorem Pi.sig_comp_eq_iff {A : Type*} [AddCommMonoid A] [Module ℂ A] + [hψ : ∀ i, (ψ i).IsFaithfulPosMap] (t : ℝ) (f g : A →ₗ[ℂ] PiMat ℂ k s) : + (Module.Dual.pi.IsFaithfulPosMap.sig hψ t).toLinearMap ∘ₗ f = g ↔ + f = (Module.Dual.pi.IsFaithfulPosMap.sig hψ (-t)).toLinearMap ∘ₗ g := + by + constructor <;> rintro rfl + all_goals rw [← LinearMap.comp_assoc, Module.Dual.pi.IsFaithfulPosMap.sig_comp_sig] + on_goal 1 => rw [neg_add_self] + on_goal 2 => rw [add_neg_self] + all_goals + rw [Module.Dual.pi.IsFaithfulPosMap.sig_zero', AlgEquiv.one_toLinearMap, LinearMap.one_comp] + +open scoped Classical in +omit [DecidableEq k] in +theorem LinearMap.pi.adjoint_real_eq {k₂ : Type*} [Fintype k₂] + {s₂ : k₂ → Type*} [Π i, Fintype (s₂ i)] [Π i, DecidableEq (s₂ i)] + {φ : Π i, Module.Dual ℂ (Matrix (s₂ i) (s₂ i) ℂ)} + {ψ : ∀ i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} + [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + [hφ : ∀ i, (φ i).IsFaithfulPosMap] (f : PiMat ℂ k s →ₗ[ℂ] PiMat ℂ k₂ s₂) : + withPiInner[ψ] (withPiInner[φ] + (LinearMap.adjoint f).real = + (Module.Dual.pi.IsFaithfulPosMap.sig hψ 1).toLinearMap ∘ₗ + (LinearMap.adjoint f.real) ∘ₗ (Module.Dual.pi.IsFaithfulPosMap.sig hφ (-1)).toLinearMap) := + by + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : _root_.NormedAddCommGroup (PiMat ℂ k₂ s₂) := Module.Dual.PiNormedAddCommGroup (φ := φ) + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k₂ s₂) := Module.Dual.pi.InnerProductSpace (φ := φ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s₂ i) (s₂ i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (φ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s₂ i) (s₂ i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := φ i) + rw [LinearMap.ext_iff] + intro x + apply ext_inner_right ℂ + intro u + nth_rw 1 [Pi.inner_symm] + simp_rw [LinearMap.real_apply, star_star, LinearMap.adjoint_inner_right] + nth_rw 1 [Pi.inner_symm] + simp_rw [star_star, ← Module.Dual.pi.IsFaithfulPosMap.sig_star, ← LinearMap.real_apply f, + LinearMap.comp_apply, ← LinearMap.adjoint_inner_left f.real, ← AlgEquiv.toLinearMap_apply, ← + LinearMap.adjoint_inner_left (Module.Dual.pi.IsFaithfulPosMap.sig hψ 1).toLinearMap, + Module.Dual.pi.IsFaithfulPosMap.sig_adjoint] + +omit [Fintype k] [DecidableEq k] in +theorem Module.Dual.pi.IsFaithfulPosMap.basis.apply_cast_eq_mp + [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + {i j : k} (h : i = j) (p : s i × s i) : + (by rw [h] : Matrix (s i) (s i) ℂ = Matrix (s j) (s j) ℂ).mp ((hψ i).basis p) = + (hψ j).basis (by rw [← h]; exact p) := + by aesop + +omit [Fintype k] [(i : k) → Fintype (s i)] [(i : k) → DecidableEq (s i)] in +lemma Matrix.includeBlock_apply' (x : PiMat ℂ k s) (i j : k) : + (includeBlock (x i)) j = ite (i = j) (x j) 0 := +by simp [includeBlock_apply]; aesop + +theorem pi_lmul_toMatrix [hψ : ∀ i, (ψ i).IsFaithfulPosMap] (x : PiMat ℂ k s) : + (Module.Dual.pi.IsFaithfulPosMap.toMatrix hψ (lmul x) : + Matrix (Σ i, s i × s i) (Σ i, s i × s i) ℂ) = + blockDiagonal' fun i => (x i ⊗ₖ 1) := + by + ext r l + simp_rw [Module.Dual.pi.IsFaithfulPosMap.toMatrix_apply', lmul_apply, hMul_includeBlock] + rw [blockDiagonal'_apply] + let x' : PiMat ℂ k s := fun a => + if h : a = l.fst then (x a * ((hψ a).basis) (by rw [h]; exact l.snd)) else 0 + have hx' : x' l.fst = x l.fst * (hψ l.fst).basis l.snd := by aesop + rw [← hx', includeBlock_apply', ite_mul, zero_mul] + simp_rw [kroneckerMap_apply, one_apply, mul_boole, @eq_comm _ r.fst] + simp_rw [x', Module.Dual.IsFaithfulPosMap.basis_apply, dite_hMul, + zero_mul, Matrix.mul_assoc, PosDef.rpow_mul_rpow, neg_add_self, + PosDef.rpow_zero, Matrix.mul_one, Matrix.single_eq] + split_ifs with h hh hhh + · simp only [mul_apply, mul_ite, mul_zero, + Finset.sum_ite_eq, Finset.mem_univ, if_true, mul_one, ite_and] + split_ifs with hhhh + · rfl + · rw [eq_comm] at hhh + contradiction + · rw [eq_comm] at h + simp only [eq_mpr_eq_cast, mul_apply, mul_ite, mul_one, mul_zero, ite_and, + Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte, ite_eq_right_iff] + intro ha + rw [eq_comm] at ha + contradiction + · rw [eq_comm] at h; contradiction + · rfl + · rfl + +example [hψ : ∀ i, (ψ i).IsFaithfulPosMap] (x : PiMat ℂ k s) : + (Module.Dual.pi.IsFaithfulPosMap.toMatrix hψ (lmul x) : + Matrix (Σ i, s i × s i) (Σ i, s i × s i) ℂ) = + blockDiagonal' fun i => (hψ i).toMatrix (lmul (x i)) := + by simp_rw [pi_lmul_toMatrix, lmul_eq_mul, LinearMap.mulLeft_toMatrix] + +theorem pi_rmul_toMatrix [hψ : ∀ i, (ψ i).IsFaithfulPosMap] (x : PiMat ℂ k s) : + (Module.Dual.pi.IsFaithfulPosMap.toMatrix hψ (rmul x) : + Matrix (Σ i, s i × s i) (Σ i, s i × s i) ℂ) = + blockDiagonal' fun i => (1 ⊗ₖ ((hψ i).sig (1 / 2) (x i))ᵀ) := + by + ext r l + simp_rw [Module.Dual.pi.IsFaithfulPosMap.toMatrix_apply', rmul_apply, includeBlock_hMul] + rw [blockDiagonal'_apply] + let x' : PiMat ℂ k s := fun a => + if h : a = l.fst then (((hψ a).basis) (by rw [h]; exact l.snd) * x a) else 0 + have hx' : x' l.fst = (hψ l.fst).basis l.snd * x l.fst := by aesop + rw [← hx', includeBlock_apply', ite_mul, zero_mul] + simp_rw [kroneckerMap_apply, one_apply, boole_mul, @eq_comm _ r.fst] + simp_rw [x', Module.Dual.IsFaithfulPosMap.basis_apply, dite_hMul, + zero_mul, Matrix.mul_assoc, ← Matrix.mul_assoc (PosDef.rpow _ (- (1 / 2))), + ← Module.Dual.IsFaithfulPosMap.sig_apply, Matrix.single_eq, Matrix.transpose_apply] + split_ifs with h hh hhh + · simp only [mul_apply, ite_mul, zero_mul, + Finset.sum_ite_eq, Finset.mem_univ, if_true, ite_and, one_mul, + Finset.sum_ite_irrel, Finset.sum_const_zero] + split_ifs with hhhh + · rfl + · rw [eq_comm] at hhh + contradiction + · rw [eq_comm] at h + simp only [eq_mpr_eq_cast, one_div, sig_apply, mul_apply, ite_mul, one_mul, + zero_mul, ite_and, Finset.sum_ite_irrel, Finset.sum_ite_eq, Finset.mem_univ, + ↓reduceIte, Finset.sum_const_zero, ite_eq_right_iff] + intro ha + rw [eq_comm] at ha + contradiction + · rw [eq_comm] at h; contradiction + · rfl + · rfl + +omit [Fintype k] [DecidableEq k] in +theorem unitary.coe_pi (U : ∀ i, unitaryGroup (s i) ℂ) : + (unitary.pi U : PiMat ℂ k s) = fun i => (U i : Matrix (s i) (s i) ℂ) := + rfl + +omit [Fintype k] [DecidableEq k] in +theorem unitary.coe_pi_apply (U : ∀ i, unitaryGroup (s i) ℂ) (i : k) : + ((fun i => (U i : Matrix (s i) (s i) ℂ)) : PiMat ℂ k s) i = U i := + rfl + +theorem pi_inner_aut_toMatrix + [hψ : ∀ i, (ψ i).IsFaithfulPosMap] (U : ∀ i, unitaryGroup (s i) ℂ) : + (Module.Dual.pi.IsFaithfulPosMap.toMatrix hψ + ((unitary.innerAutStarAlg ℂ (unitary.pi U)).toLinearMap) : + Matrix (Σ i, s i × s i) (Σ i, s i × s i) ℂ) = + blockDiagonal' fun i => + U i ⊗ₖ ((hψ i).sig (-(1 / 2 : ℝ)) (U i : Matrix (s i) (s i) ℂ))ᴴᵀ := + by + have : + ((unitary.innerAutStarAlg ℂ (unitary.pi U)).toLinearMap) = + (lmul (fun i => (U i : Matrix (s i) (s i) ℂ) : PiMat ℂ k s)) * + (rmul (star (fun i => (U i : Matrix (s i) (s i) ℂ) : PiMat ℂ k s))) := + by + ext x i + simp [Module.End.mul_apply, lmul_apply, rmul_apply, mul_assoc] + rw [this, _root_.map_mul, pi_lmul_toMatrix, pi_rmul_toMatrix, ← blockDiagonal'_mul] + simp_rw [← mul_kronecker_mul, Matrix.mul_one, Matrix.one_mul, Pi.star_apply, + star_eq_conjTranspose, blockDiagonal'_inj] + nth_rw 1 [← neg_neg (1 / 2 : ℝ)] + simp_rw [← Module.Dual.IsFaithfulPosMap.sig_conjTranspose] + rfl + + +end DirectSum diff --git a/LeanPool/Monlib4/LinearAlgebra/Ips/OpUnop.lean b/LeanPool/Monlib4/LinearAlgebra/Ips/OpUnop.lean new file mode 100644 index 0000000000..d5dc3b107a --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Ips/OpUnop.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.LinearAlgebra.TensorProduct.Basic +import Mathlib.Algebra.Algebra.Basic +import Mathlib.Data.Opposite +import Mathlib.Algebra.Star.Basic +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.Lemmas + +/-! + +# The multiplicative opposite linear equivalence + +This file defines the multiplicative opposite linear equivalence as linear maps +`op` and `unop`. + +We also define `ten_swap`, the linear automorphism on `A ⊗[R] Aᵐᵒᵖ` that +swaps the tensor factors while keeping the `ᵒᵖ` in place. + +-/ + + +variable {R A : Type _} [CommSemiring R] [AddCommMonoid A] [Module R A] + +/-- The linear equivalence sending a vector to its multiplicative opposite. -/ +abbrev op (R : Type*) {A : Type _} [CommSemiring R] [AddCommMonoid A] [Module R A] := +(MulOpposite.opLinearEquiv R : A ≃ₗ[R] Aᵐᵒᵖ) + +@[simp] +theorem op_apply (x : A) : op R x = MulOpposite.op x := + rfl + +/-- The inverse linear equivalence from the multiplicative opposite. -/ +abbrev unop (R : Type*) {A : Type _} [CommSemiring R] [AddCommMonoid A] [Module R A] : + Aᵐᵒᵖ ≃ₗ[R] A := +(op R).symm + +@[simp] +theorem unop_apply (x : Aᵐᵒᵖ) : unop R x = MulOpposite.unop x := + rfl + +@[simp] +theorem unop_op (x : A) : unop R (op R x) = x := + rfl + +@[simp] +theorem op_unop (x : Aᵐᵒᵖ) : op R (unop R x) = x := + rfl + +theorem unop_comp_op : (unop R).toLinearMap ∘ₗ (op R).toLinearMap = (1 : A →ₗ[R] A) := + rfl + +theorem op_comp_unop : (op R).toLinearMap ∘ₗ (unop R).toLinearMap = (1 : Aᵐᵒᵖ →ₗ[R] Aᵐᵒᵖ) := + rfl + +theorem op_star_apply [Star A] (a : A) : + op R (star a) = star (op R a) := + rfl + +theorem unop_star_apply [Star A] (a : Aᵐᵒᵖ) : + unop R (star a) = star (unop R a) := + rfl + +open scoped TensorProduct + +variable {B : Type*} [AddCommMonoid B] [Module R B] +/-- Swap tensor factors while moving the multiplicative-opposite marker to the other factor. -/ +noncomputable abbrev tenSwap (R : Type*) + {A B : Type*} [AddCommMonoid A] [AddCommMonoid B] + [CommSemiring R] [Module R A] [Module R B] : + A ⊗[R] Bᵐᵒᵖ ≃ₗ[R] B ⊗[R] Aᵐᵒᵖ := +(TensorProduct.comm R A Bᵐᵒᵖ).trans + (LinearEquiv.TensorProduct.map (unop R) (op R)) + +@[simp] +theorem tenSwap_apply (x : A) (y : Bᵐᵒᵖ) : + tenSwap R (x ⊗ₜ[R] y) = MulOpposite.unop y ⊗ₜ[R] MulOpposite.op x := + rfl + +theorem tenSwap_apply' (x : A) (y : B) : + tenSwap R (x ⊗ₜ MulOpposite.op y) = y ⊗ₜ[R] MulOpposite.op x := + rfl + +theorem tenSwap_symm : + (tenSwap R).symm = (tenSwap R : B ⊗[R] Aᵐᵒᵖ ≃ₗ[R] A ⊗[R] Bᵐᵒᵖ) := +by + apply LinearEquiv.toLinearMap_injective + apply TensorProduct.ext' + intro _ _ + rfl + +theorem tenSwap_comp_tenSwap : + (tenSwap R).toLinearMap ∘ₗ (tenSwap R).toLinearMap = + (1 : A ⊗[R] Bᵐᵒᵖ →ₗ[R] A ⊗[R] Bᵐᵒᵖ) := + by + apply TensorProduct.ext' + intro _ _ + rfl + +theorem tenSwap_apply_tenSwap (x : A ⊗[R] Bᵐᵒᵖ) : + tenSwap R (tenSwap R x) = x := by + simp_rw [← LinearEquiv.coe_toLinearMap, ← LinearMap.comp_apply, + tenSwap_comp_tenSwap]; rfl diff --git a/LeanPool/Monlib4/LinearAlgebra/Ips/Pos.lean b/LeanPool/Monlib4/LinearAlgebra/Ips/Pos.lean new file mode 100644 index 0000000000..e008735bf3 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Ips/Pos.lean @@ -0,0 +1,582 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Analysis.InnerProductSpace.Adjoint +import Mathlib.Analysis.InnerProductSpace.Spectrum +import LeanPool.Monlib4.LinearAlgebra.InvariantSubmodule +import LeanPool.Monlib4.LinearAlgebra.Ips.RankOne +import LeanPool.Monlib4.LinearAlgebra.End +import Mathlib.Analysis.InnerProductSpace.Positive +import LeanPool.Monlib4.Preq.RCLikeLe + +/-! + +# Positive linear maps + +This file generalises the notion of positivity to linear maps. We follow the same definition as +`continuous_linear_map.IsPositive'` but change the `self-adjoinnt` property to `is_symmertric`. +A linear map is positive if it is symmetric and `∀ x, 0 ≤ re ⟪T x, x⟫`. + +## Main statements + +for linear maps: +* `linear_map.IsPositive'.conj_adjoint` : if `T : E →ₗ[𝕜] E` and `E` is a finite-dimensional space, + then for any `S : E →ₗ[𝕜] F`, we have `S.comp (T.comp S.adjoint)` is also positive. + +-/ + +open InnerProductSpace RCLike + +open scoped InnerProduct ComplexConjugate + +variable {𝕜 E F : Type _} [RCLike 𝕜] [NormedAddCommGroup E] [NormedAddCommGroup F] + [InnerProductSpace 𝕜 E] [InnerProductSpace 𝕜 F] + +local notation "⟪" x ", " y "⟫" => @inner 𝕜 _ _ x y + +namespace LinearMap + +open scoped ComplexOrder + +/-- `T` is (semi-definite) **positive** if `T` is symmetric +and `∀ x : V, 0 ≤ re ⟪x, T x⟫` -/ +def IsPositive' (T : E →ₗ[𝕜] E) : Prop := + T.IsSymmetric ∧ ∀ x : E, 0 ≤ ⟪x, T x⟫ + +theorem IsPositive'Zero : (0 : E →ₗ[𝕜] E).IsPositive' := + by + refine ⟨IsSymmetric.zero, fun x => ?_⟩ + simp_rw [zero_apply, inner_zero_right, le_rfl] + +theorem IsPositive'One : (1 : E →ₗ[𝕜] E).IsPositive' := + ⟨IsSymmetric.id, fun _ => inner_self_nonneg'⟩ + +theorem _root_.LinearMap.IsPositive'.add {S T : E →ₗ[𝕜] E} + (hS : S.IsPositive') (hT : T.IsPositive') : + (S + T).IsPositive' := + by + refine ⟨IsSymmetric.add hS.1 hT.1, fun x => ?_⟩ + rw [add_apply, inner_add_right] + exact add_nonneg (hS.2 _) (hT.2 _) + +theorem _root_.LinearMap.IsPositive'.inner_nonneg_left {T : E →ₗ[𝕜] E} + (hT : IsPositive' T) (x : E) : + 0 ≤ ⟪T x, x⟫ := by rw [hT.1]; exact hT.2 x + +theorem _root_.LinearMap.IsPositive'.inner_nonneg_right {T : E →ₗ[𝕜] E} + (hT : IsPositive' T) (x : E) : + 0 ≤ ⟪x, T x⟫ := + hT.2 x + +/-- a linear projection onto `U` along its complement `V` is positive if +and only if `U` and `V` are pairwise orthogonal -/ +theorem linear_proj_IsPositive'_iff {U V : Submodule 𝕜 E} (hUV : IsCompl U V) : + (U.subtype.comp (U.linearProjOfIsCompl V hUV)).IsPositive' ↔ U ⟂ V := + by + constructor + · intro h u hu v hv + rw [← Subtype.coe_mk u hu, ← Subtype.coe_mk v hv, ← + Submodule.linearProjOfIsCompl_apply_left hUV ⟨u, hu⟩, ← Submodule.subtype_apply (p := U), ← + comp_apply, ← h.1 _ _, comp_apply, Submodule.linearProjOfIsCompl_apply_right hUV ⟨v, hv⟩, + map_zero, inner_zero_left] + · intro h + have : (U.subtype.comp (U.linearProjOfIsCompl V hUV)).IsSymmetric := + by + intro x y + nth_rw 1 [← Submodule.linear_proj_add_linearProjOfIsCompl_eq_self hUV y] + nth_rw 2 [← Submodule.linear_proj_add_linearProjOfIsCompl_eq_self hUV x] + rw [Submodule.isOrtho_iff_inner_eq] at h + simp_rw [inner_add_right, inner_add_left, comp_apply, Submodule.subtype_apply _] + rw [@h _ (SetLike.coe_mem _) _ (SetLike.coe_mem _), + inner_eq_zero_symm.mp (h _ (SetLike.coe_mem _) _ (SetLike.coe_mem _))] + refine ⟨this, ?_⟩ + intro x + let p : E →ₗ[𝕜] E := U.subtype.comp (U.linearProjOfIsCompl V hUV) + change 0 ≤ ⟪x, p x⟫ + have hp : p (p x) = p x := by + change + ((U.subtype.comp (U.linearProjOfIsCompl V hUV)) * + (U.subtype.comp (U.linearProjOfIsCompl V hUV))) x = + (U.subtype.comp (U.linearProjOfIsCompl V hUV)) x + rw [Submodule.linearProjOfIsCompl_idempotent hUV] + rw [← hp, ← this x (p x)] + exact inner_self_nonneg' + +theorem _root_.ContinuousLinearMap.IsPositive.toLinearMap' [FiniteDimensional 𝕜 E] (T : E →L[𝕜] E) : + letI : CompleteSpace E := FiniteDimensional.complete 𝕜 E + T.IsPositive ↔ T.toLinearMap.IsPositive' := +by + letI : CompleteSpace E := FiniteDimensional.complete 𝕜 E + simp_rw [LinearMap.IsPositive', ContinuousLinearMap.coe_coe, ContinuousLinearMap.IsPositive, + ← ContinuousLinearMap.isSelfAdjoint_iff_isSymmetric, + ContinuousLinearMap.reApplyInnerSelf_apply T, and_congr_right_iff, ← @zero_le_real 𝕜] + intro h + simp_rw [IsSelfAdjoint.inner_re_eq h, ← ContinuousLinearMap.adjoint_inner_left, + ← ContinuousLinearMap.star_eq_adjoint] + rw [h] + +lemma isPositive'_iff_isPositive + [FiniteDimensional 𝕜 E] (T : E →ₗ[𝕜] E) : + T.IsPositive' ↔ T.IsPositive := +by + letI : CompleteSpace E := FiniteDimensional.complete 𝕜 E + calc T.IsPositive' + ↔ T.toContinuousLinearMap.IsPositive := by + rw [ContinuousLinearMap.IsPositive.toLinearMap']; rfl + _ ↔ T.IsPositive := T.isPositive_toContinuousLinearMap_iff + +lemma _root_.LinearMap.IsPositive.isPositive' [FiniteDimensional 𝕜 E] {T : E →ₗ[𝕜] E} + (hT : T.IsPositive) : T.IsPositive' := +(isPositive'_iff_isPositive T).mpr hT + +section FiniteDimensional + +local notation "e" => IsSymmetric.eigenvectorBasis + +local notation "α" => IsSymmetric.eigenvalues + +local notation "√" => Real.sqrt + +variable [FiniteDimensional 𝕜 E] (T : E →ₗ[𝕜] E) + +open scoped ComplexOrder + +omit [FiniteDimensional 𝕜 E] in +private theorem _root_.spec_subseteq_nonneg : + (spectrum 𝕜 T) ⊆ { x : 𝕜 | 0 ≤ x } ↔ ∀ x ∈ spectrum 𝕜 T, 0 ≤ x := +by + simp_rw [Set.subset_def, Set.mem_setOf_eq] + +/-- the spectrum of a positive linear map is non-negative -/ +theorem _root_.LinearMap.IsPositive'.nonneg_spectrum (h : T.IsPositive') : + (spectrum 𝕜 T) ⊆ { x : 𝕜 | 0 ≤ x } := + by + intro μ hμ + simp_rw [← Module.End.hasEigenvalue_iff_mem_spectrum] at hμ + simp only [Set.mem_setOf_eq, @RCLike.nonneg_def' 𝕜] + have : ↑(re μ) = μ := by + simp_rw [← conj_eq_iff_re] + exact IsSymmetric.conj_eigenvalue_eq_self h.1 hμ + rw [← this] at hμ + exact ⟨this, eigenvalue_nonneg_of_nonneg hμ (fun _ => ((@RCLike.nonneg_def 𝕜 _ _).mp (h.2 _)).1)⟩ + +open scoped BigOperators + +/-- given a symmetric linear map with a non-negative spectrum, +we can write `T x = ∑ i, √α i • √α i • ⟪e i, x⟫` for any `x ∈ E`, +where `α i` are the eigenvalues of `T` and `e i` are the respective eigenvectors +that form an eigenbasis (`isSymmetric.eigenvector_basis`) -/ +theorem sq_mul_sq_eq_self_of_isSymmetric_and_nonneg_spectrum + (hT : T.IsSymmetric) (hT1 : (spectrum 𝕜 T) ⊆ { x : 𝕜 | 0 ≤ x }) + (v : E) : T v = ∑ i, (√ (α hT rfl i) • √ (α hT rfl i) : 𝕜) • ⟪e hT rfl i, v⟫ • e hT rfl i := + by + have : ∀ i, 0 ≤ α hT rfl i := fun i => + by + rw [spec_subseteq_nonneg] at hT1 + specialize hT1 (hT.eigenvalues rfl i) + simp only [zero_le_real] at hT1 + apply + hT1 + (Module.End.hasEigenvalue_iff_mem_spectrum.mp (hT.hasEigenvalue_eigenvalues rfl i)) + calc + T v = ∑ i, ⟪e hT rfl i, v⟫ • T (e hT rfl i) := by + simp_rw [← OrthonormalBasis.repr_apply_apply, ← map_smul_of_tower, ← map_sum, + OrthonormalBasis.sum_repr (e hT rfl) v] + _ = ∑ i, (√ (α hT rfl i) • √ (α hT rfl i) : 𝕜) • ⟪e hT rfl i, v⟫ • e hT rfl i := by + simp_rw [IsSymmetric.apply_eigenvectorBasis, smul_smul, + real_smul_ofReal, ← ofReal_mul, ← Real.sqrt_mul (this _), Real.sqrt_mul_self (this _), + mul_comm] + +/-- given a symmetric linear map `T` and a real number `r`, +we can define a linear map `S` such that `S = T ^ r` -/ +noncomputable def rePow + (hT : T.IsSymmetric) (r : ℝ) : E →ₗ[𝕜] E + where + toFun v := ∑ i, (((α hT rfl i : ℝ) ^ r : ℝ) : 𝕜) • ⟪e hT rfl i, v⟫ • e hT rfl i + map_add' x y := by simp_rw [inner_add_right, add_smul, smul_add, Finset.sum_add_distrib] + map_smul' r x := by + simp_rw [inner_smul_right, ← smul_smul, Finset.smul_sum, RingHom.id_apply, smul_smul, ← + mul_assoc, mul_comm] + +section + +/-- Complex functional calculus power of a positive linear map. -/ +noncomputable def cpow [InnerProductSpace ℂ E] [FiniteDimensional ℂ E] + (T : E →ₗ[ℂ] E) (hT : T.IsPositive') (c : ℂ) : E →ₗ[ℂ] E + where + toFun v := ∑ i, (α hT.1 rfl i ^ c : ℂ) • ⟪e hT.1 rfl i, v⟫_ℂ • e hT.1 rfl i + map_add' x y := by simp_rw [inner_add_right, add_smul, smul_add, Finset.sum_add_distrib] + map_smul' r x := by + simp_rw [inner_smul_right, ← smul_smul, Finset.smul_sum, RingHom.id_apply, smul_smul, ← + mul_assoc, mul_comm] + +theorem cpow_apply [InnerProductSpace ℂ E] [FiniteDimensional ℂ E] + (T : E →ₗ[ℂ] E) (hT : T.IsPositive') (c : ℂ) (v : E) : + T.cpow hT c v = ∑ i, (α hT.1 rfl i ^ c : ℂ) • ⟪e hT.1 rfl i, v⟫_ℂ • e hT.1 rfl i := + rfl + +end + +theorem _root_.LinearMap.rePow_apply (hT : T.IsSymmetric) + (r : ℝ) (v : E) : + T.rePow hT r v = ∑ i, (((α hT rfl i : ℝ) ^ r : ℝ) : 𝕜) • ⟪e hT rfl i, v⟫ • e hT rfl i := + rfl + +/-- the square root of a symmetric linear map can then directly be defined with `re_pow` -/ +noncomputable def _root_.LinearMap.sqrt + (h : T.IsSymmetric) : E →ₗ[𝕜] E := + T.rePow h (1 / 2 : ℝ) + +/-- the square root of a symmetric linear map `T` +is written as `T x = ∑ i, √ (α i) • ⟪e i, x⟫ • e i` for any `x ∈ E`, +where `α i` are the eigenvalues of `T` and `e i` are the respective eigenvectors +that form an eigenbasis (`isSymmetric.eigenvector_basis`) -/ +theorem _root_.LinearMap.sqrt_apply (hT : T.IsSymmetric) + (x : E) : T.sqrt hT x = ∑ i, (√ (α hT rfl i) : 𝕜) • ⟪e hT rfl i, x⟫ • e hT rfl i := by + simp_rw [Real.sqrt_eq_rpow _]; rfl + +/-- given a symmetric linear map `T` with a non-negative spectrum, +the square root of `T` composed with itself equals itself, i.e., `T.sqrt ^ 2 = T`. -/ +theorem _root_.LinearMap.sqrt_sq_eq_self_of_isSymmetric_and_nonneg_spectrum + (hT : T.IsSymmetric) (hT1 : (spectrum 𝕜 T) ⊆ {x : 𝕜 | 0 ≤ x}) : + T.sqrt hT ^ 2 = T := by + simp_rw [pow_two, Module.End.mul_eq_comp, LinearMap.ext_iff, comp_apply, sqrt_apply, inner_sum, + inner_smul_real_right, smul_smul, inner_smul_right, ← OrthonormalBasis.repr_apply_apply, + OrthonormalBasis.repr_self, PiLp.single_apply, mul_boole, smul_ite, smul_zero, + Finset.sum_ite_eq, Finset.mem_univ, if_true, Algebra.mul_smul_comm, + sq_mul_sq_eq_self_of_isSymmetric_and_nonneg_spectrum T hT hT1, + OrthonormalBasis.repr_apply_apply, ← smul_eq_mul, ← smul_assoc, forall_const] + +/-- given a symmetric linear map `T`, we have that its root is positive -/ +theorem _root_.LinearMap.IsSymmetric.sqrtIsPositive' + (hT : T.IsSymmetric) : (T.sqrt hT).IsPositive' := + by + have : (T.sqrt hT).IsSymmetric := by + intro x y + simp_rw [sqrt_apply T hT, inner_sum, sum_inner, smul_smul, inner_smul_right, inner_smul_left] + have : ∀ i, conj (√ (α hT rfl i) : 𝕜) = (√ (α hT rfl i) : 𝕜) := fun i => by + simp_rw [conj_eq_iff_re, ofReal_re] + simp_rw [mul_assoc, map_mul, this _, inner_conj_symm, mul_comm ⟪e hT rfl _, y⟫ _, ← mul_assoc] + refine ⟨this, ?_⟩ + intro x + simp_rw [sqrt_apply _ hT, inner_sum, inner_smul_right] + apply Finset.sum_nonneg' + intro i + simp_rw [← inner_conj_symm x _, ← OrthonormalBasis.repr_apply_apply, mul_conj, + ← ofReal_pow, ← ofReal_mul, ofReal_nonneg] + exact mul_nonneg (Real.sqrt_nonneg _) (sq_nonneg _) + +/-- `T` is positive if and only if `T` is symmetric +(which is automatic from the definition of positivity) +and has a non-negative spectrum -/ +theorem _root_.LinearMap.isPositive'_iff_isSymmetric_and_nonneg_spectrum : + T.IsPositive' ↔ T.IsSymmetric ∧ (spectrum 𝕜 T) ⊆ {x : 𝕜 | 0 ≤ x} := by + classical + refine ⟨fun h => ⟨h.1, fun μ hμ => IsPositive'.nonneg_spectrum T h hμ⟩, + fun h => ⟨h.1, ?_⟩⟩ + intro x + rw [← sqrt_sq_eq_self_of_isSymmetric_and_nonneg_spectrum T h.1 h.2, pow_two, + Module.End.mul_apply, ← adjoint_inner_left, + isSelfAdjoint_iff'.mp + ((isSymmetric_iff_isSelfAdjoint _).mp (IsSymmetric.sqrtIsPositive' T h.1).1)] + exact inner_self_nonneg' + +/-- `T` is positive if and only if there exists a +linear map `S` such that `T = S.adjoint * S` -/ +theorem _root_.LinearMap.isPositive'_iff_exists_adjoint_hMul_self : + T.IsPositive' ↔ ∃ S : E →ₗ[𝕜] E, T = adjoint S * S := by + classical + constructor + · rw [isPositive'_iff_isSymmetric_and_nonneg_spectrum T] + rintro ⟨hT, hT1⟩ + use T.sqrt hT + rw [isSelfAdjoint_iff'.mp + ((isSymmetric_iff_isSelfAdjoint _).mp (IsSymmetric.sqrtIsPositive' T hT).1), + ← pow_two] + exact (sqrt_sq_eq_self_of_isSymmetric_and_nonneg_spectrum T hT hT1).symm + · intro h + rcases h with ⟨S, rfl⟩ + refine ⟨isSymmetric_adjoint_mul_self S, ?_⟩ + intro x + simp_rw [Module.End.mul_apply, adjoint_inner_right] + exact inner_self_nonneg' + +section Complex + +/-- for spaces `V` over `ℂ`, it suffices to define positivity with +`0 ≤ ⟪v, T v⟫_ℂ` for all `v ∈ V` -/ +theorem _root_.LinearMap.complex_isPositive' {V : Type _} [NormedAddCommGroup V] + [InnerProductSpace ℂ V] + (T : V →ₗ[ℂ] V) : T.IsPositive' ↔ ∀ v : V, 0 ≤ ⟪v, T v⟫_ℂ := + by + simp_rw [IsPositive', isSymmetric_iff_inner_map_self_real, eq_comm, inner_conj_symm, + ← inner_conj_symm (T _), @RCLike.nonneg_def' ℂ, + RCLike.re_to_complex, Complex.conj_eq_iff_re, + ← forall_and] + exact ⟨fun h v => ⟨(h v).1, (h v).2.2⟩, + fun h v => ⟨(h v).1, (h v).1, (h v).2⟩⟩ + +end Complex + +theorem _root_.LinearMap.IsPositive'.conjAdjoint [FiniteDimensional 𝕜 F] + (T : E →ₗ[𝕜] E) (S : E →ₗ[𝕜] F) + (h : T.IsPositive') : (S.comp (T.comp (adjoint S))).IsPositive' := + by + constructor + · intro u v + simp_rw [comp_apply, ← adjoint_inner_left _ (T _), ← adjoint_inner_right _ (T _) _] + exact h.1 _ _ + · intro v + simp_rw [comp_apply, ← adjoint_inner_left _ (T _)] + exact h.2 _ + +theorem _root_.LinearMap.IsPositive'.adjointConj [FiniteDimensional 𝕜 F] + (T : E →ₗ[𝕜] E) (S : F →ₗ[𝕜] E) + (h : T.IsPositive') : (S.adjoint.comp (T.comp S)).IsPositive' := + by + constructor + · intro u v + simp_rw [comp_apply, adjoint_inner_left, adjoint_inner_right] + exact h.1 _ _ + · intro v + simp_rw [comp_apply, adjoint_inner_right] + exact h.2 _ + +local notation "√T⋆" T => + LinearMap.sqrt ((LinearMap.adjoint T) ∘ₗ T) (isSymmetric_adjoint_mul_self T) + +/-- we have `(T.adjoint.comp T).sqrt` is positive, given any linear map `T` -/ +theorem _root_.LinearMap.sqrtAdjointSelfIsPositive' (T : E →ₗ[𝕜] E) : (√T⋆T).IsPositive' := + IsSymmetric.sqrtIsPositive' _ (isSymmetric_adjoint_mul_self T) + +open Module.End + +/-- given any linear map `T` and `x ∈ E` we have +`‖(T.adjoint.comp T).sqrt x‖ = ‖T x‖` -/ +theorem _root_.LinearMap.norm_of_sqrt_adjoint_mul_self_eq (T : E →ₗ[𝕜] E) (x : E) : + ‖(√T⋆T) x‖ = ‖T x‖ := + by + simp_rw [← sq_eq_sq₀ (norm_nonneg _) (norm_nonneg _), ← @inner_self_eq_norm_sq 𝕜, ← + adjoint_inner_left, + isSelfAdjoint_iff'.mp + ((isSymmetric_iff_isSelfAdjoint _).mp (sqrtAdjointSelfIsPositive' T).1), + ← mul_eq_comp, ← mul_apply, ← pow_two, mul_eq_comp] + congr + apply sqrt_sq_eq_self_of_isSymmetric_and_nonneg_spectrum + apply IsPositive'.nonneg_spectrum _ ⟨isSymmetric_adjoint_mul_self T, _⟩ + intro x + simp_rw [mul_apply, adjoint_inner_right] + exact inner_self_nonneg' + +theorem _root_.LinearMap.invertible_iff_inner_map_self_pos + (hT : T.IsPositive') : Function.Bijective T ↔ ∀ v : E, v ≠ 0 → 0 < ⟪T v, v⟫ := + by + constructor + · intro h v hv + rcases (isPositive'_iff_exists_adjoint_hMul_self T).mp hT with ⟨S, hS⟩ + rw [hS, mul_apply, adjoint_inner_left, inner_self_eq_norm_sq_to_K] + suffices S v ≠ 0 by + rw [← norm_ne_zero_iff] at this + rw [← RCLike.ofReal_pow, RCLike.zero_lt_real] + exact sq_pos_iff.mpr this + by_contra hSv + rw [LinearMap.ext_iff] at hS + specialize hS v + rw [mul_apply, hSv, map_zero] at hS + apply hv + apply_fun T + · rw [map_zero] + exact hS + · exact h.1 + · intro h + by_contra hbij + rw [Function.Bijective, ← injective_iff_surjective, + and_self_iff, injective_iff_map_eq_zero] at hbij + push Not at hbij + rcases hbij with ⟨a, ha⟩ + specialize h a ha.2 + rw [ha.1, inner_zero_left, lt_self_iff_false] at h + exact h + +theorem _root_.LinearMap.invertiblePos (T : E →ₗ[𝕜] E) [hTi : Invertible T] + (hT : T.IsPositive') : IsPositive' (⅟ T) := + by + have : Function.Bijective T := + by + refine (Module.End.isUnit_iff T).mp ?_ + exact isUnit_of_invertible T + have t1 := this + rw [invertible_iff_inner_map_self_pos T hT] at this + constructor + · intro u v + rw [← adjoint_inner_left] + revert v + have ugh := ((isSymmetric_iff_isSelfAdjoint T).mp hT.1).star_eq + -- have hmm : Invertible (adjoint T) := by rw [ugh]; exact hTi + have t : star (⅟ T) = ⅟ (star T) := star_invOf _ + rw [← ext_inner_left_iff ((⅟ T) u) (adjoint (⅟ T) u), ← star_eq_adjoint] + simp_rw [t, ugh] + · intro x + by_cases b : ⅟ T x = 0 + · rw [b, inner_zero_right] + · specialize this _ b + rw [← mul_apply, mul_invOf_self, one_apply] at this + exact le_of_lt this + +theorem _root_.LinearMap.IsSymmetric.rePow_eq_rankOne {𝕜 E : Type _} [RCLike 𝕜] + [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] + {T : E →ₗ[𝕜] E} (hT : T.IsSymmetric) (r : ℝ) : + LinearMap.rePow T hT r = + ∑ i, + ((hT.eigenvalues rfl i ^ r : ℝ) : 𝕜) • + (_root_.rankOne 𝕜 (hT.eigenvectorBasis rfl i) (hT.eigenvectorBasis rfl i)) := + by + simp_rw [LinearMap.ext_iff, LinearMap.rePow_apply, + ContinuousLinearMap.coe_sum, ContinuousLinearMap.coe_smul, + LinearMap.sum_apply, LinearMap.smul_apply, + ContinuousLinearMap.coe_coe] + intros + rfl + +theorem _root_.LinearMap.IsSymmetric.invertible (hT : T.IsSymmetric) [Invertible T] : + (⅟ T).IsSymmetric := + by + rw [LinearMap.isSymmetric_iff_isSelfAdjoint, isSelfAdjoint_iff] at hT ⊢ + simp_rw [star_invOf] + simp only [hT] + +theorem _root_.LinearMap.isPositive'_and_invertible_pos_eigenvalues + (hT : T.IsPositive') [Invertible T] + (i : Fin (Module.finrank 𝕜 E)) : 0 < hT.1.eigenvalues rfl i := + by + -- have := linear_map.invertible_pos T hn hT, + -- have fs : function.bijective ⇑(⅟ T), + have fs : Function.Bijective ⇑T := + by + rw [Function.bijective_iff_has_inverse] + use⇑(⅟ T) + simp_rw [Function.RightInverse, Function.LeftInverse, ← Module.End.mul_apply, invOf_mul_self, + mul_invOf_self, one_apply, and_self_iff, forall_const] + obtain ⟨v, hv, gh⟩ := + Module.End.has_eigenvector_iff_hasEigenvalue.mpr + (@LinearMap.IsSymmetric.hasEigenvalue_eigenvalues 𝕜 _ E _ _ T _ _ hT.1 rfl i) + have ugh := (LinearMap.invertible_iff_inner_map_self_pos T hT).mp fs v gh + rw [hv, inner_smul_real_left, inner_self_eq_norm_sq_to_K, ← ofReal_pow, real_smul_ofReal, + ← ofReal_mul, zero_lt_real, mul_pos_iff] at ugh + simp_rw [not_lt_of_ge (sq_nonneg _), and_false, or_false] at ugh + exact ugh.1 + +/-- Invertibility of real powers of a positive invertible linear map. -/ +@[reducible] +noncomputable def _root_.LinearMap.IsPositive'.rePowIsInvertible (hT : T.IsPositive') [Invertible T] + (r : ℝ) : Invertible (T.rePow hT.1 r) := by + apply Invertible.mk (T.rePow hT.1 (-r)) <;> ext1 <;> + simp_rw [Module.End.mul_apply, LinearMap.rePow_apply, inner_sum, inner_smul_right, + orthonormal_iff_ite.mp (hT.1.eigenvectorBasis rfl).orthonormal, mul_boole, mul_ite, + MulZeroClass.mul_zero, Finset.sum_ite_eq, Finset.mem_univ, if_true, smul_smul, ← mul_assoc, + ← RCLike.ofReal_mul, ← + Real.rpow_add (LinearMap.isPositive'_and_invertible_pos_eigenvalues _ hT _), + Module.End.one_apply] <;> + simp only [add_neg_cancel, neg_add_cancel, Real.rpow_zero, RCLike.ofReal_one, one_mul, ← + OrthonormalBasis.repr_apply_apply, OrthonormalBasis.sum_repr] + +theorem _root_.LinearMap.IsPositive'.sum {𝕜 E : Type _} [RCLike 𝕜] + [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] {n : ℕ} + {T : Fin n → E →ₗ[𝕜] E} (hT : ∀ i, (T i).IsPositive') : + (∑ i, T i).IsPositive' := + by + induction n with + | zero => + simp only [Finset.univ_eq_empty, Finset.sum_empty, LinearMap.IsPositive'Zero] + | succ d hd => + simp_rw [Fin.sum_univ_castSucc] + apply LinearMap.IsPositive'.add + · apply hd + intro i + exact hT _ + · exact hT _ + +theorem _root_.LinearMap.IsPositive'.smulNonneg {𝕜 E : Type _} [RCLike 𝕜] + [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] {T : E →ₗ[𝕜] E} (hT : T.IsPositive') {r : ℝ} (hr : 0 ≤ r) : + ((r : 𝕜) • T).IsPositive' := by + simp_rw [LinearMap.IsPositive', LinearMap.IsSymmetric, LinearMap.smul_apply, inner_smul_left, + inner_smul_right, RCLike.conj_ofReal, hT.1 _ _, forall₂_true_iff, true_and] + rw [← @zero_le_real 𝕜] at hr + simp_rw [mul_nonneg hr (hT.2 _), forall_true_iff] +theorem _root_.LinearMap.IsPositive'.smulNNReal {𝕜 E : Type _} [RCLike 𝕜] + [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] {T : E →ₗ[𝕜] E} (hT : T.IsPositive') (r : NNReal) : + (((r : ℝ) : 𝕜) • T).IsPositive' := +hT.smulNonneg r.2 + +end FiniteDimensional + +end LinearMap + +theorem rankOne_self_isPositive {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] + [CompleteSpace E] {x : E} : + (_root_.rankOne 𝕜 x x).IsPositive := + by + refine ⟨rankOne_self_isSymmetric, ?_⟩ + intro y + rw [ContinuousLinearMap.reApplyInnerSelf_apply, _root_.rankOne_apply, inner_smul_left, + RCLike.conj_mul, ← RCLike.ofReal_pow, RCLike.ofReal_re] + exact sq_nonneg _ + +theorem LinearMap.IsPositive'.nonneg_eigenvalue {E : Type _} [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] {T : E →ₗ[𝕜] E} (hT : T.IsPositive') {α : ℝ} + (hα : Module.End.HasEigenvalue T α) : 0 ≤ α := + by + have this := ((spec_subseteq_nonneg _).mp (LinearMap.IsPositive'.nonneg_spectrum T hT)) α + (Module.End.hasEigenvalue_iff_mem_spectrum.mp hα) + rw [zero_le_real] at this + exact this + +open scoped BigOperators + +theorem LinearMap.isPositive'_iff_eq_sum_rankOne [FiniteDimensional 𝕜 E] + (T : E →ₗ[𝕜] E) : + T.IsPositive' ↔ + ∃ (m : ℕ) (u : Fin m → E), + T = ∑ i : Fin m, ((_root_.rankOne 𝕜 (u i) (u i)) : E →ₗ[𝕜] E) := + by + constructor + · intro hT + let a : Fin (Module.finrank 𝕜 E) → E := fun i => + (Real.sqrt (hT.1.eigenvalues rfl i) : 𝕜) • hT.1.eigenvectorBasis rfl i + refine ⟨Module.finrank 𝕜 E, a, ?_⟩ + ext1 + simp_rw [LinearMap.sum_apply, ContinuousLinearMap.coe_coe, _root_.rankOne_apply, a, + inner_smul_left, + smul_smul, mul_assoc, RCLike.conj_ofReal, mul_comm (⟪_, _⟫_𝕜), + ← mul_assoc, ← RCLike.ofReal_mul, ← + Real.sqrt_mul (hT.nonneg_eigenvalue (hT.1.hasEigenvalue_eigenvalues rfl _)), + Real.sqrt_mul_self (hT.nonneg_eigenvalue (hT.1.hasEigenvalue_eigenvalues rfl _)), + mul_comm _ (inner _ _ _), ← smul_eq_mul, smul_assoc, ← hT.1.apply_eigenvectorBasis, ← + LinearMap.map_smul, ← map_sum, ← OrthonormalBasis.repr_apply_apply, OrthonormalBasis.sum_repr] + · rintro ⟨m, u, hu⟩ + simp_rw [LinearMap.IsPositive', LinearMap.IsSymmetric, hu, LinearMap.sum_apply, + ContinuousLinearMap.coe_coe, _root_.rankOne_apply, inner_sum, sum_inner, inner_smul_left, + inner_smul_right, inner_conj_symm, mul_comm, forall₂_true_iff, true_and, + ← inner_conj_symm _ (u _), RCLike.conj_mul, ← RCLike.ofReal_pow, + ← ofReal_sum, zero_le_real] + exact fun _ => Finset.sum_nonneg' (fun _ => sq_nonneg _) + +theorem LinearMap.IsSymmetric.rePowIsPositive'OfIsPositive' {𝕜 E : Type _} [RCLike 𝕜] + [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] + {T : E →ₗ[𝕜] E} (hT : T.IsPositive') (r : ℝ) : + (T.rePow hT.1 r).IsPositive' := + by + haveI := FiniteDimensional.complete 𝕜 E + simp_rw [LinearMap.IsSymmetric.rePow_eq_rankOne, ContinuousLinearMap.coe_sum] + apply LinearMap.IsPositive'.sum + intro i + apply LinearMap.IsPositive'.smulNonneg + · rw [← ContinuousLinearMap.IsPositive.toLinearMap'] + exact rankOne_self_isPositive + · apply Real.rpow_nonneg + exact hT.nonneg_eigenvalue (hT.1.hasEigenvalue_eigenvalues rfl _) diff --git a/LeanPool/Monlib4/LinearAlgebra/Ips/RankOne.lean b/LeanPool/Monlib4/LinearAlgebra/Ips/RankOne.lean new file mode 100644 index 0000000000..6c5b584da0 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Ips/RankOne.lean @@ -0,0 +1,747 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Analysis.InnerProductSpace.Adjoint +import LeanPool.Monlib4.LinearAlgebra.Ips.Basic +import LeanPool.Monlib4.LinearAlgebra.IsProj' + +/-! + +# rank one operators + +This defines the rank one operator $| x \rangle\langle y |$ for continuous linear maps + (see `rank_one`) and linear maps (see `rank_one_lm`). + +-/ + + +section rankOne + +/-- The bra map sending a vector to the corresponding inner-product functional. -/ +@[simps!] +noncomputable abbrev bra (𝕜 : Type*) {E : Type*} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] : + E →L⋆[𝕜] (E →L[𝕜] 𝕜) := +innerSL 𝕜 +/-- The ket map sending a vector to scalar multiplication by that vector. -/ +@[simps!] +noncomputable def ket (𝕜 : Type*) {E : Type*} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] : + E →L[𝕜] (𝕜 →L[𝕜] E) where + toFun x := + { toFun := fun α => α • x + map_add' := fun _ _ => by simp only [add_smul] + map_smul' := fun _ _ => by simp only [smul_smul, smul_eq_mul]; rfl } + map_add' := fun _ _ => by simp only [smul_add]; rfl + map_smul' := fun α _ => by simp_rw [smul_smul, mul_comm _ α, ← smul_smul]; rfl + cont := + by + refine continuous_clm_apply.mpr ?_ + intro + simp only [ContinuousLinearMap.coe_mk', LinearMap.coe_mk, AddHom.coe_mk] + exact continuous_const_smul _ +@[simp high] +lemma ket_one_apply + {𝕜 E : Type*} [RCLike 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] + (x : E) : + ket 𝕜 x 1 = x := +by simp only [ket_apply_apply, one_smul] + +theorem ket_RCLike {𝕜 : Type*} [RCLike 𝕜] (x : 𝕜) : + ket 𝕜 x = ContinuousLinearMap.mul 𝕜 𝕜 x := +by + ext + simp only [ket_one_apply, ContinuousLinearMap.mul_apply', mul_one] + +lemma ContinuousLinearMap.mul_one_apply {𝕜 𝕜' : Type*} + [NontriviallyNormedField 𝕜] [SeminormedRing 𝕜'] + [NormedSpace 𝕜 𝕜'] [IsScalarTower 𝕜 𝕜' 𝕜'] [SMulCommClass 𝕜 𝕜' 𝕜'] : + mul 𝕜 𝕜' 1 = 1 := +by ext; rw [mul_apply', one_mul]; rfl + +theorem ket_RCLike_one {𝕜 : Type*} [RCLike 𝕜] : + ket 𝕜 (1 : 𝕜) = 1 := +by rw [ket_RCLike, ContinuousLinearMap.mul_one_apply] + +theorem bra_RCLike {𝕜 : Type*} [RCLike 𝕜] (x : 𝕜) : + bra 𝕜 x = ContinuousLinearMap.mul 𝕜 𝕜 ((starRingEnd 𝕜) x) := +by + ext + simp only [innerSL_apply_apply, RCLike.inner_apply, mul_one, ContinuousLinearMap.mul_apply', + one_mul] + +theorem bra_RCLike_one {𝕜 : Type*} [RCLike 𝕜] : + bra 𝕜 (1 : 𝕜) = 1 := +by rw [bra_RCLike, map_one, ContinuousLinearMap.mul_one_apply] + +lemma bra_adjoint_eq_ket {𝕜 E : Type*} [RCLike 𝕜] + [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] [CompleteSpace E] (x : E) : + ContinuousLinearMap.adjoint (bra 𝕜 x : E →L[𝕜] 𝕜) = (ket 𝕜 x) := +by + ext + apply ext_inner_left 𝕜 + intro y + simp only [ket_apply_apply, one_smul, ContinuousLinearMap.adjoint_inner_right, + bra_apply_apply, RCLike.inner_apply, inner_conj_symm, one_mul] + +lemma _root_.ket_adjoint_eq_bra {𝕜 E : Type*} [RCLike 𝕜] + [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] [CompleteSpace E] (x : E) : + ContinuousLinearMap.adjoint (ket 𝕜 x) = bra 𝕜 x := +by + rw [← bra_adjoint_eq_ket, ContinuousLinearMap.adjoint_adjoint] + +open scoped InnerProductSpace + +lemma bra_ket_apply {𝕜 E : Type*} [RCLike 𝕜] + [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] (x y : E) : + (bra 𝕜 x) ∘L (ket 𝕜 y) = ket 𝕜 ⟪x, y⟫_𝕜 := +by + ext + simp_rw [ContinuousLinearMap.comp_apply, ket_one_apply] + rfl + +lemma bra_ket_one_eq_inner {𝕜 E : Type*} [RCLike 𝕜] + [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] (x y : E) : + ((bra 𝕜 x) ∘L (ket 𝕜 y)) 1 = ⟪x, y⟫_𝕜 := +by + rw [bra_ket_apply, ket_one_apply] + +lemma continuousLinearMap_comp_ket {𝕜 E₁ E₂ : Type*} [RCLike 𝕜] [NormedAddCommGroup E₁] + [InnerProductSpace 𝕜 E₁] + [NormedAddCommGroup E₂] [InnerProductSpace 𝕜 E₂] + (f : E₁ →L[𝕜] E₂) (x : E₁) : + f ∘L ket 𝕜 x = ket 𝕜 (f x) := +by + ext + simp only [ContinuousLinearMap.comp_apply, ket_one_apply] + +lemma bra_comp_continuousLinearMap {𝕜 E₁ E₂ : Type*} [RCLike 𝕜] [NormedAddCommGroup E₁] + [InnerProductSpace 𝕜 E₁] + [NormedAddCommGroup E₂] [InnerProductSpace 𝕜 E₂] + [CompleteSpace E₁] [CompleteSpace E₂] + (x : E₂) (f : E₁ →L[𝕜] E₂) : + bra 𝕜 x ∘L f = bra 𝕜 (ContinuousLinearMap.adjoint f x) := +by + ext + simp only [ContinuousLinearMap.comp_apply, bra_apply_apply, + ContinuousLinearMap.adjoint_inner_left] + +/-- we define the rank one operator $| x \rangle\langle y |$ by + $x \mapsto \langle y,z\rangle x$ -/ +@[simps] +def rankOne (𝕜 : Type*) {E₁ E₂ : Type*} [RCLike 𝕜] [NormedAddCommGroup E₁] + [InnerProductSpace 𝕜 E₁] + [NormedAddCommGroup E₂] [InnerProductSpace 𝕜 E₂] : + E₁ →ₗ[𝕜] (E₂ →ₗ⋆[𝕜] (E₂ →L[𝕜] E₁)) where + toFun x := + { toFun := fun y => + { toFun := fun z => ⟪y,z⟫_𝕜 • x + map_add' := fun _ _ => by simp_rw [inner_add_right, add_smul] + map_smul' := fun _ _ => by simp_rw [inner_smul_right, RingHom.id_apply, smul_smul] + cont := Continuous.smul (Continuous.inner continuous_const continuous_id') continuous_const } + map_add' := fun a b => by simp only [inner_add_left, add_smul]; rfl + map_smul' := fun r x => by simp only [inner_smul_left, ← smul_smul]; rfl } + map_add' a b := by simp only [smul_add]; rfl + map_smul' r a := by + simp only [smul_smul, RingHom.id_apply, mul_comm _ r] + simp only [← smul_smul]; rfl + +variable {𝕜 E₁ E₂ : Type*} [RCLike 𝕜] [NormedAddCommGroup E₁] [InnerProductSpace 𝕜 E₁] + [NormedAddCommGroup E₂] [InnerProductSpace 𝕜 E₂] + +@[simp] +theorem rankOne_apply {x : E₁} {y : E₂} (z : E₂) : rankOne 𝕜 x y z = ⟪y,z⟫_𝕜 • x := +rfl + +theorem ket_bra_eq_rankOne {x : E₁} {y : E₂} : + ket 𝕜 x ∘L bra 𝕜 y = rankOne 𝕜 x y := +rfl + +theorem ket_eq_rankOne_one (x : E₁) : + ket 𝕜 x = rankOne 𝕜 x 1 := +by + ext + simp only [ket_apply_apply, one_smul, rankOne_apply_apply_apply, RCLike.inner_apply, map_one, + mul_one] +theorem bra_eq_one_rankOne (x : E₁) : + bra 𝕜 x = rankOne 𝕜 1 x := +by + ext + simp only [innerSL_apply_apply, rankOne_apply_apply_apply, smul_eq_mul, mul_one] + + +open ContinuousLinearMap + +theorem rankOne.smul_real_apply {x : E₁} {y : E₂} {α : ℝ} : + rankOne 𝕜 x ((α : 𝕜) • y) = (α : 𝕜) • rankOne 𝕜 x y := by + simp only [LinearMap.map_smulₛₗ, RCLike.conj_ofReal] + +/-- +$| x \rangle\langle y | | z \rangle\langle w | = +\langle y, z \rangle \cdot | x \rangle\langle w |$ +-/ +@[simp] +theorem rankOne.apply_rankOne {E₃ : Type*} [NormedAddCommGroup E₃] [InnerProductSpace 𝕜 E₃] + (x : E₁) (y z : E₂) (w : E₃) : + (rankOne 𝕜 x y) ∘L rankOne 𝕜 z w = ⟪y,z⟫_𝕜 • rankOne 𝕜 x w := + by + ext r + simp_rw [ContinuousLinearMap.smul_apply, comp_apply, rankOne_apply, + inner_smul_right, mul_comm, smul_smul] + +/-- $u \circ | x \rangle\langle y | = | u(x) \rangle\langle y |$ -/ +theorem ContinuousLinearMap.comp_rankOne {E₃ : Type*} [NormedAddCommGroup E₃] + [InnerProductSpace 𝕜 E₃] + (x : E₁) (y : E₂) (u : E₁ →L[𝕜] E₃) : + u ∘L rankOne 𝕜 x y = rankOne 𝕜 (u x) y := + by + ext r + simp_rw [comp_apply, rankOne_apply, map_smul] + +/-- $| x \rangle\langle y | \circ u = | x \rangle\langle u^*(y) |$ -/ +theorem ContinuousLinearMap.rankOne_comp {E₃ : Type*} [NormedAddCommGroup E₃] + [InnerProductSpace 𝕜 E₃] + [CompleteSpace E₂] [CompleteSpace E₃] (x : E₁) (y : E₂) (u : E₃ →L[𝕜] E₂) : + rankOne 𝕜 x y ∘L u = rankOne 𝕜 x (adjoint u y) := + by + ext r + simp_rw [comp_apply, rankOne_apply, adjoint_inner_left] + +/-- rank one operators given by norm one vectors are automatically idempotent -/ +theorem rankOne_self_isIdempotentElem_of_normOne {x : E₁} (h : ‖x‖ = 1) : + IsIdempotentElem (rankOne 𝕜 x x) := by +simp_rw [IsIdempotentElem, ContinuousLinearMap.ext_iff, mul_def, rankOne.apply_rankOne, + inner_self_eq_norm_sq_to_K, h, RCLike.ofReal_one, one_pow, one_smul, + forall_const] + +theorem rankOne_self_isSymmetric {x : E₁} : + LinearMap.IsSymmetric ((rankOne 𝕜 x x) : E₁ →ₗ[𝕜] E₁) := by +simp_rw [LinearMap.IsSymmetric, ContinuousLinearMap.coe_coe, rankOne_apply, inner_smul_left, + inner_smul_right, inner_conj_symm, mul_comm, forall₂_true_iff] + +/-- rank one operators are automatically self-adjoint -/ +@[simp] +theorem rankOne_self_isSelfAdjoint [CompleteSpace E₁] {x : E₁} : + IsSelfAdjoint (rankOne 𝕜 x x) := +isSelfAdjoint_iff_isSymmetric.mpr rankOne_self_isSymmetric + +/-- $| x \rangle\langle y |^* = | y \rangle\langle x |$ -/ +theorem rankOne_adjoint [CompleteSpace E₁] [CompleteSpace E₂] (x : E₁) (y : E₂) : + adjoint (rankOne 𝕜 x y) = rankOne 𝕜 y x := +by + rw [← ket_bra_eq_rankOne, adjoint_comp, bra_adjoint_eq_ket, ket_adjoint_eq_bra] + rfl + +theorem rankOne_inner_left (x w : E₁) (y z : E₂) : + ⟪rankOne 𝕜 x y z,w⟫_𝕜 = ⟪z,y⟫_𝕜 * ⟪x,w⟫_𝕜 := by +rw [rankOne_apply, inner_smul_left, inner_conj_symm] + +theorem rankOne_inner_right (x y : E₁) (z w : E₂) : + ⟪x, rankOne 𝕜 y z w⟫_𝕜 = ⟪z,w⟫_𝕜 * ⟪x,y⟫_𝕜 := by +rw [rankOne_apply, inner_smul_right] + +theorem ContinuousLinearMap.commutes_with_all_iff [CompleteSpace E₁] {T : E₁ →L[𝕜] E₁} : + (∀ S, Commute S T) ↔ ∃ α : 𝕜, T = α • 1 := + by + constructor + · intro h + have h' : ∀ x y : E₁, rankOne 𝕜 x y ∘L T = T ∘L rankOne 𝕜 x y := fun x y => h _ + simp_rw [ContinuousLinearMap.rankOne_comp, ContinuousLinearMap.comp_rankOne] at h' + have h'' : ∀ x y : E₁, rankOne 𝕜 (adjoint T y) x = rankOne 𝕜 y (T x) := + by + intro x y + nth_rw 1 [← rankOne_adjoint] + rw [h', rankOne_adjoint] + simp_rw [ContinuousLinearMap.ext_iff, rankOne_apply] at h' h'' + by_cases H : ∀ x : E₁, x = 0 + · use 0 + simp_rw [ContinuousLinearMap.ext_iff] + intro x + rw [H x, zero_smul, map_zero, zero_apply] + push Not at H + obtain ⟨x, hx⟩ := H + use (⟪x,x⟫_𝕜)⁻¹ * ⟪adjoint T x, x⟫_𝕜 + simp_rw [ContinuousLinearMap.ext_iff, ContinuousLinearMap.smul_apply, one_apply, + mul_smul, h', smul_smul] + rw [inv_mul_cancel₀] + · simp_rw [one_smul, forall_true_iff] + · rw [inner_self_ne_zero] + exact hx + · rintro ⟨α, hα⟩ S + simp_rw [Commute, SemiconjBy, mul_def, hα, comp_smul, smul_comp, one_def, comp_id, id_comp] + +theorem ContinuousLinearMap.centralizer [CompleteSpace E₁] : + (@Set.univ (E₁ →L[𝕜] E₁)).centralizer = { x : E₁ →L[𝕜] E₁ | ∃ α : 𝕜, x = α • 1 } := + by + simp_rw [Set.centralizer, Set.mem_univ, true_imp_iff, ← ContinuousLinearMap.commutes_with_all_iff] + rfl + +theorem ContinuousLinearMap.scalar_centralizer : + {x : E₁ →L[𝕜] E₁ | ∃ α : 𝕜, x = α • 1}.centralizer = @Set.univ (E₁ →L[𝕜] E₁) := + by + simp_rw [Set.centralizer, Set.ext_iff, Set.mem_setOf, Set.mem_univ, iff_true] + rintro x y ⟨α, rfl⟩ + simp only [Algebra.smul_mul_assoc, one_mul, Algebra.mul_smul_comm, mul_one] + +theorem ContinuousLinearMap.centralizer_centralizer [CompleteSpace E₁] : + (@Set.univ (E₁ →L[𝕜] E₁)).centralizer.centralizer = Set.univ := by + rw [ContinuousLinearMap.centralizer, ContinuousLinearMap.scalar_centralizer] + +theorem colinear_of_rankOne_self_eq_rankOne_self + (x y : E₁) (h : rankOne 𝕜 x x = rankOne 𝕜 y y) : + ∃ α : 𝕜ˣ, x = (α : 𝕜) • y := +by + have : x = 0 ↔ y = 0 := + by + constructor <;> intro hh <;> + simp only [hh, ContinuousLinearMap.ext_iff, map_zero, ContinuousLinearMap.zero_apply, + @eq_comm _ (0 : E₁ →L[𝕜] E₁), rankOne_apply, smul_eq_zero] at h + on_goal 1 => specialize h y + on_goal 2 => specialize h x + all_goals + simp_rw [inner_self_eq_zero, or_self_iff] at h + exact h + simp_rw [ContinuousLinearMap.ext_iff, rankOne_apply] at h + by_cases Hx : x = 0 + · use 1 + simp_rw [Hx, Units.val_one, one_smul, eq_comm, ← this, Hx] + · have ugh : inner 𝕜 y x ≠ 0 := by + intro hy + specialize h x + rw [hy, zero_smul, smul_eq_zero, inner_self_eq_zero, or_self_iff] at h + contradiction + use Units.mk0 (inner 𝕜 y x / inner 𝕜 x x) + (div_ne_zero ugh ((@inner_self_ne_zero 𝕜 _ _ _ _ _).mpr Hx)) + simp_rw [div_eq_inv_mul, Units.val_mk0, mul_smul, ← h, smul_smul, + inv_mul_cancel₀ ((@inner_self_ne_zero 𝕜 _ _ _ _ _).mpr Hx), one_smul] + +theorem rankOne.ext_iff {x y : E₁} (_hx : x ≠ 0) (_hy : y ≠ 0) + (h : rankOne 𝕜 x x = rankOne 𝕜 y y) : + ∃ α : 𝕜ˣ, x = (α : 𝕜) • y := + colinear_of_rankOne_self_eq_rankOne_self x y h + +theorem colinear_of_ne_zero_rankOne_eq_rankOne [CompleteSpace E₂] [CompleteSpace E₁] + {a c : E₁} {b d : E₂} (h : rankOne 𝕜 a b = rankOne 𝕜 c d) + (ha : a ≠ 0) (hb : b ≠ 0) : + (∃ α β : 𝕜ˣ, a = (α : 𝕜) • c ∧ b = (α * β : 𝕜) • d) := +by + have h₂ := h + apply_fun ContinuousLinearMap.adjoint at h₂ + simp only [rankOne_adjoint, ContinuousLinearMap.ext_iff, rankOne_apply] at h h₂ + specialize h b + specialize h₂ a + have h₃ : a = (⟪d, b⟫_𝕜 / ⟪b, b⟫_𝕜) • c := by + calc a = (⟪b, b⟫_𝕜 / ⟪b, b⟫_𝕜) • a := by + rw [div_self, one_smul] + simp only [ne_eq, inner_self_eq_zero]; exact hb + _ = (1 / ⟪b, b⟫_𝕜) • (⟪b, b⟫_𝕜 • a) := by simp only [smul_smul]; ring_nf + _ = (1 / ⟪b, b⟫_𝕜) • (⟪d, b⟫_𝕜 • c) := by rw [h] + _ = (⟪d, b⟫_𝕜 / ⟪b, b⟫_𝕜) • c := by simp only [smul_smul]; ring_nf + have h₄ := + calc b = (⟪a, a⟫_𝕜 / ⟪a, a⟫_𝕜) • b := by + rw [div_self, one_smul] + simp only [ne_eq, inner_self_eq_zero]; exact ha + _ = (1 / ⟪a, a⟫_𝕜) • (⟪a, a⟫_𝕜 • b) := by simp only [smul_smul]; ring_nf + _ = (1 / ⟪a, a⟫_𝕜) • (⟪c, a⟫_𝕜 • d) := by rw [h₂] + _ = (1 / ⟪a, a⟫_𝕜) • (⟪c, (⟪d, b⟫_𝕜 / ⟪b, b⟫_𝕜) • c⟫_𝕜 • d) := by rw [h₃] + _ = ((⟪d, b⟫_𝕜 / ⟪b, b⟫_𝕜) * (⟪c, c⟫_𝕜 / (⟪a, a⟫_𝕜))) • d := by + simp only [inner_smul_right, smul_smul]; ring_nf + have h₅ : ⟪d, b⟫_𝕜 ≠ 0 := by + intro h + rw [h, zero_div, zero_mul, zero_smul] at h₄ + exact hb h₄ + let α := Units.mk0 (⟪d, b⟫_𝕜 / ⟪b, b⟫_𝕜) (div_ne_zero h₅ (inner_self_ne_zero.mpr hb)) + have h₆ : c ≠ 0 := by + rintro rfl + simp only [smul_zero] at h₃ + exact ha h₃ + let β := Units.mk0 (⟪c, c⟫_𝕜 / ⟪a, a⟫_𝕜) + (div_ne_zero (inner_self_ne_zero.mpr h₆) (inner_self_ne_zero.mpr ha)) + exact ⟨α, β, h₃, h₄⟩ + +theorem ket_eq_ket_iff {x y : E₁} : + ket 𝕜 x = ket 𝕜 y ↔ x = y := +by + simp only [ContinuousLinearMap.ext_iff, ket_apply_apply, + ← @sub_eq_zero _ _ (_ • _), ← @sub_eq_zero _ _ x] + simp only [← smul_sub, smul_eq_zero, forall_or_right, + or_iff_right_iff_imp] + intro h + specialize h 1 + simp only [one_ne_zero] at h + +theorem bra_eq_bra_iff {x y : E₁} : + bra 𝕜 x = bra 𝕜 y ↔ x = y := +by + simp only [ContinuousLinearMap.ext_iff, bra_apply_apply, + ← @sub_eq_zero _ _ ⟪_, _⟫_𝕜, ← @sub_eq_zero _ _ x] + simp only [← inner_sub_left, forall_inner_eq_zero_iff] + +theorem ContinuousLinearMap.ext_inner_map {F : Type _} [NormedAddCommGroup F] + [InnerProductSpace 𝕜 F] (T S : E₁ →L[𝕜] F) : + T = S ↔ ∀ x y, ⟪T x,y⟫_𝕜 = ⟪S x,y⟫_𝕜 := +by + simp only [ContinuousLinearMap.ext_iff] + constructor + · intro h x y + rw [h] + · intro h x + apply @ext_inner_right 𝕜 + exact h x +theorem LinearMap.ext_inner_map {F : Type _} [NormedAddCommGroup F] + [InnerProductSpace 𝕜 F] (T S : E₁ →ₗ[𝕜] F) : + T = S ↔ ∀ x y, ⟪T x,y⟫_𝕜 = ⟪S x,y⟫_𝕜 := +by + simp only [LinearMap.ext_iff] + constructor + · intro h x y + rw [h] + · intro h x + apply @ext_inner_right 𝕜 + exact h x + +open scoped BigOperators + +theorem ContinuousLinearMap.exists_sum_rankOne + [FiniteDimensional 𝕜 E₁] [FiniteDimensional 𝕜 E₂] (T : E₁ →L[𝕜] E₂) : + ∃ (x : Fin (Module.finrank 𝕜 E₁) × Fin (Module.finrank 𝕜 E₂) → E₂) + (y : Fin (Module.finrank 𝕜 E₁) × Fin (Module.finrank 𝕜 E₂) → E₁), + T = ∑ i, rankOne 𝕜 (x i) (y i) := + by + letI := FiniteDimensional.complete 𝕜 E₁ + letI := FiniteDimensional.complete 𝕜 E₂ + let e₁ := stdOrthonormalBasis 𝕜 E₁ + let e₂ := stdOrthonormalBasis 𝕜 E₂ + let b : Fin (Module.finrank 𝕜 E₁) × Fin (Module.finrank 𝕜 E₂) → E₁ := fun ij => + e₁ ij.1 + let a : Fin (Module.finrank 𝕜 E₁) × Fin (Module.finrank 𝕜 E₂) → E₂ := fun ij => + e₂.repr (T (e₁ ij.1)) ij.2 • e₂ ij.2 + refine ⟨a, b, ?_⟩ + simp only [a, b] + simp only [ContinuousLinearMap.ext_inner_map, sum_apply, sum_inner, rankOne_inner_left, + inner_smul_left, OrthonormalBasis.repr_apply_apply, inner_conj_symm] + intro u v + symm + calc + ∑ x : Fin (Module.finrank 𝕜 E₁) × Fin (Module.finrank 𝕜 E₂), + ⟪u,e₁ x.fst⟫_𝕜 * (⟪T (e₁ x.fst),e₂ x.snd⟫_𝕜 * ⟪e₂ x.snd,v⟫_𝕜) = + ∑ x_1, ∑ x_2, + ⟪u,e₁ x_1⟫_𝕜 * (⟪T (e₁ x_1),e₂ x_2⟫_𝕜 * ⟪e₂ x_2,v⟫_𝕜) := + by simp_rw [← Finset.sum_product', Finset.univ_product_univ] + _ = ∑ x_1, ⟪u,e₁ x_1⟫_𝕜 * ⟪T (e₁ x_1),v⟫_𝕜 := by + simp_rw [← Finset.mul_sum, OrthonormalBasis.sum_inner_mul_inner] + _ = ⟪T u,v⟫_𝕜 := by simp_rw [← adjoint_inner_right T, OrthonormalBasis.sum_inner_mul_inner] + +example [FiniteDimensional 𝕜 E₁] (T : E₁ →L[𝕜] E₁) : + ∃ x y : Fin (Module.finrank 𝕜 E₁) × Fin (Module.finrank 𝕜 E₁) → E₁, + T = ∑ i, rankOne 𝕜 (x i) (y i) := +ContinuousLinearMap.exists_sum_rankOne T + +theorem LinearMap.exists_sum_rankOne [FiniteDimensional 𝕜 E₁] [FiniteDimensional 𝕜 E₂] + (T : E₁ →ₗ[𝕜] E₂) : + ∃ (x : Fin (Module.finrank 𝕜 E₁) × Fin (Module.finrank 𝕜 E₂) → E₂) + (y : Fin (Module.finrank 𝕜 E₁) × Fin (Module.finrank 𝕜 E₂) → E₁), + T = ∑ i, ↑(rankOne 𝕜 (x i) (y i)) := +by + obtain ⟨a, b, h⟩ := ContinuousLinearMap.exists_sum_rankOne (toContinuousLinearMap T) + refine ⟨a, b, ?_⟩ + simpa using congrArg ContinuousLinearMap.toLinearMap h + +theorem rankOne.sum_orthonormalBasis_eq_id {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] {ι : Type _} [Fintype ι] (b : OrthonormalBasis ι 𝕜 E) : + ∑ i, rankOne 𝕜 (b i) (b i) = 1 := +by + rw [ContinuousLinearMap.ext_iff] + intros + apply @ext_inner_left 𝕜 _ + intro v + simp_rw [ContinuousLinearMap.sum_apply, rankOne_apply, ← OrthonormalBasis.repr_apply_apply, + OrthonormalBasis.sum_repr, ContinuousLinearMap.one_apply] + +end rankOne + +section rankOneLm + + +/-- Same as `rankOne`, but as a linear map. -/ +abbrev rankOneLm {𝕜 E₁ E₂ : Type*} [RCLike 𝕜] [NormedAddCommGroup E₁] + [InnerProductSpace 𝕜 E₁] [NormedAddCommGroup E₂] [InnerProductSpace 𝕜 E₂] + (x : E₁) (y : E₂) : E₂ →ₗ[𝕜] E₁ := + (rankOne 𝕜 x y).toLinearMap + +variable {𝕜 E₁ E₂ : Type _} [RCLike 𝕜] [NormedAddCommGroup E₁] [InnerProductSpace 𝕜 E₁] + [NormedAddCommGroup E₂] [InnerProductSpace 𝕜 E₂] +variable {E : Type _} [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] + +theorem rankOneLm_eq_rankOne (x : E₁) (y : E₂) : + rankOneLm (𝕜 := 𝕜) x y = (rankOne 𝕜 x y).toLinearMap := + rfl + +theorem rankOne_eq_rankOneLm (x : E₁) (y : E₂) : + (rankOne 𝕜 x y : E₂ →ₗ[𝕜] E₁) = rankOneLm (𝕜 := 𝕜) x y := + rfl + +theorem rankOneLm_apply (x : E₁) (y z : E₂) : + rankOneLm (𝕜 := 𝕜) x y z = inner 𝕜 y z • x := + rankOne_apply (𝕜 := 𝕜) (x := x) (y := y) (z := z) + +theorem rankOneLm_smul (x : E₁) (y : E₂) (r : 𝕜) : + rankOneLm (𝕜 := 𝕜) (r • x) y = r • rankOneLm (𝕜 := 𝕜) x y := by + ext z + simp [rankOneLm_apply, smul_smul, mul_comm] + +theorem smul_rankOneLm (x : E₁) (y : E₂) (r : 𝕜) : + rankOneLm (𝕜 := 𝕜) x (star r • y) = r • rankOneLm (𝕜 := 𝕜) x y := by + ext z + simp [rankOneLm_apply, smul_smul, inner_smul_left] + +theorem smul_rankOneLm' (x : E₁) (y : E₂) (r : 𝕜) : + rankOneLm (𝕜 := 𝕜) x (r • y) = star r • rankOneLm (𝕜 := 𝕜) x y := by + simpa using smul_rankOneLm (𝕜 := 𝕜) x y (star r) + +theorem rankOneLm_comp_rankOneLm (x : E₁) (y z : E₂) (w : E) : + rankOneLm (𝕜 := 𝕜) x y ∘ₗ rankOneLm (𝕜 := 𝕜) z w = + inner 𝕜 y z • rankOneLm (𝕜 := 𝕜) x w := by + ext v + rw [LinearMap.comp_apply, rankOneLm_apply, rankOneLm_apply, LinearMap.smul_apply, + rankOneLm_apply, inner_smul_right, mul_smul, smul_smul] + rw [smul_smul, mul_comm] + +-- theorem rankOneLm_apply_rank_one (x : E₁) (y z : E₂) (w v : E) : +-- (rankOneLm x y : _ →ₗ[𝕜] _) ((rankOneLm z w : _ →ₗ[𝕜] _) v) = (⟪y,z⟫_𝕜 * ⟪w,v⟫_𝕜) • x := by +-- rw [← LinearMap.comp_apply, rankOneLm_comp_rankOneLm, LinearMap.smul_apply, rankOneLm_apply, +-- smul_smul] + +-- theorem rankOneLm_adjoint [FiniteDimensional 𝕜 E₁] [FiniteDimensional 𝕜 E₂] (x : E₁) (y : E₂) : +-- LinearMap.adjoint (rankOneLm x y : _ →ₗ[𝕜] _) = rankOneLm y x := +-- by +-- simp_rw [rankOneLm, LinearMap.adjoint_eq_toCLM_adjoint, +-- ContinuousLinearMap.coe_inj, ← @rankOne.adjoint 𝕜 _ _ _ _ _ _ _ +-- (FiniteDimensional.complete 𝕜 E₁) (FiniteDimensional.complete 𝕜 E₂) x y] +-- rfl + +open scoped BigOperators + + +theorem ContinuousLinearMap.ext_of_rankOne {𝕜 H₁ H₂ H' : Type _} [RCLike 𝕜] + [NormedAddCommGroup H'] [Module 𝕜 H'] + [NormedAddCommGroup H₁] [InnerProductSpace 𝕜 H₁] + [NormedAddCommGroup H₂] [InnerProductSpace 𝕜 H₂] + [FiniteDimensional 𝕜 H₁] [FiniteDimensional 𝕜 H₂] + {x y : (H₁ →L[𝕜] H₂) →L[𝕜] H'} + (h : ∀ a b, x (rankOne 𝕜 a b) = y (rankOne 𝕜 a b)) : x = y := +by + ext a + obtain ⟨α, β, rfl⟩ := ContinuousLinearMap.exists_sum_rankOne a + simp_rw [map_sum, h] + +theorem LinearMap.ext_of_rankOne {𝕜 H₁ H₂ H' : Type _} [RCLike 𝕜] [AddCommMonoid H'] [Module 𝕜 H'] + [NormedAddCommGroup H₁] [InnerProductSpace 𝕜 H₁] + [NormedAddCommGroup H₂] [InnerProductSpace 𝕜 H₂] + [FiniteDimensional 𝕜 H₁] [FiniteDimensional 𝕜 H₂] + {x y : (H₁ →L[𝕜] H₂) →ₗ[𝕜] H'} + (h : ∀ a b, x (rankOne 𝕜 a b) = y (rankOne 𝕜 a b)) : x = y := +by + ext a + obtain ⟨α, β, rfl⟩ := ContinuousLinearMap.exists_sum_rankOne a + simp_rw [map_sum, h] + +theorem AddMonoidHom.ext_of_rank_one' {𝕜 H₁ H₂ H' : Type _} [RCLike 𝕜] + [AddCommMonoid H'] [Module 𝕜 H'] + [NormedAddCommGroup H₁] [InnerProductSpace 𝕜 H₁] + [NormedAddCommGroup H₂] [InnerProductSpace 𝕜 H₂] + [FiniteDimensional 𝕜 H₁] [FiniteDimensional 𝕜 H₂] + {x y : (H₁ →ₗ[𝕜] H₂) →+ H'} + (h : ∀ a b, x (rankOne 𝕜 a b).toLinearMap = y (rankOne 𝕜 a b).toLinearMap) : + x = y := +by + ext a + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne a + simp_rw [map_sum, h] + +theorem LinearMap.ext_of_rank_one' {𝕜 H₁ H₂ H' : Type _} [RCLike 𝕜] [AddCommMonoid H'] [Module 𝕜 H'] + [NormedAddCommGroup H₁] [InnerProductSpace 𝕜 H₁] + [NormedAddCommGroup H₂] [InnerProductSpace 𝕜 H₂] + [FiniteDimensional 𝕜 H₁] [FiniteDimensional 𝕜 H₂] + {x y : (H₁ →ₗ[𝕜] H₂) →ₗ[𝕜] H'} + (h : ∀ a b, x (rankOne 𝕜 a b).toLinearMap = y (rankOne 𝕜 a b).toLinearMap) : x = y := +by + ext a + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne a + simp_rw [map_sum, h] + +open scoped BigOperators + +theorem rankOne.sum_orthonormalBasis_eq_id_lm {𝕜 : Type _} {E : Type _} [RCLike 𝕜] + [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] {ι : Type _} [Fintype ι] + (b : OrthonormalBasis ι 𝕜 E) : + ∑ i, (rankOne 𝕜 (b i) (b i) : E →L[𝕜] E).toLinearMap = 1 := +by + simp only [← ContinuousLinearMap.coe_sum, rankOne.sum_orthonormalBasis_eq_id b] + rfl + +theorem ContinuousLinearMap.coe_eq_zero {𝕜 E₁ E₂ : Type _} [RCLike 𝕜] [NormedAddCommGroup E₁] + [NormedAddCommGroup E₂] [InnerProductSpace 𝕜 E₁] [InnerProductSpace 𝕜 E₂] (f : E₁ →L[𝕜] E₂) : + (f : E₁ →ₗ[𝕜] E₂) = 0 ↔ f = 0 := by norm_cast + +theorem rankOne.left_sub {𝕜 E₁ E₂ : Type _} [RCLike 𝕜] [NormedAddCommGroup E₁] + [NormedAddCommGroup E₂] [InnerProductSpace 𝕜 E₁] [InnerProductSpace 𝕜 E₂] + (x y : E₁) (z : E₂) : + rankOne 𝕜 (x - y) z = rankOne 𝕜 x z - rankOne 𝕜 y z := by + ext w + simp [] + +theorem rankOne.smul_right_to_left {𝕜 E₁ E₂ : Type _} [RCLike 𝕜] [NormedAddCommGroup E₁] + [NormedAddCommGroup E₂] [InnerProductSpace 𝕜 E₁] [InnerProductSpace 𝕜 E₂] + (x : E₁) (y : E₂) (r : 𝕜) : + rankOne 𝕜 x (r • y) = rankOne 𝕜 (star r • x) y := by + ext w + simp [smul_smul] + +theorem rankOne.eq_zero_iff {𝕜 E₁ E₂ : Type _} [RCLike 𝕜] [NormedAddCommGroup E₁] + [NormedAddCommGroup E₂] [InnerProductSpace 𝕜 E₁] [InnerProductSpace 𝕜 E₂] + (x : E₁) (y : E₂) : + rankOne 𝕜 x y = 0 ↔ x = 0 ∨ y = 0 := by + simp_rw [ContinuousLinearMap.ext_iff, rankOne_apply, ContinuousLinearMap.zero_apply, + smul_eq_zero, forall_or_right, forall_inner_eq_zero_iff, or_comm] + +theorem LinearMap.rankOne_comp {𝕜 E₁ E₂ E₃ : Type _} [RCLike 𝕜] [NormedAddCommGroup E₁] + [NormedAddCommGroup E₂] [NormedAddCommGroup E₃] [InnerProductSpace 𝕜 E₁] + [InnerProductSpace 𝕜 E₂] [InnerProductSpace 𝕜 E₃] [FiniteDimensional 𝕜 E₂] + [FiniteDimensional 𝕜 E₃] (x : E₁) (y : E₂) (u : E₃ →ₗ[𝕜] E₂) : + (rankOne 𝕜 x y).toLinearMap ∘ₗ u = (rankOne 𝕜 x (adjoint u y)) := +by + ext + simp_rw [LinearMap.comp_apply, ContinuousLinearMap.coe_coe, rankOne_apply, + LinearMap.adjoint_inner_left] + +theorem LinearMap.rankOne_comp' {𝕜 E₁ E₂ E₃ : Type _} [RCLike 𝕜] [NormedAddCommGroup E₁] + [NormedAddCommGroup E₂] [NormedAddCommGroup E₃] [InnerProductSpace 𝕜 E₁] + [InnerProductSpace 𝕜 E₂] [InnerProductSpace 𝕜 E₃] [FiniteDimensional 𝕜 E₂] + [FiniteDimensional 𝕜 E₃] (x : E₁) (y : E₂) (u : E₂ →ₗ[𝕜] E₃) : + (rankOne 𝕜 x y).toLinearMap ∘ₗ adjoint u = (rankOne 𝕜 x (u y)) := +by rw [LinearMap.rankOne_comp, LinearMap.adjoint_adjoint] + +theorem OrthonormalBasis.orthogonalProjection'_eq_sum_rankOne {ι 𝕜 : Type _} [RCLike 𝕜] {E : Type _} + [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] [Fintype ι] {U : Submodule 𝕜 E} + [CompleteSpace U] (b : OrthonormalBasis ι 𝕜 ↥U) : + orthogonalProjection' U = ∑ i : ι, rankOne 𝕜 (b i : E) (b i : E) := +by + ext + simp_rw [orthogonalProjection'_apply, OrthonormalBasis.orthogonalProjection_apply_eq_sum b, + ContinuousLinearMap.sum_apply, rankOne_apply, Submodule.coe_sum, Submodule.coe_smul_of_tower] + +theorem LinearMap.comp_rankOne {𝕜 E₁ E₂ E₃ : Type _} [RCLike 𝕜] [NormedAddCommGroup E₁] + [NormedAddCommGroup E₂] [NormedAddCommGroup E₃] [InnerProductSpace 𝕜 E₁] + [InnerProductSpace 𝕜 E₂] + [InnerProductSpace 𝕜 E₃] (x : E₁) (y : E₂) (u : E₁ →ₗ[𝕜] E₃) : + u ∘ₗ (rankOne 𝕜 x y).toLinearMap = rankOne 𝕜 (u x) y := +by + ext + simp_rw [LinearMap.comp_apply, ContinuousLinearMap.coe_coe, rankOne_apply, _root_.map_smul] + + +theorem _root_.rankOne_smul_smul {𝕜 E₁ E₂ : Type _} [RCLike 𝕜] [NormedAddCommGroup E₁] + [NormedAddCommGroup E₂] [InnerProductSpace 𝕜 E₁] [InnerProductSpace 𝕜 E₂] + (x : E₁) (y : E₂) (r₁ r₂ : 𝕜) : + rankOne 𝕜 (r₁ • x) (star r₂ • y) = (r₁ * r₂) • rankOne 𝕜 x y := by + simp only [map_smulₛₗ, LinearMap.smul_apply, smul_smul, starRingEnd_apply, star_star, mul_comm, + RingHom.id_apply] + +theorem _root_.rankOne_lm_smul_smul {𝕜 E₁ E₂ : Type _} [RCLike 𝕜] [NormedAddCommGroup E₁] + [NormedAddCommGroup E₂] [InnerProductSpace 𝕜 E₁] [InnerProductSpace 𝕜 E₂] + (x : E₁) (y : E₂) (r₁ r₂ : 𝕜) : + (rankOne 𝕜 (r₁ • x) (star r₂ • y)).toLinearMap = + (r₁ * r₂) • ((rankOne 𝕜 x y : _ →L[𝕜] _).toLinearMap) := + by rw [rankOne_smul_smul, ContinuousLinearMap.coe_smul] + +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/ +theorem _root_.rankOne_lm_sum_sum {𝕜 E₁ E₂ : Type _} [RCLike 𝕜] [NormedAddCommGroup E₁] + [NormedAddCommGroup E₂] [InnerProductSpace 𝕜 E₁] [InnerProductSpace 𝕜 E₂] + {ι₁ ι₂ : Type _} {k : Finset ι₁} {k₂ : Finset ι₂} (f : ι₁ → E₁) (g : ι₂ → E₂) : + (rankOne 𝕜 (∑ i ∈ k, f i) (∑ i ∈ k₂, g i)).toLinearMap = + ∑ i ∈ k, ∑ j ∈ k₂, (rankOne 𝕜 (f i) (g j)).toLinearMap := +by + simp_rw [map_sum, LinearMap.sum_apply, ContinuousLinearMap.coe_sum] + rw [Finset.sum_comm] + +theorem ContinuousLinearMap.linearMap_adjoint {𝕜 B C : Type _} [RCLike 𝕜] [NormedAddCommGroup B] + [NormedAddCommGroup C] [InnerProductSpace 𝕜 B] [InnerProductSpace 𝕜 C] [FiniteDimensional 𝕜 B] + [FiniteDimensional 𝕜 C] (x : B →L[𝕜] C) : + LinearMap.adjoint (x : B →ₗ[𝕜] C) = + @ContinuousLinearMap.adjoint 𝕜 _ _ _ _ _ _ _ (FiniteDimensional.complete 𝕜 B) + (FiniteDimensional.complete 𝕜 C) x := + rfl + +theorem LinearMap.toContinuousLinearMap_adjoint {𝕜 B C : Type _} [RCLike 𝕜] [NormedAddCommGroup B] + [NormedAddCommGroup C] [InnerProductSpace 𝕜 B] [InnerProductSpace 𝕜 C] [FiniteDimensional 𝕜 B] + [FiniteDimensional 𝕜 C] {x : B →ₗ[𝕜] C} : + letI := FiniteDimensional.complete 𝕜 B + letI := FiniteDimensional.complete 𝕜 C + ContinuousLinearMap.adjoint (toContinuousLinearMap x) = + toContinuousLinearMap (LinearMap.adjoint x) := +rfl +theorem LinearMap.toContinuousLinearMap_adjoint' {𝕜 B C : Type _} [RCLike 𝕜] [NormedAddCommGroup B] + [NormedAddCommGroup C] [InnerProductSpace 𝕜 B] [InnerProductSpace 𝕜 C] [FiniteDimensional 𝕜 B] + [FiniteDimensional 𝕜 C] {x : B →ₗ[𝕜] C} : + letI := FiniteDimensional.complete 𝕜 B + letI := FiniteDimensional.complete 𝕜 C + ContinuousLinearMap.toLinearMap (ContinuousLinearMap.adjoint (toContinuousLinearMap x)) = + LinearMap.adjoint x := +rfl + +open scoped InnerProductSpace + +theorem OrthonormalBasis.repr_adjoint {ι 𝕜 E : Type*} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] [Fintype ι] (b : OrthonormalBasis ι 𝕜 E) : + letI := Module.Basis.finiteDimensional_of_finite b.toBasis + letI := FiniteDimensional.complete 𝕜 E + ContinuousLinearMap.adjoint b.repr.toContinuousLinearEquiv.toContinuousLinearMap + = b.repr.symm.toContinuousLinearEquiv.toContinuousLinearMap := +by + haveI := Module.Basis.finiteDimensional_of_finite b.toBasis + haveI := FiniteDimensional.complete 𝕜 E + ext x + apply ext_inner_left 𝕜 + intro + simp_rw [ContinuousLinearMap.adjoint_inner_right, ContinuousLinearEquiv.coe_apply, + LinearIsometryEquiv.coe_toContinuousLinearEquiv] + rw [PiLp.inner_apply] + simp_rw [OrthonormalBasis.repr_apply_apply, RCLike.inner_apply, inner_conj_symm, + ← inner_smul_right, ← inner_sum, OrthonormalBasis.sum_repr_symm] + +theorem OrthonormalBasis.repr_adjoint' + {ι 𝕜 E : Type*} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] [Fintype ι] (b : OrthonormalBasis ι 𝕜 E) : + haveI := Module.Basis.finiteDimensional_of_finite b.toBasis + haveI := FiniteDimensional.complete 𝕜 E + LinearMap.adjoint b.repr.toLinearMap + = b.repr.symm.toLinearMap := +haveI := Module.Basis.finiteDimensional_of_finite b.toBasis +haveI := FiniteDimensional.complete 𝕜 E +calc LinearMap.adjoint b.repr.toLinearMap + = ContinuousLinearMap.adjoint b.repr.toContinuousLinearEquiv.toContinuousLinearMap := rfl + _ = b.repr.symm.toContinuousLinearEquiv.toContinuousLinearMap := by rw [b.repr_adjoint] + +open scoped Matrix +theorem rankOne_toMatrix_of_onb + {ι₁ ι₂ 𝕜 E₁ E₂ : Type*} [RCLike 𝕜] [NormedAddCommGroup E₁] + [NormedAddCommGroup E₂] [InnerProductSpace 𝕜 E₁] [InnerProductSpace 𝕜 E₂] + [Fintype ι₁] [Fintype ι₂] [DecidableEq ι₂] + (b₁ : OrthonormalBasis ι₁ 𝕜 E₁) (b₂ : OrthonormalBasis ι₂ 𝕜 E₂) (x : E₁) (y : E₂) : + LinearMap.toMatrix b₂.toBasis b₁.toBasis (rankOne 𝕜 x y).toLinearMap + = + (Matrix.replicateCol (Fin 1) (b₁.repr x)) * (Matrix.replicateCol (Fin 1) (b₂.repr y))ᴴ := +by + ext1 i j + simp_rw [LinearMap.toMatrix_apply, ContinuousLinearMap.coe_coe, rankOne_apply, + map_smul, Finsupp.smul_apply, OrthonormalBasis.coe_toBasis_repr_apply, + OrthonormalBasis.coe_toBasis, + Matrix.conjTranspose_replicateCol] + simp [Matrix.mul_apply, Matrix.replicateCol_apply, Matrix.replicateRow_apply, + Pi.star_apply, OrthonormalBasis.repr_apply_apply, RCLike.star_def, inner_conj_symm, + smul_eq_mul, mul_comm] + +end rankOneLm diff --git a/LeanPool/Monlib4/LinearAlgebra/Ips/Strict.lean b/LeanPool/Monlib4/LinearAlgebra/Ips/Strict.lean new file mode 100644 index 0000000000..1bff39e44a --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Ips/Strict.lean @@ -0,0 +1,180 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.LinearAlgebra.TensorProduct.Associator +import Mathlib.Algebra.Algebra.Bilinear + +/-! +# Strict tensor product (wip) +-/ + + +variable {R E F G : Type _} [CommSemiring R] [AddCommGroup E] [AddCommGroup F] [AddCommGroup G] + [Module R E] [Module R F] [Module R G] + +open scoped TensorProduct + +@[reducible, instance] +noncomputable def TensorProduct.assocHasCoe : + CoeFun ((E ⊗[R] F) ⊗[R] G) (fun _ ↦ E ⊗[R] (F ⊗[R] G)) + where coe x := TensorProduct.assoc R E F G x + +@[reducible, instance] +noncomputable def TensorProduct.assocSymmHasCoe : + CoeFun (E ⊗[R] (F ⊗[R] G)) (fun _ ↦ (E ⊗[R] F) ⊗[R] G) + where coe x := (TensorProduct.assoc R E F G).symm x + +theorem TensorProduct.assoc_tmul_coe (a : E) (b : F) (c : G) : + (a ⊗ₜ[R] b) ⊗ₜ[R] c = ↑(a ⊗ₜ[R] (b ⊗ₜ[R] c)) := + rfl + +theorem TensorProduct.assoc_coe_coe (a : (E ⊗[R] F) ⊗[R] G) : + a = ↑(a : E ⊗[R] (F ⊗[R] G)) := by + simp only [LinearEquiv.symm_apply_apply] + +theorem TensorProduct.tmul_assoc_coe (a : E) (b : F) (c : G) : + a ⊗ₜ[R] (b ⊗ₜ[R] c) = ↑((a ⊗ₜ[R] b) ⊗ₜ[R] c) := + rfl + +theorem TensorProduct.coe_coe_assoc (a : E ⊗[R] (F ⊗[R] G)) : + a = ↑(a : (E ⊗[R] F) ⊗[R] G) := by + simp only [LinearEquiv.apply_symm_apply] + +@[reducible, instance] +noncomputable def TensorProduct.lidHasCoe : + CoeFun (R ⊗[R] E) (fun _ => E) where + coe x := TensorProduct.lid R E x + +@[reducible, instance] +noncomputable def TensorProduct.ridHasCoe : + CoeFun (E ⊗[R] R) (fun _ => E) where + coe x := TensorProduct.rid R E x + +@[reducible, instance] +noncomputable def TensorProduct.lidSymmHasCoe : + Coe E (R ⊗[R] E) where + coe x := (TensorProduct.lid R E).symm x + +@[reducible, instance] +noncomputable def TensorProduct.ridSymmHasCoe : + Coe E (E ⊗[R] R) where + coe x := (TensorProduct.rid R E).symm x + +theorem TensorProduct.lid_coe (x : E) (r : R) : + (r ⊗ₜ[R] x : R ⊗[R] E) = r • x := + by simp only [lid_symm_apply, smul_tmul', smul_eq_mul, mul_one] + +theorem TensorProduct.rid_coe (x : E) (r : R) : (x ⊗ₜ[R] r) = r • x := + by simp only [rid_symm_apply, smul_tmul', smul_tmul, smul_eq_mul, mul_one] + +theorem TensorProduct.lid_symm_coe (x : E) : (x : R ⊗[R] E) = (1 : R) ⊗ₜ[R] x := + rfl + +theorem TensorProduct.rid_symm_coe (x : E) : (x : E ⊗[R] R) = x ⊗ₜ[R] (1 : R) := + rfl + +theorem TensorProduct.lid_coe' (x : E) (r : R) : r ⊗ₜ[R] x = r • x := by + rw [TensorProduct.lid_symm_coe, TensorProduct.smul_tmul', smul_eq_mul, mul_one] + +theorem TensorProduct.rid_coe' (x : E) (r : R) : x ⊗ₜ[R] r = r • x := by + rw [TensorProduct.rid_symm_coe, TensorProduct.smul_tmul', TensorProduct.smul_tmul, smul_eq_mul, + mul_one] + +theorem TensorProduct.lid_coe_rid_coe (x : E) : + (x : R ⊗[R] E) = (x : E ⊗[R] R) := + by + simp only [LinearEquiv.apply_symm_apply] + +@[reducible, instance] +noncomputable def funTensorProductAssocHasCoe {A : Type _} : + CoeFun (((E ⊗[R] F) ⊗[R] G → A)) (fun _ => E ⊗[R] (F ⊗[R] G) → A) + where coe f x := f x + +@[reducible, instance] +noncomputable def LinearMap.tensorProductAssocHasCoe {A : Type _} [AddCommMonoid A] [Module R A] : + Coe ((E ⊗[R] F) ⊗[R] G →ₗ[R] A) (E ⊗[R] (F ⊗[R] G) →ₗ[R] A) + where coe f := + f ∘ₗ + (((TensorProduct.assoc R E F G).symm : + E ⊗[R] (F ⊗[R] G) ≃ₗ[R] (E ⊗[R] F) ⊗[R] G) : + E ⊗[R] (F ⊗[R] G) →ₗ[R] (E ⊗[R] F) ⊗[R] G) + +@[reducible, instance] +noncomputable def funTensorProductAssocHasCoe' {A : Type _} : + Coe (E ⊗[R] (F ⊗[R] G) → A) ((E ⊗[R] F) ⊗[R] G → A) + where coe f x := f x + +@[reducible, instance] +noncomputable def LinearMap.tensorProductAssocHasCoe' {A : Type _} [AddCommMonoid A] [Module R A] : + Coe (E ⊗[R] (F ⊗[R] G) →ₗ[R] A) ((E ⊗[R] F) ⊗[R] G →ₗ[R] A) + where coe f := + f ∘ₗ + ((TensorProduct.assoc R E F G : + (E ⊗[R] F) ⊗[R] G ≃ₗ[R] E ⊗[R] (F ⊗[R] G)) : + (E ⊗[R] F) ⊗[R] G →ₗ[R] E ⊗[R] (F ⊗[R] G)) + +@[reducible, instance] +noncomputable def funLidHasCoe {A : Type _} : + CoeFun (R ⊗[R] E → A) (fun _ ↦ E → A) where + coe f x := f x + +@[reducible, instance] +noncomputable def LinearMap.tensorProductLidHasCoe {A : Type _} [AddCommMonoid A] [Module R A] : + Coe (R ⊗[R] E →ₗ[R] A) (E →ₗ[R] A) where + coe f := f ∘ₗ ↑(TensorProduct.lid R E).symm + +@[reducible, instance] +noncomputable def funLidHasCoe' {A : Type _} : + Coe (E → A) (R ⊗[R] E → A) where + coe f x := f x + +@[reducible, instance] +noncomputable def LinearMap.tensorProductLidHasCoe' {A : Type _} [AddCommMonoid A] [Module R A] : + Coe (E →ₗ[R] A) (R ⊗[R] E →ₗ[R] A) where + coe f := f ∘ₗ ↑(TensorProduct.lid R E) + +@[reducible, instance] +noncomputable def funRidHasCoe {A : Type _} : + CoeFun (E ⊗[R] R → A) (fun _ => E → A) where + coe f x := f x + +@[reducible, instance] +noncomputable def LinearMap.tensorProductRidHasCoe {A : Type _} [AddCommMonoid A] [Module R A] : + Coe (E ⊗[R] R →ₗ[R] A) (E →ₗ[R] A) where + coe f := f ∘ₗ ↑(TensorProduct.rid R E).symm + +@[reducible, instance] +noncomputable def funRidHasCoe' {A : Type _} : + Coe (E → A) (E ⊗[R] R → A) where + coe f x := f x + +@[reducible, instance] +noncomputable def LinearMap.tensorProductRidHasCoe' {A : Type _} [AddCommMonoid A] [Module R A] : + Coe (E →ₗ[R] A) (E ⊗[R] R →ₗ[R] A) where + coe f := f ∘ₗ ↑(TensorProduct.rid R E) + +theorem LinearMap.lid_coe {A : Type _} [AddCommMonoid A] [Module R A] (f : E →ₗ[R] A) : + f = (f : R ⊗[R] E →ₗ[R] A) := by + simp only [LinearMap.comp_assoc, LinearEquiv.comp_coe, + LinearEquiv.symm_trans_self, LinearEquiv.refl_toLinearMap, LinearMap.comp_id] + +theorem LinearMap.lid_symm_coe {A : Type _} [AddCommMonoid A] [Module R A] (f : R ⊗[R] E →ₗ[R] A) : + f = (f : E →ₗ[R] A) := by + simp only [LinearMap.comp_assoc, LinearEquiv.comp_coe, + LinearEquiv.self_trans_symm, LinearEquiv.refl_toLinearMap, LinearMap.comp_id] + +theorem LinearMap.rid_coe {A : Type _} [AddCommMonoid A] [Module R A] (f : E →ₗ[R] A) : + f = (f : E ⊗[R] R →ₗ[R] A) := by + simp only [LinearMap.comp_assoc, LinearEquiv.comp_coe, + LinearEquiv.symm_trans_self, LinearEquiv.refl_toLinearMap, LinearMap.comp_id] + +theorem LinearMap.rid_symm_coe {A : Type _} [AddCommMonoid A] [Module R A] (f : E ⊗[R] R →ₗ[R] A) : + f = (f : E →ₗ[R] A) := by + simp only [LinearMap.comp_assoc, LinearEquiv.comp_coe, + LinearEquiv.self_trans_symm, LinearEquiv.refl_toLinearMap, LinearMap.comp_id] + +example {A : Type _} (f : E ⊗[R] (F ⊗[R] G) → A) : + f = ↑(↑f : (E ⊗[R] F) ⊗[R] G → A) := by + simp only [LinearEquiv.apply_symm_apply] diff --git a/LeanPool/Monlib4/LinearAlgebra/Ips/Symm.lean b/LeanPool/Monlib4/LinearAlgebra/Ips/Symm.lean new file mode 100644 index 0000000000..84310fd4e0 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Ips/Symm.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Analysis.InnerProductSpace.Symmetric +import Mathlib.Analysis.InnerProductSpace.Adjoint + +/-! + +# some obvious lemmas on self-adjoint operators + +This file provides the polarization identity for self adjoint continuous linear maps + over `is_R_or_C`. + +-/ + + +variable {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] + +local notation "⟪" x "," y "⟫" => @inner 𝕜 _ _ x y + +namespace ContinuousLinearMap +namespace IsSelfAdjoint + +/-- Given a self-adjoint continuous linear operator $T$ on $E$, we get + $\langle T x, x \rangle = 0$ for any $x\in E$ if and only if $T=0$. -/ +theorem inner_map_self_eq_zero [CompleteSpace E] {T : E →L[𝕜] E} (hT : IsSelfAdjoint T) : + (∀ x, ⟪T x,x⟫ = 0) ↔ T = 0 := + by + simp_rw [ContinuousLinearMap.ext_iff, ← ContinuousLinearMap.coe_coe, ← LinearMap.ext_iff, + coe_zero] + simp_rw [isSelfAdjoint_iff_isSymmetric] at hT + exact hT.inner_map_self_eq_zero + +open RCLike + +/-- The polarization identity for self-adjoint operators. -/ +theorem inner_map_polarization [CompleteSpace E] {T : E →L[𝕜] E} (hT : IsSelfAdjoint T) + (x y : E) : + ⟪T x,y⟫ = + (⟪T (x + y),x + y⟫ - ⟪T (x - y),x - y⟫ - I * ⟪T (x + (I : 𝕜) • y),x + (I : 𝕜) • y⟫ + + I * ⟪T (x - (I : 𝕜) • y),x - (I : 𝕜) • y⟫) / + 4 := + by + rw [← ContinuousLinearMap.coe_coe, + LinearMap.IsSymmetric.inner_map_polarization (IsSelfAdjoint.isSymmetric hT)] + + +end IsSelfAdjoint +end ContinuousLinearMap diff --git a/LeanPool/Monlib4/LinearAlgebra/Ips/TensorHilbert.lean b/LeanPool/Monlib4/LinearAlgebra/Ips/TensorHilbert.lean new file mode 100644 index 0000000000..7e493be3c6 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Ips/TensorHilbert.lean @@ -0,0 +1,207 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Analysis.InnerProductSpace.TensorProduct +import Mathlib.LinearAlgebra.FiniteDimensional.Defs + +/-! + +# Tensor product of inner product spaces + +Compatibility lemmas for Monlib's tensor-product inner-product API. The core +inner product space structure now lives in Mathlib. + +-/ + +open scoped TensorProduct BigOperators + +namespace TensorProduct + +variable {𝕜 E F G H : Type*} [RCLike 𝕜] + [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] + [NormedAddCommGroup F] [InnerProductSpace 𝕜 F] + [NormedAddCommGroup G] [InnerProductSpace 𝕜 G] + [NormedAddCommGroup H] [InnerProductSpace 𝕜 H] + +/-- Compatibility alias for Monlib's named tensor-product inner structure. -/ +noncomputable abbrev Inner : _root_.Inner 𝕜 (E ⊗[𝕜] F) := + inferInstance + +/-- Compatibility alias for Monlib's named tensor-product normed additive group. -/ +noncomputable abbrev normedAddCommGroup : NormedAddCommGroup (E ⊗[𝕜] F) := + inferInstance + +/-- Compatibility alias for Monlib's named tensor-product inner product space. -/ +noncomputable abbrev innerProductSpace : InnerProductSpace 𝕜 (E ⊗[𝕜] F) := + inferInstance + +/-- Inner products distribute over addition on the left in a tensor product. -/ +protected theorem inner_add_left (x y z : E ⊗[𝕜] F) : + inner 𝕜 (x + y) z = inner 𝕜 x z + inner 𝕜 y z := + inner_add_left x y z + +/-- The inner product with zero on the right is zero in a tensor product. -/ +protected theorem inner_zero_right (x : E ⊗[𝕜] F) : + inner 𝕜 x (0 : E ⊗[𝕜] F) = 0 := + inner_zero_right x + +/-- Conjugate symmetry of the tensor-product inner product. -/ +protected theorem inner_conj_symm (x y : E ⊗[𝕜] F) : + starRingEnd 𝕜 (inner 𝕜 x y) = inner 𝕜 y x := + inner_conj_symm y x + +/-- The inner product with zero on the left is zero in a tensor product. -/ +protected theorem inner_zero_left (x : E ⊗[𝕜] F) : + inner 𝕜 (0 : E ⊗[𝕜] F) x = 0 := + inner_zero_left x + +/-- Inner products distribute over addition on the right in a tensor product. -/ +protected theorem inner_add_right (x y z : E ⊗[𝕜] F) : + inner 𝕜 x (y + z) = inner 𝕜 x y + inner 𝕜 x z := + inner_add_right x y z + +/-- A finite sum in the left argument may be pulled out of the tensor-product inner product. -/ +protected theorem inner_sum {n : Type*} [Fintype n] (x : n → E ⊗[𝕜] F) + (y : E ⊗[𝕜] F) : inner 𝕜 (∑ i, x i) y = ∑ i, inner 𝕜 (x i) y := by + simpa using (sum_inner (𝕜 := 𝕜) Finset.univ x y) + +/-- A finite sum in the right argument may be pulled out of the tensor-product inner product. -/ +protected theorem sum_inner {n : Type*} [Fintype n] (y : E ⊗[𝕜] F) + (x : n → E ⊗[𝕜] F) : inner 𝕜 y (∑ i, x i) = ∑ i, inner 𝕜 y (x i) := by + simpa using (inner_sum (𝕜 := 𝕜) Finset.univ x y) + +/-- The real part of `⟪x, x⟫` is nonnegative in a tensor product. -/ +protected theorem inner_nonneg_re (x : E ⊗[𝕜] F) : + 0 ≤ RCLike.re (inner 𝕜 x x) := + inner_self_nonneg + +/-- A tensor-product element can be expanded as a finite sum of pure tensors. -/ +theorem eq_span {𝕜 E F : Type*} [RCLike 𝕜] [AddCommGroup E] [Module 𝕜 E] + [AddCommGroup F] [Module 𝕜 F] [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] + (x : E ⊗[𝕜] F) : + ∃ (α : Module.Basis.ofVectorSpaceIndex 𝕜 E × Module.Basis.ofVectorSpaceIndex 𝕜 F → E) + (β : Module.Basis.ofVectorSpaceIndex 𝕜 E × Module.Basis.ofVectorSpaceIndex 𝕜 F → F), + ∑ i, α i ⊗ₜ[𝕜] β i = x := by + let b₁ := Module.Basis.ofVectorSpace 𝕜 E + let b₂ := Module.Basis.ofVectorSpace 𝕜 F + rw [← Module.Basis.sum_repr (b₁.tensorProduct b₂) x] + simp_rw [Module.Basis.tensorProduct_apply', TensorProduct.smul_tmul'] + exact ⟨fun i => ((b₁.tensorProduct b₂).repr x) i • b₁ i.fst, fun i => b₂ i.snd, rfl⟩ + +variable [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] + [FiniteDimensional 𝕜 G] [FiniteDimensional 𝕜 H] + +/-- The adjoint of the left unitor is its inverse. -/ +theorem lid_adjoint : + LinearMap.adjoint (TensorProduct.lid 𝕜 E).toLinearMap = + (TensorProduct.lid 𝕜 E).symm.toLinearMap := by + simpa [TensorProduct.toLinearEquiv_lidIsometry] using + LinearIsometryEquiv.adjoint_toLinearMap_eq_symm (TensorProduct.lidIsometry 𝕜 E) + +/-- The adjoint of the symmetry is its inverse. -/ +theorem comm_adjoint : + LinearMap.adjoint (TensorProduct.comm 𝕜 E F).toLinearMap = + (TensorProduct.comm 𝕜 E F).symm.toLinearMap := by + simpa [TensorProduct.toLinearEquiv_commIsometry] using + LinearIsometryEquiv.adjoint_toLinearMap_eq_symm (TensorProduct.commIsometry 𝕜 E F) + +/-- The adjoint of the associator is its inverse. -/ +theorem assoc_adjoint : + LinearMap.adjoint (TensorProduct.assoc 𝕜 E F G).toLinearMap = + (TensorProduct.assoc 𝕜 E F G).symm.toLinearMap := by + simpa [TensorProduct.toLinearEquiv_assocIsometry] using + LinearIsometryEquiv.adjoint_toLinearMap_eq_symm (TensorProduct.assocIsometry 𝕜 E F G) + +/-- The adjoint of the inverse associator is the associator. -/ +theorem assoc_symm_adjoint : + LinearMap.adjoint ((TensorProduct.assoc 𝕜 E F G).symm).toLinearMap = + (TensorProduct.assoc 𝕜 E F G).toLinearMap := by + simpa [TensorProduct.toLinearEquiv_assocIsometry] using + LinearIsometryEquiv.adjoint_toLinearMap_eq_symm (TensorProduct.assocIsometry 𝕜 E F G).symm + +/-- The adjoint of a tensor map is the tensor map of the adjoints. -/ +theorem map_adjoint (f : E →ₗ[𝕜] F) (g : G →ₗ[𝕜] H) : + LinearMap.adjoint (TensorProduct.map f g) = + TensorProduct.map (LinearMap.adjoint f) (LinearMap.adjoint g) := + TensorProduct.adjoint_map f g + +/-- The adjoint of the inverse left unitor is the left unitor. -/ +theorem lid_symm_adjoint : + LinearMap.adjoint (TensorProduct.lid 𝕜 E).symm.toLinearMap = + (TensorProduct.lid 𝕜 E).toLinearMap := by + simpa [TensorProduct.toLinearEquiv_lidIsometry] using + LinearIsometryEquiv.adjoint_toLinearMap_eq_symm (TensorProduct.lidIsometry 𝕜 E).symm + +/-- The adjoint of the inverse symmetry is the symmetry. -/ +theorem comm_symm_adjoint : + LinearMap.adjoint (TensorProduct.comm 𝕜 E F).symm.toLinearMap = + (TensorProduct.comm 𝕜 E F).toLinearMap := by + simpa [TensorProduct.toLinearEquiv_commIsometry] using + LinearIsometryEquiv.adjoint_toLinearMap_eq_symm (TensorProduct.commIsometry 𝕜 E F).symm + +omit [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] in +/-- Equality of tensor-product elements can be tested against pure tensors. -/ +theorem inner_ext_iff' (x y : E ⊗[𝕜] F) : + x = y ↔ ∀ (a : E) (b : F), inner 𝕜 x (a ⊗ₜ[𝕜] b) = inner 𝕜 y (a ⊗ₜ[𝕜] b) := + TensorProduct.ext_iff_inner_right (x := x) (y := y) + +omit [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] in +/-- Equality of pure tensors can be tested against pure tensors. -/ +theorem inner_ext_iff (x z : E) (y w : F) : + x ⊗ₜ[𝕜] y = z ⊗ₜ[𝕜] w ↔ + ∀ (a : E) (b : F), + inner 𝕜 (x ⊗ₜ[𝕜] y) (a ⊗ₜ[𝕜] b) = + inner 𝕜 (z ⊗ₜ[𝕜] w) (a ⊗ₜ[𝕜] b) := + TensorProduct.ext_iff_inner_right (x := x ⊗ₜ[𝕜] y) (y := z ⊗ₜ[𝕜] w) + +omit [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] in +/-- A tensor is zero iff its inner product against every pure tensor is zero. -/ +theorem forall_inner_eq_zero (x : E ⊗[𝕜] F) : + (∀ (a : E) (b : F), inner 𝕜 x (a ⊗ₜ[𝕜] b) = 0) ↔ x = 0 := by + constructor + · intro h + rw [TensorProduct.inner_ext_iff' x 0] + intro a b + simp [h a b] + · intro hx a b + simp [hx] + +omit [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] + [FiniteDimensional 𝕜 G] [FiniteDimensional 𝕜 H] in +/-- Equality in a fourfold tensor product can be tested against pure tensors. -/ +theorem inner_ext_fourfold_iff' (x y : (E ⊗[𝕜] F) ⊗[𝕜] (G ⊗[𝕜] H)) : + x = y ↔ ∀ (a : E) (b : F) (c : G) (d : H), + inner 𝕜 x ((a ⊗ₜ[𝕜] b) ⊗ₜ[𝕜] (c ⊗ₜ[𝕜] d)) = + inner 𝕜 y ((a ⊗ₜ[𝕜] b) ⊗ₜ[𝕜] (c ⊗ₜ[𝕜] d)) := by + constructor + · intro h a b c d + rw [h] + · intro h + rw [TensorProduct.ext_iff_inner_right] + intro p q + induction p with + | zero => simp + | tmul a b => + induction q with + | zero => simp + | tmul c d => exact h a b c d + | add q₁ q₂ hq₁ hq₂ => simp [TensorProduct.tmul_add, inner_add_right, hq₁, hq₂] + | add p₁ p₂ hp₁ hp₂ => simp [TensorProduct.add_tmul, inner_add_right, hp₁, hp₂] + +omit [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] + [FiniteDimensional 𝕜 G] [FiniteDimensional 𝕜 H] in +/-- A fourfold tensor is zero iff its inner product against every pure tensor is zero. -/ +theorem forall_fourfold_inner_eq_zero (x : (E ⊗[𝕜] F) ⊗[𝕜] (G ⊗[𝕜] H)) : + (∀ (a : E) (b : F) (c : G) (d : H), + inner 𝕜 x ((a ⊗ₜ[𝕜] b) ⊗ₜ[𝕜] (c ⊗ₜ[𝕜] d)) = 0) ↔ x = 0 := by + constructor + · intro h + rw [TensorProduct.inner_ext_fourfold_iff'] + intro a b c d + simp [h] + · intro hx a b c d + simp [hx] + +end TensorProduct diff --git a/LeanPool/Monlib4/LinearAlgebra/Ips/Vn.lean b/LeanPool/Monlib4/LinearAlgebra/Ips/Vn.lean new file mode 100644 index 0000000000..f34420612c --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Ips/Vn.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.LinearAlgebra.InvariantSubmodule +import LeanPool.Monlib4.LinearAlgebra.Ips.Basic +import LeanPool.Monlib4.LinearAlgebra.Ips.Ips +import Mathlib.Analysis.VonNeumannAlgebra.Basic +import LeanPool.Monlib4.LinearAlgebra.Ips.MinimalProj +import LeanPool.Monlib4.LinearAlgebra.Ips.RankOne + +/-! + +# A bit on von Neumann algebras + +This file contains two simple results about von Neumann algebras. + +-/ + + +namespace VonNeumannAlgebra + +variable {H : Type _} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +lemma star_commutant_iff {M : VonNeumannAlgebra H} {e : H →L[ℂ] H} : + star e ∈ M.commutant ↔ e ∈ M.commutant := +by + simp only [mem_commutant_iff] + constructor + · rintro h g hg + have : star g ∈ M := by aesop + specialize h (star g) this + simp_rw [← star_mul, star_inj] at h + exact h.symm + · rintro h g hg + have : star g ∈ M := by aesop + specialize h (star g) this + rw [← star_star g] + simp_rw [← star_mul, h] + +/-- a continuous linear map `e` is in the von Neumann algebra `M` +if and only if `e.ker` and `e.range` are `M'` +(i.e., the commutant of `M` or `M.centralizer`) invariant subspaces -/ +theorem elem_idempotent_iff_ker_and_range_invariantUnder_commutant (M : VonNeumannAlgebra H) + (e : H →L[ℂ] H) (h : IsIdempotentElem e) : + e ∈ M ↔ ∀ y : H →L[ℂ] H, y ∈ M.commutant → + (LinearMap.ker e.toLinearMap).InvariantUnder y.toLinearMap ∧ + (LinearMap.range e.toLinearMap).InvariantUnder y.toLinearMap := + by + simp_rw [Submodule.invariantUnder_iff, Set.subset_def, + ContinuousLinearMap.coe_coe, Set.mem_image, SetLike.mem_coe, LinearMap.mem_ker, + LinearMap.mem_range, forall_exists_index, and_imp, + forall_apply_eq_imp_iff₂] + constructor + · intro he y hy + have : e.comp y = y.comp e := + by + rw [← VonNeumannAlgebra.commutant_commutant M, VonNeumannAlgebra.mem_commutant_iff] at he + exact (he y hy).symm + exact + ⟨fun x hx => by + have hxy := congrArg (fun f : H →L[ℂ] H => f x) this + change e (y x) = y (e x) at hxy + change e x = 0 at hx + change e (y x) = 0 + rw [hxy, hx, map_zero], + fun u ⟨v, hv⟩ => by + refine ⟨y v, ?_⟩ + have hxy := congrArg (fun f : H →L[ℂ] H => f v) this + change e (y v) = y (e v) at hxy + change e v = u at hv + change e (y v) = y u + rw [hxy, hv]⟩ + · intro H' + rw [← VonNeumannAlgebra.commutant_commutant M] + intro m hm; ext x + obtain ⟨v, w, hvw, _⟩ := + Submodule.existsUnique_add_of_isCompl + (IsIdempotentElem.isCompl_range_ker (IsIdempotentElem.clm_to_lm.mp h)) x + obtain ⟨y, hy⟩ := SetLike.coe_mem w + simp_rw [ContinuousLinearMap.coe_coe] at hy + simp_rw [Set.mem_union, Set.mem_star, SetLike.mem_coe, + star_commutant_iff, or_self] at hm + have hv_ker : e (v : H) = 0 := LinearMap.map_coe_ker e.toLinearMap v + have hw_fixed : e (w : H) = w := by + rw [← hy, ← ContinuousLinearMap.mul_apply e e, IsIdempotentElem.eq h, hy] + have hmv_ker : e (m (v : H)) = 0 := (H' m hm).1 (v : H) hv_ker + have hmw_fixed : e (m (w : H)) = m w := by + obtain ⟨p, hp⟩ := (H' m hm).2 (w : H) ⟨y, hy⟩ + rw [← hp] + change (e * e) p = e p + rw [IsIdempotentElem.eq h] + calc + (m * e) x = m (e ((v : H) + w)) := by + rw [← hvw] + rfl + _ = m (w : H) := by + rw [map_add, hv_ker, hw_fixed, zero_add] + _ = e (m ((v : H) + w)) := by + rw [map_add, map_add, hmv_ker, hmw_fixed, zero_add] + _ = (e * m) x := by + rw [hvw] + rfl + +/-- The algebra of all bounded linear operators on a Hilbert space as a von Neumann algebra. -/ +def ofHilbertSpace : VonNeumannAlgebra H + where + carrier := Set.univ + mul_mem' _ _ := Set.mem_univ _ + add_mem' _ _ := Set.mem_univ _ + star_mem' _ := Set.mem_univ _ + algebraMap_mem' _ := Set.mem_univ _ + centralizer_centralizer' := ContinuousLinearMap.centralizer_centralizer + +end VonNeumannAlgebra diff --git a/LeanPool/Monlib4/LinearAlgebra/IsProj'.lean b/LeanPool/Monlib4/LinearAlgebra/IsProj'.lean new file mode 100644 index 0000000000..8ade10db3b --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/IsProj'.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import Mathlib.Analysis.InnerProductSpace.Projection.Submodule + +/-! + # is_proj' + +This file contains the definition of `linear_map.is_proj'` and lemmas relating to it, which is +essentially `linear_map.is_proj` but as a linear map from `E` to `U`. +-/ + +section + +variable {R E : Type _} [Ring R] [AddCommGroup E] [Module R E] {U : Submodule R E} + +/-- `linear_map.is_proj` but as a linear map from `E` to `U`. -/ +def isProj' {p : E →ₗ[R] E} (hp : LinearMap.IsProj U p) : E →ₗ[R] U + where + toFun x := ⟨p x, hp.1 x⟩ + map_add' x y := by simp_rw [map_add, AddMemClass.mk_add_mk] + map_smul' r x := by simp_rw [LinearMap.map_smul, RingHom.id_apply, SetLike.mk_smul_mk] + +theorem isProj'_apply {p : E →ₗ[R] E} (hp : LinearMap.IsProj U p) (x : E) : ↑(isProj' hp x) = p x := + rfl + +theorem isProj'_eq {p : E →ₗ[R] E} (hp : LinearMap.IsProj U p) : ∀ x : U, isProj' hp (x : E) = x := + by + intro x + ext + simp_rw [isProj'_apply, LinearMap.IsProj.map_id hp _ (SetLike.coe_mem x)] + +end + +variable {E 𝕜 : Type _} [RCLike 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] + +theorem orthogonalProjection_eq_linear_proj' {K : Submodule 𝕜 E} [K.HasOrthogonalProjection] : + (K.orthogonalProjection : E →ₗ[𝕜] K) = + Submodule.linearProjOfIsCompl K _ Submodule.isCompl_orthogonal_of_hasOrthogonalProjection := + Submodule.toLinearMap_orthogonalProjection_eq_linearProjOfIsCompl + +theorem orthogonalProjection_eq_linear_proj'' + {K : Submodule 𝕜 E} [K.HasOrthogonalProjection] (x : E) : + K.orthogonalProjection x = + Submodule.linearProjOfIsCompl K _ Submodule.isCompl_orthogonal_of_hasOrthogonalProjection x := + Submodule.orthogonalProjection_apply_eq_linearProjOfIsCompl x + +/-- The orthogonal projection onto a submodule as an endomorphism of the ambient space. -/ +noncomputable def orthogonalProjection' + (U : Submodule 𝕜 E) [U.HasOrthogonalProjection] : E →L[𝕜] E := + U.starProjection + +theorem orthogonalProjection'_apply (U : Submodule 𝕜 E) [U.HasOrthogonalProjection] (x : E) : + orthogonalProjection' U x = U.orthogonalProjection x := + rfl + +local notation "P" => Submodule.orthogonalProjection + +local notation "↥P" => orthogonalProjection' + +namespace orthogonalProjection + +theorem range (U : Submodule 𝕜 E) [U.HasOrthogonalProjection] : + (↥P U).range = U := + Submodule.range_starProjection U + +end orthogonalProjection + +@[simp] +theorem orthogonalProjection'_eq (U : Submodule 𝕜 E) [U.HasOrthogonalProjection] : + ↥P U = U.subtypeL.comp (P U) := + rfl + +theorem orthogonal_projection'_eq_linear_proj {K : Submodule 𝕜 E} [K.HasOrthogonalProjection] : + (K.subtypeL.comp K.orthogonalProjection : E →ₗ[𝕜] E) = + (K.subtype).comp + (K.linearProjOfIsCompl Kᗮ + Submodule.isCompl_orthogonal_of_hasOrthogonalProjection) := + by simpa [Submodule.starProjection, Submodule.IsCompl.projection] using + Submodule.toLinearMap_starProjection_eq_isComplProjection (K := K) + +theorem orthogonalProjection'_eq_linear_proj' + {K : Submodule 𝕜 E} [K.HasOrthogonalProjection] (x : E) : + (orthogonalProjection' K : E →ₗ[𝕜] E) x = + (K.subtype).comp + (K.linearProjOfIsCompl Kᗮ + Submodule.isCompl_orthogonal_of_hasOrthogonalProjection) x := + by + rw [← orthogonal_projection'_eq_linear_proj] + rfl diff --git a/LeanPool/Monlib4/LinearAlgebra/IsReal.lean b/LeanPool/Monlib4/LinearAlgebra/IsReal.lean new file mode 100644 index 0000000000..133701ff09 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/IsReal.lean @@ -0,0 +1,247 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import Mathlib.Algebra.Algebra.Basic +import Mathlib.Algebra.Algebra.Bilinear +import Mathlib.Algebra.Algebra.Spectrum.Basic +import Mathlib.Algebra.Star.BigOperators +import Mathlib.Algebra.Star.StarAlgHom +import Mathlib.Analysis.InnerProductSpace.Basic +import Mathlib.Analysis.RCLike.Basic +import LeanPool.Monlib4.LinearAlgebra.End + +/-! +# Real Linear Maps + +This file defines `LinearMap.real`, the star-conjugate of a linear map, +`φ.real x = star (φ (star x))`. A map is real, equivalently star-preserving, +when `φ = φ.real`. +-/ + +/-- A function-like map is real if it commutes with star. -/ +def LinearMap.IsReal {M₁ M₂ : Type*} {F : Type*} [FunLike F M₁ M₂] + [Star M₁] [Star M₂] (φ : F) : Prop := + ∀ x, φ (star x) = star (φ x) + +@[simp] +theorem starHomClass.linearMap_isReal {M₁ M₂ : Type*} {F : Type*} [FunLike F M₁ M₂] + [Star M₁] [Star M₂] [StarHomClass F M₁ M₂] (φ : F) : + LinearMap.IsReal φ := by + intro + simp only [map_star] + +section Sec + +variable {E F K : Type _} [AddCommMonoid E] [StarAddMonoid E] [AddCommMonoid F] + [StarAddMonoid F] + +/-- The star-conjugate of a linear map. -/ +@[simps!] +def LinearMap.real + [Semiring K] [Module K E] [Module K F] + [InvolutiveStar K] [StarModule K E] [StarModule K F] (φ : E →ₗ[K] F) : + E →ₗ[K] F where + toFun x := star (φ (star x)) + map_add' _ _ := by simp only [star_add, map_add] + map_smul' _ _ := by simp only [star_smul, _root_.map_smul, star_star, RingHom.id_apply] + +/-- Star-conjugating a linear map is a semilinear involution. -/ +@[simps! apply_apply] +def LinearMap.realSLinearEquiv + [CommSemiring K] [Module K E] [Module K F] + [StarRing K] [StarModule K E] [StarModule K F] : + (E →ₗ[K] F) ≃ₛₗ[starRingEnd K] (E →ₗ[K] F) where + toFun φ := φ.real + invFun φ := φ.real + left_inv _ := by + ext + simp only [star_star, real_apply] + right_inv _ := by + ext + simp only [star_star, real_apply] + map_add' _ _ := by + ext + simp only [LinearMap.add_apply, star_add, real_apply] + map_smul' _ _ := by + ext + simp only [LinearMap.smul_apply, star_smul, real_apply] + rfl + +variable [Semiring K] [Module K E] [Module K F] + [InvolutiveStar K] [StarModule K E] [StarModule K F] + +@[simp] +theorem LinearMap.real_add (f g : E →ₗ[K] F) : (f + g).real = f.real + g.real := by + ext + simp only [LinearMap.real_apply, LinearMap.add_apply, star_add] + +open scoped BigOperators + +@[simp] +theorem LinearMap.real_sum {n : Type _} {s : Finset n} (f : n → E →ₗ[K] F) : + (∑ i ∈ s, f i).real = ∑ i ∈ s, (f i).real := by + ext + simp only [LinearMap.real_apply, LinearMap.sum_apply, star_sum] + +@[simp] +theorem LinearMap.real_real (f : E →ₗ[K] F) : f.real.real = f := by + ext + simp only [LinearMap.real_apply, star_star] + +theorem LinearMap.isReal_iff (φ : E →ₗ[K] F) : + IsReal φ ↔ real φ = φ := by + simp_rw [LinearMap.IsReal, LinearMap.ext_iff, LinearMap.real_apply, + @eq_star_iff_eq_star _ _ (φ (star _)), eq_comm] + +theorem LinearMap.real_of_isReal {φ : E →ₗ[K] F} + (hφ : LinearMap.IsReal φ) : + φ.real = φ := + (LinearMap.isReal_iff φ).mp hφ + +open scoped BigOperators + +@[simp] +theorem LinearMap.real_comp + {G : Type _} [AddCommMonoid G] [StarAddMonoid G] [Module K G] + [StarModule K G] (f : E →ₗ[K] F) (g : G →ₗ[K] E) : + (f ∘ₗ g).real = f.real ∘ₗ g.real := by + ext + simp only [LinearMap.real_apply, LinearMap.comp_apply, star_star] + +theorem LinearMap.real_starAlgEquiv_conj {E K F : Type _} [CommSemiring K] [Semiring E] + [Semiring F] [Algebra K E] [Algebra K F] + [InvolutiveStar K] [StarAddMonoid E] [StarAddMonoid F] + [StarModule K E] [StarModule K F] + (f : E →ₗ[K] E) (φ : E ≃⋆ₐ[K] F) : + (φ.toAlgEquiv.toLinearMap ∘ₗ + f ∘ₗ φ.symm.toAlgEquiv.toLinearMap).real = + φ.toAlgEquiv.toLinearMap ∘ₗ + f.real ∘ₗ φ.symm.toAlgEquiv.toLinearMap := by + ext x + simp only [LinearMap.real_apply, LinearMap.comp_apply, AlgEquiv.toLinearMap_apply] + change star (φ (f (φ.symm (star x)))) = φ (star (f (star (φ.symm x)))) + rw [← map_star φ] + congr 1 + rw [map_star] + +theorem LinearMap.real_starAlgEquiv_conj_iff + {E F K : Type _} [CommSemiring K] [Semiring E] [Semiring F] + [Algebra K E] [Algebra K F] + [InvolutiveStar K] [StarAddMonoid E] [StarAddMonoid F] + [StarModule K E] [StarModule K F] (f : E →ₗ[K] E) + (φ : E ≃⋆ₐ[K] F) : + LinearMap.IsReal (φ.toAlgEquiv.toLinearMap ∘ₗ + f ∘ₗ φ.symm.toAlgEquiv.toLinearMap) ↔ + LinearMap.IsReal f := by + rw [LinearMap.isReal_iff, LinearMap.isReal_iff, LinearMap.real_starAlgEquiv_conj] + constructor + · intro h + ext x + have hx := LinearMap.congr_fun h (φ x) + simpa using φ.injective hx + · intro h + ext x + simp [h] + +/-- Star-conjugation as a ring equivalence of linear endomorphisms. -/ +def LinearMap.realRingEquiv {R E : Type _} [Semiring R] [AddCommMonoid E] + [StarAddMonoid E] [Module R E] [InvolutiveStar R] [StarModule R E] : + (E →ₗ[R] E) ≃+* (E →ₗ[R] E) where + toFun f := f.real + invFun f := f.real + map_add' _ _ := real_add _ _ + map_mul' _ _ := LinearMap.real_comp _ _ + left_inv _ := real_real _ + right_inv _ := real_real _ + +theorem LinearMap.mulRight_real {E K : Type _} [CommSemiring K] [NonUnitalSemiring E] + [InvolutiveStar K] [StarRing E] [Module K E] [StarModule K E] [SMulCommClass K E E] + [IsScalarTower K E E] (x : E) : + (mulRight K x).real = mulLeft K (star x) := by + ext u + simp_rw [LinearMap.real_apply, LinearMap.mulRight_apply, LinearMap.mulLeft_apply, star_mul, + star_star] + +theorem LinearMap.mulLeft_real {E K : Type _} [CommSemiring K] [NonUnitalSemiring E] + [InvolutiveStar K] [StarRing E] [Module K E] [StarModule K E] [SMulCommClass K E E] + [IsScalarTower K E E] (x : E) : + (mulLeft K x).real = mulRight K (star x) := by + ext u + simp_rw [LinearMap.real_apply, LinearMap.mulRight_apply, LinearMap.mulLeft_apply, star_mul, + star_star] + +end Sec + +variable {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] + [StarAddMonoid E] [StarModule 𝕜 E] + +theorem LinearMap.real.spectrum [FiniteDimensional 𝕜 E] + (φ : E →ₗ[𝕜] E) : + spectrum 𝕜 φ.real = star (spectrum 𝕜 φ) := by + ext + simp_rw [Set.mem_star, ← Module.End.hasEigenvalue_iff_mem_spectrum, + ← Module.End.has_eigenvector_iff_hasEigenvalue, LinearMap.real_apply, + star_eq_iff_star_eq, star_smul] + constructor <;> rintro ⟨v, ⟨h, hv⟩⟩ + · exact ⟨star v, h.symm, star_ne_zero.mpr hv⟩ + · refine ⟨star v, ?_, star_ne_zero.mpr hv⟩ + rw [star_star] + exact h.symm + +theorem LinearMap.real.eigenspace {E : Type _} [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] [StarAddMonoid E] [StarModule 𝕜 E] + (φ : E →ₗ[𝕜] E) (α : 𝕜) (x : E) : + x ∈ Module.End.eigenspace φ.real α ↔ + star x ∈ Module.End.eigenspace φ (star α) := by + simp_rw [Module.End.mem_eigenspace_iff, LinearMap.real_apply, star_eq_iff_star_eq, + star_smul, eq_comm] + +theorem LinearMap.real_neg {E : Type _} {F : Type _} {K : Type _} [AddCommMonoid E] + [StarAddMonoid E] [AddCommGroup F] [StarAddMonoid F] [Semiring K] [Module K E] + [Module K F] [InvolutiveStar K] [StarModule K E] [StarModule K F] + (f : E →ₗ[K] F) : (-f).real = -f.real := by + ext + simp only [LinearMap.neg_apply, LinearMap.real_apply, star_neg] + +theorem LinearMap.real_sub {E : Type _} {F : Type _} {K : Type _} [AddCommMonoid E] + [StarAddMonoid E] [AddCommGroup F] [StarAddMonoid F] [Semiring K] [Module K E] + [Module K F] [InvolutiveStar K] [StarModule K E] [StarModule K F] + (f g : E →ₗ[K] F) : + (f - g).real = f.real - g.real := by + simp_rw [sub_eq_add_neg, ← LinearMap.real_neg] + exact LinearMap.real_add _ _ + +theorem LinearMap.real_smul {E F K : Type _} [CommSemiring K] [AddCommMonoid E] + [AddCommMonoid F] [StarRing K] [StarAddMonoid E] [StarAddMonoid F] [Module K E] + [Module K F] [StarModule K E] [StarModule K F] (f : E →ₗ[K] F) (α : K) : + (α • f).real = starRingEnd K α • f.real := by + ext + simp_rw [LinearMap.real_apply, LinearMap.smul_apply, star_smul, starRingEnd_apply] + rfl + +theorem LinearMap.real_inj_eq {E F K : Type _} [Semiring K] [AddCommMonoid E] + [AddCommMonoid F] [InvolutiveStar K] [StarAddMonoid E] [StarAddMonoid F] + [Module K E] [Module K F] [StarModule K E] [StarModule K F] + (f g : E →ₗ[K] F) : + f = g ↔ f.real = g.real := by + refine ⟨fun h => by rw [h], fun h => ?_⟩ + rw [← LinearMap.real_real f, h, LinearMap.real_real] + +theorem LinearMap.isRealOne {E K : Type _} [Semiring K] [AddCommMonoid E] [Module K E] + [Star E] : + LinearMap.IsReal (1 : E →ₗ[K] E) := fun _ => rfl + +lemma LinearMap.isRealZero + {E F K : Type*} [Semiring K] [AddCommMonoid E] [AddCommMonoid F] + [Module K E] [Module K F] [Star E] [StarAddMonoid F] : + LinearMap.IsReal (0 : E →ₗ[K] F) := by + intro + simp only [zero_apply, star_zero] + +theorem LinearMap.real_one {E K : Type _} [Semiring K] [InvolutiveStar K] + [AddCommMonoid E] [StarAddMonoid E] [Module K E] [StarModule K E] : + (1 : E →ₗ[K] E).real = 1 := + (LinearMap.isReal_iff _).mp LinearMap.isRealOne diff --git a/LeanPool/Monlib4/LinearAlgebra/KroneckerToTensor.lean b/LeanPool/Monlib4/LinearAlgebra/KroneckerToTensor.lean new file mode 100644 index 0000000000..d9c31513a1 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/KroneckerToTensor.lean @@ -0,0 +1,221 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.RingTheory.MatrixAlgebra +import Mathlib.LinearAlgebra.TensorProduct.Matrix +import Mathlib.LinearAlgebra.TensorProduct.Finiteness +import LeanPool.Monlib4.LinearAlgebra.Matrix.Basic +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.FiniteDimensional + +/-! +# Kronecker product to the tensor product + +This file contains the definition of `tensorToKronecker` and +`kroneckerToTensor`, the algebra equivalences between `⊗ₜ` and `⊗ₖ`. + +-/ + + +open scoped TensorProduct BigOperators Kronecker + +section + +variable {R m n : Type _} [CommSemiring R] [Fintype m] [Fintype n] [DecidableEq m] + [DecidableEq n] + +-- set_option synthInstance.maxHeartbeats 0 in +/-- Convert a tensor of square matrices into its Kronecker-product matrix. -/ +noncomputable def TensorProduct.toKronecker : + Matrix m m R ⊗[R] Matrix n n R →ₗ[R] Matrix (m × n) (m × n) R + where + toFun x ij kl := (matrixEquivTensor _ _ _).symm x ij.2 kl.2 ij.1 kl.1 + map_add' x y := by simp_rw [_root_.map_add, Matrix.add_apply]; rfl + map_smul' r x := + by + simp only [_root_.map_smul (matrixEquivTensor n R (Matrix m m R)).symm, + Matrix.smul_apply, smul_eq_mul, RingHom.id_apply] + rfl + +theorem TensorProduct.toKronecker_apply (x : Matrix m m R) (y : Matrix n n R) : + toKronecker (x ⊗ₜ[R] y) = x ⊗ₖ y := + by + simp_rw [TensorProduct.toKronecker, LinearMap.coe_mk] + simp only [AddHom.coe_mk, matrixEquivTensor_apply_symm, Matrix.map_apply, + Algebra.algebraMap_eq_smul_one, Matrix.mul_apply, + Matrix.one_apply, smul_eq_mul, mul_ite, MulZeroClass.mul_zero, + Finset.sum_ite_eq', Finset.mem_univ, if_true, Matrix.kroneckerMap, + Matrix.smul_apply, smul_eq_mul, mul_one] + rfl + +/-- Convert a Kronecker-product matrix back to the tensor of matrix algebras. -/ +noncomputable def Matrix.kroneckerToTensorProduct : + Matrix (m × n) (m × n) R →ₗ[R] Matrix m m R ⊗[R] Matrix n n R + where + toFun x := (matrixEquivTensor n R (Matrix m m R)) fun i j k l => x (k, i) (l, j) + map_add' x y := by simp_rw [Matrix.add_apply, ← _root_.map_add]; rfl + map_smul' r x := by + simp_rw [Matrix.smul_apply, ← _root_.map_smul (matrixEquivTensor n R (Matrix m m R)), + RingHom.id_apply] + rfl + +theorem TensorProduct.toKronecker_to_tensorProduct (x : Matrix m m R ⊗[R] Matrix n n R) : + Matrix.kroneckerToTensorProduct (toKronecker x) = x := by + simp_rw [TensorProduct.toKronecker, Matrix.kroneckerToTensorProduct, LinearMap.coe_mk, + AddHom.coe_mk, AlgEquiv.apply_symm_apply] + +theorem Matrix.kroneckerToTensorProduct_apply (x : Matrix m m R) (y : Matrix n n R) : + kroneckerToTensorProduct (x ⊗ₖ y) = x ⊗ₜ[R] y := by + rw [← TensorProduct.toKronecker_apply, TensorProduct.toKronecker_to_tensorProduct] + +theorem Matrix.kroneckerToTensorProduct_toKronecker (x : Matrix (m × n) (m × n) R) : + TensorProduct.toKronecker (kroneckerToTensorProduct x) = x := by + simp_rw [Matrix.kroneckerToTensorProduct, TensorProduct.toKronecker, LinearMap.coe_mk, + AddHom.coe_mk, AlgEquiv.symm_apply_apply] + +open scoped Matrix + +theorem TensorProduct.matrix_star {R m n : Type _} [Field R] [StarRing R] + (x : Matrix m m R) (y : Matrix n n R) : star (x ⊗ₜ[R] y) = xᴴ ⊗ₜ yᴴ := + TensorProduct.star_tmul _ _ + +theorem TensorProduct.toKronecker_star {R m n : Type _} [Field R] [StarRing R] + [Fintype m] [Fintype n] [DecidableEq m] [DecidableEq n] + (x : Matrix m m R ⊗[R] Matrix n n R) : + star (toKronecker x) = toKronecker (star x) := by + obtain ⟨s, rfl⟩ := TensorProduct.exists_finset x + simp only [map_sum, star_sum, + TensorProduct.matrix_star, TensorProduct.toKronecker_apply, Matrix.star_eq_conjTranspose, + Matrix.conjTranspose_kronecker] + +open Matrix + +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j k l) -/ +theorem Matrix.kronecker_eq_sum_std_basis (x : Matrix (m × n) (m × n) R) : + x = ∑ i, ∑ j, ∑ k, ∑ l, x (i, k) (j, l) • single i j 1 ⊗ₖ single k l 1 := +by + ext a b + rcases a with ⟨a₁, a₂⟩ + rcases b with ⟨b₁, b₂⟩ + simp only [Matrix.sum_apply, Matrix.smul_apply, Matrix.kroneckerMap, Matrix.of_apply, + Matrix.single, smul_eq_mul, mul_ite, mul_one, mul_zero] + rw [Finset.sum_eq_single a₁] + · rw [Finset.sum_eq_single b₁] + · rw [Finset.sum_eq_single a₂] + · rw [Finset.sum_eq_single b₂] + · simp + · intro y _ hy + simp [hy] + · intro h + simp at h + · intro y _ hy + simp [hy] + · intro h + simp at h + · intro y _ hy + simp [hy] + · intro h + simp at h + · intro y _ hy + simp [hy] + · intro h + simp at h + +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j k l) -/ +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j k l) -/ +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j k l) -/ +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j k l) -/ +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j k l) -/ +theorem TensorProduct.matrix_eq_sum_std_basis (x : Matrix m m R ⊗[R] Matrix n n R) : + x = + ∑ i, ∑ j, ∑ k, ∑ l, + (toKronecker x) (i, k) (j, l) • single i j 1 ⊗ₜ single k l 1 := + by + rw [eq_comm] + calc + ∑ i, ∑ j, ∑ k, ∑ l, + (toKronecker x) (i, k) (j, l) • + single i j (1 : R) ⊗ₜ single k l (1 : R) = + ∑ i, ∑ j, ∑ k, ∑ l, + (toKronecker x) (i, k) (j, l) • + kroneckerToTensorProduct (toKronecker (single i j (1 : R) ⊗ₜ + single k l (1 : R))) := + by simp_rw [TensorProduct.toKronecker_to_tensorProduct] + _ = + ∑ i, ∑ j, ∑ k, ∑ l, + toKronecker x (i, k) (j, l) • + kroneckerToTensorProduct (single i j (1 : R) ⊗ₖ + single k l (1 : R)) := + by simp_rw [TensorProduct.toKronecker_apply] + _ = + kroneckerToTensorProduct (∑ i, ∑ j, ∑ k, ∑ l, + toKronecker x (i, k) (j, l) • + single i j (1 : R) ⊗ₖ + single k l (1 : R)) := + by simp_rw [map_sum, _root_.map_smul] + _ = kroneckerToTensorProduct (toKronecker x) := by rw [← Matrix.kronecker_eq_sum_std_basis] + _ = x := TensorProduct.toKronecker_to_tensorProduct _ + +-- set_option maxHeartbeats 900000 in +theorem TensorProduct.toKronecker_hMul (x y : Matrix m m R ⊗[R] Matrix n n R) : + toKronecker (x * y) = toKronecker x * toKronecker y := +x.induction_on + (by simp only [zero_mul, map_zero]) + (y.induction_on + (by simp only [mul_zero, map_zero, implies_true]) + (fun _ _ _ _ => by + simp only [Algebra.TensorProduct.tmul_mul_tmul, toKronecker_apply, Matrix.mul_kronecker_mul]) + (fun _ _ h1 h2 _ _ => by simp only [_root_.map_add, h1, h2, mul_add])) + (fun _ _ h1 h2 => by simp only [_root_.map_add, add_mul, h1, h2]) + +theorem Matrix.kroneckerToTensorProduct_hMul (x y : Matrix m m R) (z w : Matrix n n R) : + kroneckerToTensorProduct (x ⊗ₖ z * y ⊗ₖ w) = + kroneckerToTensorProduct (x ⊗ₖ z) * kroneckerToTensorProduct (y ⊗ₖ w) := + by + simp_rw [← Matrix.mul_kronecker_mul, Matrix.kroneckerToTensorProduct_apply, + Algebra.TensorProduct.tmul_mul_tmul] + +/-- Algebra equivalence from the tensor product of matrix algebras to Kronecker matrices. -/ +@[simps] +noncomputable def tensorToKronecker : + Matrix m m R ⊗[R] Matrix n n R ≃ₐ[R] Matrix (m × n) (m × n) R + where + toFun := TensorProduct.toKronecker + invFun := Matrix.kroneckerToTensorProduct + left_inv := TensorProduct.toKronecker_to_tensorProduct + right_inv := kroneckerToTensorProduct_toKronecker + map_add' _ _ := map_add _ _ _ + map_mul' := TensorProduct.toKronecker_hMul + commutes' r := by + simp only [Algebra.TensorProduct.algebraMap_apply] + simp_rw [Algebra.algebraMap_eq_smul_one] + rw [TensorProduct.toKronecker_apply, smul_kronecker, + one_kronecker_one] + +/-- Algebra equivalence from Kronecker matrices to the tensor product of matrix algebras. -/ +@[simps!] +noncomputable def kroneckerToTensor : + Matrix (m × n) (m × n) R ≃ₐ[R] Matrix m m R ⊗[R] Matrix n n R := + tensorToKronecker.symm + +theorem Matrix.kroneckerToTensorProduct_star {R m n : Type _} [Field R] [StarRing R] + [Fintype m] [Fintype n] [DecidableEq m] [DecidableEq n] + (x : Matrix (m × n) (m × n) R) : + star (kroneckerToTensorProduct x) = kroneckerToTensorProduct (star x) := by + apply_fun TensorProduct.toKronecker using AlgEquiv.injective tensorToKronecker + simp only [← TensorProduct.toKronecker_star, kroneckerToTensorProduct_toKronecker] + +theorem kroneckerToTensor_toLinearMap_eq : + (kroneckerToTensor : Matrix (n × m) (n × m) R ≃ₐ[R] _).toLinearMap = + (kroneckerToTensorProduct : Matrix (n × m) (n × m) R →ₗ[R] Matrix n n R ⊗[R] Matrix m m R) := + rfl + +theorem tensorToKronecker_toLinearMap_eq : + ((@tensorToKronecker R m n _ _ _ _ _ : + Matrix m m R ⊗[R] Matrix n n R ≃ₐ[R] _).toLinearMap : + Matrix m m R ⊗[R] Matrix n n R →ₗ[R] Matrix (m × n) (m × n) R) = + (TensorProduct.toKronecker : Matrix m m R ⊗[R] Matrix n n R →ₗ[R] Matrix (m × n) (m × n) R) := + rfl + +end diff --git a/LeanPool/Monlib4/LinearAlgebra/LinearMapOp.lean b/LeanPool/Monlib4/LinearAlgebra/LinearMapOp.lean new file mode 100644 index 0000000000..3392351bda --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/LinearMapOp.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Algebra.Opposites +import Mathlib.Algebra.Module.LinearMap.Basic +import Mathlib.Data.Opposite +import Mathlib.Algebra.Algebra.Equiv +import Mathlib.Algebra.Algebra.Opposite + +/-- Push a semilinear map between modules through the multiplicative opposite. -/ +@[simps] +def LinearMap.op {R S : Type*} [Semiring R] [Semiring S] {σ : R →+* S} + {M M₂ : Type*} [AddCommMonoid M] [AddCommMonoid M₂] [Module R M] [Module S M₂] + (f : M →ₛₗ[σ] M₂) : Mᵐᵒᵖ →ₛₗ[σ] M₂ᵐᵒᵖ where + toFun x := MulOpposite.op (f (MulOpposite.unop x)) + map_add' _ _ := by simp only [MulOpposite.unop_add, map_add, MulOpposite.op_add] + map_smul' _ _ := by simp only [MulOpposite.unop_smul, LinearMap.map_smulₛₗ, MulOpposite.op_smul] + +/-- Pull a semilinear map between opposite modules back through the multiplicative opposite. -/ +@[simps] +def LinearMap.unop {R S : Type*} [Semiring R] [Semiring S] {σ : R →+* S} + {M M₂ : Type*} [AddCommMonoid M] [AddCommMonoid M₂] [Module R M] [Module S M₂] + (f : Mᵐᵒᵖ →ₛₗ[σ] M₂ᵐᵒᵖ) : M →ₛₗ[σ] M₂ where + toFun x := MulOpposite.unop (f (MulOpposite.op x)) + map_add' _ _ := by simp only [MulOpposite.unop_add, map_add, MulOpposite.op_add] + map_smul' _ _ := by simp only [MulOpposite.unop_smul, LinearMap.map_smulₛₗ, MulOpposite.op_smul] +@[simp] +lemma LinearMap.unop_op {R S : Type*} [Semiring R] [Semiring S] {σ : R →+* S} + {M M₂ : Type*} [AddCommMonoid M] [AddCommMonoid M₂] [Module R M] [Module S M₂] + (f : Mᵐᵒᵖ →ₛₗ[σ] M₂ᵐᵒᵖ) : + f.unop.op = f := +rfl +@[simp] +lemma LinearMap.op_unop {R S : Type*} [Semiring R] [Semiring S] {σ : R →+* S} + {M M₂ : Type*} [AddCommMonoid M] [AddCommMonoid M₂] [Module R M] [Module S M₂] + (f : M →ₛₗ[σ] M₂) : + f.op.unop = f := +rfl + +@[simp] +theorem AlgEquiv.op_toLinearMap + {R A B : Type*} [CommSemiring R] [Semiring A] [Semiring B] [Algebra R A] + [Algebra R B] (f : A ≃ₐ[R] B) : + f.op.toLinearMap = f.toLinearMap.op := +rfl diff --git a/LeanPool/Monlib4/LinearAlgebra/LmulRmul.lean b/LeanPool/Monlib4/LinearAlgebra/LmulRmul.lean new file mode 100644 index 0000000000..dc42f71736 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/LmulRmul.lean @@ -0,0 +1,244 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Algebra.Algebra.Bilinear +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.BasicLemmas +import LeanPool.Monlib4.LinearAlgebra.LinearMapOp + +/-! +# lmul and rmul + +The left and right multiplication maps, copied from `LinearMap.mulLeft` and +`LinearMap.mulRight` but defined as linear maps. + +-/ + + +section + +variable {R E F : Type _} [CommSemiring R] [NonUnitalNonAssocSemiring E] + [NonUnitalNonAssocSemiring F] [Module R E] [Module R F] [SMulCommClass R E E] + [SMulCommClass R F F] [IsScalarTower R E E] [IsScalarTower R F F] + +omit [IsScalarTower R E E] [IsScalarTower R F F] in +theorem LinearMap.mulLeft_conj_of_mulEquivClass_apply + {Fn : Type*} [EquivLike Fn E F] [MulEquivClass Fn E F] + (f : Fn) (x : E) (y : F) : + f (LinearMap.mulLeft R x (EquivLike.inv f y)) = LinearMap.mulLeft R (f x) y := +by + simp_rw [LinearMap.mulLeft_apply, map_mul] + simp only [EquivLike.apply_inv_apply] + +omit [SMulCommClass R E E] [SMulCommClass R F F] in +theorem LinearMap.mulRight_conj_of_mulEquivClass_apply + {Fn : Type*} [EquivLike Fn E F] [MulEquivClass Fn E F] + (f : Fn) (x : E) (y : F) : + f (LinearMap.mulRight R x (EquivLike.inv f y)) = LinearMap.mulRight R (f x) y := +by + simp_rw [LinearMap.mulRight_apply, map_mul] + simp only [EquivLike.apply_inv_apply] + +end + +local notation "l(" x "," y ")" => y →ₗ[x] y + +variable {R H₁ H₂ : Type _} [CommSemiring R] + -- [semiring H₁] [semiring H₂] + -- [algebra R H₁] [algebra R H₂] + [NonUnitalNonAssocSemiring H₁] + [Module R H₁] [SMulCommClass R H₁ H₁] [IsScalarTower R H₁ H₁] [NonUnitalNonAssocSemiring H₂] + [Module R H₂] [SMulCommClass R H₂ H₂] [IsScalarTower R H₂ H₂] + +theorem left_module_map_iff {H₁ : Type _} [Semiring H₁] [Algebra R H₁] {x : l(R,H₁)} : + (∀ a b : H₁, x (a * b) = a * x b) ↔ x = LinearMap.mulRight R (x 1) := + by + simp_rw [LinearMap.ext_iff, LinearMap.mulRight_apply] + constructor <;> intro h <;> intros + · rw [← h, mul_one] + · rw [h, mul_assoc, ← h] + +theorem right_module_map_iff {H₂ : Type _} [Semiring H₂] [Algebra R H₂] {x : l(R,H₂)} : + (∀ a b : H₂, x (a * b) = x a * b) ↔ x = LinearMap.mulLeft R (x 1) := + by + simp_rw [LinearMap.ext_iff, LinearMap.mulLeft_apply] + constructor <;> intro h <;> intros + · rw [← h, one_mul] + · rw [h, ← mul_assoc, ← h] + +/-- The linear map sending an element to left multiplication by that element. -/ +def lmul : H₁ →ₗ[R] l(R,H₁) where + toFun x := LinearMap.mulLeft R x + map_add' x y := by + ext1 + simp only [LinearMap.mulLeft_apply, add_mul, LinearMap.add_apply] + map_smul' r x := by + ext1 + simp only [LinearMap.mulLeft_apply, LinearMap.smul_apply, RingHom.id_apply, smul_mul_assoc] + +theorem lmul_apply (x y : H₁) : (lmul x : l(R,H₁)) y = x * y := + rfl + +theorem lmul_eq_mul (x : H₁) : lmul x = LinearMap.mulLeft R x := + rfl + +theorem lmul_eq_alg_lmul {H₁ : Type _} [Semiring H₁] [Algebra R H₁] (x : H₁) : + (lmul x : l(R,H₁)) = Algebra.lmul R H₁ x := + rfl + +theorem lmul_one {H₁ : Type _} [NonAssocSemiring H₁] [Module R H₁] [SMulCommClass R H₁ H₁] + [IsScalarTower R H₁ H₁] : (lmul (1 : H₁) : l(R,H₁)) = 1 := by + ext + simp_rw [lmul_apply, Module.End.one_apply, one_mul] + +/-- The linear map sending an element to right multiplication by that element. -/ +def rmul : H₂ →ₗ[R] l(R,H₂) where + toFun x := LinearMap.mulRight R x + map_add' x y := by + ext1 + simp only [LinearMap.mulRight_apply, mul_add, LinearMap.add_apply] + map_smul' r x := by + ext1 + simp only [LinearMap.mulRight_apply, LinearMap.smul_apply, RingHom.id_apply, mul_smul_comm] + +theorem rmul_apply (x y : H₂) : (rmul x : l(R,H₂)) y = y * x := + rfl + +theorem rmul_eq_mul (x : H₂) : rmul x = LinearMap.mulRight R x := + rfl + +theorem rmul_one {H₁ : Type _} [NonAssocSemiring H₁] [Module R H₁] [SMulCommClass R H₁ H₁] + [IsScalarTower R H₁ H₁] : (rmul (1 : H₁) : l(R,H₁)) = 1 := + by + ext + simp only [rmul_apply, mul_one, Module.End.one_apply] + +open scoped TensorProduct + +local notation x " ⊗ₘ " y => TensorProduct.map x y + +/-- Tensor right multiplication on the left factor with left multiplication on the right factor. -/ +noncomputable def rmulMapLmul {R H₁ H₂ : Type*} [CommSemiring R] + [NonUnitalNonAssocSemiring H₁] [Module R H₁] [SMulCommClass R H₁ H₁] [IsScalarTower R H₁ H₁] + [NonUnitalNonAssocSemiring H₂] [Module R H₂] [SMulCommClass R H₂ H₂] [IsScalarTower R H₂ H₂] : + H₁ ⊗[R] H₂ →ₗ[R] ((H₁ ⊗[R] H₂) →ₗ[R] (H₁ ⊗[R] H₂)) := +(TensorProduct.homTensorHomMap (.id R) H₁ H₂ H₁ H₂) ∘ₗ (TensorProduct.map rmul lmul) + +theorem rmulMapLmul_apply (x : H₁) (y : H₂) : rmulMapLmul (x ⊗ₜ[R] y) = rmul x ⊗ₘ lmul y := + by + rw [rmulMapLmul, LinearMap.comp_apply, TensorProduct.map_tmul, + TensorProduct.homTensorHomMap_apply] + +theorem rmulMapLmul_one {H₁ : Type _} [NonAssocSemiring H₁] [Module R H₁] [SMulCommClass R H₁ H₁] + [IsScalarTower R H₁ H₁] {H₂ : Type _} [NonAssocSemiring H₂] [Module R H₂] + [SMulCommClass R H₂ H₂] [IsScalarTower R H₂ H₂] : rmulMapLmul (1 ⊗ₜ 1 : H₁ ⊗[R] H₂) = 1 := + by + apply TensorProduct.ext' + intro a b + simp_rw [rmulMapLmul_apply, TensorProduct.map_tmul, rmul_apply, lmul_apply, mul_one, one_mul, + Module.End.one_apply] + +open scoped BigOperators + +theorem LinearMap.mulLeft_sum {R : Type _} {A : Type _} [CommSemiring R] + [NonUnitalNonAssocSemiring A] [Module R A] [SMulCommClass R A A] [IsScalarTower R A A] + {n : Type _} {s : Finset n} {x : n → A} : + ∑ i ∈ s, LinearMap.mulLeft R (x i) = LinearMap.mulLeft R (∑ i ∈ s, x i) := +by simp_rw [← lmul_eq_mul, map_sum] + +theorem LinearMap.mulRight_sum {R : Type _} {A : Type _} [CommSemiring R] + [NonUnitalNonAssocSemiring A] [Module R A] [SMulCommClass R A A] [IsScalarTower R A A] + {n : Type _} {s : Finset n} {x : n → A} : + ∑ i ∈ s, LinearMap.mulRight R (x i) = LinearMap.mulRight R (∑ i ∈ s, x i) := +by simp_rw [← rmul_eq_mul, map_sum] + +theorem lmul_eq_zero_iff {H₁ : Type _} [Semiring H₁] [Algebra R H₁] (x : H₁) : + (lmul x : l(R,H₁)) = 0 ↔ x = 0 := + LinearMap.mulLeft_eq_zero_iff _ _ _ + +theorem rmul_eq_zero_iff {H₁ : Type _} [Semiring H₁] [Algebra R H₁] (x : H₁) : + (rmul x : l(R,H₁)) = 0 ↔ x = 0 := + LinearMap.mulRight_eq_zero_iff _ _ _ + +theorem lmul_eq_one_iff {H₁ : Type _} [NonAssocSemiring H₁] [Module R H₁] [SMulCommClass R H₁ H₁] + [IsScalarTower R H₁ H₁] (x : H₁) : (lmul x : l(R,H₁)) = 1 ↔ x = 1 := + by + simp_rw [LinearMap.ext_iff, lmul_apply, Module.End.one_apply] + refine ⟨fun h => ?_, fun h a => by rw [h, one_mul]⟩ + · specialize h 1 + rw [mul_one] at h + exact h + +theorem LinearMap.mulLeft_eq_one_iff {H₁ : Type _} [NonAssocSemiring H₁] [Module R H₁] + [SMulCommClass R H₁ H₁] [IsScalarTower R H₁ H₁] (x : H₁) : LinearMap.mulLeft R x = 1 ↔ x = 1 := + lmul_eq_one_iff _ + +theorem rmul_eq_one_iff {H₁ : Type _} [NonAssocSemiring H₁] [Module R H₁] [SMulCommClass R H₁ H₁] + [IsScalarTower R H₁ H₁] (x : H₁) : (rmul x : l(R,H₁)) = 1 ↔ x = 1 := + by + simp_rw [LinearMap.ext_iff, rmul_apply, Module.End.one_apply] + refine ⟨fun h => ?_, fun h a => by rw [h, mul_one]⟩ + · specialize h 1 + rw [one_mul] at h + exact h + +theorem LinearMap.mulRight_eq_one_iff {H₁ : Type _} [NonAssocSemiring H₁] [Module R H₁] + [SMulCommClass R H₁ H₁] [IsScalarTower R H₁ H₁] (x : H₁) : LinearMap.mulRight R x = 1 ↔ x = 1 := + rmul_eq_one_iff _ + +theorem LinearMap.mulLeft_eq_one_or_zero_iff_mulRight_tfae {H₁ : Type _} [Semiring H₁] + [Algebra R H₁] (x : H₁) (p : Prop) [Decidable p] : + List.TFAE [LinearMap.mulLeft R x = ite p 1 0, + LinearMap.mulRight R x = ite p 1 0, x = ite p 1 0] := + by + by_cases h : p + · simp_rw [h, if_true, LinearMap.mulLeft_eq_one_iff, LinearMap.mulRight_eq_one_iff] + tfae_finish + · simp_rw [h, if_false, LinearMap.mulLeft_eq_zero_iff, LinearMap.mulRight_eq_zero_iff] + tfae_finish + +theorem LinearMap.mulLeft_eq_one_or_zero_iff_mulRight {H₁ : Type _} [Semiring H₁] [Algebra R H₁] + (x : H₁) (p : Prop) [Decidable p] : + LinearMap.mulLeft R x = ite p 1 0 ↔ LinearMap.mulRight R x = ite p 1 0 := + List.TFAE.out (@LinearMap.mulLeft_eq_one_or_zero_iff_mulRight_tfae R _ H₁ _ _ x p _) 0 1 + +theorem LinearMap.mulRight_smul (x : H₁) (α : R) : + LinearMap.mulRight R (α • x) = α • LinearMap.mulRight R x := + rmul.map_smul _ _ + +theorem LinearMap.mulLeft_smul (x : H₁) (α : R) : + LinearMap.mulLeft R (α • x) = α • LinearMap.mulLeft R x := + lmul.map_smul _ _ + +theorem LinearMap.mulLeft_comp_inj {H₁ H₂ : Type _} [Semiring H₁] [Module R H₁] [AddCommMonoid H₂] + [Module R H₂] [SMulCommClass R H₁ H₁] [IsScalarTower R H₁ H₁] (f g : H₁ →ₗ[R] H₂) (x : H₁) + [Invertible x] : f ∘ₗ LinearMap.mulLeft R x = g ∘ₗ LinearMap.mulLeft R x ↔ f = g := + by + refine ⟨?_, fun h => by rw [h]⟩ + simp_rw [LinearMap.ext_iff, LinearMap.comp_apply, LinearMap.mulLeft_apply] + intro h y + specialize h (⅟ x * y) + simp_rw [← mul_assoc, mul_invOf_self, one_mul] at h + exact h + +theorem LinearMap.mulLeft_apply_inj {H₁ : Type _} [Semiring H₁] [Module R H₁] + [SMulCommClass R H₁ H₁] + [IsScalarTower R H₁ H₁] (x : H₁) [Invertible x] (y z : H₁) : + LinearMap.mulLeft R x y = LinearMap.mulLeft R x z ↔ y = z := + IsUnit.mul_right_inj (isUnit_of_invertible x) + +theorem lmul_op {R A : Type*} [CommSemiring R] [NonUnitalNonAssocSemiring A] [Module R A] + [SMulCommClass R A A] [IsScalarTower R A A] (x : Aᵐᵒᵖ) : + lmul x = (rmul (x.unop) : A →ₗ[R] A).op := + rfl + +theorem lmul_op' {R A : Type*} [CommSemiring R] [NonUnitalNonAssocSemiring A] [Module R A] + [SMulCommClass R A A] [IsScalarTower R A A] (x : A) : + lmul (MulOpposite.op x) = (rmul x : A →ₗ[R] A).op := + rfl + +theorem rmul_op' {R A : Type*} [CommSemiring R] [NonUnitalNonAssocSemiring A] [Module R A] + [SMulCommClass R A A] [IsScalarTower R A A] (x : A) : + rmul (MulOpposite.op x) = (lmul x : A →ₗ[R] A).op := + rfl diff --git a/LeanPool/Monlib4/LinearAlgebra/Matrix.lean b/LeanPool/Monlib4/LinearAlgebra/Matrix.lean new file mode 100644 index 0000000000..14504048ab --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Matrix.lean @@ -0,0 +1,23 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.Matrix.Basic +import LeanPool.Monlib4.LinearAlgebra.Matrix.Cast +import LeanPool.Monlib4.LinearAlgebra.Matrix.Conj +import LeanPool.Monlib4.LinearAlgebra.Matrix.IncludeBlock +import LeanPool.Monlib4.LinearAlgebra.Matrix.IsAlmostHermitian +import LeanPool.Monlib4.LinearAlgebra.Matrix.PiMat +import LeanPool.Monlib4.LinearAlgebra.Matrix.PosDefRpow +import LeanPool.Monlib4.LinearAlgebra.Matrix.PosEqLinearMapIsPositive +import LeanPool.Monlib4.LinearAlgebra.Matrix.Reshape +import LeanPool.Monlib4.LinearAlgebra.Matrix.Spectra +import LeanPool.Monlib4.LinearAlgebra.Matrix.StarOrderedRing + +/-! +# Matrix + +Import-only index for the `Matrix` directory of the monlib4 import. +-/ diff --git a/LeanPool/Monlib4/LinearAlgebra/Matrix/Basic.lean b/LeanPool/Monlib4/LinearAlgebra/Matrix/Basic.lean new file mode 100644 index 0000000000..622815524b --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Matrix/Basic.lean @@ -0,0 +1,421 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.LinearAlgebra.Matrix.ToLin +import Mathlib.LinearAlgebra.TensorProduct.Matrix +import Mathlib.LinearAlgebra.Trace +import Mathlib.LinearAlgebra.Matrix.Hermitian +import Mathlib.Analysis.Matrix.Spectrum +import Mathlib.LinearAlgebra.UnitaryGroup +import Mathlib.Analysis.RCLike.Basic +import LeanPool.Monlib4.LinearAlgebra.Matrix.Conj +import LeanPool.Monlib4.LinearAlgebra.Ips.RankOne + +/-! +# Matrix basics + +Basic matrix lemmas used by the monlib4 automorphism-of-matrix-algebras +formalization. +-/ + +namespace Matrix + +open scoped BigOperators Matrix Kronecker + +/-- Compatibility name for the old Monlib/mathlib3 matrix unit API. -/ +abbrev stdBasisMatrix {R n m : Type _} [Zero R] [DecidableEq n] [DecidableEq m] + (i : n) (j : m) (a : R) : Matrix n m R := + single i j a + +theorem eq_zero {R n₁ n₂ : Type _} [Zero R] (x : Matrix n₁ n₂ R) : + (∀ (i : n₁) (j : n₂), x i j = 0) ↔ x = 0 := by + simp_rw [← Matrix.ext_iff, Matrix.zero_apply] + +theorem mulVec_stdBasis {R m n : Type _} [Semiring R] [Fintype n] + (a : Matrix m n R) (i : m) (j : n) : + (a.mulVec (Pi.basisFun R n j)) i = a i j := by + classical + simp_rw [mulVec, dotProduct, Pi.basisFun_apply, Pi.single_apply, + mul_boole, Finset.sum_ite_eq', Finset.mem_univ, if_true] + +theorem mulVec_eq {R m n : Type _} [CommSemiring R] [Fintype n] + (a b : Matrix m n R) : + a = b ↔ ∀ c : n → R, a.mulVec c = b.mulVec c := by + refine ⟨fun h c => by rw [h], fun h => ?_⟩ + ext i j + rw [← mulVec_stdBasis a i j, ← mulVec_stdBasis b i j, h _] + +/-- A vector is nonzero iff at least one entry is nonzero. -/ +theorem vec_ne_zero {R n : Type _} [Semiring R] (a : n → R) : + (∃ i, a i ≠ 0) ↔ a ≠ 0 := by + simp_rw [ne_eq, ← Classical.not_forall] + constructor + · intro h hzero + simp_rw [hzero, Pi.zero_apply, imp_true_iff, not_true] at h + · intro h hentries + apply h + ext x + rw [Pi.zero_apply] + exact hentries x + +/-- Two vectors are equal iff their entries are equal. -/ +theorem ext_vec {𝕜 n : Type _} (α β : n → 𝕜) : + α = β ↔ ∀ i : n, α i = β i := by + refine ⟨fun h i => by rw [h], fun h => ?_⟩ + ext i + exact h i + +/-- The transpose of `vecMulVec x y` is `vecMulVec y x`. -/ +theorem vecMulVec_transpose {R n : Type _} [CommSemiring R] (x y : n → R) : + (vecMulVec x y).transpose = vecMulVec y x := by + simp_rw [← Matrix.ext_iff, transpose_apply, vecMulVec, mul_comm, of_apply, + forall₂_true_iff] + +theorem smul_mulVec_assoc {R m n : Type _} [Semiring R] [Fintype n] + (r : R) (x : Matrix m n R) (y : n → R) : + (r • x) *ᵥ y = r • (x *ᵥ y) := by + ext i + simp [mulVec, dotProduct, Finset.mul_sum, mul_assoc] + +/-- The identity matrix as a sum of standard matrix units. -/ +theorem one_eq_sum_std_matrix {n R : Type _} [CommSemiring R] [Fintype n] [DecidableEq n] : + (1 : Matrix n n R) = ∑ r : n, Matrix.single r r (1 : R) := by + simp_rw [← Matrix.ext_iff, Matrix.sum_apply, Matrix.one_apply, Matrix.single, ite_and, + of_apply, Finset.sum_ite_eq', Finset.mem_univ, if_true, forall₂_true_iff] + +/-- The trace of a Kronecker product is the product of traces. -/ +theorem kronecker_trace {R n : Type _} [CommSemiring R] [Fintype n] + (A B : Matrix n n R) : + (A ⊗ₖ B).trace = A.trace * B.trace := by + simp_rw [Matrix.trace, Matrix.diag, Matrix.kroneckerMap, Finset.sum_mul_sum, + Matrix.of_apply, Fintype.sum_prod_type] + +theorem _root_.Matrix.kronecker.trace {R n : Type _} [CommSemiring R] [Fintype n] + (A B : Matrix n n R) : + (A ⊗ₖ B).trace = A.trace * B.trace := + kronecker_trace A B + +/-- The unitary eigenvector matrix associated to a Hermitian matrix. -/ +noncomputable abbrev _root_.Matrix.IsHermitian.eigenvectorMatrix {n 𝕜 : Type*} [RCLike 𝕜] + [Fintype n] [DecidableEq n] {A : Matrix n n 𝕜} (hA : A.IsHermitian) : + Matrix n n 𝕜 := + hA.eigenvectorUnitary + +lemma _root_.Matrix.IsHermitian.eigenvectorUnitary_coe_eq_eigenvectorMatrix {n 𝕜 : Type*} [RCLike 𝕜] + [Fintype n] [DecidableEq n] {A : Matrix n n 𝕜} (hA : A.IsHermitian) : + hA.eigenvectorMatrix = hA.eigenvectorUnitary := + rfl + +lemma _root_.Matrix.IsHermitian.eigenvalues_eq' {n 𝕜 : Type*} [RCLike 𝕜] [Fintype n] + [DecidableEq n] {A : Matrix n n 𝕜} (hA : A.IsHermitian) (i : n) : + hA.eigenvalues i = + RCLike.re (star (hA.eigenvectorMatrixᵀ i) ⬝ᵥ A *ᵥ hA.eigenvectorMatrixᵀ i) := by + simpa [IsHermitian.eigenvectorMatrix, Matrix.IsHermitian.eigenvectorUnitary_transpose_apply] using + hA.eigenvalues_eq i + +lemma _root_.Matrix.IsHermitian.eigenvectorMatrix_conjTranspose {n 𝕜 : Type*} [RCLike 𝕜] + [Fintype n] [DecidableEq n] {A : Matrix n n 𝕜} (hA : A.IsHermitian) : + hA.eigenvectorMatrixᴴ = (hA.eigenvectorUnitary : Matrix n n 𝕜)ᴴ := + rfl + +theorem _root_.Matrix.IsHermitian.eigenvectorMatrix_mul_conjTranspose {n 𝕜 : Type*} [RCLike 𝕜] + [Fintype n] [DecidableEq n] {A : Matrix n n 𝕜} (hA : A.IsHermitian) : + hA.eigenvectorMatrix * hA.eigenvectorMatrixᴴ = 1 := by + rw [IsHermitian.eigenvectorMatrix, ← star_eq_conjTranspose] + exact (SetLike.coe_mem hA.eigenvectorUnitary).2 + +theorem _root_.Matrix.IsHermitian.trace_eq {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] [DecidableEq n] + {A : Matrix n n 𝕜} (hA : A.IsHermitian) : + A.trace = ∑ i : n, hA.eigenvalues i := by + simpa using hA.trace_eq_sum_eigenvalues + +theorem _root_.LinearMap.IsSymmetric.eigenvalue_mem_spectrum {𝕜 n : Type _} [RCLike 𝕜] + [Fintype n] {E : Type _} [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] {A : E →ₗ[𝕜] E} + (hn : Module.finrank 𝕜 E = Fintype.card n) (hA : A.IsSymmetric) + (i : Fin (Fintype.card n)) : + (hA.eigenvalues hn i : 𝕜) ∈ spectrum 𝕜 A := by + rw [← Module.End.hasEigenvalue_iff_mem_spectrum] + exact hA.hasEigenvalue_eigenvalues hn i + +theorem _root_.Matrix.IsHermitian.eigenvalues_hasEigenvalue {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] + [DecidableEq n] {M : Matrix n n 𝕜} (hM : M.IsHermitian) (i : n) : + Module.End.HasEigenvalue (toEuclideanLin M) (hM.eigenvalues i) := by + simp_rw [Matrix.IsHermitian.eigenvalues, Matrix.IsHermitian.eigenvalues₀] + exact LinearMap.IsSymmetric.hasEigenvalue_eigenvalues _ _ _ + +theorem _root_.Matrix.IsHermitian.hasEigenvector_eigenvectorBasis + {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] + [DecidableEq n] {M : Matrix n n 𝕜} (hM : M.IsHermitian) (i : n) : + Module.End.HasEigenvector (toEuclideanLin M) (hM.eigenvalues i) (hM.eigenvectorBasis i) := by + simp_rw [Matrix.IsHermitian.eigenvectorBasis, Matrix.IsHermitian.eigenvalues, + Matrix.IsHermitian.eigenvalues₀, OrthonormalBasis.reindex_apply] + exact LinearMap.IsSymmetric.hasEigenvector_eigenvectorBasis _ _ _ + +theorem _root_.Matrix.IsHermitian.apply_eigenvectorBasis {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] + [DecidableEq n] {M : Matrix n n 𝕜} (hM : M.IsHermitian) (i : n) : + M.mulVec (hM.eigenvectorBasis i) = hM.eigenvalues i • hM.eigenvectorBasis i := by + simpa using hM.mulVec_eigenvectorBasis i + +/-- Expand a square matrix indexed by a product as a sum of Kronecker products of matrix units. -/ +theorem kmul_representation {R n₁ n₂ : Type _} [Fintype n₁] [Fintype n₂] + [DecidableEq n₁] [DecidableEq n₂] [Semiring R] + (x : Matrix (n₁ × n₂) (n₁ × n₂) R) : + x = + ∑ i : n₁, ∑ j : n₁, ∑ k : n₂, ∑ l : n₂, + x (i, k) (j, l) • Matrix.single i j (1 : R) ⊗ₖ Matrix.single k l (1 : R) := by + simp_rw [← Matrix.ext_iff, Matrix.sum_apply, Matrix.smul_apply, Matrix.kroneckerMap, + Matrix.single, Matrix.of_apply, ite_mul, MulZeroClass.zero_mul, one_mul, smul_ite, + smul_zero, ite_and, Finset.sum_ite_irrel, Finset.sum_const_zero, Finset.sum_ite_eq', + Finset.mem_univ, if_true, Prod.mk.eta, smul_eq_mul, mul_one, forall₂_true_iff] + +theorem kronecker_conjTranspose {R m n : Type _} [CommSemiring R] [StarRing R] + (x : Matrix n n R) (y : Matrix m m R) : + (x ⊗ₖ y)ᴴ = xᴴ ⊗ₖ yᴴ := by + simp_rw [← Matrix.ext_iff, conjTranspose_apply, kroneckerMap, of_apply, star_mul', + conjTranspose_apply, forall₂_true_iff] + +theorem kronecker_star {R n : Type _} [CommSemiring R] [StarRing R] (x y : Matrix n n R) : + star (x ⊗ₖ y) = star x ⊗ₖ star y := + Matrix.kronecker_conjTranspose _ _ + +theorem _root_.Matrix.kronecker.star {R n : Type _} [CommSemiring R] [StarRing R] + (x y : Matrix n n R) : + star (x ⊗ₖ y) = star x ⊗ₖ star y := + kronecker_star x y + +theorem kronecker_transpose {R n : Type _} [CommSemiring R] (x y : Matrix n n R) : + (x ⊗ₖ y)ᵀ = xᵀ ⊗ₖ yᵀ := by + simp_rw [← Matrix.ext_iff] + intro i j + simp only [Matrix.transpose_apply, Matrix.kroneckerMap, of_apply] + +theorem _root_.Matrix.kronecker.transpose {R n : Type _} [CommSemiring R] (x y : Matrix n n R) : + (x ⊗ₖ y)ᵀ = xᵀ ⊗ₖ yᵀ := + kronecker_transpose x y + +theorem kronecker_conj {R n : Type _} [CommSemiring R] [StarRing R] (x y : Matrix n n R) : + (x ⊗ₖ y)ᴴᵀ = xᴴᵀ ⊗ₖ yᴴᵀ := by + rw [Matrix.conj, Matrix.kronecker_conjTranspose, Matrix.kronecker_transpose] + rfl + +theorem _root_.Matrix.kronecker.conj {R n : Type _} [CommSemiring R] [StarRing R] + (x y : Matrix n n R) : + (x ⊗ₖ y)ᴴᵀ = xᴴᵀ ⊗ₖ yᴴᵀ := + kronecker_conj x y + +theorem _root_.Matrix.unitaryGroup.coe_mk {n 𝕜 : Type _} [RCLike 𝕜] [Fintype n] [DecidableEq n] + (x : Matrix n n 𝕜) (hx : x ∈ Matrix.unitaryGroup n 𝕜) : + ⇑(⟨x, hx⟩ : Matrix.unitaryGroup n 𝕜) = x := + rfl + +end Matrix + +open scoped BigOperators InnerProductSpace Kronecker + +theorem kmul_representation {R n₁ n₂ : Type _} [Fintype n₁] [Fintype n₂] [DecidableEq n₁] + [DecidableEq n₂] [Semiring R] (x : Matrix (n₁ × n₂) (n₁ × n₂) R) : + x = + ∑ i : n₁, ∑ j : n₁, ∑ k : n₂, ∑ l : n₂, + x (i, k) (j, l) • Matrix.single i j (1 : R) ⊗ₖ Matrix.single k l (1 : R) := + Matrix.kmul_representation x + +noncomputable instance EuclideanSpace.instInnerPi {n 𝕜 : Type _} [RCLike 𝕜] [Fintype n] : + Inner 𝕜 (n → 𝕜) := + { inner := fun x y => + ⟪(EuclideanSpace.equiv n 𝕜).symm x, (EuclideanSpace.equiv n 𝕜).symm y⟫_𝕜 } + +theorem EuclideanSpace.inner_eq {n 𝕜 : Type _} [RCLike 𝕜] [Fintype n] {x y : n → 𝕜} : + inner 𝕜 x y = star (x : n → 𝕜) ⬝ᵥ (y : n → 𝕜) := by + change (∑ i, y i * star (x i)) = ∑ i, star (x i) * y i + exact Finset.sum_congr rfl fun i _ => mul_comm (y i) (star (x i)) + +theorem EuclideanSpace.rankOne_of_orthonormalBasis_eq_one {n 𝕜 : Type _} [RCLike 𝕜] + [Fintype n] (h : OrthonormalBasis n 𝕜 (EuclideanSpace 𝕜 n)) : + ∑ i : n, rankOne 𝕜 (h i) (h i) = 1 := by + simpa using rankOne.sum_orthonormalBasis_eq_id h + +open scoped Matrix + +variable {R n m : Type _} [Semiring R] [StarAddMonoid R] [DecidableEq n] [DecidableEq m] + +theorem Matrix.single_conjTranspose (i : n) (j : m) (a : R) : + (Matrix.single i j a)ᴴ = Matrix.single j i (star a) := by + ext x y + simp_rw [conjTranspose_apply, Matrix.single, ite_and] + by_cases h : j = x ∧ i = y + · simp_rw [h.1, h.2, of_apply, if_true] + by_cases h' : a = 0 + · simp only [of_apply, h', star_zero, ite_self] + · simp_rw [← ite_and, of_apply, @and_comm _ (j = x), + (Ne.ite_eq_right_iff (star_ne_zero.mpr h')).mpr h, star_eq_iff_star_eq, star_zero] + symm + rw [ite_eq_right_iff] + intro H + exact False.elim (h H) + +theorem Matrix.single.star_apply (i k : n) (j l : m) (a : R) : + star (Matrix.single i j a k l) = Matrix.single j i (star a) l k := by + rw [← Matrix.single_conjTranspose, ← Matrix.conjTranspose_apply] + +theorem Matrix.single.star_apply' (i : n) (j : m) (x : n × m) (a : R) : + star (Matrix.single i j a x.fst x.snd) = + Matrix.single j i (star a) x.snd x.fst := by + rw [Matrix.single.star_apply] + +/-- The conjugate transpose of a standard matrix unit. -/ +theorem Matrix.single.star_one {R : Type _} [Semiring R] [StarRing R] (i : n) (j : m) : + (Matrix.single i j (1 : R))ᴴ = Matrix.single j i (1 : R) := by + nth_rw 2 [← _root_.star_one] + exact Matrix.single_conjTranspose _ _ _ + +open scoped BigOperators + +theorem Matrix.trace_iff {R n : Type _} [AddCommMonoid R] [Fintype n] (x : Matrix n n R) : + x.trace = ∑ k : n, x k k := + rfl + +theorem Matrix.single.hMul_apply_basis {R p q : Type _} [Semiring R] [DecidableEq p] + [DecidableEq q] (i x : n) (j y : m) (k z : p) (l w : q) : + Matrix.single k l (Matrix.single i j (1 : R) x y) z w = + Matrix.single i j (1 : R) x y * Matrix.single k l (1 : R) z w := by + simp_rw [Matrix.single, ite_and, of_apply, ite_mul, MulZeroClass.zero_mul, one_mul, + ← ite_and, and_rotate, ← @and_assoc (k = z), @and_comm _ (i = x), + ← and_assoc, @and_assoc _ (k = z), and_comm, and_assoc] + +theorem Matrix.single.mul_apply_basis' {R p q : Type _} [Semiring R] [DecidableEq p] + [DecidableEq q] (i x : n) (j y : m) (k z : p) (l w : q) : + Matrix.single k l (Matrix.single i j (1 : R) x y) z w = + ite (i = x ∧ j = y ∧ k = z ∧ l = w) 1 0 := by + simp_rw [Matrix.single.hMul_apply_basis, Matrix.single, ite_and, of_apply, ite_mul, + MulZeroClass.zero_mul, one_mul] + +theorem Matrix.single.hMul_apply {R : Type _} [Fintype n] [Semiring R] + (i j k l m p : n) : + ∑ x : n × n, ∑ x_1 : n × n, ∑ x_2 : n, ∑ x_3 : n, + Matrix.single l k (Matrix.single p m (1 : R) x_1.snd x_1.fst) x.snd x.fst * + Matrix.single i x_2 (Matrix.single x_3 j (1 : R) x_1.fst x_1.snd) x.fst x.snd = + ∑ x : n × n, ∑ x_1 : n × n, ∑ x_2 : n, ∑ x_3 : n, + ite + (p = x_1.snd ∧ + m = x_1.fst ∧ + l = x.snd ∧ k = x.fst ∧ x_3 = x_1.fst ∧ j = x_1.snd ∧ i = x.fst ∧ + x_2 = x.snd) + 1 0 := by + simp_rw [Matrix.single.mul_apply_basis', ite_mul, one_mul, MulZeroClass.zero_mul, ← ite_and, + and_assoc] + +theorem Matrix.single.sum_star_hMul_self [Fintype n] (i j : n) (a b : R) : + ∑ k : n, ∑ l : n, ∑ m : n, ∑ p : n, + Matrix.single i j a k l * star (Matrix.single i j b) m p = + a * star b := by + simp_rw [Matrix.star_apply, Matrix.single.star_apply, Matrix.single, Matrix.of_apply, ite_mul, + MulZeroClass.zero_mul, mul_ite, MulZeroClass.mul_zero, ite_and, Finset.sum_ite_irrel, + Finset.sum_const_zero, Finset.sum_ite_eq, Finset.mem_univ, if_true] + +theorem Matrix.single.sum_star_hMul_self' {R : Type _} [Fintype n] [Semiring R] [StarRing R] + (i j : n) : + ∑ kl : n × n, ∑ mp : n × n, + Matrix.single i j (1 : R) kl.1 kl.2 * star (Matrix.single i j (1 : R)) mp.1 mp.2 = + 1 := by + classical + rw [Finset.sum_eq_single (i, j)] + · rw [Finset.sum_eq_single (j, i)] + · simp [Matrix.star_apply, Matrix.single, Matrix.of_apply] + · intro b _ hne + have hcond : ¬(i = b.2 ∧ j = b.1) := by + intro h + apply hne + ext <;> simp [h.1, h.2] + simp [Matrix.star_apply, Matrix.single, Matrix.of_apply, hcond] + · intro hnot + simp at hnot + · intro b _ hne + have hcond : ¬(i = b.1 ∧ j = b.2) := by + intro h + apply hne + ext <;> simp [h.1, h.2] + simp [Matrix.single, Matrix.of_apply, hcond] + · intro hnot + simp at hnot + +theorem Matrix.single.hMul_stdBasisMatrix {R p : Type _} [Semiring R] [DecidableEq p] + [Fintype m] (i x : n) (j k : m) (l y : p) (a b : R) : + (Matrix.single i j a * Matrix.single k l b) x y = + ite (i = x ∧ j = k ∧ l = y) (a * b) 0 := by + simp_rw [Matrix.mul_apply, Matrix.single, ite_and, of_apply, ite_mul, + MulZeroClass.zero_mul, mul_ite, MulZeroClass.mul_zero, Finset.sum_ite_irrel, + Finset.sum_ite_eq, Finset.mem_univ, if_true, Finset.sum_const_zero, eq_comm] + +theorem Matrix.single.hMul_stdBasis_matrix' {R p : Type _} [Fintype n] [DecidableEq p] + [Semiring R] (i : m) (j k : n) (l : p) : + Matrix.single i j (1 : R) * Matrix.single k l (1 : R) = + ite (j = k) (1 : R) 0 • Matrix.single i l (1 : R) := by + ext x y + simp_rw [Matrix.smul_apply, Matrix.mul_apply, Matrix.single, ite_and, of_apply, ite_mul, + MulZeroClass.zero_mul, one_mul, Finset.sum_ite_irrel, Finset.sum_ite_eq, Finset.mem_univ, + if_true, Finset.sum_const_zero, smul_ite, smul_zero, smul_eq_mul, mul_one, ← ite_and, + eq_comm, and_comm] + +theorem Matrix.transposeAlgEquiv_symm_op_apply {n R α : Type _} [CommSemiring R] + [CommSemiring α] [Fintype n] [DecidableEq n] [Algebra R α] (x : Matrix n n α) : + (Matrix.transposeAlgEquiv n R α).symm (MulOpposite.op x) = xᵀ := by + rw [Matrix.transposeAlgEquiv_symm_apply] + rfl + +open Matrix + +theorem Matrix.dotProduct_eq_trace {R n : Type _} [CommSemiring R] [StarRing R] [Fintype n] + (x : n → R) (y : Matrix n n R) : + star x ⬝ᵥ y.mulVec x = + ((Matrix.replicateCol (Fin 1) x * Matrix.replicateRow (Fin 1) (star x))ᴴ * y).trace := by + simp_rw [Matrix.trace_iff, dotProduct, Matrix.conjTranspose_mul, + Matrix.conjTranspose_replicateRow, Matrix.conjTranspose_replicateCol, star_star, + Matrix.mul_apply, Matrix.mulVec, dotProduct, Matrix.replicateCol_apply, + Matrix.replicateRow_apply, Pi.star_apply, Finset.sum_const] + simp only [Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Finset.card_singleton, one_smul] + simp_rw [Finset.mul_sum, mul_comm (x _), mul_comm _ (x _), ← mul_assoc, mul_comm] + rw [Finset.sum_comm] + +theorem forall_left_hMul {n R : Type _} [Fintype n] [Semiring R] + (x y : Matrix n n R) : x = y ↔ ∀ a : Matrix n n R, a * x = a * y := by + classical + refine ⟨fun h a => by rw [h], fun h => ?_⟩ + specialize h 1 + simp_rw [one_mul] at h + exact h + +lemma _root_.Matrix.smul_one_eq_one_iff {𝕜 n : Type*} [DecidableEq n] [Field 𝕜] (c : 𝕜) : + c • (1 : Matrix n n 𝕜) = (1 : Matrix n n 𝕜) ↔ c = 1 ∨ IsEmpty n := by + simp_rw [← Matrix.ext_iff, Matrix.smul_apply, Matrix.one_apply, smul_ite, smul_zero, + smul_eq_mul, mul_one] + by_cases h : IsEmpty n + · simp only [h, or_true, iff_true] + intro i + exact h.elim i + · simp only [h, or_false] + constructor + · rintro h1 + rw [not_isEmpty_iff] at h + let i : n := h.some + specialize h1 i i + simp only [↓reduceIte] at h1 + exact h1 + · rintro rfl i j + rfl + +/-- A linear equivalence of `R^n` gives an invertible matrix. -/ +@[reducible] +def LinearEquiv.toInvertibleMatrix {n R : Type _} [CommSemiring R] + [Fintype n] [DecidableEq n] (x : (n → R) ≃ₗ[R] n → R) : + Invertible (LinearMap.toMatrix' (x : (n → R) →ₗ[R] n → R)) := by + refine Invertible.mk + (LinearMap.toMatrix' (x.symm : (n → R) →ₗ[R] n → R)) ?_ ?_ + · simp only [← LinearMap.toMatrix'_mul, Module.End.mul_eq_comp, + LinearEquiv.comp_coe, LinearEquiv.self_trans_symm, + LinearEquiv.refl_toLinearMap, LinearMap.toMatrix'_id] + · simp only [← LinearMap.toMatrix'_mul, Module.End.mul_eq_comp, + LinearEquiv.comp_coe, LinearEquiv.symm_trans_self, + LinearEquiv.refl_toLinearMap, LinearMap.toMatrix'_id] diff --git a/LeanPool/Monlib4/LinearAlgebra/Matrix/Cast.lean b/LeanPool/Monlib4/LinearAlgebra/Matrix/Cast.lean new file mode 100644 index 0000000000..b9aa7665b5 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Matrix/Cast.lean @@ -0,0 +1,24 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Data.Matrix.Basic + +variable {R k : Type*} {s : k → Type _} + +theorem Matrix.cast_apply {i j : k} (x : Matrix (s i) (s i) R) (h : i = j) (p q : s j) : + (by rw [h] : Matrix (s i) (s i) R = Matrix (s j) (s j) R).mp x p q = + x (by rw [h]; exact p) (by rw [h]; exact q) := +by aesop +theorem Matrix.cast_apply' {i j : k} (x : Matrix (s j) (s j) R) (h : j = i) (p q : s i) : + (by rw [h] : Matrix (s i) (s i) R = Matrix (s j) (s j) R).mpr x p q = + x (by rw [h]; exact p) (by rw [h]; exact q) := +by aesop + +theorem Matrix.cast_hMul [Semiring R] [Π i, Fintype (s i)] + {i j : k} (x y : Matrix (s i) (s i) R) (h : i = j) : + (by rw [h] : Matrix (s i) (s i) R = Matrix (s j) (s j) R).mp (x * y) = + (by rw [h] : Matrix (s i) (s i) R = Matrix (s j) (s j) R).mp x * + (by rw [h] : Matrix (s i) (s i) R = Matrix (s j) (s j) R).mp y := +by aesop diff --git a/LeanPool/Monlib4/LinearAlgebra/Matrix/Conj.lean b/LeanPool/Monlib4/LinearAlgebra/Matrix/Conj.lean new file mode 100644 index 0000000000..a8d4502170 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Matrix/Conj.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Data.Matrix.Basic +import Mathlib.LinearAlgebra.Matrix.Hermitian +import LeanPool.Monlib4.Preq.Ites + +/-! + # Conjugate of a matrix + +This file defines the conjugate of a matrix, `matrix.conj` with the notation `ᴴᵀ` +(i.e., `xᴴᵀ i j = star (x i j)`), and shows basic properties about it. +-/ + + +namespace Matrix + +open scoped Matrix + +variable {α n₁ n₂ : Type _} + +/-- +conjugate of matrix defined as $\bar{x} := {(x^*)}^\top$, i.e., $\bar{x}_{ij}=\overline{x_{ij}}$ -/ +def conj [Star α] (x : Matrix n₁ n₂ α) : Matrix n₁ n₂ α := + xᴴᵀ + +/-- Postfix notation `ᴴᵀ` for `Matrix.conj`. -/ +scoped postfix:1024 "ᴴᵀ" => Matrix.conj + +theorem conj_apply [Star α] (x : Matrix n₁ n₂ α) (i : n₁) (j : n₂) : xᴴᵀ i j = star (x i j) := + rfl + +theorem conj_conj [InvolutiveStar α] (x : Matrix n₁ n₂ α) : xᴴᵀᴴᵀ = x := + calc + xᴴᵀᴴᵀ = xᵀᵀᴴᴴ := rfl + _ = xᵀᵀ := (conjTranspose_conjTranspose _) + _ = x := transpose_transpose _ + +theorem conj_add [AddMonoid α] [StarAddMonoid α] (x y : Matrix n₁ n₂ α) : (x + y)ᴴᵀ = xᴴᵀ + yᴴᵀ := + by simp_rw [conj, ← transpose_add, ← conjTranspose_add] + +theorem conj_smul {R : Type _} [Star R] [Star α] [SMul R α] [StarModule R α] (c : R) + (x : Matrix n₁ n₂ α) : (c • x)ᴴᵀ = star c • xᴴᵀ := by + simp_rw [conj, ← transpose_smul, ← conjTranspose_smul] + +theorem conj_conjTranspose [InvolutiveStar α] (x : Matrix n₁ n₂ α) : xᴴᵀᴴ = xᵀ := + calc + xᴴᵀᴴ = xᵀᴴᴴ := rfl + _ = xᵀ := conjTranspose_conjTranspose _ + +theorem conjTranspose_conj [InvolutiveStar α] (x : Matrix n₁ n₂ α) : xᴴᴴᵀ = xᵀ := + calc + xᴴᴴᵀ = xᴴᵀᴴ := rfl + _ = xᵀ := conj_conjTranspose _ + +theorem transpose_conj_eq_conjTranspose [Star α] (x : Matrix n₁ n₂ α) : xᴴᵀᵀ = xᴴ := + rfl + +namespace IsHermitian + +theorem conj {α n : Type _} [Star α] {x : Matrix n n α} (hx : x.IsHermitian) : + xᴴᵀ = xᵀ := by simp_rw [Matrix.conj, hx.eq] + +end IsHermitian + +theorem conj_mul {α m n p : Type _} [Fintype n] [CommSemiring α] [StarRing α] (x : Matrix m n α) + (y : Matrix n p α) : (x * y)ᴴᵀ = xᴴᵀ * yᴴᵀ := + by + ext + simp_rw [conj_apply, mul_apply, star_sum, StarMul.star_mul, conj_apply, mul_comm] + +theorem conj_one {α n : Type _} [DecidableEq n] [Semiring α] [StarRing α] : + (1 : Matrix n n α)ᴴᵀ = 1 := by + ext + simp_rw [conj_apply, one_apply, star_ite, star_one, star_zero] + +theorem conj_zero {α n₁ n₂ : Type _} [AddMonoid α] [StarAddMonoid α] : + (0 : Matrix n₁ n₂ α)ᴴᵀ = 0 := by + ext + simp_rw [conj_apply, zero_apply, star_zero] + +end Matrix diff --git a/LeanPool/Monlib4/LinearAlgebra/Matrix/IncludeBlock.lean b/LeanPool/Monlib4/LinearAlgebra/Matrix/IncludeBlock.lean new file mode 100644 index 0000000000..7ac94435b3 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Matrix/IncludeBlock.lean @@ -0,0 +1,804 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.LinearAlgebra.Matrix.Block +import Mathlib.LinearAlgebra.Matrix.Trace +import Mathlib.Data.Matrix.Basis +import LeanPool.Monlib4.Preq.Dite +import Mathlib.LinearAlgebra.Matrix.Hermitian +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.BasicLemmas +import Mathlib.LinearAlgebra.Matrix.Kronecker +import LeanPool.Monlib4.LinearAlgebra.ToMatrixOfEquiv +import LeanPool.Monlib4.LinearAlgebra.Matrix.PiMat + +/-! + +# Include block + + This file defines `matrix.includeBlock`, which imitates `direct_sum.component_of` + for `pi` instead of `direct_sum` :TODO: + + The direct sum in these files are sort of misleading. + +-/ + + +open scoped BigOperators + +theorem Finset.sum_sigma_univ {β α : Type _} [AddCommMonoid β] [Fintype α] {σ : α → Type _} + [∀ i, Fintype (σ i)] (f : (Σ i, σ i) → β) : + ∑ x : Σ i : α, σ i, f x = ∑ a : α, ∑ s : σ a, f (⟨a, s⟩ : Σ i, σ i) := + Finset.sum_sigma _ _ _ + +namespace Matrix + +/-- The algebra homomorphism from block-indexed matrices to their block diagonal matrix. -/ +def blockDiagonal'AlgHom {o : Type _} {m' : o → Type _} {α : Type _} [Fintype o] [DecidableEq o] + [∀ i, Fintype (m' i)] [∀ i, DecidableEq (m' i)] [CommSemiring α] : + PiMat α o m' →ₐ[α] Matrix (Σ i : o, m' i) (Σ i : o, m' i) α + where + toFun a := blockDiagonal' a + map_one' := blockDiagonal'_one + map_mul' a b := blockDiagonal'_mul _ _ + map_zero' := blockDiagonal'_zero + map_add' a b := blockDiagonal'_add _ _ + commutes' a := by + simp_rw [Algebra.algebraMap_eq_smul_one, blockDiagonal'_smul, blockDiagonal'_one] + +theorem blockDiagonal'AlgHom_apply {o : Type _} {m' : o → Type _} {α : Type _} [Fintype o] + [DecidableEq o] [∀ i, Fintype (m' i)] [∀ i, DecidableEq (m' i)] [CommSemiring α] + (x : PiMat α o m') : Matrix.blockDiagonal'AlgHom x = blockDiagonal' x := + rfl + +/-- The linear map sending a matrix to the family of its diagonal blocks. -/ +def blockDiag'LinearMap {o : Type _} {m' n' : o → Type _} {α : Type _} [Semiring α] : + Matrix (Σ i : o, m' i) (Σ i : o, n' i) α →ₗ[α] Π i : o, Matrix (m' i) (n' i) α + where + toFun x := Matrix.blockDiag' x + map_add' x y := blockDiag'_add x y + map_smul' r x := blockDiag'_smul r x + +theorem blockDiag'LinearMap_apply {o : Type _} {m' : o → Type _} {n' : o → Type _} {α : Type _} + [Semiring α] (x : Matrix (Σ i : o, m' i) (Σ i : o, n' i) α) : + Matrix.blockDiag'LinearMap x = blockDiag' x := + rfl + +theorem blockDiag'LinearMap_blockDiagonal'AlgHom {o : Type _} {m' : o → Type _} {α : Type _} + [Fintype o] [DecidableEq o] [∀ i, Fintype (m' i)] [∀ i, DecidableEq (m' i)] [CommSemiring α] + (x : PiMat α o m') : + Matrix.blockDiag'LinearMap (Matrix.blockDiagonal'AlgHom x) = x := + blockDiag'_blockDiagonal' x + +theorem blockDiagonal'_ext {R : Type _} {k : Type _} {s : k → Type _} + (x y : Matrix (Σ i, s i) (Σ i, s i) R) : x = y ↔ ∀ i j k l, x ⟨i, j⟩ ⟨k, l⟩ = y ⟨i, j⟩ ⟨k, l⟩ := + by + simp only [← Matrix.ext_iff, Sigma.forall] + +/-- A matrix indexed by a sigma type is block diagonal when its off-diagonal blocks vanish. -/ +def IsBlockDiagonal {o : Type _} {m' n' : o → Type _} {α : Type _} [DecidableEq o] [Zero α] + (x : Matrix (Σ i, m' i) (Σ i, n' i) α) : Prop := + blockDiagonal' (blockDiag' x) = x + +/-- Include a single matrix block in the corresponding component of a block-indexed family. -/ +def includeBlock {o : Type _} [DecidableEq o] {m' : o → Type _} {α : Type _} [Semiring α] + {i : o} : Matrix (m' i) (m' i) α →ₗ[α] (PiMat α o m') := +@LinearMap.single α o _ (fun j => Matrix (m' j) (m' j) α) _ _ _ i + +theorem includeBlock_apply {o : Type _} [DecidableEq o] {m' : o → Type _} {α : Type _} + [CommSemiring α] {i : o} (x : Matrix (m' i) (m' i) α) : + (includeBlock : Matrix (m' i) (m' i) α →ₗ[α] PiMat α o m') x = fun j : o => + dite (i = j) (fun h => Eq.mp (by rw [h]) x) fun _ => 0 := + by + ext j₁ j₂ j₃ + simp only [includeBlock, LinearMap.coe_single, Pi.single, Function.update, eq_comm, + Pi.zero_apply] + split_ifs with h <;> aesop + +theorem includeBlock_hMul_same {o : Type _} [DecidableEq o] {m' : o → Type _} + {α : Type _} [∀ i, Fintype (m' i)] [CommSemiring α] {i : o} + (x y : Matrix (m' i) (m' i) α) : includeBlock x * includeBlock y = includeBlock (x * y) := + by + ext i x_1 x_2 + simp_rw [includeBlock_apply, Pi.mul_apply, hMul_dite, dite_hMul, MulZeroClass.mul_zero, + MulZeroClass.zero_mul] + simp only [eq_mp_eq_cast, dite_eq_ite, ite_self] + aesop + +theorem includeBlock_hMul_ne_same {o : Type _} [DecidableEq o] {m' : o → Type _} + {α : Type _} [∀ i, Fintype (m' i)] [CommSemiring α] {i j : o} + (h : i ≠ j) (x : Matrix (m' i) (m' i) α) (y : Matrix (m' j) (m' j) α) : + includeBlock x * includeBlock y = 0 := by + ext + simp_rw [includeBlock_apply, Pi.mul_apply, hMul_dite, dite_hMul, MulZeroClass.mul_zero, + MulZeroClass.zero_mul, Pi.zero_apply] + simp only [eq_mp_eq_cast, dite_eq_ite, ite_self] + aesop + +theorem includeBlock_hMul {o : Type _} [DecidableEq o] {m' : o → Type _} {α : Type _} + [∀ i, Fintype (m' i)] [CommSemiring α] {i : o} + (x : Matrix (m' i) (m' i) α) (y : PiMat α o m') : + includeBlock x * y = includeBlock (x * y i) := + by + ext + simp only [includeBlock_apply, Pi.mul_apply, dite_hMul, MulZeroClass.zero_mul] + split_ifs <;> aesop + +theorem hMul_includeBlock {o : Type _} [DecidableEq o] {m' : o → Type _} {α : Type _} + [∀ i, Fintype (m' i)] [CommSemiring α] {i : o} + (x : PiMat α o m') (y : Matrix (m' i) (m' i) α) : + x * includeBlock y = includeBlock (x i * y) := + by + ext + simp only [includeBlock_apply, Pi.mul_apply] + split_ifs <;> aesop + +open scoped BigOperators + +theorem sum_includeBlock {R k : Type _} [CommSemiring R] [Fintype k] [DecidableEq k] + {s : k → Type _} (x : PiMat R k s) : + ∑ i, includeBlock (x i) = x := by + ext + simp only [Finset.sum_apply, includeBlock_apply, Finset.sum_dite_eq', Finset.mem_univ, if_true] + rfl + +theorem blockDiagonal'_includeBlock_trace {R k : Type _} [CommSemiring R] [Fintype k] + [DecidableEq k] {s : k → Type _} [∀ i, Fintype (s i)] + (x : PiMat R k s) (j : k) : + (blockDiagonal' (includeBlock (x j))).trace = (x j).trace := + by + calc + (blockDiagonal' (includeBlock (x j))).trace + = ∑ i, (includeBlock (x j) i).trace := + by simp_rw [Matrix.trace, Matrix.diag, blockDiagonal'_apply, dif_pos, + Finset.sum_sigma']; rfl + _ = ∑ i, ∑ a, includeBlock (x j) i a a := rfl + _ = ∑ i, ∑ a, dite (j = i) (fun h => by rw [← h]; exact (x j)) + (fun _ => (0 : Matrix (s i) (s i) R)) a a := + by simp_rw [includeBlock_apply]; rfl + _ = ∑ i, ∑ a, dite (j = i) (fun h => + (by rw [← h]; exact x j : Matrix (s i) (s i) R) a a) + (fun _ => (0 : R)) := by congr; ext; congr; ext; aesop + _ = (x j).trace := by + simp_rw [Finset.sum_dite_irrel, Finset.sum_const_zero, + Finset.sum_dite_eq, Finset.mem_univ, if_true] + rfl + +open scoped Matrix + +theorem single_hMul_trace {R n p : Type _} [Semiring R] [Fintype p] [DecidableEq p] + [Fintype n] [DecidableEq n] (i : n) (j : p) (x : Matrix p n R) : + Matrix.trace (single i j (1 : R) * x) = x j i := by + simp_rw [Matrix.trace, Matrix.diag, mul_apply, single, of_apply, boole_mul, ite_and, + Finset.sum_ite_irrel, Finset.sum_const_zero, Finset.sum_ite_eq, Finset.mem_univ, if_true] + +theorem ext_iff_trace {R n p : Type _} [Fintype n] [Fintype p] + [CommSemiring R] (x y : Matrix n p R) : x = y ↔ ∀ a, (x * a).trace = (y * a).trace := + by + classical + refine ⟨fun h a => by rw [h], fun h => ?_⟩ + ext i j + specialize h (single j i 1) + simp_rw [trace_mul_comm _ (single _ _ _), Matrix.single_hMul_trace j i] at h + exact h + +variable {R : Type _} [CommSemiring R] + +namespace IsBlockDiagonal + +theorem eq {k : Type _} [DecidableEq k] {s : k → Type _} + {x : Matrix (Σ i, s i) (Σ i, s i) R} (hx : x.IsBlockDiagonal) : + blockDiagonal' x.blockDiag' = x := + hx + +theorem add {k : Type _} [DecidableEq k] {s : k → Type _} + {x y : Matrix (Σ i, s i) (Σ i, s i) R} (hx : x.IsBlockDiagonal) (hy : y.IsBlockDiagonal) : + (x + y).IsBlockDiagonal := by + simp only [Matrix.IsBlockDiagonal, blockDiag'_add, blockDiagonal'_add, hx.eq, hy.eq] + +end IsBlockDiagonal + +/-- The subtype of block-diagonal square matrices indexed by a sigma type. -/ +@[reducible] +def BlockDiagonals (R k : Type _) [Zero R] [DecidableEq k] (s : k → Type _) := +{ x : Matrix (Σ i, s i) (Σ i, s i) R // IsBlockDiagonal x } + +namespace IsBlockDiagonal + +theorem zero {k : Type _} [DecidableEq k] {s : k → Type _} : + (0 : Matrix (Σ i, s i) (Σ i, s i) R).IsBlockDiagonal := by + simp only [Matrix.IsBlockDiagonal, blockDiag'_zero, blockDiagonal'_zero] + +instance HAdd {k : Type _} [DecidableEq k] {s : k → Type _} : + Add (BlockDiagonals R k s) where + add x y := ⟨↑x + ↑y, Matrix.IsBlockDiagonal.add x.property y.property⟩ + +theorem coe_add {k : Type _} [DecidableEq k] {s : k → Type _} + {x y : (BlockDiagonals R k s)} : + ((x + y : (BlockDiagonals R k s)) : + Matrix (Σ i, s i) (Σ i, s i) R) = + x + y := + rfl + +instance Zero {k : Type _} [DecidableEq k] {s : k → Type _} : + Zero ((BlockDiagonals R k s)) where zero := ⟨0, IsBlockDiagonal.zero⟩ + +theorem coe_zero {k : Type _} [DecidableEq k] {s : k → Type _} : + ((0 : (BlockDiagonals R k s)) : + Matrix (Σ i, s i) (Σ i, s i) R) = + 0 := + rfl + +theorem smul {k : Type _} [DecidableEq k] {s : k → Type _} + {x : Matrix (Σ i, s i) (Σ i, s i) R} (hx : x.IsBlockDiagonal) (α : R) : + (α • x).IsBlockDiagonal := by + simp only [Matrix.IsBlockDiagonal, blockDiag'_smul, blockDiagonal'_smul, hx.eq] + +instance Smul {k : Type _} [DecidableEq k] {s : k → Type _} : + SMul R (BlockDiagonals R k s) + where smul a x := + ⟨a • (x : Matrix (Σ i, s i) (Σ i, s i) R), Matrix.IsBlockDiagonal.smul (Subtype.mem x) a⟩ + +theorem coe_smul {k : Type _} [DecidableEq k] {s : k → Type _} + (a : R) (x : (BlockDiagonals R k s)) : + ((a • x : (BlockDiagonals R k s)) : + Matrix (Σ i, s i) (Σ i, s i) R) = + a • ↑x := + rfl + +end IsBlockDiagonal + +instance addCommMonoidBlockDiagonal {k : Type _} [DecidableEq k] {s : k → Type _} : + AddCommMonoid (BlockDiagonals R k s) + where + add_assoc x y z := by + ext + simp only [IsBlockDiagonal.coe_add, add_assoc] + zero_add a := by + ext + simp only [IsBlockDiagonal.coe_add, IsBlockDiagonal.coe_zero, zero_add] + add_zero a := by + ext + simp only [IsBlockDiagonal.coe_zero, IsBlockDiagonal.coe_add, add_zero] + add_comm a b := by + ext + simp only [IsBlockDiagonal.coe_add, add_comm] + nsmul n x := (n : R) • x + nsmul_zero x := by + ext + simp only [IsBlockDiagonal.coe_smul, Nat.cast_zero, zero_smul] + rfl + nsmul_succ n x := by + ext + simp only [IsBlockDiagonal.coe_smul, Nat.cast_succ, add_smul, one_smul, add_comm] + simp only [IsBlockDiagonal.coe_add, add_apply] + rw [add_comm] + rfl + + +private theorem IsBlockDiagonal.coe_sum_aux {k : Type _} [DecidableEq k] {s : k → Type _} {n : ℕ} + {x : Fin n → (BlockDiagonals R k s)} : + ((∑ i, x i : (BlockDiagonals R k s)) : + Matrix (Σ i, s i) (Σ i, s i) R) = + ∑ i, (x i : Matrix (Σ i, s i) (Σ i, s i) R) := + by + induction n with + | zero => + rfl + | succ d hd => + simp only [Fin.sum_univ_succ, Matrix.IsBlockDiagonal.coe_add, hd] + +namespace IsBlockDiagonal + +theorem coe_sum {k : Type _} [DecidableEq k] {s : k → Type _} {n : Type _} [Fintype n] + {x : n → (BlockDiagonals R k s)} : + ((∑ i, x i : (BlockDiagonals R k s)) : + Matrix (Σ i, s i) (Σ i, s i) R) = + ∑ i, (x i : Matrix (Σ i, s i) (Σ i, s i) R) := + by + let σ : Fin (Fintype.card n) ≃ n := (Fintype.equivFin n).symm + have : ∑ i : n, x i = ∑ i : Fin (Fintype.card n), x (σ i) := + by + apply Fintype.sum_equiv σ.symm + intro i + simp only [Equiv.apply_symm_apply] + rw [this] + have : ∑ i : n, (x i : Matrix (Σ i, s i) (Σ i, s i) R) = ∑ i : Fin (Fintype.card n), x (σ i) := + by + simp_rw [IsBlockDiagonal.coe_sum_aux] + apply Fintype.sum_equiv σ.symm + intro i + simp only [Equiv.apply_symm_apply] + rw [this] + +end IsBlockDiagonal + +instance mulActionBlockDiagonal {k : Type _} [DecidableEq k] {s : k → Type _} : + MulAction R (BlockDiagonals R k s) + where + one_smul x := by ext; simp only [IsBlockDiagonal.coe_smul, one_smul] + mul_smul a b x := by ext; simp only [← smul_smul, IsBlockDiagonal.coe_smul] + +instance distribMulActionBlockDiagonal {k : Type _} [DecidableEq k] {s : k → Type _} : + DistribMulAction R (BlockDiagonals R k s) + where + smul_zero x := by + ext + simp only [IsBlockDiagonal.coe_smul, Matrix.IsBlockDiagonal.coe_zero, smul_zero] + smul_add a x y := by + simp only [Subtype.ext_iff, Matrix.IsBlockDiagonal.coe_add, Matrix.IsBlockDiagonal.coe_smul, + smul_add] + +instance moduleBlockDiagonal {k : Type _} [DecidableEq k] {s : k → Type _} : + Module R (BlockDiagonals R k s) + where + add_smul x y a := by + ext + simp only [IsBlockDiagonal.coe_add, add_smul, Matrix.IsBlockDiagonal.coe_smul] + zero_smul a := + by + simp only [Subtype.ext_iff, Matrix.IsBlockDiagonal.coe_smul, zero_smul] + rfl + +namespace IsBlockDiagonal + +theorem blockDiagonal' {k : Type _} [DecidableEq k] {s : k → Type _} + (x : PiMat R k s) : (blockDiagonal' x).IsBlockDiagonal := by + rw [Matrix.IsBlockDiagonal, blockDiag'_blockDiagonal'] + +end IsBlockDiagonal + +theorem isBlockDiagonal_iff {k : Type _} [DecidableEq k] {s : k → Type _} + (x : Matrix (Σ i, s i) (Σ i, s i) R) : + x.IsBlockDiagonal ↔ ∃ y : PiMat R k s, x = blockDiagonal' y := + ⟨fun h => ⟨x.blockDiag', h.symm⟩, by + rintro ⟨y, rfl⟩; exact Matrix.IsBlockDiagonal.blockDiagonal' y⟩ + +/-- A block-diagonal matrix with one nonzero matrix-entry inside a specified block. -/ +def singleBlockDiagonal {k : Type _} [DecidableEq k] {s : k → Type _} + [∀ i, DecidableEq (s i)] (i : k) (j l : s i) (α : R) : + (BlockDiagonals R k s) := + ⟨single ⟨i, j⟩ ⟨i, l⟩ α, + by + simp only [Matrix.IsBlockDiagonal, blockDiag'_apply, blockDiagonal'_apply, + Matrix.blockDiagonal'_ext, dite_eq_iff'] + intro a b c d + constructor + · intro h + congr + simp only [cast_heq] + · intro h + symm + apply single_apply_of_ne + rintro ⟨⟨rfl, h2⟩, ⟨rfl, h4⟩⟩ + contradiction⟩ + +theorem includeBlock_conjTranspose {R k : Type _} [CommSemiring R] [StarRing R] [DecidableEq k] + {s : k → Type _} {i : k} + {x : Matrix (s i) (s i) R} : star (includeBlock x) = includeBlock xᴴ := + by + ext + simp only [Pi.star_apply, includeBlock_apply, star_apply] + split_ifs <;> aesop + +theorem includeBlock_inj {k : Type _} [DecidableEq k] {s : k → Type _} {i : k} + {x y : Matrix (s i) (s i) R} : + includeBlock x = includeBlock y ↔ x = y := + by + simp only [includeBlock_apply] + refine ⟨fun h => ?_, fun h => by rw [h]⟩ + simp_rw [funext_iff, ← Matrix.ext_iff, eq_mp_eq_cast] at h + ext j k + specialize h i j k + aesop + +theorem blockDiagonal'_includeBlock_isHermitian_iff {R k : Type _} [CommSemiring R] [StarRing R] + [DecidableEq k] {s : k → Type _} {i : k} (x : Matrix (s i) (s i) R) : + (blockDiagonal' (includeBlock x)).IsHermitian ↔ x.IsHermitian := by + calc + (blockDiagonal' (includeBlock x)).IsHermitian ↔ + (blockDiagonal' (includeBlock x))ᴴ = blockDiagonal' (includeBlock x) := + by simp only [IsHermitian] + _ ↔ blockDiagonal' (star (includeBlock x)) = blockDiagonal' (includeBlock x) := by + simp only [blockDiagonal'_conjTranspose]; rfl + _ ↔ star (includeBlock x) = (includeBlock x) := blockDiagonal'_inj + _ ↔ (includeBlock xᴴ) = (includeBlock x) := by simp only [includeBlock_conjTranspose] + _ ↔ xᴴ = x := includeBlock_inj + _ ↔ x.IsHermitian := by simp only [IsHermitian] + +theorem matrix_eq_sum_includeBlock {R k : Type _} [CommSemiring R] [Fintype k] [DecidableEq k] + {s : k → Type _} (x : PiMat R k s) : + x = ∑ i, includeBlock (x i) := + (sum_includeBlock _).symm + +theorem includeBlock_apply_same {R k : Type _} [CommSemiring R] [DecidableEq k] + {s : k → Type _} {i : k} + (x : Matrix (s i) (s i) R) : includeBlock x i = x := by rw [includeBlock_apply]; aesop + +theorem includeBlock_apply_ne_same {R k : Type _} [CommSemiring R] [DecidableEq k] + {s : k → Type _} {i j : k} + (x : Matrix (s i) (s i) R) (h : i ≠ j) : includeBlock x j = 0 := by + simp only [includeBlock_apply, h, dif_neg, not_false_iff] + +theorem includeBlock_apply_single {R k : Type _} [CommSemiring R] [DecidableEq k] + {s : k → Type _} [∀ i, DecidableEq (s i)] {i : k} + (a b : s i) : + includeBlock (single a b (1 : R)) = + (single (⟨i, a⟩ : Σ j, s j) (⟨i, b⟩ : Σ j, s j) (1 : R)).blockDiag' := + by + ext c d e + simp_rw [includeBlock_apply, blockDiag'_apply] + split_ifs with h + · simp only [eq_mp_eq_cast, single] + aesop + · symm + apply single_apply_of_ne + simp only [Sigma.mk.inj_iff, h, false_and, and_self, not_false_eq_true] + +theorem includeBlock_hMul_includeBlock {R k : Type _} [CommSemiring R] [DecidableEq k] + {s : k → Type _} [∀ i, Fintype (s i)] {i j : k} + (x : Matrix (s i) (s i) R) (y : Matrix (s j) (s j) R) : + includeBlock x * includeBlock y = + dite (j = i) (fun h => includeBlock (x * by rw [← h]; exact y)) fun h => 0 := + by + ext + simp [includeBlock_apply, MulZeroClass.mul_zero, MulZeroClass.zero_mul, dite_apply] + split_ifs <;> aesop + +namespace IsBlockDiagonal + +theorem mul {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Fintype (s i)] {x y : Matrix (Σ i, s i) (Σ i, s i) R} (hx : x.IsBlockDiagonal) + (hy : y.IsBlockDiagonal) : (x * y).IsBlockDiagonal := + by + simp only [Matrix.IsBlockDiagonal] + rw [← hx.eq, ← hy.eq, ← blockDiagonal'_mul, blockDiag'_blockDiagonal'] + +@[reducible, instance] +def hasMul {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Fintype (s i)] : + Mul (BlockDiagonals R k s) + where mul x y := ⟨↑x * ↑y, IsBlockDiagonal.mul x.2 y.2⟩ + +theorem coe_mul {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Fintype (s i)] + {x y : (BlockDiagonals R k s)} : + ((x * y : (BlockDiagonals R k s)) : + Matrix (Σ i, s i) (Σ i, s i) R) = + x * y := + rfl + +theorem one {k : Type _} [DecidableEq k] {s : k → Type _} [∀ i, DecidableEq (s i)] : + (1 : Matrix (Σ i, s i) (Σ i, s i) R).IsBlockDiagonal := by + simp only [Matrix.IsBlockDiagonal, blockDiag'_one, blockDiagonal'_one] + +@[reducible, instance] +def hasOne {k : Type _} [DecidableEq k] {s : k → Type _} [∀ i, DecidableEq (s i)] : + One (BlockDiagonals R k s) + where one := ⟨(1 : Matrix (Σ i, s i) (Σ i, s i) R), IsBlockDiagonal.one⟩ + +theorem coe_one {k : Type _} [DecidableEq k] {s : k → Type _} [∀ i, DecidableEq (s i)] : + ((1 : (BlockDiagonals R k s)) : + Matrix (Σ i, s i) (Σ i, s i) R) = + 1 := + rfl + +theorem coe_nsmul {k : Type _} [DecidableEq k] {s : k → Type _} (n : ℕ) + (x : (BlockDiagonals R k s)) : + ((n • x : (BlockDiagonals R k s)) : + Matrix (Σ i, s i) (Σ i, s i) R) = + n • ↑x := + by simp_rw [← Nat.cast_smul_eq_nsmul R n, ← IsBlockDiagonal.coe_smul] + +theorem npow {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Fintype (s i)] [∀ i, DecidableEq (s i)] (n : ℕ) {x : Matrix (Σ i, s i) (Σ i, s i) R} + (hx : x.IsBlockDiagonal) : (x ^ n).IsBlockDiagonal := + by + induction n with + | zero => + simp only [pow_zero] + exact IsBlockDiagonal.one + | succ d hd => + simp only [pow_succ] + exact IsBlockDiagonal.mul hd hx + +@[reducible, instance] +def hasNpow {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Fintype (s i)] [∀ i, DecidableEq (s i)] : + Pow (BlockDiagonals R k s) ℕ + where pow x n := ⟨(x : Matrix (Σ i, s i) (Σ i, s i) R) ^ n, IsBlockDiagonal.npow n x.2⟩ + +theorem coe_npow {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Fintype (s i)] [∀ i, DecidableEq (s i)] (n : ℕ) + (x : (BlockDiagonals R k s)) : + ((x ^ n : (BlockDiagonals R k s)) : + Matrix (Σ i, s i) (Σ i, s i) R) = + x ^ n := + rfl + +@[reducible, instance] +def semiring {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Fintype (s i)] [∀ i, DecidableEq (s i)] : + Semiring (BlockDiagonals R k s) + where + -- add := (· + ·) + -- add_assoc := add_assoc + -- zero := 0 + -- zero_add := zero_add + -- add_zero := add_zero + -- nsmul := (· • ·) + -- nsmul_zero x := by simp only [zero_nsmul] <;> rfl + -- nsmul_succ n x := by + -- ext + -- simp only [IsBlockDiagonal.coe_nsmul, IsBlockDiagonal.coe_add, Nat.succ_eq_add_one, + -- add_smul, one_smul, add_comm] + -- add_comm := add_comm + mul := (· * ·) + left_distrib x y z := by + ext + simp only [IsBlockDiagonal.coe_mul, IsBlockDiagonal.coe_add, mul_add] + right_distrib x y z := by + ext + simp only [IsBlockDiagonal.coe_mul, IsBlockDiagonal.coe_add, add_mul] + zero_mul x := by + ext; + simp only [IsBlockDiagonal.coe_mul, IsBlockDiagonal.coe_zero, MulZeroClass.zero_mul] + mul_zero x := by + ext + simp only [IsBlockDiagonal.coe_mul, IsBlockDiagonal.coe_zero, MulZeroClass.mul_zero] + mul_assoc x y z := by ext; simp only [IsBlockDiagonal.coe_mul, mul_assoc] + one := 1 + one_mul x := by ext; simp only [IsBlockDiagonal.coe_mul, IsBlockDiagonal.coe_one, one_mul] + mul_one x := by ext; simp only [IsBlockDiagonal.coe_mul, IsBlockDiagonal.coe_one, mul_one] + natCast n := n • 1 + natCast_zero := by + ext + simp only [IsBlockDiagonal.coe_zero, zero_smul] + natCast_succ a := by + ext + simp only [IsBlockDiagonal.coe_nsmul, IsBlockDiagonal.coe_one, IsBlockDiagonal.coe_add, + add_smul, one_smul, add_comm] + npow n x := x ^ n + npow_zero x := by + ext + simp only [IsBlockDiagonal.coe_npow, IsBlockDiagonal.coe_one, pow_zero] + npow_succ n x := by + ext + simp_rw [IsBlockDiagonal.coe_npow, pow_add, IsBlockDiagonal.coe_mul, + pow_one, IsBlockDiagonal.coe_npow] + +@[reducible, instance] +def algebra {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Fintype (s i)] [∀ i, DecidableEq (s i)] : + Algebra R (BlockDiagonals R k s) + where + algebraMap := + { toFun r := + ⟨algebraMap R (Matrix (Σ i, s i) (Σ i, s i) R) r, + by + rw [Algebra.algebraMap_eq_smul_one] + exact Matrix.IsBlockDiagonal.smul Matrix.IsBlockDiagonal.one r⟩ + map_one' := by + apply Subtype.ext + exact map_one (algebraMap R (Matrix (Σ i, s i) (Σ i, s i) R)) + map_zero' := by + apply Subtype.ext + exact map_zero (algebraMap R (Matrix (Σ i, s i) (Σ i, s i) R)) + map_add' x y := by + apply Subtype.ext + exact map_add (algebraMap R (Matrix (Σ i, s i) (Σ i, s i) R)) x y + map_mul' x y := by + apply Subtype.ext + exact map_mul (algebraMap R (Matrix (Σ i, s i) (Σ i, s i) R)) x y } + commutes' r x := by + apply Subtype.ext + exact Algebra.commutes r (x : Matrix (Σ i, s i) (Σ i, s i) R) + smul_def' r x := by + apply Subtype.ext + exact Algebra.smul_def r (x : Matrix (Σ i, s i) (Σ i, s i) R) + +theorem coe_blockDiagonal'_blockDiag' {k : Type _} [DecidableEq k] {s : k → Type _} + (x : (BlockDiagonals R k s)) : + Matrix.blockDiagonal' (blockDiag' (x : Matrix (Σ i, s i) (Σ i, s i) R)) = x := + x.property + +end IsBlockDiagonal + +/-- Block-diagonal matrices are algebra-equivalent to block-indexed matrix families. -/ +@[simps] +def isBlockDiagonalPiAlgEquiv {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Fintype (s i)] [∀ i, DecidableEq (s i)] : + (BlockDiagonals R k s) ≃ₐ[R] PiMat R k s + where + toFun x := blockDiag' (x : Matrix (Σ i, s i) (Σ i, s i) R) + invFun x := ⟨blockDiagonal' x, Matrix.IsBlockDiagonal.blockDiagonal' x⟩ + left_inv x := by + ext + simp only [IsBlockDiagonal.coe_blockDiagonal'_blockDiag'] + right_inv x := by + ext + simp only [blockDiag'_blockDiagonal'] + map_add' x y := by + change blockDiag' ((x : Matrix (Σ i, s i) (Σ i, s i) R) + + (y : Matrix (Σ i, s i) (Σ i, s i) R)) = + blockDiag' (x : Matrix (Σ i, s i) (Σ i, s i) R) + + blockDiag' (y : Matrix (Σ i, s i) (Σ i, s i) R) + exact blockDiag'_add _ _ + commutes' r := by + ext i a b + simp only [Algebra.algebraMap_eq_smul_one, IsBlockDiagonal.coe_smul, + IsBlockDiagonal.coe_one, blockDiag'_smul, blockDiag'_one, Pi.smul_apply] + map_mul' x y := by + apply blockDiagonal'_injective + calc + blockDiagonal' + (blockDiag' ((x * y : BlockDiagonals R k s) : + Matrix (Σ i, s i) (Σ i, s i) R)) = + ((x * y : BlockDiagonals R k s) : + Matrix (Σ i, s i) (Σ i, s i) R) := + IsBlockDiagonal.coe_blockDiagonal'_blockDiag' (x * y) + _ = (x : Matrix (Σ i, s i) (Σ i, s i) R) * y := rfl + _ = + blockDiagonal' (blockDiag' (x : Matrix (Σ i, s i) (Σ i, s i) R)) * + blockDiagonal' (blockDiag' (y : Matrix (Σ i, s i) (Σ i, s i) R)) := by + rw [IsBlockDiagonal.coe_blockDiagonal'_blockDiag' x, + IsBlockDiagonal.coe_blockDiagonal'_blockDiag' y] + _ = blockDiagonal' + (blockDiag' (x : Matrix (Σ i, s i) (Σ i, s i) R) * + blockDiag' (y : Matrix (Σ i, s i) (Σ i, s i) R)) := by + rw [← blockDiagonal'_mul] + rfl + +namespace IsBlockDiagonal + +theorem star {R : Type _} [CommSemiring R] [StarAddMonoid R] {k : Type _} + [DecidableEq k] {s : k → Type _} {x : Matrix (Σ i, s i) (Σ i, s i) R} (hx : x.IsBlockDiagonal) : + xᴴ.IsBlockDiagonal := by + rw [IsBlockDiagonal] + nth_rw 2 [← hx.eq] + simp_rw [blockDiagonal'_conjTranspose, ← blockDiag'_conjTranspose] + +@[reducible, instance] +def hasStar {R : Type _} [CommSemiring R] [StarAddMonoid R] {k : Type _} + [DecidableEq k] {s : k → Type _} : + Star (BlockDiagonals R k s) + where star x := ⟨(x : Matrix (Σ i, s i) (Σ i, s i) R)ᴴ, IsBlockDiagonal.star x.property⟩ + +theorem coe_star {R : Type _} [CommSemiring R] [StarAddMonoid R] {k : Type _} + [DecidableEq k] {s : k → Type _} + (y : (BlockDiagonals R k s)) : + ((Star.star y : BlockDiagonals R k s) : Matrix (Σ i, s i) (Σ i, s i) R) = yᴴ := + rfl + +end IsBlockDiagonal + +namespace isBlockDiagonalPiAlgEquiv + +theorem map_star {R : Type _} [CommSemiring R] [StarAddMonoid R] + {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} [∀ i, Fintype (s i)] + [∀ i, DecidableEq (s i)] (x : (BlockDiagonals R k s)) : + Matrix.isBlockDiagonalPiAlgEquiv (star x) = star (Matrix.isBlockDiagonalPiAlgEquiv x) := + by + ext1 + simp_rw [Pi.star_apply, isBlockDiagonalPiAlgEquiv_apply, IsBlockDiagonal.coe_star, + blockDiag'_conjTranspose] + rfl + +theorem symm_map_star {R : Type _} [CommSemiring R] [StarAddMonoid R] + {k : Type _} [Fintype k] [DecidableEq k] {s : k → Type _} [∀ i, Fintype (s i)] + [∀ i, DecidableEq (s i)] (x : PiMat R k s) : + Matrix.isBlockDiagonalPiAlgEquiv.symm (star x) = + star (Matrix.isBlockDiagonalPiAlgEquiv.symm x) := + by + ext1 + simp_rw [IsBlockDiagonal.coe_star, isBlockDiagonalPiAlgEquiv_symm_apply_coe, + blockDiagonal'_conjTranspose] + rfl + +end isBlockDiagonalPiAlgEquiv + +namespace Equiv + +/-- A variant of `Equiv.sigmaProdDistrib` with the product coordinate first. -/ +@[simps!] +def sigmaProdDistrib' {ι : Type _} (β : Type _) (α : ι → Type _) : + (β × Σ i : ι, α i) ≃ Σ i : ι, β × α i := + by + let this : (Σ i : ι, β × α i) ≃ Σ i : ι, α i × β := + by + apply Equiv.sigmaCongrRight + intro i + exact Equiv.prodComm _ _ + exact ((Equiv.prodComm _ _).trans (Equiv.sigmaProdDistrib _ _)).trans this.symm + +end Equiv + +/-- Distribute a product of sigma types into a nested sigma type. -/ +@[simps] +def sigmaProdSigma {α β : Type _} {ζ : α → Type _} {℘ : β → Type _} : + ((Σ i, ζ i) × Σ i, ℘ i) ≃ Σ i j, ζ i × ℘ j + where + toFun x := by + refine ⟨(Equiv.sigmaProdDistrib _ _ x).1, (Equiv.sigmaProdDistrib' _ _ x).1, (x.1.2, x.2.2)⟩ + invFun x := (⟨x.1, x.2.2.1⟩, ⟨x.2.1, x.2.2.2⟩) + left_inv x := + by + ext + <;> simp only [Equiv.sigmaProdDistrib'_apply_fst, Equiv.sigmaProdDistrib, Equiv.coe_fn_mk] + <;> rfl + right_inv x := + by + ext + <;> simp only [Equiv.sigmaProdDistrib'_apply_fst, Equiv.coe_fn_mk, Equiv.sigmaProdDistrib, + Equiv.coe_fn_mk] + simp only [Prod.mk.eta, heq_iff_eq] + +namespace IsBlockDiagonal + +theorem apply_of_ne {R : Type _} [CommSemiring R] {k : Type _} [DecidableEq k] + {s : k → Type _} {x : Matrix (Σ i, s i) (Σ i, s i) R} (hx : x.IsBlockDiagonal) (i j : Σ i, s i) + (h : i.1 ≠ j.1) : x i j = 0 := by + rw [← hx.eq] + simp_rw [blockDiagonal'_apply, blockDiag'_apply, dif_neg h] + +theorem apply_of_ne_coe {R : Type _} [CommSemiring R] {k : Type _} [DecidableEq k] {s : k → Type _} + (x : (BlockDiagonals R k s)) (i j : Σ i, s i) + (h : i.fst ≠ j.fst) : (x : Matrix (Σ i, s i) (Σ i, s i) R) i j = 0 := + IsBlockDiagonal.apply_of_ne x.2 i j h + +open scoped Kronecker + +theorem kronecker_hMul {R : Type _} [CommSemiring R] {k : Type _} [DecidableEq k] {s : k → Type _} + {x y : Matrix (Σ i, s i) (Σ i, s i) R} (hx : x.IsBlockDiagonal) : + IsBlockDiagonal fun i j => (x ⊗ₖ y) (sigmaProdSigma.symm i) (sigmaProdSigma.symm j) := + by + rw [Matrix.IsBlockDiagonal, blockDiagonal'_ext] + intro a b c d + simp only [blockDiagonal'_apply', blockDiag'_apply, kroneckerMap_apply, + sigmaProdSigma_symm_apply] + split_ifs with h + · congr <;> simp [h] + · rw [hx.apply_of_ne, MulZeroClass.zero_mul] + simpa [ne_eq] + +end IsBlockDiagonal + +/-- Conjugation by the block-diagonal/pi-matrix algebra equivalence on endomorphisms. -/ +@[simps!] +def directSumLinearMapAlgEquivIsBlockDiagonalLinearMap {R : Type _} [CommSemiring R] {k : Type _} + [Fintype k] [DecidableEq k] {s : k → Type _} [∀ i, Fintype (s i)] [∀ i, DecidableEq (s i)] : + ((PiMat R k s) →ₗ[R] PiMat R k s) ≃ₐ[R] + (BlockDiagonals R k s) →ₗ[R] + (BlockDiagonals R k s) := + isBlockDiagonalPiAlgEquiv.symm.toLinearEquiv.innerConj + +end Matrix + +variable {R k : Type _} [CommSemiring R] [Fintype k] [DecidableEq k] {s : k → Type _} + [∀ i, Fintype (s i)] [∀ i, DecidableEq (s i)] + +local notation x " ⊗ₘ " y => TensorProduct.map x y + +-- local notation "ℍ₂" => PiMat R k s + +local notation "ℍ_ " i => Matrix (s i) (s i) R + +open Matrix + +theorem TensorProduct.assoc_includeBlock {k : Type _} [DecidableEq k] {s : k → Type _} {i j : k} : + (↑(TensorProduct.assoc R (PiMat R k s) (PiMat R k s) + (PiMat R k s)).symm ∘ₗ + (includeBlock : Matrix (s i) (s i) R →ₗ[R] PiMat R k s) ⊗ₘ + (includeBlock : Matrix (s j) (s j) R →ₗ[R] PiMat R k s) ⊗ₘ + (includeBlock : Matrix (s j) (s j) R →ₗ[R] PiMat R k s)) = + (((includeBlock : Matrix (s i) (s i) R →ₗ[R] PiMat R k s) ⊗ₘ + (includeBlock : Matrix (s j) (s j) R →ₗ[R] PiMat R k s)) ⊗ₘ + (includeBlock : Matrix (s j) (s j) R →ₗ[R] PiMat R k s)) ∘ₗ + ↑(TensorProduct.assoc R (Matrix (s i) (s i) R) (Matrix (s j) (s j) R) + (Matrix (s j) (s j) R)).symm := + by + apply TensorProduct.ext_threefold' + intro x y z + simp only [LinearMap.comp_apply, LinearEquiv.coe_coe, TensorProduct.assoc_symm_tmul, + TensorProduct.map_tmul] diff --git a/LeanPool/Monlib4/LinearAlgebra/Matrix/IsAlmostHermitian.lean b/LeanPool/Monlib4/LinearAlgebra/Matrix/IsAlmostHermitian.lean new file mode 100644 index 0000000000..ca386e99fd --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Matrix/IsAlmostHermitian.lean @@ -0,0 +1,214 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Data.Complex.Basic +import Mathlib.LinearAlgebra.Matrix.Block +import Mathlib.LinearAlgebra.Matrix.Hermitian +import Mathlib.LinearAlgebra.Matrix.Kronecker +import Mathlib.Tactic +import LeanPool.Monlib4.LinearAlgebra.Matrix.Basic +import LeanPool.Monlib4.LinearAlgebra.Matrix.Conj + +/-! + # Almost Hermitian Matrices + + This file contains the definition and some basic results about almost Hermitian matrices. + + We say a matrix `x` is `is_almost_hermitian` if there exists some scalar `α ∈ ℂ`. +-/ + + +namespace Matrix + +variable {𝕜 n : Type _} + +open scoped Matrix + +/-- +a matrix $x \in M_n(\mathbb{k})$ is ``almost Hermitian'' if there exists some $\alpha\in\mathbb{k}$ + and $y\in M_n(\mathbb{k})$ such that $\alpha y = x$ and $y$ is Hermitian -/ +def IsAlmostHermitian [Star 𝕜] [SMul 𝕜 (Matrix n n 𝕜)] (x : Matrix n n 𝕜) : Prop := + ∃ (α : 𝕜) (y : Matrix n n 𝕜), α • y = x ∧ y.IsHermitian + +open scoped Kronecker + +open Complex + +open scoped ComplexConjugate + +/-- $x\in M_n(\mathbb{C})$ is almost Hermitian if and only if $x \otimes_k \bar{x}$ is Hermitian -/ +theorem isAlmostHermitian_iff (x : Matrix n n ℂ) : x.IsAlmostHermitian ↔ (x ⊗ₖ xᴴᵀ).IsHermitian := + by + constructor + · rintro ⟨α, y, ⟨rfl, h⟩⟩ + simp_rw [IsHermitian, conjTranspose_kronecker, conj_conjTranspose, conj_smul, transpose_smul, + conjTranspose_smul, h.eq, kronecker_smul, smul_kronecker, smul_smul, mul_comm, h.conj] + · intro h + simp_rw [IsHermitian, ← Matrix.ext_iff, conjTranspose_apply, kroneckerMap, of_apply, + conj_apply, star_mul', star_star, mul_comm _ (star _)] at h + have : ∀ i j : n, x i j = 0 ↔ x j i = 0 := by + intro i j + specialize h (i, i) (j, j) + simp_rw [RCLike.star_def, RCLike.conj_mul] at h + norm_cast at h + constructor <;> intro H + · rw [H, norm_zero, zero_pow (two_ne_zero), sq_eq_zero_iff, norm_eq_zero] at h + exact h + · rw [H, norm_zero, zero_pow (two_ne_zero), eq_comm, sq_eq_zero_iff, norm_eq_zero] at h + exact h + -- have this1 : ∀ i j : n, x i j = 0 ↔ xᴴ i j = 0 := by + -- simp_rw [conjTranspose_apply, star_eq_zero, this, forall₂_true_iff] + by_cases h' : x = 0 + · rw [h'] + use 0; use 0 + simp_rw [zero_smul, isHermitian_zero, true_and] + -- have hα_pre : + -- ∀ i j k l : n, x i j ≠ 0 → x k l ≠ 0 → x i j / star (x j i) = x k l / star (x l k) := + -- by + -- intro m₁ m₂ m₃ m₄ hx₁ hx₂ + -- rw [ne_eq, this] at hx₁ hx₂ + -- simp_rw [div_eq_div_iff (star_ne_zero.mpr hx₁) (star_ne_zero.mpr hx₂), mul_comm _ (star _), + -- RCLike.star_def] + -- exact h (_, _) (_, _) + have nonzero_ : ∃ i j : n, x i j ≠ 0 := + by + contrapose! h' + ext i j + exact h' i j + rcases nonzero_ with ⟨i, k, hik⟩ + let α := x i k / star (x k i) + have hα' : α ≠ 0 := + by + simp_rw [α, div_ne_zero_iff, star_ne_zero, ne_eq, this k i] + exact ⟨hik, hik⟩ + have Hα : α⁻¹ = conj α := by + simp_rw [α, ← RCLike.star_def, star_div₀, star_star, inv_div, RCLike.star_def, + div_eq_div_iff hik ((not_iff_not.mpr (this i k)).mp hik), ← RCLike.star_def, + h (k, k) (i, i)] + have conj_ : ∀ α : ℂ, RCLike.normSq α = RCLike.re (conj α * α) := fun α => by + simp_rw [RCLike.conj_mul, ← RCLike.ofReal_pow, RCLike.ofReal_re, + RCLike.normSq_eq_def'] + have Hα' : Real.sqrt (RCLike.normSq α) = 1 := by + simp_rw [Real.sqrt_eq_iff_eq_sq (RCLike.normSq_nonneg _) zero_le_one, one_pow, conj_, ← Hα, + inv_mul_cancel₀ hα', RCLike.one_re] + have another_hα : ∀ p q : n, x p q ≠ 0 → x p q = α * conj (x q p) := + by + intro p q _ + simp_rw [α, div_mul_eq_mul_div, mul_comm (x i k), ← RCLike.star_def, h (p, _) (_, _), ← + div_mul_eq_mul_div, ← star_div₀, div_self ((not_iff_not.mpr (this i k)).mp hik), star_one, + one_mul] + have : ∃ β : ℂ, β ^ 2 = α := by + exists α ^ ((2 : ℕ) : ℂ)⁻¹ + exact Complex.cpow_nat_inv_pow α two_ne_zero + rcases this with ⟨β, hβ⟩ + have hβ' : β ≠ 0 := by + rw [ne_eq, ← sq_eq_zero_iff, hβ] + exact hα' + have hβ'' : β⁻¹ = conj β := + by + rw [← mul_left_inj' hβ', inv_mul_cancel₀ hβ', ← Complex.normSq_eq_conj_mul_self] + norm_cast + simp_rw [Complex.normSq_eq_norm_sq, ← Complex.norm_pow, hβ] + exact Hα'.symm + have hαβ : β * α⁻¹ = β⁻¹ := by + rw [← hβ, pow_two, mul_inv, ← mul_assoc, mul_inv_cancel₀ hβ', one_mul] + use β + use β⁻¹ • x + simp_rw [IsHermitian, conjTranspose_smul, ← Matrix.ext_iff, Matrix.smul_apply, + conjTranspose_apply, smul_eq_mul, ← mul_assoc, mul_inv_cancel₀ hβ', one_mul, + forall₂_true_iff, true_and, hβ'', ← Complex.star_def, star_star] + · intro p q + by_cases H : x p q = 0 + · simp_rw [H, (this p q).mp H, star_zero, MulZeroClass.mul_zero] + · calc + β * star (x q p) = β * star (α * star (x p q)) := ?_ + _ = β * α⁻¹ * x p q := ?_ + _ = star β * x p q := ?_ + · rw [another_hα _ _ ((not_iff_not.mpr (this p q)).mp H), Complex.star_def] + · rw [star_mul', star_star, mul_comm (star _) (x p q), mul_assoc, + mul_comm _ (star _), Hα, ← Complex.star_def] + · simp_rw [hαβ, hβ'', ← Complex.star_def] + +/-- 0 is almost Hermitian -/ +theorem isAlmostHermitian_zero [Semiring 𝕜] [StarRing 𝕜] : (0 : Matrix n n 𝕜).IsAlmostHermitian := + by + use 0; use 0 + simp_rw [isHermitian_zero, zero_smul, and_true] + +/-- if $x$ is almost Hermitian, then it is also normal -/ +theorem _root_.Matrix.AlmostHermitian.isStarNormal [Fintype n] [CommSemiring 𝕜] [StarRing 𝕜] + {M : Matrix n n 𝕜} (hM : M.IsAlmostHermitian) : IsStarNormal M := + by + obtain ⟨α, N, ⟨rfl, hN⟩⟩ := hM + apply IsStarNormal.mk + simp_rw [Commute, SemiconjBy, star_smul, smul_mul_smul_comm, star_eq_conjTranspose, + hN.eq, mul_comm] + +/-- $x$ is almost Hermitian if and only if $\beta \cdot x$ is almost Hermitian for any $\beta$ -/ +theorem almost_hermitian_iff_smul [CommSemiring 𝕜] [StarRing 𝕜] {M : Matrix n n 𝕜} : + M.IsAlmostHermitian ↔ ∀ β : 𝕜, (β • M).IsAlmostHermitian := + by + constructor + · rintro ⟨α, N, ⟨rfl, hN⟩⟩ β + use β * α + use N + simp_rw [smul_smul, true_and, hN] + · intro h + specialize h (1 : 𝕜) + simp_rw [one_smul] at h + exact h + +/-- A matrix whose off-diagonal entries are zero. -/ +def IsDiagonal {R n : Type _} [Zero R] (A : Matrix n n R) : Prop := + ∀ i j : n, i ≠ j → A i j = 0 + +theorem isDiagonal_eq {R : Type _} [Zero R] [DecidableEq n] (A : Matrix n n R) : + A.IsDiagonal ↔ diagonal A.diag = A := + by + simp_rw [← ext_iff, IsDiagonal, diagonal] + constructor + · intro h i j + by_cases H : i = j + · simp_rw [H, of_apply, if_true, diag] + · rw [of_apply, h _ _ H, ite_eq_right_iff] + intros + contradiction + · rintro h i j hij + specialize h i j + simp_rw [of_apply, hij, if_false] at h + exact h.symm + +open scoped BigOperators + +/-- an almost Hermitian matrix is upper-triangular if and only if it is diagonal -/ +theorem _root_.Matrix.IsAlmostHermitian.upper_triangular_iff_diagonal [Field 𝕜] [StarRing 𝕜] + [LinearOrder n] {M : Matrix n n 𝕜} (hM : M.IsAlmostHermitian) : + M.BlockTriangular id ↔ M.IsDiagonal := + by + rcases hM with ⟨α, N, ⟨rfl, hN⟩⟩ + simp_rw [BlockTriangular, Function.id_def, Matrix.smul_apply] + constructor + · intro h i j hij + by_cases H : j < i + · exact h H + · simp_rw [not_lt, le_iff_eq_or_lt, hij, false_or] at H + specialize h H + by_cases Hα : α = 0 + · simp_rw [Hα, zero_smul, Matrix.zero_apply] + · simp_rw [smul_eq_zero, Hα, false_or] at h + rw [← hN.eq] + simp_rw [Matrix.smul_apply, conjTranspose_apply, h, star_zero, smul_zero] + · intro h i j hij + exact h i j (ne_of_lt hij).symm + +theorem _root_.Matrix.IsHermitian.isAlmostHermitian [Semiring 𝕜] [Star 𝕜] {x : Matrix n n 𝕜} + (hx : x.IsHermitian) : x.IsAlmostHermitian := + by + use 1 + use x + rw [one_smul] + exact ⟨rfl, hx⟩ + +end Matrix diff --git a/LeanPool/Monlib4/LinearAlgebra/Matrix/PiMat.lean b/LeanPool/Monlib4/LinearAlgebra/Matrix/PiMat.lean new file mode 100644 index 0000000000..fd972797df --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Matrix/PiMat.lean @@ -0,0 +1,19 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import Mathlib.Data.Matrix.Basic + +/-- Square matrices over `R` indexed by `n`. -/ +abbrev Mat (R n : Type*) := Matrix n n R + +/-- Families of square matrices whose index type can vary with the family index. -/ +abbrev PiMat (R k : Type*) (s : k → Type*) := +Π i, (fun j => Mat R (s j)) i + +@[ext] +theorem PiMat.ext {R k : Type*} {s : k → Type*} {x y : PiMat R k s} + (h : ∀ i, x i = y i) : x = y := + funext h diff --git a/LeanPool/Monlib4/LinearAlgebra/Matrix/PosDefRpow.lean b/LeanPool/Monlib4/LinearAlgebra/Matrix/PosDefRpow.lean new file mode 100644 index 0000000000..78d2745867 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Matrix/PosDefRpow.lean @@ -0,0 +1,243 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.Matrix.PosEqLinearMapIsPositive +import LeanPool.Monlib4.LinearAlgebra.InnerAut +import LeanPool.Monlib4.LinearAlgebra.Matrix.StarOrderedRing + +/-! +# Real powers of positive definite matrices + +This file restores the upstream monlib4 API for real powers of positive +semidefinite and positive definite matrices. The definitions are stated in +terms of the current Mathlib Hermitian spectral theorem. +-/ + +namespace Matrix + +variable {n 𝕜 : Type _} [RCLike 𝕜] [Fintype n] [DecidableEq n] + +open scoped Matrix BigOperators ComplexOrder MatrixOrder + +theorem _root_.Matrix.IsHermitian.eigenvectorMatrix_conjTranspose_mul {A : Matrix n n 𝕜} + (hA : A.IsHermitian) : + hA.eigenvectorMatrixᴴ * hA.eigenvectorMatrix = 1 := by + rw [IsHermitian.eigenvectorMatrix, ← star_eq_conjTranspose] + exact UnitaryGroup.star_mul_self _ + +/-- Real powers of a Hermitian matrix, defined by spectral calculus. -/ +noncomputable def _root_.Matrix.IsHermitian.rpow {Q : Matrix n n 𝕜} + (hQ : IsHermitian Q) (r : ℝ) : + Matrix n n 𝕜 := + Matrix.innerAut hQ.eigenvectorUnitary + (Matrix.diagonal (RCLike.ofReal ∘ (hQ.eigenvalues ^ (r : ℝ) : n → ℝ) : n → 𝕜)) + +/-- Real powers of a positive semidefinite matrix. -/ +noncomputable abbrev _root_.Matrix.PosSemidef.rpow {Q : Matrix n n 𝕜} + (hQ : PosSemidef Q) (r : ℝ) : + Matrix n n 𝕜 := + hQ.1.rpow r + +/-- Real powers of a positive definite matrix. -/ +noncomputable abbrev _root_.Matrix.PosDef.rpow {Q : Matrix n n 𝕜} + (hQ : PosDef Q) (r : ℝ) : + Matrix n n 𝕜 := + hQ.1.rpow r + +lemma _root_.Matrix.PosDef.rpow_eq {Q : Matrix n n 𝕜} (hQ : Q.PosDef) (r : ℝ) : + hQ.rpow r = + Matrix.innerAut hQ.1.eigenvectorUnitary + (Matrix.diagonal (RCLike.ofReal ∘ (hQ.1.eigenvalues ^ r : n → ℝ) : n → 𝕜)) := + rfl + +theorem _root_.Matrix.PosSemidef.rpow_mul_rpow (r₁ r₂ : NNRealˣ) {Q : Matrix n n 𝕜} + (hQ : PosSemidef Q) : + hQ.rpow r₁ * hQ.rpow r₂ = hQ.rpow (r₁ + r₂) := by + simp_rw [PosSemidef.rpow, IsHermitian.rpow, ← innerAut.map_mul, Pi.pow_def, + diagonal_mul_diagonal, Function.comp_apply, ← RCLike.ofReal_mul] + congr + ext i + simp only [Function.comp_apply] + by_cases h : hQ.1.eigenvalues i = 0 + · simp_rw [h] + have hr₁ : (r₁ : ℝ) ≠ 0 := by + exact_mod_cast Units.ne_zero r₁ + have hr₂ : (r₂ : ℝ) ≠ 0 := by + exact_mod_cast Units.ne_zero r₂ + have hsum : ((r₁ : ℝ) + (r₂ : ℝ)) ≠ 0 := by + intro hsum + have hnn : ((r₁ : NNReal) + (r₂ : NNReal)) = 0 := by + exact_mod_cast hsum + exact Units.ne_zero r₁ (add_eq_zero.mp hnn).1 + simp [Real.zero_rpow, hr₁, hr₂, hsum] + · rw [← Real.rpow_add] + apply lt_of_le_of_ne (hQ.eigenvalues_nonneg _) + rw [ne_eq, eq_comm] + exact h + +theorem _root_.Matrix.PosDef.rpow_mul_rpow (r₁ r₂ : ℝ) {Q : Matrix n n 𝕜} + (hQ : PosDef Q) : + hQ.rpow r₁ * hQ.rpow r₂ = hQ.rpow (r₁ + r₂) := by + simp_rw [Matrix.PosDef.rpow, IsHermitian.rpow, ← innerAut.map_mul, Pi.pow_def, + diagonal_mul_diagonal, Function.comp_apply, ← RCLike.ofReal_mul, + ← Real.rpow_add (hQ.pos_eigenvalues _)] + rfl + +theorem _root_.Matrix.IsHermitian.rpow_one_eq_self {Q : Matrix n n 𝕜} + (hQ : Q.IsHermitian) : + hQ.rpow 1 = Q := by + simp_rw [IsHermitian.rpow, Pi.pow_def, Real.rpow_one] + rw [← IsHermitian.spectral_theorem'' hQ] + +theorem _root_.Matrix.PosSemidef.rpow_one_eq_self {Q : Matrix n n 𝕜} + (hQ : Q.PosSemidef) : + hQ.rpow 1 = Q := + hQ.1.rpow_one_eq_self + +theorem _root_.Matrix.PosDef.rpow_one_eq_self {Q : Matrix n n 𝕜} (hQ : Q.PosDef) : + hQ.rpow 1 = Q := + hQ.1.rpow_one_eq_self + +@[reducible, instance] +noncomputable def _root_.Matrix.PosDef.eigenvaluesInvertible {Q : Matrix n n 𝕜} + (hQ : Q.PosDef) : + Invertible (IsHermitian.eigenvalues hQ.1) := by + use (IsHermitian.eigenvalues hQ.1)⁻¹ + · ext i + simp_rw [Pi.mul_apply, Pi.inv_apply] + simp_rw [inv_mul_cancel₀ (NeZero.of_pos (hQ.pos_eigenvalues i)).out] + rfl + · ext i + simp_rw [Pi.mul_apply, Pi.inv_apply] + simp_rw [mul_inv_cancel₀ (NeZero.of_pos (hQ.pos_eigenvalues i)).out] + rfl + +@[reducible, instance] +noncomputable def _root_.Matrix.PosDef.eigenvaluesInvertible' {Q : Matrix n n 𝕜} + (hQ : Q.PosDef) : + Invertible (RCLike.ofReal ∘ (IsHermitian.eigenvalues hQ.1) : n → 𝕜) := by + letI := hQ.eigenvaluesInvertible + use (RCLike.ofReal ∘ (IsHermitian.eigenvalues hQ.1)⁻¹ : n → 𝕜) + · ext i + simp only [Pi.mul_def, Function.comp_apply, ← RCLike.ofReal_mul, Pi.inv_def, + inv_mul_cancel_of_invertible, RCLike.ofReal_one, Pi.one_def] + · ext i + simp only [Pi.mul_def, Function.comp_apply, ← RCLike.ofReal_mul, Pi.inv_def, + mul_inv_cancel_of_invertible, RCLike.ofReal_one, Pi.one_def] + +theorem _root_.Matrix.PosDef.rpow_neg_one_eq_inv_self {Q : Matrix n n 𝕜} + (hQ : Q.PosDef) : + hQ.rpow (-1) = Q⁻¹ := by + simp_rw [Matrix.PosDef.rpow] + symm + nth_rw 1 [IsHermitian.spectral_theorem'' hQ.1] + simp_rw [innerAut.map_inv, IsHermitian.rpow, Pi.pow_def, Real.rpow_neg_one, + Matrix.inv_diagonal] + simp only [innerAut_coe, EmbeddingLike.apply_eq_iff_eq, diagonal_eq_diagonal_iff, + Function.comp_apply] + intro i + letI := hQ.eigenvaluesInvertible' + simp_rw [Ring.inverse_invertible] + rfl + +theorem _root_.Matrix.IsHermitian.rpow_zero {Q : Matrix n n 𝕜} (hQ : Q.IsHermitian) : + hQ.rpow 0 = 1 := by + rw [IsHermitian.rpow, innerAut_eq_iff, innerAut_apply_one] + ext i j + by_cases h : i = j <;> simp [diagonal, h, Matrix.one_apply] + +theorem _root_.Matrix.PosSemidef.rpow_zero {Q : Matrix n n 𝕜} (hQ : Q.PosSemidef) : + hQ.rpow 0 = 1 := + hQ.1.rpow_zero + +theorem _root_.Matrix.PosDef.rpow_zero {Q : Matrix n n 𝕜} (hQ : Q.PosDef) : + hQ.rpow 0 = 1 := + hQ.1.rpow_zero + +theorem _root_.Matrix.IsHermitian.rpow.isHermitian {Q : Matrix n n 𝕜} + (hQ : Q.IsHermitian) (r : ℝ) : + (hQ.rpow r).IsHermitian := by + rw [IsHermitian.rpow, ← innerAut_isHermitian_iff, isHermitian_diagonal_iff] + simp only [Function.comp_apply, Pi.pow_apply, _root_.IsSelfAdjoint, RCLike.star_def, + RCLike.conj_ofReal, implies_true] + +theorem _root_.Matrix.PosSemidef.rpow.isPosSemidef {Q : Matrix n n 𝕜} + (hQ : Q.PosSemidef) (r : ℝ) : + (hQ.rpow r).PosSemidef := by + rw [Matrix.PosSemidef.rpow, IsHermitian.rpow, innerAut_posSemidef_iff, + Matrix.PosSemidef.diagonal_iff] + simp only [Function.comp_apply, RCLike.zero_le_real, Pi.pow_apply] + exact fun i => Real.rpow_nonneg (PosSemidef.eigenvalues_nonneg hQ i) r + +theorem _root_.Matrix.PosDef.rpow.isPosDef {Q : Matrix n n 𝕜} + (hQ : Q.PosDef) (r : ℝ) : + (hQ.rpow r).PosDef := by + rw [Matrix.PosDef.rpow_eq, innerAut_posDef_iff, Matrix.PosDef.diagonal_iff] + simp only [Function.comp_apply, RCLike.zero_lt_real, Pi.pow_apply] + exact fun i => Real.rpow_pos_of_pos (PosDef.pos_eigenvalues hQ i) r + +theorem _root_.Matrix.PosSemidef.sqrt_eq_rpow {Q : Matrix n n 𝕜} + (hQ : Q.PosSemidef) : + CFC.sqrt Q = hQ.rpow (1 / 2) := by + rw [CFC.sqrt_eq_cfc, cfc_nnreal_eq_real _ Q, hQ.1.cfc_eq] + simp only [Real.coe_sqrt, Real.coe_toNNReal', one_div] + have hdiag : + (diagonal (RCLike.ofReal ∘ (fun x => Real.sqrt (max x 0)) ∘ hQ.1.eigenvalues) : + Matrix n n 𝕜) = + diagonal (RCLike.ofReal ∘ (hQ.1.eigenvalues ^ ((2 : ℝ)⁻¹))) := by + ext i j + by_cases hij : i = j <;> simp [diagonal, hij, Real.sqrt_eq_rpow, + max_eq_left (hQ.eigenvalues_nonneg j)] + simp [PosSemidef.rpow, IsHermitian.rpow, IsHermitian.cfc, hdiag] + +theorem _root_.Matrix.PosDef.sqrt_eq_rpow {Q : Matrix n n 𝕜} (hQ : Q.PosDef) : + CFC.sqrt Q = hQ.rpow (1 / 2) := + hQ.posSemidef.sqrt_eq_rpow + +theorem _root_.Matrix.PosDef.rpow_ne_zero [Nonempty n] {Q : Matrix n n ℂ} + (hQ : Q.PosDef) {r : ℝ} : + hQ.rpow r ≠ 0 := by + simp_rw [Matrix.PosDef.rpow_eq, ne_eq, innerAut_eq_iff, innerAut_apply_zero, + ← Matrix.ext_iff, Matrix.diagonal, Matrix.zero_apply, of_apply, + ite_eq_right_iff, Function.comp_apply, RCLike.ofReal_eq_zero, Pi.pow_apply, + Real.rpow_eq_zero_iff_of_nonneg (le_of_lt (hQ.pos_eigenvalues _)), + (NeZero.of_pos (hQ.pos_eigenvalues _)).out, false_and, imp_false, + Classical.not_forall, Classical.not_not, exists_eq', exists_const] + +lemma _root_.Matrix.IsHermitian.rpow_cast {Q : Matrix n n 𝕜} (hQ : Q.IsHermitian) (r : ℝ) + {S : Matrix n n 𝕜} (hQS : Q = S) : + hQ.rpow r = (by rw [← hQS]; exact hQ : IsHermitian S).rpow r := by + aesop + +lemma _root_.Matrix.PosDef.rpow_cast {Q : Matrix n n 𝕜} (hQ : Q.PosDef) (r : ℝ) + {S : Matrix n n 𝕜} (hQS : Q = S) : + hQ.rpow r = (by rw [← hQS]; exact hQ : PosDef S).rpow r := + Matrix.IsHermitian.rpow_cast _ _ hQS + +lemma _root_.Matrix.PosSemidef.rpow_cast {Q : Matrix n n 𝕜} + (hQ : Q.PosSemidef) (r : ℝ) + {S : Matrix n n 𝕜} (hQS : Q = S) : + hQ.rpow r = (by rw [← hQS]; exact hQ : PosSemidef S).rpow r := + Matrix.IsHermitian.rpow_cast _ _ hQS + +theorem _root_.Matrix.posDefOne_rpow (n : Type _) [Fintype n] [DecidableEq n] (r : ℝ) : + (posDefOne : PosDef (1 : Matrix n n 𝕜)).rpow r = 1 := by + let hQ : PosDef (1 : Matrix n n 𝕜) := posDefOne + have heig : hQ.1.eigenvalues = fun _ => 1 := by + ext i + rw [hQ.1.eigenvalues_eq i, one_mulVec] + rw [dotProduct_comm, ← EuclideanSpace.inner_eq_star_dotProduct] + rw [inner_self_eq_norm_sq_to_K, hQ.1.eigenvectorBasis.orthonormal.norm_eq_one] + simp + rw [PosDef.rpow_eq] + rw [heig] + simp_rw [Pi.pow_def, Real.one_rpow] + have hdiag : (diagonal (RCLike.ofReal ∘ fun _ : n => (1 : ℝ)) : Matrix n n 𝕜) = 1 := by + ext i j + by_cases hij : i = j <;> simp [diagonal, hij, Matrix.one_apply] + rw [hdiag, innerAut_apply_one] + +end Matrix diff --git a/LeanPool/Monlib4/LinearAlgebra/Matrix/PosEqLinearMapIsPositive.lean b/LeanPool/Monlib4/LinearAlgebra/Matrix/PosEqLinearMapIsPositive.lean new file mode 100644 index 0000000000..ef626e3081 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Matrix/PosEqLinearMapIsPositive.lean @@ -0,0 +1,567 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Analysis.InnerProductSpace.Positive +import Mathlib.Analysis.Matrix.Order +import Mathlib.Analysis.Matrix.PosDef +import Mathlib.LinearAlgebra.Matrix.NonsingularInverse +import LeanPool.Monlib4.LinearAlgebra.End +import LeanPool.Monlib4.LinearAlgebra.Ips.Pos +import LeanPool.Monlib4.LinearAlgebra.Ips.RankOne +import LeanPool.Monlib4.LinearAlgebra.Matrix.Basic +import LeanPool.Monlib4.Preq.Ites +import LeanPool.Monlib4.Preq.RCLikeLe + +/-! +# Positivity of matrices and linear maps + +Compatibility wrappers for the part of Monlib's matrix-positive API now covered by Mathlib. +-/ + +namespace Matrix + +variable {𝕜 m n : Type*} [RCLike 𝕜] + [Fintype m] [DecidableEq m] [Fintype n] [DecidableEq n] + +open scoped ComplexConjugate + +/-- The adjoint of the linear map associated to a matrix is the map associated to its conjugate +transpose. -/ +theorem conjTranspose_eq_adjoint (A : Matrix m n 𝕜) : + A.conjTranspose.toEuclideanLin = LinearMap.adjoint A.toEuclideanLin := + Matrix.toEuclideanLin_conjTranspose_eq_adjoint A + +end Matrix + +variable {n 𝕜 : Type*} [RCLike 𝕜] + +open Matrix +open scoped Matrix ComplexOrder + +alias Matrix.posSemidef_star_mul_self := Matrix.posSemidef_conjTranspose_mul_self +alias Matrix.posSemidef_mul_star_self := Matrix.posSemidef_self_mul_conjTranspose + +theorem Matrix.toEuclideanLin_eq_piLp_linearEquiv [Fintype n] [DecidableEq n] : + Matrix.toEuclideanLin (𝕜 := 𝕜) (m := n) (n := n) = + Matrix.toLin (PiLp.basisFun 2 𝕜 n) (PiLp.basisFun 2 𝕜 n) := by + simpa [Matrix.toEuclideanLin] using + Matrix.toLpLin_eq_toLin (R := 𝕜) (m := n) (n := n) 2 2 + +open scoped InnerProductSpace + +lemma Matrix.of_isHermitian' [Fintype n] {x : Matrix n n 𝕜} + (hx : x.IsHermitian) : + ∀ x_1 : n → 𝕜, ↑(RCLike.re (Finset.sum Finset.univ fun i ↦ + (star x_1 i * Finset.sum Finset.univ fun x_2 ↦ x i x_2 * x_1 x_2))) = + Finset.sum Finset.univ fun x_2 ↦ + star x_1 x_2 * Finset.sum Finset.univ fun x_3 ↦ x x_2 x_3 * x_1 x_3 := by + classical + simp_rw [← RCLike.conj_eq_iff_re] + have hinner : ∀ x_1 : n → 𝕜, + (Finset.sum Finset.univ fun i ↦ star x_1 i * + Finset.sum Finset.univ fun x_2 ↦ x i x_2 * x_1 x_2) = + ⟪(EuclideanSpace.equiv n 𝕜).symm x_1, + (toEuclideanLin x) ((EuclideanSpace.equiv n 𝕜).symm x_1)⟫_𝕜 := fun x_1 => by + calc (Finset.sum Finset.univ fun i ↦ star x_1 i * + Finset.sum Finset.univ fun x_2 ↦ x i x_2 * x_1 x_2) + = ⟪x_1, x *ᵥ x_1⟫_𝕜 := by simp [inner, mul_comm, mulVec, dotProduct] + _ = ⟪(EuclideanSpace.equiv n 𝕜).symm x_1, + (EuclideanSpace.equiv n 𝕜).symm (x *ᵥ x_1)⟫_𝕜 := rfl + _ = ⟪(EuclideanSpace.equiv n 𝕜).symm x_1, + (toEuclideanLin x) ((EuclideanSpace.equiv n 𝕜).symm x_1)⟫_𝕜 := rfl + simp_rw [hinner, inner_conj_symm, ← LinearMap.adjoint_inner_left, + ← Matrix.toEuclideanLin_conjTranspose_eq_adjoint, hx.eq, forall_true_iff] + +theorem Matrix.posSemidef_eq_linearMap_positive' [Fintype n] [DecidableEq n] + (x : Matrix n n 𝕜) : + x.PosSemidef ↔ x.toEuclideanLin.IsPositive' := by + rw [LinearMap.isPositive'_iff_isPositive] + exact Matrix.isPositive_toEuclideanLin_iff.symm + +open scoped MatrixOrder + +theorem Matrix.posSemidef_iff [Fintype n] (x : Matrix n n 𝕜) : + x.PosSemidef ↔ ∃ y : Matrix n n 𝕜, x = yᴴ * y := by + classical + rw [← Matrix.nonneg_iff_posSemidef] + simpa [Matrix.star_eq_conjTranspose] using + (CStarAlgebra.nonneg_iff_eq_star_mul_self (a := x)) + +local notation "⟪" x "," y "⟫_𝕜" => @inner 𝕜 _ _ x y + +open scoped BigOperators + +theorem Matrix.dotProduct_eq_inner {n : Type*} [Fintype n] (x y : n → 𝕜) : + dotProduct (star x) y = ∑ i : n, ⟪x i, y i⟫_𝕜 := by + simp [dotProduct, RCLike.inner_apply, mul_comm] + +theorem Matrix.isHermitian_self_hMul_conjTranspose {m n : Type*} [Fintype m] + (A : Matrix m n 𝕜) : + (Aᴴ * A).IsHermitian := + Matrix.isHermitian_conjTranspose_mul_self A + +theorem Matrix.trace_star [Fintype n] {A : Matrix n n 𝕜} : star A.trace = Aᴴ.trace := by + rw [Matrix.trace_conjTranspose] + +theorem Matrix.nonneg_eigenvalues_of_posSemidef [Fintype n] [DecidableEq n] + {μ : ℝ} {A : Matrix n n 𝕜} + (hμ : Module.End.HasEigenvalue (toEuclideanLin A) ↑μ) (H : A.PosSemidef) : + 0 ≤ μ := by + have hpos := Matrix.isPositive_toEuclideanLin_iff.mpr H + exact eigenvalue_nonneg_of_nonneg hμ fun v => by + rw [← hpos.1 v v] + exact hpos.2 v + +theorem Matrix.IsHermitian.nonneg_eigenvalues_of_posSemidef [Fintype n] [DecidableEq n] + {A : Matrix n n 𝕜} (hA : A.PosSemidef) (i : n) : + 0 ≤ hA.1.eigenvalues i := + hA.eigenvalues_nonneg i + +/-- A matrix is invertible when its associated linear map is bijective. -/ +@[reducible] +noncomputable def Matrix.invertible_of_bij_toLin' [Fintype n] [DecidableEq n] + {Q : Matrix n n 𝕜} (h : Function.Bijective (toLin' Q)) : + Invertible Q := by + have h : Invertible (toLin' Q) := by + refine IsUnit.invertible ?_ + rw [LinearMap.isUnit_iff_ker_eq_bot] + exact LinearMap.ker_eq_bot_of_injective h.1 + refine IsUnit.invertible ?_ + rw [Matrix.isUnit_iff_isUnit_det] + rw [← LinearMap.det_toLin'] + apply LinearMap.isUnit_det + rw [← nonempty_invertible_iff_isUnit] + exact Nonempty.intro h + +lemma Matrix.bij_toLin'_of_invertible [Fintype n] [DecidableEq n] + {Q : Matrix n n 𝕜} (h : Invertible Q) : + Function.Bijective (toLin' Q) := by + simp_rw [Function.bijective_iff_has_inverse] + use (toLin' ⅟ Q) + simp only [Function.LeftInverse, Function.RightInverse, ← toLin'_mul_apply, + Invertible.invOf_mul_self, mul_invOf_self, toLin'_one, and_self, + LinearMap.id_apply, forall_true_iff] + +theorem Matrix.PosSemidef.invertible_iff_posDef {n : Type*} [Fintype n] + [DecidableEq n] {x : Matrix n n 𝕜} (hx : x.PosSemidef) : + Function.Bijective (toLin' x) ↔ x.PosDef := by + have hbij_isUnit : Function.Bijective (toLin' x) ↔ IsUnit x := by + constructor + · intro h + exact (nonempty_invertible_iff_isUnit x).mp ⟨Matrix.invertible_of_bij_toLin' h⟩ + · intro h + rcases (nonempty_invertible_iff_isUnit x).mpr h with ⟨hInv⟩ + exact Matrix.bij_toLin'_of_invertible hInv + rw [hbij_isUnit, hx.posDef_iff_isUnit] + +/-- A positive definite matrix is invertible. -/ +@[reducible] +noncomputable def Matrix.PosDef.invertible [Fintype n] [DecidableEq n] {Q : Matrix n n 𝕜} + (hQ : Q.PosDef) : + Invertible Q := + hQ.isUnit.invertible + +theorem Matrix.posSemidef_iff_vecMulVec [Finite n] {x : Matrix n n 𝕜} : + x.PosSemidef ↔ + ∃ (m : ℕ) (v : Fin m → EuclideanSpace 𝕜 n), + x = ∑ i : Fin m, vecMulVec (v i : n → 𝕜) (star (v i : n → 𝕜)) := by + constructor + · intro h + rcases (Matrix.posSemidef_iff_eq_sum_vecMulVec (𝕜 := 𝕜) (M := x)).mp h with + ⟨m, v, hv⟩ + exact ⟨m, fun i => WithLp.toLp 2 (v i), by simpa using hv⟩ + · rintro ⟨m, v, hv⟩ + apply (Matrix.posSemidef_iff_eq_sum_vecMulVec (𝕜 := 𝕜) (M := x)).mpr + exact ⟨m, fun i => (v i : n → 𝕜), by simpa using hv⟩ + +theorem vecMulVec_posSemidef [Finite n] (x : n → 𝕜) : + (vecMulVec x (star x)).PosSemidef := + Matrix.posSemidef_vecMulVec_self_star x + +/-- The identity is a positive definite matrix. -/ +theorem Matrix.posDefOne [DecidableEq n] : (1 : Matrix n n 𝕜).PosDef := + Matrix.PosDef.one + +alias Matrix.PosDef.pos_eigenvalues := Matrix.PosDef.eigenvalues_pos + +theorem Matrix.PosDef.trace_ne_zero [Fintype n] [Nonempty n] + {x : Matrix n n 𝕜} (hx : x.PosDef) : + x.trace ≠ 0 := by + exact ne_of_gt hx.trace_pos + +/-- A positive definite matrix has trace with positive real part. -/ +theorem Matrix.PosDef.pos_trace [Fintype n] [Nonempty n] + {x : Matrix n n 𝕜} (hx : x.PosDef) : + 0 < RCLike.re x.trace := + (RCLike.pos_def.mp hx.trace_pos).1 + +/-- The Euclidean linear map associated to a matrix acts by matrix-vector multiplication. -/ +lemma Matrix.toEuclideanLin_apply' [Fintype n] [DecidableEq n] + (x : Matrix n n 𝕜) (v : EuclideanSpace 𝕜 n) : + x.toEuclideanLin v = x.mulVec v := + rfl + +namespace rankOne + +theorem _root_.rankOne.EuclideanSpace.toEuclideanLin_symm {𝕜 : Type*} [RCLike 𝕜] {n m : Type*} + [Fintype n] [Fintype m] [DecidableEq m] + (x : EuclideanSpace 𝕜 n) (y : EuclideanSpace 𝕜 m) : + Matrix.toEuclideanLin.symm (rankOne 𝕜 x y).toLinearMap = + Matrix.replicateCol (Fin 1) (x : n → 𝕜) * + (Matrix.replicateCol (Fin 1) (y : m → 𝕜))ᴴ := by + have hrank : (rankOne 𝕜 x y).toLinearMap = + (InnerProductSpace.rankOne 𝕜 x y).toLinearMap := by + ext z i + rfl + rw [hrank, InnerProductSpace.symm_toEuclideanLin_rankOne] + rw [Matrix.vecMulVec_eq (Fin 1), Matrix.conjTranspose_replicateCol] + rfl + +theorem _root_.rankOne.EuclideanSpace.toMatrix' {𝕜 : Type*} [RCLike 𝕜] {n m : Type*} + [Fintype n] [Fintype m] [DecidableEq m] + (x : EuclideanSpace 𝕜 n) (y : EuclideanSpace 𝕜 m) : + Matrix.toEuclideanLin.symm (rankOne 𝕜 x y).toLinearMap = + Matrix.replicateCol (Fin 1) (x : n → 𝕜) * + (Matrix.replicateCol (Fin 1) (y : m → 𝕜))ᴴ := + rankOne.EuclideanSpace.toEuclideanLin_symm x y + +theorem _root_.rankOne.Pi.toMatrix'' {𝕜 : Type*} [RCLike 𝕜] {n : Type*} [Fintype n] + [DecidableEq n] (x y : n → 𝕜) : + Matrix.toEuclideanLin.symm + (rankOne 𝕜 ((EuclideanSpace.equiv n 𝕜).symm x) + ((EuclideanSpace.equiv n 𝕜).symm y)).toLinearMap = + Matrix.replicateCol (Fin 1) x * (Matrix.replicateCol (Fin 1) y)ᴴ := + rankOne.EuclideanSpace.toEuclideanLin_symm _ _ + +end rankOne + +theorem Matrix.vecMulVec_eq_replicateCol_conjTranspose (v : n → 𝕜) : + vecMulVec v (star v) = replicateCol (Fin 1) v * (replicateCol (Fin 1) v)ᴴ := by + rw [Matrix.conjTranspose_replicateCol] + rw [Matrix.vecMulVec_eq (Fin 1)] + rfl + +theorem Matrix.posSemidef_iff_replicateCol_mul_conjTranspose_replicateCol [Finite n] + {x : Matrix n n 𝕜} : + x.PosSemidef ↔ + ∃ (m : ℕ) (v : Fin m → EuclideanSpace 𝕜 n), + x = + ∑ i : Fin m, + replicateCol (Fin 1) (v i : n → 𝕜) * + (replicateCol (Fin 1) (v i : n → 𝕜))ᴴ := by + rw [Matrix.posSemidef_iff_vecMulVec] + constructor <;> rintro ⟨m, v, hv⟩ <;> refine ⟨m, v, ?_⟩ + · simpa only [Matrix.vecMulVec_eq_replicateCol_conjTranspose] using hv + · simpa only [Matrix.vecMulVec_eq_replicateCol_conjTranspose] using hv + +theorem Matrix.posSemidef_iff_vecMulVec' [Finite n] + {x : Matrix n n 𝕜} : + x.PosSemidef ↔ + ∃ (m : Type) (_hm : Fintype m) (v : m → EuclideanSpace 𝕜 n), + x = ∑ i : m, vecMulVec (v i : n → 𝕜) (star (v i : n → 𝕜)) := by + constructor + · intro hx + rcases (Matrix.posSemidef_iff_vecMulVec.mp hx) with ⟨m, v, hv⟩ + exact ⟨Fin m, inferInstance, v, hv⟩ + · rintro ⟨m, hm, v, hv⟩ + letI := hm + rw [Matrix.posSemidef_iff_vecMulVec] + let v' : Fin (Fintype.card m) → EuclideanSpace 𝕜 n := + fun i => v ((Fintype.equivFin m).symm i) + refine ⟨Fintype.card m, v', ?_⟩ + rw [hv] + exact Fintype.sum_equiv (Fintype.equivFin m) + (fun i => vecMulVec (v i : n → 𝕜) (star (v i : n → 𝕜))) + (fun i => vecMulVec (v' i : n → 𝕜) (star (v' i : n → 𝕜))) + (by intro i; simp [v']) + +theorem Matrix.posSemidef_iff_replicateCol_mul_conjTranspose_replicateCol' [Finite n] + {x : Matrix n n 𝕜} : + x.PosSemidef ↔ + ∃ (m : Type) (_hm : Fintype m) (v : m → EuclideanSpace 𝕜 n), + x = + ∑ i : m, + replicateCol (Fin 1) (v i : n → 𝕜) * + (replicateCol (Fin 1) (v i : n → 𝕜))ᴴ := by + rw [Matrix.posSemidef_iff_vecMulVec'] + constructor <;> rintro ⟨m, hm, v, hv⟩ <;> refine ⟨m, hm, v, ?_⟩ + · simpa only [Matrix.vecMulVec_eq_replicateCol_conjTranspose] using hv + · simpa only [Matrix.vecMulVec_eq_replicateCol_conjTranspose] using hv + +theorem Matrix.posSemidef_iff_eq_rankOne [Fintype n] [DecidableEq n] + {x : Matrix n n 𝕜} : + x.PosSemidef ↔ + ∃ (m : ℕ) (v : Fin m → EuclideanSpace 𝕜 n), + x = ∑ i : Fin m, Matrix.toEuclideanLin.symm (rankOne 𝕜 (v i) (v i)).toLinearMap := by + rw [Matrix.posSemidef_iff_replicateCol_mul_conjTranspose_replicateCol] + simp_rw [rankOne.EuclideanSpace.toEuclideanLin_symm] + +theorem Matrix.posSemidef_iff_eq_rankOne' [Fintype n] [DecidableEq n] + {x : Matrix n n 𝕜} : + x.PosSemidef ↔ + ∃ (m : ℕ) (v : Fin m → (n → 𝕜)), + x = + ∑ i : Fin m, + Matrix.toEuclideanLin.symm + (rankOne 𝕜 ((EuclideanSpace.equiv n 𝕜).symm (v i)) + ((EuclideanSpace.equiv n 𝕜).symm (v i))).toLinearMap := by + rw [Matrix.posSemidef_iff_eq_rankOne] + constructor + · rintro ⟨m, v, hv⟩ + exact ⟨m, fun i => (v i : n → 𝕜), by simpa using hv⟩ + · rintro ⟨m, v, hv⟩ + exact ⟨m, fun i => (EuclideanSpace.equiv n 𝕜).symm (v i), by simpa using hv⟩ + +theorem Matrix.posSemidef_iff_eq_rankOne'' [Fintype n] [DecidableEq n] + {x : Matrix n n 𝕜} : + x.PosSemidef ↔ + ∃ (m : Type) (_hm : Fintype m) (v : m → (n → 𝕜)), + x = + ∑ i : m, + Matrix.toEuclideanLin.symm + (rankOne 𝕜 ((EuclideanSpace.equiv n 𝕜).symm (v i)) + ((EuclideanSpace.equiv n 𝕜).symm (v i))).toLinearMap := by + rw [Matrix.posSemidef_iff_replicateCol_mul_conjTranspose_replicateCol'] + constructor + · rintro ⟨m, hm, v, hv⟩ + exact ⟨m, hm, fun i => (v i : n → 𝕜), by simpa only [← rankOne.Pi.toMatrix''] using hv⟩ + · rintro ⟨m, hm, v, hv⟩ + exact ⟨m, hm, fun i => (EuclideanSpace.equiv n 𝕜).symm (v i), + by simpa only [rankOne.Pi.toMatrix''] using hv⟩ + +/-- For complex matrices, positive semidefiniteness is equivalent to nonnegative quadratic +forms. -/ +theorem Matrix.PosSemidef.complex [Fintype n] (x : Matrix n n ℂ) : + x.PosSemidef ↔ ∀ y : n → ℂ, 0 ≤ star y ⬝ᵥ x.mulVec y := by + classical + rw [Matrix.posSemidef_eq_linearMap_positive' x, LinearMap.complex_isPositive'] + constructor + · intro h y + specialize h (WithLp.toLp 2 y) + simpa [Matrix.toLpLin_toLp, PiLp.inner_apply, Matrix.dotProduct_eq_inner, + RCLike.inner_apply, Matrix.mulVec] using h + · intro h v + let y : n → ℂ := v + specialize h y + simpa [y, Matrix.toLpLin_toLp, PiLp.inner_apply, Matrix.dotProduct_eq_inner, + RCLike.inner_apply, Matrix.mulVec] using h + +theorem PosSemidef.complex [Fintype n] (x : Matrix n n ℂ) : + x.PosSemidef ↔ ∀ y : n → ℂ, 0 ≤ star y ⬝ᵥ x.mulVec y := + Matrix.PosSemidef.complex x + +theorem single.sum_eq_one [Fintype n] [DecidableEq n] (a : 𝕜) : + ∑ k : n, single k k a = a • 1 := by + rw [Matrix.one_eq_sum_std_matrix] + simp_rw [Finset.smul_sum, Matrix.smul_single, smul_eq_mul, mul_one] + +theorem single_hMul [Fintype n] [DecidableEq n] (i j k l : n) (a b : 𝕜) : + single i j a * single k l b = + ite (j = k) (1 : 𝕜) (0 : 𝕜) • single i l (a * b) := by + ext p q + rw [Matrix.single.hMul_stdBasisMatrix i p j k l q a b] + by_cases hip : i = p <;> by_cases hjk : j = k <;> by_cases hlq : l = q <;> + simp [Matrix.smul_apply, Matrix.single, smul_eq_mul, hip, hjk, hlq] + +theorem Matrix.smul_single' {n R : Type*} [CommSemiring R] [DecidableEq n] (i j : n) + (c : R) : + single i j c = c • single i j 1 := by + rw [smul_single, smul_eq_mul, mul_one] + +theorem Matrix.trace_iff' [Fintype n] (x : Matrix n n 𝕜) : x.trace = ∑ i : n, x i i := + rfl + +theorem existsUnique_trace [Fintype n] [DecidableEq n] [Nontrivial n] : + ∃! φ : Matrix n n 𝕜 →ₗ[𝕜] 𝕜, + (∀ a b : Matrix n n 𝕜, φ (a * b) = φ (b * a)) ∧ φ 1 = 1 := by + use (1 / Fintype.card n : 𝕜) • traceLinearMap n 𝕜 𝕜 + have trace_functional_iff : + ∀ φ : Matrix n n 𝕜 →ₗ[𝕜] 𝕜, + (∀ a b : Matrix n n 𝕜, φ (a * b) = φ (b * a)) ∧ φ 1 = 1 ↔ + φ = (1 / Fintype.card n : 𝕜) • traceLinearMap n 𝕜 𝕜 := by + intro φ + have hcard_inv : (↑(Fintype.card n) : 𝕜)⁻¹ * ↑(@Finset.univ n _).card = 1 := by + rw [inv_mul_eq_one₀] + · rfl + · simp only [ne_eq, Nat.cast_eq_zero, Fintype.card_ne_zero] + exact not_false + constructor + · intro h + rw [LinearMap.ext_iff] + intro x + have hsingle : + ∀ i j : n, + φ (single i j (1 : 𝕜)) = + (1 / (Fintype.card n : 𝕜)) • ite (j = i) (1 : 𝕜) (0 : 𝕜) := by + intro i j + calc + φ (single i j (1 : 𝕜)) = + (1 / (Fintype.card n : 𝕜)) • + ∑ k, φ (single i k 1 * (single k j 1 : Matrix n n 𝕜)) := ?_ + _ = + (1 / (Fintype.card n : 𝕜)) • + ∑ k, φ (single k j 1 * single i k 1) := ?_ + _ = (1 / (Fintype.card n : 𝕜)) • + ite (j = i) (φ (∑ k, single k k 1)) 0 := ?_ + _ = (1 / (Fintype.card n : 𝕜)) • ite (j = i) (φ 1) 0 := ?_ + _ = (1 / (Fintype.card n : 𝕜)) • ite (j = i) 1 0 := ?_ + · simp_rw [single_mul_single_same, one_mul] + simp only [one_div, Finset.sum_const, nsmul_eq_mul, smul_eq_mul] + rw [← mul_assoc] + simp_rw [hcard_inv, one_mul] + · simp_rw [h.1] + · simp_rw [single_hMul, one_mul, _root_.map_smul, smul_eq_mul, boole_mul, + Finset.sum_ite_irrel, Finset.sum_const_zero, map_sum] + · simp_rw [single.sum_eq_one, one_smul] + · simp_rw [h.2] + rw [LinearMap.smul_apply, Matrix.traceLinearMap_apply] + nth_rw 1 [matrix_eq_sum_single x] + simp_rw [Matrix.smul_single' _ _ (x _ _), map_sum, _root_.map_smul] + calc + ∑ x_1, ∑ x_2, x x_1 x_2 • φ (single x_1 x_2 1) = + ∑ x_1, ∑ x_2, + x x_1 x_2 • (1 / (Fintype.card n : 𝕜)) • + ite (x_2 = x_1) (1 : 𝕜) 0 := ?_ + _ = ∑ x_1, x x_1 x_1 • (1 / Fintype.card n : 𝕜) := ?_ + _ = (1 / Fintype.card n : 𝕜) • x.trace := ?_ + · simp_rw [← hsingle] + · simp_rw [smul_ite, smul_zero, Finset.sum_ite_eq', Finset.mem_univ, if_true, + smul_eq_mul, mul_one] + · simp_rw [← Finset.sum_smul, Matrix.trace_iff' x, smul_eq_mul, mul_comm] + · rintro rfl + simp_rw [LinearMap.smul_apply, traceLinearMap_apply, Matrix.trace_iff' 1, one_apply_eq, + Finset.sum_const, one_div, nsmul_eq_mul, mul_one] + refine ⟨fun x y => ?_, hcard_inv⟩ + rw [trace_mul_comm] + simp only [trace_functional_iff, imp_self, forall_true_iff, and_true] + +theorem Matrix.single.trace [Fintype n] [DecidableEq n] (i j : n) (a : 𝕜) : + (single i j a).trace = ite (i = j) a 0 := by + by_cases h : i = j + · subst h + simp [Matrix.trace_single_eq_same] + · simp [Matrix.trace_single_eq_of_ne i j a h, h] + +theorem Matrix.single_eq {R n m : Type*} [Semiring R] [DecidableEq n] [DecidableEq m] + (i : n) (j : m) (a : R) : + single i j a = fun i' j' => ite (i = i' ∧ j = j') a 0 := + rfl + +theorem vecMulVec_eq_zero_iff (x : n → 𝕜) : vecMulVec x (star x) = 0 ↔ x = 0 := by + constructor + · intro h + by_contra hx + exact Matrix.vecMulVec_ne_zero hx (by simpa using hx) h + · intro h + simp [h] + +lemma norm_ite {α : Type*} [Norm α] (P : Prop) [Decidable P] (a b : α) : + ‖(ite P a b : α)‖ = (ite P ‖a‖ ‖b‖) := by + split_ifs <;> rfl + +theorem Matrix.PosSemidef.diagonal_iff [DecidableEq n] (x : n → 𝕜) : + (diagonal x).PosSemidef ↔ ∀ i, 0 ≤ x i := + Matrix.posSemidef_diagonal_iff + +theorem Matrix.PosDef.diagonal_iff [DecidableEq n] (x : n → 𝕜) : + (diagonal x).PosDef ↔ ∀ i, 0 < x i := + Matrix.posDef_diagonal_iff + +theorem Matrix.toLin_piLp_eq_toLin' {n : Type*} [Fintype n] [DecidableEq n] : + Matrix.toLpLin (R := 𝕜) (m := n) (n := n) 2 2 = + Matrix.toLin (PiLp.basisFun 2 𝕜 n) (PiLp.basisFun 2 𝕜 n) := by + exact Matrix.toLpLin_eq_toLin (R := 𝕜) (m := n) (n := n) 2 2 + +alias Matrix.commute_iff := Matrix.IsHermitian.commute_iff + +namespace Matrix + +theorem _root_.Matrix.Finset.sum_abs_eq_zero_iff' {s : Type*} [Fintype s] {x : s → 𝕜} : + ∑ i, ‖x i‖ ^ 2 = 0 ↔ ∀ i : s, ‖x i‖ ^ 2 = 0 := by + have hnonneg : ∀ i : s, 0 ≤ ‖x i‖ ^ 2 := fun i => sq_nonneg _ + constructor + · intro h i + have hnonneg_mem : ∀ i : s, i ∈ Finset.univ → 0 ≤ ‖x i‖ ^ 2 := by + intro i _ + exact hnonneg i + have hsum : ∑ i, ‖(x i : 𝕜)‖ ^ 2 = 0 := h + rw [Finset.sum_eq_zero_iff_of_nonneg hnonneg_mem] at hsum + simp only [Finset.mem_univ, forall_true_left] at hsum + exact hsum i + · intro h + simp_rw [h, Finset.sum_const_zero] + +/-- The trace of `xᴴ * x` is nonnegative. -/ +theorem trace_conjTranspose_hMul_self_nonneg {m : Type*} [Fintype m] [Fintype n] + (x : Matrix m n 𝕜) : + 0 ≤ (xᴴ * x).trace := + (Matrix.posSemidef_conjTranspose_mul_self x).trace_nonneg + +/-- A positive semidefinite matrix gives a nonnegative weighted `xᴴ * x` trace. -/ +theorem _root_.Matrix.PosSemidef.trace_conjTranspose_hMul_self_nonneg {m : Type*} + [Fintype m] [Fintype n] {Q : Matrix m m 𝕜} + (hQ : Q.PosSemidef) (x : Matrix n m 𝕜) : + 0 ≤ (Q * xᴴ * x).trace := by + classical + rcases (Matrix.posSemidef_iff Q).mp hQ with ⟨y, rfl⟩ + rw [Matrix.trace_mul_cycle, ← Matrix.mul_assoc] + nth_rw 1 [← conjTranspose_conjTranspose x] + rw [← Matrix.conjTranspose_mul] + simp_rw [Matrix.mul_assoc] + exact Matrix.trace_conjTranspose_hMul_self_nonneg _ + +/-- The trace of `xᴴ * x` vanishes exactly when `x` is zero. -/ +theorem trace_conjTranspose_hMul_self_eq_zero {m : Type*} [Fintype n] [Fintype m] + (x : Matrix n m 𝕜) : + (xᴴ * x).trace = 0 ↔ x = 0 := + Matrix.trace_conjTranspose_mul_self_eq_zero_iff + +/-- A positive definite matrix gives a faithful weighted `xᴴ * x` trace. -/ +theorem _root_.Matrix.PosDef.trace_conjTranspose_hMul_self_eq_zero {m : Type*} + [Fintype m] [Fintype n] {Q : Matrix m m 𝕜} + (hQ : Q.PosDef) {x : Matrix n m 𝕜} : + (Q * xᴴ * x).trace = 0 ↔ x = 0 := by + classical + rcases (Matrix.posSemidef_iff Q).mp hQ.posSemidef with ⟨y, hy⟩ + rw [hy, trace_mul_cycle, ← Matrix.mul_assoc] + nth_rw 1 [← conjTranspose_conjTranspose x] + rw [← conjTranspose_mul] + simp_rw [Matrix.mul_assoc] + rw [Matrix.trace_conjTranspose_hMul_self_eq_zero _] + constructor + · intro h + have hQx : Q * xᴴ = 0 := by + rw [hy, Matrix.mul_assoc, h, Matrix.mul_zero] + letI := hQ.invertible + have hxT : xᴴ = 0 := by + exact (Matrix.mul_right_injective_of_invertible (A := Q)) (by simpa using hQx) + rwa [← Matrix.conjTranspose_eq_zero] + · intro h + rw [h, conjTranspose_zero, Matrix.mul_zero] + +alias _root_.Matrix.Nontracial.trace_conjTranspose_hMul_self_eq_zero := + _root_.Matrix.PosDef.trace_conjTranspose_hMul_self_eq_zero + +/-- Hermitian weighted traces are conjugate symmetric. -/ +theorem _root_.Matrix.IsHermitian.trace_conj_symm_star_hMul {m : Type*} [Fintype m] [Fintype n] + {Q : Matrix m m 𝕜} (hQ : Q.IsHermitian) (x y : Matrix n m 𝕜) : + (starRingEnd 𝕜) (Q * yᴴ * x).trace = (Q * xᴴ * y).trace := by + simp_rw [starRingEnd_apply, ← trace_conjTranspose, conjTranspose_mul, + conjTranspose_conjTranspose, hQ.eq, Matrix.mul_assoc] + rw [trace_mul_cycle'] + +/-- `xᴴ * x` vanishes exactly when `x` is zero. -/ +theorem conjTranspose_hMul_self_eq_zero {m : Type*} [Fintype n] + (x : Matrix n m 𝕜) : + xᴴ * x = 0 ↔ x = 0 := + Matrix.conjTranspose_mul_self_eq_zero + +theorem _root_.Matrix.PosSemidef.replicateColMulConjTransposereplicateCol [Finite n] + (x : n → 𝕜) : + (replicateCol (Fin 1) x * (replicateCol (Fin 1) x)ᴴ : Matrix n n 𝕜).PosSemidef := by + rw [← Matrix.vecMulVec_eq_replicateCol_conjTranspose] + exact Matrix.posSemidef_vecMulVec_self_star x + +end Matrix diff --git a/LeanPool/Monlib4/LinearAlgebra/Matrix/Reshape.lean b/LeanPool/Monlib4/LinearAlgebra/Matrix/Reshape.lean new file mode 100644 index 0000000000..0f655b092f --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Matrix/Reshape.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.LinearAlgebra.Matrix.Conj + +/-! + +# Reshaping matrices + +This defines the identification between `Mₙₓₘ(R)` and `Rⁿˣᵐ` (see `matrix.reshape`), +and shows some obvious properties of this identification. + +-/ + + +namespace Matrix + +open scoped Matrix + +variable {R I J : Type _} [Semiring R] + +/-- identifies matrices $M_{I\times J}(R)$ with $R^{I \times J}$, + this is given by $\varrho (x)_{(i,j)} = x_{ij}$ -/ +def reshape : Matrix I J R ≃ₗ[R] I × J → R := + (LinearEquiv.curry R _ _ _).symm + +theorem reshape_apply (x : Matrix I J R) (ij : I × J) : reshape x ij = x ij.1 ij.2 := + rfl + +theorem reshape_symm_apply (x : I × J → R) (i : I) (j : J) : + (reshape : Matrix I J R ≃ₗ[R] I × J → R).symm x i j = x (i, j) := + rfl + +theorem reshape_symm_apply' (x : I × J → R) (ij : I × J) : + (reshape : Matrix I J R ≃ₗ[R] I × J → R).symm x ij.1 ij.2 = x ij := by + rw [reshape_symm_apply x ij.1 ij.2, Prod.mk.eta] + +theorem reshape_one [DecidableEq I] (x y : I) : + reshape (1 : Matrix I I R) (x, y) = ite (x = y) 1 0 := by + simp_rw [Matrix.reshape_apply, Matrix.one_apply] + +/-- ${\varrho(x)}^*=\varrho(\bar{x})$ -/ +theorem reshape_aux_star [Star R] (x : Matrix I J R) : star (reshape x) = reshape xᴴᵀ := + by + ext1 + simp_rw [Pi.star_apply, Matrix.reshape_apply, Matrix.conj_apply] + +end Matrix diff --git a/LeanPool/Monlib4/LinearAlgebra/Matrix/Spectra.lean b/LeanPool/Monlib4/LinearAlgebra/Matrix/Spectra.lean new file mode 100644 index 0000000000..8a5f1d7a87 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Matrix/Spectra.lean @@ -0,0 +1,168 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Analysis.Matrix.Spectrum +import LeanPool.Monlib4.LinearAlgebra.Matrix.Basic +import LeanPool.Monlib4.LinearAlgebra.Matrix.IsAlmostHermitian +import LeanPool.Monlib4.LinearAlgebra.InnerAut + +/-! +# Matrix Spectra + +Spectral helpers for Hermitian and almost-Hermitian matrices. +-/ + +instance multisetCoe {α β : Type _} [Coe α β] : Coe (Multiset α) (Multiset β) + where coe s := s.map (Coe.coe : α → β) + +instance multisetCoeTC {α β : Type _} [CoeTC α β] : CoeTC (Multiset α) (Multiset β) + where coe s := s.map (CoeTC.coe : α → β) + +theorem Finset.val.map_coe {α β γ : Type _} (f : α → β) (s : Finset α) [CoeTC β γ] : + (s.val.map f).map (fun x : β => (x : γ)) = s.val.map (fun x => (f x : γ)) := by + simp only [Multiset.map_map, Function.comp_apply] + +theorem Finset.val.map_coe' {α β γ : Type _} (f : α → β) (s : Finset α) [Coe β γ] : + (s.val.map f).map (fun x : β => (x : γ)) = s.val.map (fun x => (f x : γ)) := + Finset.val.map_coe f s + +noncomputable instance multisetCoeTC_RToRCLike {𝕜 : Type _} [RCLike 𝕜] : + CoeTC (Multiset ℝ) (Multiset 𝕜) := +@multisetCoeTC ℝ 𝕜 ⟨RCLike.ofReal⟩ +noncomputable instance multisetCoeRToRCLike {𝕜 : Type _} [RCLike 𝕜] : + Coe (Multiset ℝ) (Multiset 𝕜) where + coe := (@multisetCoeTC_RToRCLike 𝕜 _).coe + +namespace Matrix + +variable {n 𝕜 : Type _} [RCLike 𝕜] [Fintype n] [DecidableEq n] + +open scoped Matrix + +/-- Choose a scalar and Hermitian matrix witnessing that an almost-Hermitian matrix is scalar +Hermitian. -/ +noncomputable def _root_.Matrix.IsAlmostHermitian.scalar_matrix {n : Type _} {x : Matrix n n 𝕜} + (hx : x.IsAlmostHermitian) : 𝕜 × (Matrix n n 𝕜) := by + choose! α y hy using hx + exact ⟨α, y⟩ + +/-- The scalar chosen from an almost-Hermitian witness. -/ +noncomputable def _root_.Matrix.IsAlmostHermitian.scalar {n : Type _} {x : Matrix n n 𝕜} + (hx : x.IsAlmostHermitian) : 𝕜 := hx.scalar_matrix.1 + +/-- The Hermitian matrix chosen from an almost-Hermitian witness. -/ +noncomputable def _root_.Matrix.IsAlmostHermitian.matrix {n : Type _} {x : Matrix n n 𝕜} + (hx : x.IsAlmostHermitian) : Matrix n n 𝕜 := hx.scalar_matrix.2 + +theorem _root_.Matrix.IsAlmostHermitian.eq_smul_matrix {n : Type _} {x : Matrix n n 𝕜} + (hx : x.IsAlmostHermitian) : x = hx.scalar • hx.matrix := + by + rw [IsAlmostHermitian.scalar, IsAlmostHermitian.matrix, IsAlmostHermitian.scalar_matrix] + generalize_proofs + simp_all + +theorem _root_.Matrix.IsAlmostHermitian.matrix_isHermitian {n : Type _} {x : Matrix n n 𝕜} + (hx : x.IsAlmostHermitian) : hx.matrix.IsHermitian := + by + rw [IsAlmostHermitian.matrix, IsAlmostHermitian.scalar_matrix] + generalize_proofs + simp_all + +/-- Eigenvalues of the Hermitian factor, rescaled by the almost-Hermitian scalar. -/ +noncomputable def _root_.Matrix.IsAlmostHermitian.eigenvalues {x : Matrix n n 𝕜} + (hx : x.IsAlmostHermitian) : + n → 𝕜 := + fun i => hx.scalar • hx.matrix_isHermitian.eigenvalues i + +/-- Multiset of eigenvalues for an almost-Hermitian matrix. -/ +noncomputable def _root_.Matrix.IsAlmostHermitian.spectra {A : Matrix n n 𝕜} + (hA : A.IsAlmostHermitian) : + Multiset 𝕜 := + Finset.univ.val.map fun i => hA.eigenvalues i + +/-- Multiset of real eigenvalues for a Hermitian matrix. -/ +noncomputable def _root_.Matrix.IsHermitian.spectra {A : Matrix n n 𝕜} + (hA : A.IsHermitian) : Multiset ℝ := + Finset.univ.val.map fun i => hA.eigenvalues i + +theorem _root_.Matrix.IsHermitian.spectra_coe {A : Matrix n n 𝕜} (hA : A.IsHermitian) : + (hA.spectra : Multiset 𝕜) = Finset.univ.val.map fun i => hA.eigenvalues i := + by + simp only [Multiset.map_map, IsHermitian.spectra] + +open scoped BigOperators + +theorem _root_.Matrix.IsHermitian.mem_coe_spectra_diagonal {A : n → 𝕜} + (hA : (diagonal A).IsHermitian) + (x : 𝕜) : + x ∈ (hA.spectra : Multiset 𝕜) ↔ ∃ i : n, A i = x := + by + rw [IsHermitian.spectra_coe] + simp only [Multiset.mem_map, Finset.mem_univ_val, true_and, exists_exists_eq_and] + have hset : RCLike.ofReal '' Set.range hA.eigenvalues = Set.range A := by + rw [← hA.spectrum_eq_image_range, spectrum_diagonal] + simpa [Set.mem_image, Set.mem_range] using Set.ext_iff.mp hset x + +theorem _root_.Matrix.IsHermitian.spectra_set_eq_spectrum {A : Matrix n n 𝕜} + (hA : A.IsHermitian) : + {x : 𝕜 | x ∈ (hA.spectra : Multiset 𝕜)} = _root_.spectrum 𝕜 (toLin' A) := + by + ext x + rw [IsHermitian.spectra_coe] + simp only [Set.mem_setOf, Multiset.mem_map, Finset.mem_univ_val, true_and, exists_exists_eq_and] + rw [spectrum_toLin', hA.spectrum_eq_image_range] + simp [Set.mem_image, Set.mem_range] + +theorem _root_.Matrix.IsHermitian.of_innerAut {A : Matrix n n 𝕜} (hA : A.IsHermitian) + (U : unitaryGroup n 𝕜) : + (innerAut U A).IsHermitian := + (innerAut_isHermitian_iff U A).mp hA + +omit [Fintype n] [DecidableEq n] in +theorem isAlmostHermitian_iff_smul {A : Matrix n n 𝕜} : + A.IsAlmostHermitian ↔ ∀ α : 𝕜, (α • A).IsAlmostHermitian := + by + constructor + · rintro ⟨β, y, rfl, hy⟩ α + rw [smul_smul] + exact ⟨α * β, y, rfl, hy⟩ + · intro h + specialize h 1 + rw [one_smul] at h + exact h + +omit [Fintype n] [DecidableEq n] in +theorem _root_.Matrix.IsAlmostHermitian.smul {A : Matrix n n 𝕜} (hA : A.IsAlmostHermitian) + (α : 𝕜) : + (α • A).IsAlmostHermitian := + isAlmostHermitian_iff_smul.mp hA _ + +theorem _root_.Matrix.IsAlmostHermitian.of_innerAut {A : Matrix n n 𝕜} (hA : A.IsAlmostHermitian) + (U : unitaryGroup n 𝕜) : (innerAut U A).IsAlmostHermitian := + by + obtain ⟨α, y, rfl, hy⟩ := hA + refine ⟨α, innerAut U y, ?_, hy.of_innerAut _⟩ + simp_rw [_root_.map_smul] + +theorem isAlmostHermitian_iff_of_innerAut {A : Matrix n n 𝕜} (U : unitaryGroup n 𝕜) : + A.IsAlmostHermitian ↔ (innerAut U A).IsAlmostHermitian := + by + refine ⟨fun h => h.of_innerAut _, ?_⟩ + rintro ⟨α, y, h, hy⟩ + rw [eq_comm, innerAut_eq_iff] at h + rw [h, _root_.map_smul] + clear h + revert α + rw [← isAlmostHermitian_iff_smul] + apply IsAlmostHermitian.of_innerAut + exact hy.isAlmostHermitian + +/-- A matrix has almost equal spectra to another if a nonzero scalar multiple has equal spectra. -/ +def _root_.Matrix.IsAlmostHermitian.HasAlmostEqualSpectraTo {x y : Matrix n n 𝕜} + (hx : x.IsAlmostHermitian) + (hy : y.IsAlmostHermitian) : Prop := + ∃ β : 𝕜ˣ, hx.spectra = (hy.smul β).spectra + +end Matrix diff --git a/LeanPool/Monlib4/LinearAlgebra/Matrix/StarOrderedRing.lean b/LeanPool/Monlib4/LinearAlgebra/Matrix/StarOrderedRing.lean new file mode 100644 index 0000000000..9faf34712d --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Matrix/StarOrderedRing.lean @@ -0,0 +1,316 @@ +/- +Copyright (c) 2024 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.PiStarOrderedRing +import LeanPool.Monlib4.LinearAlgebra.PiDirectSum +import LeanPool.Monlib4.LinearAlgebra.InnerAut +import LeanPool.Monlib4.LinearAlgebra.Matrix.PosEqLinearMapIsPositive +import LeanPool.Monlib4.LinearAlgebra.KroneckerToTensor +import LeanPool.Monlib4.Preq.Complex +import LeanPool.Monlib4.LinearAlgebra.Matrix.PiMat +import LeanPool.Monlib4.LinearAlgebra.Matrix.Spectra +import Mathlib.Analysis.InnerProductSpace.Basic + +/-! +# Matrix algebras as star ordered rings + +This file keeps the upstream monlib4 API around matrix positivity and the +`MatrixOrder` scoped order. Current Mathlib supplies the underlying matrix +order and `StarOrderedRing` instance, so this file restores the Monlib-facing +negative definiteness definitions, spectral criteria, and compatibility names. +-/ + +namespace Matrix + +open scoped ComplexOrder MatrixOrder + +theorem _root_.Matrix.eq_zero_iff {n : Type _} [Fintype n] + {x : Matrix n n ℂ} : + x = 0 ↔ ∀ a : n → ℂ, star a ⬝ᵥ x.mulVec a = 0 := by + classical + calc + x = 0 ↔ (Matrix.toLpLin 2 2) x = 0 := by simp only [LinearEquiv.map_eq_zero_iff] + _ ↔ ∀ a : WithLp 2 (n → ℂ), + (inner ℂ (((Matrix.toLpLin 2 2) x) a) a : ℂ) = 0 := by + exact (inner_map_self_eq_zero (T := (Matrix.toLpLin 2 2) x)).symm + _ ↔ ∀ a : WithLp 2 (n → ℂ), + (inner ℂ a (((Matrix.toLpLin 2 2) x) a) : ℂ) = 0 := by + simp_rw [inner_eq_zero_symm] + _ ↔ ∀ a : n → ℂ, star a ⬝ᵥ x *ᵥ a = 0 := by + constructor + · intro h a + specialize h (WithLp.toLp 2 a) + simpa [Matrix.toLpLin_apply, Matrix.dotProduct_eq_inner] using h + · intro h a + specialize h a.ofLp + simpa [Matrix.toLpLin_apply, Matrix.dotProduct_eq_inner] using h + +/-- The upstream Monlib order relation, now supplied by Mathlib under `MatrixOrder`. -/ +@[reducible] +protected def _root_.Matrix.LE {n : Type _} : + LE (Matrix n n ℂ) := + ⟨fun x y => (y - x).PosSemidef⟩ + +/-- A matrix is negative semidefinite when its Hermitian quadratic form is nonpositive. -/ +def _root_.Matrix.NegSemidef {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] + (x : Matrix n n 𝕜) : Prop := + x.IsHermitian ∧ ∀ a : n → 𝕜, dotProduct (Star.star a) (x *ᵥ a) ≤ 0 + +/-- A matrix is negative definite when its quadratic form is negative on nonzero inputs. -/ +def _root_.Matrix.NegDef {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] + (x : Matrix n n 𝕜) : Prop := + x.IsHermitian ∧ ∀ a : n → 𝕜, a ≠ 0 → (star a) ⬝ᵥ (x *ᵥ a) < 0 + +theorem _root_.Matrix.IsHermitian.neg_iff {𝕜 n : Type _} [RCLike 𝕜] + (x : Matrix n n 𝕜) : + (-x).IsHermitian ↔ x.IsHermitian := by + constructor + · intro h + rw [← neg_neg x] + exact Matrix.IsHermitian.neg h + · exact Matrix.IsHermitian.neg + +theorem _root_.Matrix.negSemidef_iff_neg_posSemidef {𝕜 n : Type _} [RCLike 𝕜] + [Fintype n] (x : Matrix n n 𝕜) : + x.NegSemidef ↔ (-x).PosSemidef := by + rw [Matrix.posSemidef_iff_dotProduct_mulVec] + constructor + · intro h + refine ⟨Matrix.IsHermitian.neg h.1, fun a => ?_⟩ + simpa [Matrix.neg_mulVec, dotProduct_neg] using neg_nonneg.mpr (h.2 a) + · intro h + refine ⟨(Matrix.IsHermitian.neg_iff x).mp h.1, fun a => ?_⟩ + exact neg_nonneg.mp (by simpa [Matrix.neg_mulVec, dotProduct_neg] using h.2 a) + +theorem _root_.Matrix.negDef_iff_neg_posDef {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] + (x : Matrix n n 𝕜) : + x.NegDef ↔ (-x).PosDef := by + rw [Matrix.posDef_iff_dotProduct_mulVec] + constructor + · intro h + refine ⟨Matrix.IsHermitian.neg h.1, fun a ha => ?_⟩ + simpa [Matrix.neg_mulVec, dotProduct_neg] using neg_pos.mpr (h.2 a ha) + · intro h + refine ⟨(Matrix.IsHermitian.neg_iff x).mp h.1, fun a ha => ?_⟩ + exact neg_pos.mp (by simpa [Matrix.neg_mulVec, dotProduct_neg] using h.2 (x := a) ha) + +theorem _root_.Matrix.NegDef.re_dotProduct_neg {n 𝕜 : Type _} [RCLike 𝕜] [Fintype n] + {M : Matrix n n 𝕜} (hM : M.NegDef) {x : n → 𝕜} (hx : x ≠ 0) : + RCLike.re (dotProduct (star x) (M *ᵥ x)) < 0 := + RCLike.neg_iff.mp (hM.2 _ hx) |>.1 + +theorem _root_.Matrix.NegSemidef.nonpos_eigenvalues {𝕜 n : Type _} [RCLike 𝕜] + [Fintype n] [DecidableEq n] {x : Matrix n n 𝕜} (hx : x.NegSemidef) (i : n) : + hx.1.eigenvalues i ≤ 0 := by + rw [hx.1.eigenvalues_eq i] + exact (RCLike.nonpos_def.mp (hx.2 _)).1 + +theorem _root_.Matrix.NegDef.neg_eigenvalues {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] + [DecidableEq n] {x : Matrix n n 𝕜} (hx : x.NegDef) (i : n) : + hx.1.eigenvalues i < 0 := by + rw [hx.1.eigenvalues_eq i] + apply hx.re_dotProduct_neg + intro h + exact hx.1.eigenvectorBasis.orthonormal.ne_zero i <| PiLp.ext fun j => by + simpa using congrFun h j + +theorem _root_.Matrix.posSemidef_and_negSemidef_iff_eq_zero {𝕜 n : Type _} + [RCLike 𝕜] [Fintype n] {x : Matrix n n 𝕜} : + x.PosSemidef ∧ x.NegSemidef ↔ x = 0 := by + classical + constructor + · rintro ⟨h1, h2⟩ + rw [← h1.1.eigenvalues_eq_zero_iff] + ext i + have hpos := h1.eigenvalues_nonneg i + have hneg := h2.nonpos_eigenvalues i + exact le_antisymm hneg hpos + · rintro rfl + simp only [negSemidef_iff_neg_posSemidef, neg_zero, and_self, PosSemidef.zero] + +theorem _root_.Matrix.not_posDef_and_negDef {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] + [Nonempty n] (x : Matrix n n 𝕜) : + ¬ (x.PosDef ∧ x.NegDef) := by + classical + let i : n := Nonempty.some (by infer_instance) + rintro ⟨h1, h2⟩ + have hh1 := PosDef.pos_eigenvalues h1 i + have hh2 := NegDef.neg_eigenvalues h2 i + linarith + +open scoped BigOperators + +theorem _root_.Matrix.diagonal_posSemidef_iff {𝕜 n : Type _} [RCLike 𝕜] + [DecidableEq n] (x : n → 𝕜) : + (diagonal x).PosSemidef ↔ 0 ≤ x := by + simp [Pi.le_def, Matrix.PosSemidef.diagonal_iff x] + +theorem _root_.Matrix.diagonal_negSemidef_iff {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] + [DecidableEq n] (x : n → 𝕜) : + (diagonal x).NegSemidef ↔ x ≤ 0 := by + simp_rw [negSemidef_iff_neg_posSemidef, diagonal_neg, diagonal_posSemidef_iff, + Pi.le_def, Pi.zero_apply, Left.nonneg_neg_iff] + +theorem _root_.Matrix.diagonal_posDef_iff {𝕜 n : Type _} [RCLike 𝕜] + [DecidableEq n] (x : n → 𝕜) : + (diagonal x).PosDef ↔ ∀ i, 0 < x i := + Matrix.PosDef.diagonal_iff x + +theorem _root_.Matrix.diagonal_negDef_iff {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] + [DecidableEq n] (x : n → 𝕜) : + (diagonal x).NegDef ↔ ∀ i, x i < 0 := by + simp_rw [negDef_iff_neg_posDef, diagonal_neg, diagonal_posDef_iff, Left.neg_pos_iff] + +theorem _root_.Matrix.posSemidef_iff_of_isHermitian {𝕜 n : Type _} [RCLike 𝕜] + [Fintype n] [DecidableEq n] {x : Matrix n n 𝕜} (hx : x.IsHermitian) : + x.PosSemidef ↔ 0 ≤ hx.eigenvalues := + hx.posSemidef_iff_eigenvalues_nonneg + +theorem _root_.Matrix.posSemidef_iff_isHermitian_and_nonneg_spectrum {𝕜 n : Type _} + [RCLike 𝕜] [Fintype n] [DecidableEq n] {x : Matrix n n 𝕜} : + x.PosSemidef ↔ x.IsHermitian ∧ spectrum 𝕜 (Matrix.toLin' x) ⊆ {x : 𝕜 | 0 ≤ x} := by + rw [Matrix.spectrum_toLin'] + exact Matrix.posSemidef_iff_isHermitian_and_spectrum_nonneg + +theorem _root_.Matrix.posDef_iff_of_isHermitian {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] + [DecidableEq n] {x : Matrix n n 𝕜} (hx : x.IsHermitian) : + x.PosDef ↔ ∀ i, 0 < hx.eigenvalues i := + hx.posDef_iff_eigenvalues_pos + +theorem _root_.Matrix.posDef_iff_isHermitian_and_pos_spectrum {𝕜 n : Type _} [RCLike 𝕜] + [Fintype n] [DecidableEq n] {x : Matrix n n 𝕜} : + x.PosDef ↔ x.IsHermitian ∧ spectrum 𝕜 (Matrix.toLin' x) ⊆ {x : 𝕜 | 0 < x} := by + rw [Matrix.spectrum_toLin'] + constructor + · intro h + refine ⟨h.1, ?_⟩ + rw [h.1.spectrum_eq_image_range] + rintro z ⟨_, ⟨i, rfl⟩, rfl⟩ + change 0 < (RCLike.ofReal (h.1.eigenvalues i) : 𝕜) + exact_mod_cast h.eigenvalues_pos i + · rintro ⟨h1, h2⟩ + rw [posDef_iff_of_isHermitian h1] + intro i + apply (RCLike.zero_lt_real (𝕜 := 𝕜)).mp + exact h2 (by rw [h1.spectrum_eq_image_range]; exact ⟨_, ⟨i, rfl⟩, rfl⟩) + +theorem _root_.Matrix.posSemidef_iff_commute {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] + {x y : Matrix n n 𝕜} (hx : x.PosSemidef) (hy : y.PosSemidef) : + Commute x y ↔ (x * y).PosSemidef := by + classical + refine ⟨fun h => ?_, fun h => (Matrix.commute_iff hx.1 hy.1).mpr h.1⟩ + rw [posSemidef_iff_isHermitian_and_nonneg_spectrum] + refine ⟨(Matrix.commute_iff hx.1 hy.1).mp h, ?_⟩ + obtain ⟨a, rfl⟩ := (posSemidef_iff _).mp hx + obtain ⟨b, rfl⟩ := (posSemidef_iff _).mp hy + calc + spectrum 𝕜 (toLin' (aᴴ * a * (bᴴ * b))) = + spectrum 𝕜 ((toLin' a) * toLin' (bᴴ * b) * toLin' aᴴ) := by + rw [Module.End.mul_eq_comp, spectrum.comm] + simp_rw [Module.End.mul_eq_comp, ← toLin'_mul, mul_assoc] + _ = spectrum 𝕜 (toLin' ((b * aᴴ)ᴴ * (b * aᴴ))) := by + simp_rw [conjTranspose_mul, conjTranspose_conjTranspose, Module.End.mul_eq_comp, + ← toLin'_mul, mul_assoc] + exact (posSemidef_iff_isHermitian_and_nonneg_spectrum.mp + (posSemidef_conjTranspose_mul_self _)).2 + +theorem _root_.Matrix.innerAut_negSemidef_iff {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] + [DecidableEq n] (U : unitaryGroup n 𝕜) {a : Matrix n n 𝕜} : + (innerAut U a).NegSemidef ↔ a.NegSemidef := by + simp_rw [negSemidef_iff_neg_posSemidef, ← map_neg, innerAut_posSemidef_iff] + +/-- `f_U(x)` is negative definite if and only if `x` is negative definite. -/ +theorem _root_.Matrix.innerAut_negDef_iff {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] + [DecidableEq n] (U : unitaryGroup n 𝕜) {x : Matrix n n 𝕜} : + (innerAut U x).NegDef ↔ x.NegDef := by + simp_rw [negDef_iff_neg_posDef, ← map_neg, innerAut_posDef_iff] + +theorem _root_.Matrix.negSemidef_iff_of_isHermitian {𝕜 n : Type _} [RCLike 𝕜] + [Fintype n] [DecidableEq n] {x : Matrix n n 𝕜} (hx : x.IsHermitian) : + x.NegSemidef ↔ hx.eigenvalues ≤ 0 := by + nth_rw 1 [IsHermitian.spectral_theorem'' hx, innerAut_negSemidef_iff, + diagonal_negSemidef_iff] + simp_rw [Pi.le_def, Function.comp_apply, Pi.zero_apply, ← @RCLike.ofReal_zero 𝕜, + RCLike.real_le_real] + +theorem _root_.Matrix.negDef_iff_of_isHermitian {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] + [DecidableEq n] {x : Matrix n n 𝕜} (hx : x.IsHermitian) : + x.NegDef ↔ ∀ i, hx.eigenvalues i < 0 := by + nth_rw 1 [IsHermitian.spectral_theorem'' hx, innerAut_negDef_iff, diagonal_negDef_iff] + simp_rw [Function.comp_apply, ← @RCLike.ofReal_zero 𝕜, RCLike.real_lt_real] + +theorem _root_.Matrix.posDef_of_posSemidef {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] + [DecidableEq n] {x : Matrix n n 𝕜} (hx : x.PosSemidef) : + x.PosDef ↔ ∀ i, hx.1.eigenvalues i ≠ 0 := by + rw [posDef_iff_of_isHermitian hx.1] + simp_rw [lt_iff_le_and_ne, ne_eq, hx.eigenvalues_nonneg, true_and, eq_comm] + +theorem _root_.Matrix.negDef_of_negSemidef {𝕜 n : Type _} [RCLike 𝕜] [Fintype n] + [DecidableEq n] {x : Matrix n n 𝕜} (hx : x.NegSemidef) : + x.NegDef ↔ ∀ i, hx.1.eigenvalues i ≠ 0 := by + rw [negDef_iff_of_isHermitian hx.1] + simp_rw [lt_iff_le_and_ne, ne_eq, NegSemidef.nonpos_eigenvalues hx, true_and] + +/-- The matrix partial order induced by positive semidefinite differences. -/ +@[reducible] +noncomputable def _root_.Matrix.partialOrder {n : Type _} : + PartialOrder (Matrix n n ℂ) := by + infer_instance + +theorem _root_.Matrix.starOrderedRing {n : Type _} [Fintype n] : + StarOrderedRing (Matrix n n ℂ) := by + infer_instance + +theorem _root_.Matrix.Pi.le_iff_sub_nonneg {ι : Type _} {n : ι → Type _} + [∀ i, Fintype (n i)] (x y : PiMat ℂ ι n) : + x ≤ y ↔ ∃ z : PiMat ℂ ι n, y = x + star z * z := by + simp_rw [funext_iff, Pi.add_apply, Pi.mul_apply, Pi.star_apply, Pi.le_def, Matrix.le_iff, + Matrix.posSemidef_iff, sub_eq_iff_eq_add', Matrix.star_eq_conjTranspose] + exact ⟨fun hx => ⟨fun i => (hx i).choose, fun i => (hx i).choose_spec⟩, + fun ⟨y, hy⟩ i => ⟨y i, hy i⟩⟩ + +theorem _root_.Matrix.PiStarOrderedRing {ι : Type _} {n : ι → Type _} + [∀ i, Fintype (n i)] : + StarOrderedRing (PiMat ℂ ι n) := + StarOrderedRing.of_le_iff fun a b => by simp_rw [Pi.le_iff_sub_nonneg] + +scoped[MatrixOrder] attribute [instance] Matrix.PiStarOrderedRing + +theorem _root_.Matrix.negSemidef_iff_nonpos {n : Type _} [Fintype n] + (x : Matrix n n ℂ) : + x.NegSemidef ↔ x ≤ 0 := by + rw [Matrix.negSemidef_iff_neg_posSemidef, Matrix.le_iff, zero_sub] + +theorem _root_.Matrix.PosSemidef.conj_by_isHermitian_posSemidef {𝕜 n : Type _} + [RCLike 𝕜] [Fintype n] {x y : Matrix n n 𝕜} + (hx : x.PosSemidef) (hy : y.IsHermitian) : + PosSemidef (y * x * y) := by + nth_rw 1 [← hy.eq] + exact PosSemidef.conjTranspose_mul_mul_same hx _ + +theorem _root_.Matrix.IsHermitian.conj_by_isHermitian_posSemidef {𝕜 n : Type _} + [RCLike 𝕜] [Fintype n] {x y : Matrix n n 𝕜} + (hx : x.IsHermitian) (hy : y.PosSemidef) : + PosSemidef (x * y * x) := by + nth_rw 1 [← hx.eq] + exact PosSemidef.conjTranspose_mul_mul_same hy _ + +alias isHermitian_mul_iff := Matrix.commute_iff + +end Matrix + +lemma StarAlgEquiv.map_pow {R A₁ A₂ : Type _} [CommSemiring R] [Semiring A₁] + [Semiring A₂] [Algebra R A₁] [Algebra R A₂] [Star A₁] [Star A₂] + (e : A₁ ≃⋆ₐ[R] A₂) (x : A₁) (n : ℕ) : + e (x ^ n) = e x ^ n := by + induction n with + | zero => simp + | succ n ih => rw [pow_succ', map_mul, ih, ← pow_succ'] + +lemma Matrix.innerAut.map_pow {n : Type _} [Fintype n] [DecidableEq n] {𝕜 : Type _} + [RCLike 𝕜] (U : unitaryGroup n 𝕜) (x : Matrix n n 𝕜) (n : ℕ) : + (innerAut U x) ^ n = innerAut U (x ^ n) := by + simp_rw [← innerAutStarAlg_apply_eq_innerAut_apply, StarAlgEquiv.map_pow] diff --git a/LeanPool/Monlib4/LinearAlgebra/Mul''.lean b/LeanPool/Monlib4/LinearAlgebra/Mul''.lean new file mode 100644 index 0000000000..189c4a25ff --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Mul''.lean @@ -0,0 +1,168 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Algebra.Algebra.Bilinear +import LeanPool.Monlib4.LinearAlgebra.KroneckerToTensor +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.BasicLemmas +import LeanPool.Monlib4.LinearAlgebra.Nacgor +import LeanPool.Monlib4.LinearAlgebra.Ips.TensorHilbert + +/-! + +# linear_map.mul'' + +this defines the multiplication map $M_{n\times n} \to M_n$ + +-/ + + +open Matrix + +open scoped Matrix Kronecker BigOperators + +section + +variable {R A B : Type _} [CommSemiring R] + +theorem commutes_with_unit_iff [Semiring A] [Semiring B] [Algebra R A] [Algebra R B] + (f : A →ₗ[R] B) : + f ∘ₗ Algebra.linearMap R A = Algebra.linearMap R B ↔ f 1 = 1 := + by + simp_rw [LinearMap.ext_iff, LinearMap.comp_apply, Algebra.linearMap_apply, + Algebra.algebraMap_eq_smul_one, _root_.map_smul] + refine ⟨fun h => ?_, fun h x => by rw [h]⟩ + · specialize h 1 + simp_rw [one_smul] at h + exact h + +theorem commutes_with_mul'_iff [NonUnitalNonAssocSemiring A] [Module R A] + [SMulCommClass R A A] [IsScalarTower R A A] + [NonUnitalNonAssocSemiring B] [Module R B] [SMulCommClass R B B] [IsScalarTower R B B] + (f : A →ₗ[R] B) : + LinearMap.mul' R B ∘ₗ TensorProduct.map f f = f ∘ₗ LinearMap.mul' R A ↔ + ∀ x y : A, f (x * y) = f x * f y := + by + simp_rw [TensorProduct.ext_iff', LinearMap.comp_apply, TensorProduct.map_tmul, + LinearMap.mul'_apply, eq_comm] + +end + +theorem LinearMap.adjoint_commutes_with_mul_adjoint_iff {𝕜 X Y : Type*} [RCLike 𝕜] + [NormedAddCommGroupOfRing X] [NormedAddCommGroupOfRing Y] + [InnerProductSpace 𝕜 X] [InnerProductSpace 𝕜 Y] [SMulCommClass 𝕜 X X] + [SMulCommClass 𝕜 Y Y] [IsScalarTower 𝕜 X X] [IsScalarTower 𝕜 Y Y] + [FiniteDimensional 𝕜 X] [FiniteDimensional 𝕜 Y] (f : X →ₗ[𝕜] Y) : + (TensorProduct.map (LinearMap.adjoint f) (LinearMap.adjoint f)) ∘ₗ + (LinearMap.adjoint (LinearMap.mul' 𝕜 Y)) + = (LinearMap.adjoint (LinearMap.mul' 𝕜 X)) ∘ₗ LinearMap.adjoint f + ↔ + ∀ x y : X, f (x * y) = f x * f y := +by + simp_rw [← TensorProduct.map_adjoint, ← LinearMap.adjoint_comp, ← commutes_with_mul'_iff] + refine ⟨fun h => ?_, fun h => by rw [h]⟩ + apply_fun LinearMap.adjoint at h + simpa only [LinearMap.adjoint_adjoint] using h + +lemma LinearMap.commutes_with_mul_adjoint_iff {𝕜 X Y : Type*} [RCLike 𝕜] + [NormedAddCommGroupOfRing X] [NormedAddCommGroupOfRing Y] [InnerProductSpace 𝕜 X] + [InnerProductSpace 𝕜 Y] [SMulCommClass 𝕜 X X] [SMulCommClass 𝕜 Y Y] + [IsScalarTower 𝕜 X X] [IsScalarTower 𝕜 Y Y] [FiniteDimensional 𝕜 X] + [FiniteDimensional 𝕜 Y] (f : X →ₗ[𝕜] Y) : + (TensorProduct.map f f) ∘ₗ (LinearMap.adjoint (LinearMap.mul' 𝕜 X)) + = (LinearMap.adjoint (LinearMap.mul' 𝕜 Y)) ∘ₗ f + ↔ + ∀ x y : Y, (adjoint f) (x * y) = (adjoint f) x * (adjoint f) y := +by + simp_rw [← commutes_with_mul'_iff] + constructor <;> + · intro h + apply_fun LinearMap.adjoint at h + simpa only [adjoint_comp, TensorProduct.map_adjoint, adjoint_adjoint] using h + +lemma LinearIsometryEquiv.commutes_with_mul_adjoint_iff_of_surjective_isometry + {𝕜 X Y : Type*} [RCLike 𝕜] [NormedAddCommGroupOfRing X] + [NormedAddCommGroupOfRing Y] [InnerProductSpace 𝕜 X] [InnerProductSpace 𝕜 Y] + [SMulCommClass 𝕜 X X] [SMulCommClass 𝕜 Y Y] [IsScalarTower 𝕜 X X] + [IsScalarTower 𝕜 Y Y] [FiniteDimensional 𝕜 X] [FiniteDimensional 𝕜 Y] + (f : X ≃ₗᵢ[𝕜] Y) : + (TensorProduct.map (f.toLinearMap : X →ₗ[𝕜] Y) (f.toLinearMap : X →ₗ[𝕜] Y)) ∘ₗ + (LinearMap.adjoint (LinearMap.mul' 𝕜 X)) + = (LinearMap.adjoint (LinearMap.mul' 𝕜 Y)) ∘ₗ f.toLinearMap + ↔ + ∀ x y : X, f (x * y) = f x * f y := +by + simp_rw [LinearMap.commutes_with_mul_adjoint_iff] + haveI : CompleteSpace X := FiniteDimensional.complete 𝕜 _ + haveI : CompleteSpace Y := FiniteDimensional.complete 𝕜 _ + have : LinearMap.adjoint f.toLinearMap = f.symm.toLinearMap := by + calc + LinearMap.adjoint f.toLinearMap = + ContinuousLinearMap.adjoint + (LinearIsometry.toContinuousLinearMap f.toLinearIsometry) := rfl + _ = LinearIsometry.toContinuousLinearMap f.symm.toLinearIsometry := by + simp only [ContinuousLinearMap.coe_inj] + exact adjoint_eq_symm _ + _ = f.symm.toLinearMap := rfl + rw [this] + constructor + · intro h x y + specialize h (f x) (f y) + simp only [LinearEquiv.coe_coe, coe_toLinearEquiv, symm_apply_apply] at h + rw [← h, apply_symm_apply] + · intro h x y + specialize h (f.symm x) (f.symm y) + simp only [LinearEquiv.coe_coe, coe_toLinearEquiv, apply_symm_apply] at h ⊢ + rw [← h, symm_apply_apply] + +-- MOVE: +theorem Matrix.KroneckerProduct.ext_iff {R P n₁ n₂ : Type _} [Finite n₁] [Finite n₂] + [CommSemiring R] [AddCommMonoid P] [Module R P] + {g h : Matrix (n₁ × n₂) (n₁ × n₂) R →ₗ[R] P} : + g = h ↔ ∀ (x : Matrix n₁ n₁ R) (y : Matrix n₂ n₂ R), g (x ⊗ₖ y) = h (x ⊗ₖ y) := + by + classical + letI := Fintype.ofFinite n₁ + letI := Fintype.ofFinite n₂ + refine ⟨fun h x y => by rw [h], fun h => ?_⟩ + rw [LinearMap.ext_iff] + intro x + rw [Matrix.kmul_representation x] + simp_rw [map_sum, _root_.map_smul, h _ _] + +private def mul_map_aux (𝕜 X : Type _) [RCLike 𝕜] [NormedAddCommGroupOfRing X] [NormedSpace 𝕜 X] + [SMulCommClass 𝕜 X X] [IsScalarTower 𝕜 X X] [FiniteDimensional 𝕜 X] : X →ₗ[𝕜] X →L[𝕜] X + where + toFun x := + { toFun := LinearMap.mul 𝕜 X x + map_add' := map_add _ + map_smul' := map_smul _ } + map_add' x y := by + ext + simp_rw [map_add, ContinuousLinearMap.coe_mk', LinearMap.coe_mk, AddHom.coe_mk, + LinearMap.add_apply, ContinuousLinearMap.add_apply] + rfl + map_smul' r x := by + ext + simp_rw [_root_.map_smul, ContinuousLinearMap.coe_mk', LinearMap.coe_mk, AddHom.coe_mk, + LinearMap.smul_apply, ContinuousLinearMap.smul_apply] + rfl + +namespace LinearMap + +/-- Multiplication as a continuous bilinear map, curried as a continuous linear map. -/ +def mulToClm (𝕜 X : Type _) [RCLike 𝕜] [NormedAddCommGroupOfRing X] [NormedSpace 𝕜 X] + [SMulCommClass 𝕜 X X] [IsScalarTower 𝕜 X X] [FiniteDimensional 𝕜 X] : X →L[𝕜] X →L[𝕜] X + where + toFun := mul_map_aux 𝕜 X + map_add' := map_add _ + map_smul' := _root_.map_smul _ + cont := map_continuous _ + +theorem mulToClm_apply {𝕜 X : Type _} [RCLike 𝕜] [NormedAddCommGroupOfRing X] + [NormedSpace 𝕜 X] [SMulCommClass 𝕜 X X] [IsScalarTower 𝕜 X X] [FiniteDimensional 𝕜 X] + (x y : X) : mulToClm 𝕜 X x y = x * y := + rfl + +end LinearMap diff --git a/LeanPool/Monlib4/LinearAlgebra/MyBimodule.lean b/LeanPool/Monlib4/LinearAlgebra/MyBimodule.lean new file mode 100644 index 0000000000..37fe85cfd1 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/MyBimodule.lean @@ -0,0 +1,362 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Algebra.Algebra.Bilinear +import Mathlib.LinearAlgebra.Basis.VectorSpace +import Mathlib.LinearAlgebra.TensorProduct.Basis +import Mathlib.RingTheory.TensorProduct.Basic +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.BasicLemmas +import LeanPool.Monlib4.LinearAlgebra.End +import LeanPool.Monlib4.Preq.Finset +import LeanPool.Monlib4.LinearAlgebra.LmulRmul + +/-! +# (A-A)-Bimodules + +We define (A-A)-bimodules, where A is a commutative semiring, and show basic +properties of them. +-/ + + +variable {R H₁ H₂ : Type _} [CommSemiring R] [Semiring H₁] [Semiring H₂] [Algebra R H₁] + [Algebra R H₂] + +open scoped TensorProduct + +local notation x " ⊗ₘ " y => TensorProduct.map x y + +/-- Left multiplication on the left tensor factor. -/ +noncomputable def Bimodule.lsmul (x : H₁) (y : H₁ ⊗[R] H₂) : H₁ ⊗[R] H₂ := + (LinearMap.mulLeft R x ⊗ₘ 1) y + +/-- Right multiplication on the right tensor factor. -/ +noncomputable def Bimodule.rsmul (x : H₁ ⊗[R] H₂) (y : H₂) : H₁ ⊗[R] H₂ := + (1 ⊗ₘ LinearMap.mulRight R y) x + +/-- Scoped notation for left multiplication on the left tensor factor. -/ +scoped[Bimodule] infixl:72 " •ₗ " => Bimodule.lsmul + +/-- Scoped notation for right multiplication on the right tensor factor. -/ +scoped[Bimodule] infixl:72 " •ᵣ " => Bimodule.rsmul + +open scoped Bimodule BigOperators + +theorem Bimodule.lsmul_apply (x a : H₁) (b : H₂) : x •ₗ a ⊗ₜ b = (x * a) ⊗ₜ[R] b := + rfl + +theorem Bimodule.rsmul_apply (a : H₁) (x b : H₂) : a ⊗ₜ b •ᵣ x = a ⊗ₜ[R] (b * x) := + rfl + +theorem Bimodule.lsmul_rsmul_assoc (x : H₁) (y : H₂) (a : H₁ ⊗[R] H₂) : + x •ₗ a •ᵣ y = x •ₗ (a •ᵣ y) := by + simp_rw [Bimodule.lsmul, Bimodule.rsmul, ← LinearMap.comp_apply, ← TensorProduct.map_comp, + LinearMap.one_comp, LinearMap.comp_one] + +theorem Bimodule.lsmul_zero (x : H₁) : x •ₗ (0 : H₁ ⊗[R] H₂) = 0 := + rfl + +theorem Bimodule.zero_lsmul (x : H₁ ⊗[R] H₂) : 0 •ₗ x = 0 := by + rw [Bimodule.lsmul, LinearMap.mulLeft_zero_eq_zero, TensorProduct.map_zero_left, + LinearMap.zero_apply] + +theorem Bimodule.zero_rsmul (x : H₂) : (0 : H₁ ⊗[R] H₂) •ᵣ x = 0 := + rfl + +theorem Bimodule.rsmul_zero (x : H₁ ⊗[R] H₂) : x •ᵣ 0 = 0 := by + rw [Bimodule.rsmul, LinearMap.mulRight_zero_eq_zero, TensorProduct.map_zero_right, + LinearMap.zero_apply] + +theorem Bimodule.lsmul_add (x : H₁) (a b : H₁ ⊗[R] H₂) : x •ₗ (a + b) = x •ₗ a + x •ₗ b := + map_add _ _ _ + +theorem Bimodule.add_rsmul (x : H₂) (a b : H₁ ⊗[R] H₂) : (a + b) •ᵣ x = a •ᵣ x + b •ᵣ x := + map_add _ _ _ + +theorem Bimodule.lsmul_sum (x : H₁) {k : Type _} {s : Finset k} (a : k → H₁ ⊗[R] H₂) : + x •ₗ ∑ i ∈ s, a i = ∑ i ∈ s, x •ₗ a i := + map_sum _ _ _ + +theorem Bimodule.sum_rsmul (x : H₂) {k : Type _} {s : Finset k} (a : k → H₁ ⊗[R] H₂) : + (∑ i ∈ s, a i) •ᵣ x = ∑ i ∈ s, a i •ᵣ x := + map_sum _ _ _ + +theorem Bimodule.one_lsmul (x : H₁ ⊗[R] H₂) : 1 •ₗ x = x := by + rw [Bimodule.lsmul, LinearMap.mulLeft_one, ← Module.End.one_eq_id, TensorProduct.map_one, + Module.End.one_apply] + +theorem Bimodule.rsmul_one (x : H₁ ⊗[R] H₂) : x •ᵣ 1 = x := by + rw [Bimodule.rsmul, LinearMap.mulRight_one, ← Module.End.one_eq_id, TensorProduct.map_one, + Module.End.one_apply] + +theorem Bimodule.lsmul_one (x : H₁) : x •ₗ (1 : H₁ ⊗[R] H₂) = x ⊗ₜ 1 := by + rw [Algebra.TensorProduct.one_def, Bimodule.lsmul_apply, mul_one] + +theorem Bimodule.one_rsmul (x : H₂) : (1 : H₁ ⊗[R] H₂) •ᵣ x = 1 ⊗ₜ x := by + rw [Algebra.TensorProduct.one_def, Bimodule.rsmul_apply, one_mul] + +theorem Bimodule.lsmul_smul (α : R) (x : H₁) (a : H₁ ⊗[R] H₂) : x •ₗ α • a = α • (x •ₗ a) := by + simp_rw [Bimodule.lsmul, _root_.map_smul] + +theorem Bimodule.smul_rsmul (α : R) (x : H₂) (a : H₁ ⊗[R] H₂) : α • a •ᵣ x = α • (a •ᵣ x) := by + simp_rw [Bimodule.rsmul, _root_.map_smul] + +theorem Bimodule.lsmul_lsmul (x y : H₁) (a : H₁ ⊗[R] H₂) : x •ₗ (y •ₗ a) = (x * y) •ₗ a := by + simp_rw [Bimodule.lsmul, ← LinearMap.comp_apply, ← TensorProduct.map_comp, + ← LinearMap.mulLeft_mul] + rfl + +theorem Bimodule.rsmul_rsmul (x y : H₂) (a : H₁ ⊗[R] H₂) : a •ᵣ x •ᵣ y = a •ᵣ (x * y) := by + simp_rw [Bimodule.rsmul, ← LinearMap.comp_apply, ← TensorProduct.map_comp, + ← LinearMap.mulRight_mul] + rfl + +local notation "l(" x "," y ")" => y →ₗ[x] y + +/-- A linear map commuting with the left and right tensor-factor actions. -/ +def LinearMap.IsBimoduleMap (P : l(R,H₁ ⊗[R] H₂)) : Prop := + ∀ (x : H₁) (y : H₂) (a : H₁ ⊗[R] H₂), P (x •ₗ a •ᵣ y) = x •ₗ P a •ᵣ y + +theorem LinearMap.IsBimoduleMap.lsmul {P : l(R,H₁ ⊗[R] H₂)} (hP : P.IsBimoduleMap) (x : H₁) + (a : H₁ ⊗[R] H₂) : P (x •ₗ a) = x •ₗ P a := + by + nth_rw 1 [← Bimodule.rsmul_one a] + rw [← Bimodule.lsmul_rsmul_assoc, hP, Bimodule.rsmul_one] + +theorem LinearMap.IsBimoduleMap.rsmul {P : l(R,H₁ ⊗[R] H₂)} (hP : P.IsBimoduleMap) (x : H₂) + (a : H₁ ⊗[R] H₂) : P (a •ᵣ x) = P a •ᵣ x := + by + nth_rw 1 [← Bimodule.one_lsmul a] + rw [hP, Bimodule.one_lsmul] + +theorem LinearMap.IsBimoduleMap.add {P Q : l(R,H₁ ⊗[R] H₂)} (hP : P.IsBimoduleMap) + (hQ : Q.IsBimoduleMap) : (P + Q).IsBimoduleMap := + by + simp_rw [LinearMap.IsBimoduleMap, LinearMap.add_apply, Bimodule.lsmul_add, Bimodule.add_rsmul] + intro x y a + rw [hP, hQ] + +theorem LinearMap.isBimoduleMap.zero : (0 : l(R,H₁ ⊗[R] H₂)).IsBimoduleMap := + by + intro x y a + simp_rw [LinearMap.zero_apply, Bimodule.lsmul_zero, Bimodule.zero_rsmul] + +theorem LinearMap.IsBimoduleMap.smul {x : l(R,H₁ ⊗[R] H₂)} (hx : x.IsBimoduleMap) (k : R) : + (k • x).IsBimoduleMap := by + intro x y a + simp only [LinearMap.smul_apply, Bimodule.lsmul_smul, Bimodule.smul_rsmul] + rw [hx] + +theorem LinearMap.IsBimoduleMap.nsmul {x : l(R,H₁ ⊗[R] H₂)} (hx : x.IsBimoduleMap) (k : ℕ) : + (k • x).IsBimoduleMap := by + intro x y a + simp only [LinearMap.smul_apply, ← Nat.cast_smul_eq_nsmul R k, + Bimodule.lsmul_smul, Bimodule.smul_rsmul] + rw [hx] + +/-- The submodule of bimodule endomorphisms of a tensor product. -/ +noncomputable def LinearMap.IsBimoduleMaps (R H₁ H₂ : Type _) [CommSemiring R] + [Semiring H₁] [Semiring H₂] [Algebra R H₁] [Algebra R H₂] : + Submodule R (l(R, H₁ ⊗[R] H₂)) where + carrier x := x.IsBimoduleMap + add_mem' x y := x.add y + zero_mem' := LinearMap.isBimoduleMap.zero + smul_mem' r _ x := x.smul r + +-- { x : l(R,H₁ ⊗[R] H₂) // x.IsBimoduleMap } + + +-- noncomputable instance LinearMap.IsBidmoduleMaps.Add : +-- Add (LinearMap.IsBimoduleMaps R H₁ H₂) := +-- ⟨fun x y => ⟨↑x + ↑y, x.property.add y.property⟩⟩ +-- noncomputable instance LinearMap.IsBimoduleMaps.Zero : +-- Zero (LinearMap.IsBimoduleMaps R H₁ H₂) := +-- ⟨⟨0, LinearMap.isBimoduleMap.zero⟩⟩ +-- noncomputable instance LinearMap.IsBimoduleMaps.Smul : +-- SMul R (LinearMap.IsBimoduleMaps R H₁ H₂) := +-- ⟨fun a x => ⟨a • ↑x, x.property.smul a⟩⟩ +-- noncomputable instance LinearMap.IsBimoduleMaps.NSmul : +-- SMul ℕ (LinearMap.IsBimoduleMaps R H₁ H₂) := +-- ⟨fun a x => ⟨a • ↑x, x.property.nsmul a⟩⟩ + +@[simp] lemma LinearMap.IsBimoduleMaps.coe_add (x y : IsBimoduleMaps R H₁ H₂) : + ((x + y : IsBimoduleMaps R H₁ H₂) : H₁ ⊗[R] H₂ →ₗ[R] H₁ ⊗[R] H₂) = ↑x + ↑y := rfl +@[simp] lemma LinearMap.IsBimoduleMaps.coe_smul (x : IsBimoduleMaps R H₁ H₂) + (r : R) : + ((r • x : IsBimoduleMaps R H₁ H₂) : H₁ ⊗[R] H₂ →ₗ[R] H₁ ⊗[R] H₂) = r • ↑x := rfl +@[simp] lemma LinearMap.IsBimoduleMaps.coe_nsmul (x : IsBimoduleMaps R H₁ H₂) + (r : ℕ) : + ((r • x : IsBimoduleMaps R H₁ H₂) : H₁ ⊗[R] H₂ →ₗ[R] H₁ ⊗[R] H₂) = r • ↑x := rfl +@[simp] lemma LinearMap.IsBimoduleMaps.coe_zero : + ((0 : IsBimoduleMaps R H₁ H₂) : H₁ ⊗[R] H₂ →ₗ[R] H₁ ⊗[R] H₂) = 0 := rfl + +-- @[instance] +-- noncomputable def LinearMap.IsBimoduleMaps.AddCommMonoid : AddCommMonoid (IsBimoduleMaps R H₁ H₂) +-- where +-- add_assoc x y z := by ext; simp only [coe_add, add_assoc] +-- zero_add x := by ext; simp only [coe_zero, coe_add, zero_add] +-- add_zero x := by ext; simp only [coe_zero, coe_add, add_zero] +-- nsmul n x := n • x +-- nsmul_zero x := by ext; simp only [coe_nsmul, coe_zero, zero_smul] +-- nsmul_succ k x := +-- by +-- ext +-- simp only [coe_add, coe_nsmul, add_smul, one_mul, add_comm, +-- nsmul_eq_mul, Nat.cast_one] +-- add_comm x y := by +-- rw [← Subtype.coe_inj] +-- simp_rw [coe_add, add_comm] + +theorem LinearMap.IsBimoduleMap.add_smul (a b : R) (x : (IsBimoduleMaps R H₁ H₂)) : + (a + b) • x = a • x + b • x := by + rw [← Subtype.coe_inj] + simp_rw [IsBimoduleMaps.coe_smul, IsBimoduleMaps.coe_add, _root_.add_smul] + rfl + +-- open LinearMap.IsBimoduleMaps in +-- noncomputable instance : MulAction R (LinearMap.IsBimoduleMaps R H₁ H₂) +-- where +-- one_smul x := by +-- simp_rw [← Subtype.coe_inj] +-- simp_rw [coe_smul, one_smul] +-- mul_smul x y a := by +-- simp_rw [← Subtype.coe_inj] +-- simp_rw [coe_smul, ← smul_smul] + +-- open LinearMap.IsBimoduleMaps in +-- noncomputable instance : DistribMulAction R (LinearMap.IsBimoduleMaps R H₁ H₂) +-- where +-- smul_zero x := rfl +-- smul_add x y z := by +-- simp only [← Subtype.coe_inj, coe_smul, coe_add, smul_add] + +-- noncomputable instance LinearMap.IsBimoduleMaps.Module : +-- Module R (IsBimoduleMaps R H₁ H₂) +-- where +-- add_smul r s x := IsBimoduleMap.add_smul _ _ _ +-- zero_smul x := by +-- simp_rw [← Subtype.coe_inj, coe_smul, zero_smul, coe_zero] + +-- @[reducible] +-- def LinearMap.IsBimoduleMaps.submodule : +-- Submodule R (IsBimoduleMaps R H₁ H₂) +-- where +-- carrier x := x.IsBimoduleMap +-- add_mem' x y hx hy := hx.add hy +-- zero_mem' := LinearMap.isBimoduleMapZero +-- smul_mem' r x hx := hx.smul r + +theorem LinearMap.isBimoduleMap_iff {T : l(R,H₁ ⊗[R] H₂)} : + T.IsBimoduleMap ↔ ∀ a b x y, T ((a * x) ⊗ₜ[R] (y * b)) = a •ₗ T (x ⊗ₜ[R] y) •ᵣ b := +⟨fun h a b x y => by rw [← h]; rfl, fun h a b x => + x.induction_on + (by simp only [map_zero, Bimodule.lsmul_zero, Bimodule.zero_rsmul]) + (fun _ _ => h _ _ _ _) + (fun _ _ hc hd => by simp only [map_add, Bimodule.lsmul_add, Bimodule.add_rsmul, hc, hd])⟩ + +theorem LinearMap.isBimoduleMap_iff_ltensor_lsmul_rtensor_rsmul {R H₁ H₂ : Type _} + [Field R] [Ring H₁] [Ring H₂] [Algebra R H₁] [Algebra R H₂] {x : l(R,H₁)} + {y : l(R,H₂)} : + (x ⊗ₘ y).IsBimoduleMap ↔ + (x ⊗ₘ y) = 0 ∨ x = LinearMap.mulRight R (x 1) ∧ y = LinearMap.mulLeft R (y 1) := + by + rw [← left_module_map_iff, ← right_module_map_iff] + by_cases h : (x ⊗ₘ y) = 0 + · simp_rw [h, true_or, iff_true, LinearMap.isBimoduleMap.zero] + simp_rw [isBimoduleMap_iff, TensorProduct.map_tmul, Bimodule.lsmul_apply, Bimodule.rsmul_apply, h, + false_or] + have hy : y ≠ 0 := by + intro hy + rw [hy, TensorProduct.map_zero_right] at h + contradiction + have hx : x ≠ 0 := by + intro hx + rw [hx, TensorProduct.map_zero_left] at h + contradiction + simp_rw [ne_eq, LinearMap.ext_iff, LinearMap.zero_apply, Classical.not_forall] at hx hy + refine ⟨fun hxy => ?_, fun hxy a b c d => by rw [hxy.1, hxy.2]⟩ + obtain ⟨a, ha⟩ := hx + obtain ⟨b, hb⟩ := hy + have H : ∀ x_4 x_2 x_1 x_3, + x (x_1 * x_3) ⊗ₜ y (x_4 * x_2) = (x_1 * x x_3) ⊗ₜ (y x_4 * x_2) := + fun x_4 x_2 x_1 x_3 => hxy x_1 x_2 x_3 x_4 + rw [Forall.rotate] at hxy + specialize hxy a 1 + specialize H b 1 + simp_rw [mul_one, one_mul, ← @sub_eq_zero _ _ _ (_ ⊗ₜ[R] (_ * _) : H₁ ⊗[R] H₂), ← + @sub_eq_zero _ _ _ ((_ * _) ⊗ₜ[R] _), ← TensorProduct.sub_tmul, ← TensorProduct.tmul_sub, + TensorProduct.tmul_eq_zero, sub_eq_zero, ha, hb, false_or, or_false] at H hxy + exact ⟨H, fun _ _ => hxy _ _⟩ + +-- noncomputable def LinearMap.IsBimoduleMap.sum {p : Type _} {s : Finset p} +-- (x : p → (IsBimoduleMaps R H₁ H₂)) : +-- (IsBimoduleMaps R H₁ H₂) := +-- ⟨∑ i in s, (x i).1, fun a b c => +-- by +-- simp_rw [LinearMap.sum_apply, Bimodule.lsmul_sum, Bimodule.sum_rsmul] +-- apply Finset.sum_congr rfl; intros +-- rw [Subtype.mem (x _)]⟩ + +theorem LinearMap.IsBimoduleMap.sum_coe {p : Type _} {s : Finset p} + (x : p → (IsBimoduleMaps R H₁ H₂)) : + (∑ i ∈ s, x i : IsBimoduleMaps R H₁ H₂).1 = ∑ i ∈ s, (x i).1 := +Submodule.coe_sum _ _ _ + +theorem rmulMapLmul_apply_apply (x : H₁ ⊗[R] H₂) (a : H₁) (b : H₂) : + rmulMapLmul x (a ⊗ₜ b) = a •ₗ x •ᵣ b := +x.induction_on (by simp only [map_zero]; rfl) + (fun α β => by + simp_rw [rmulMapLmul_apply, TensorProduct.map_tmul, rmul_apply, lmul_apply] + rfl) + (fun α β hα hβ => by + simp_rw [map_add, LinearMap.add_apply] + rw [hα, hβ, Bimodule.lsmul_add, Bimodule.add_rsmul]) + +theorem LinearMap.isBimoduleMap_iff' {f : l(R,H₁ ⊗[R] H₂)} : + f.IsBimoduleMap ↔ rmulMapLmul (f 1) = f := + by + constructor + · intro h + apply TensorProduct.ext' + intro x y + rw [rmulMapLmul_apply_apply, ← h, Bimodule.lsmul_one, Bimodule.rsmul_apply, one_mul] + · intro h + rw [isBimoduleMap_iff] + intro a b c d + rw [← h, rmulMapLmul_apply_apply, rmulMapLmul_apply_apply, + ← Bimodule.lsmul_lsmul, ← Bimodule.rsmul_rsmul, Bimodule.lsmul_rsmul_assoc] + +@[simp] +theorem rmulMapLmul_apply_one (x : H₁ ⊗[R] H₂) : + rmulMapLmul x 1 = x := by +calc rmulMapLmul x 1 = rmulMapLmul x (1 ⊗ₜ[R] 1) := rfl + _ = 1 •ₗ x •ᵣ 1 := by rw [rmulMapLmul_apply_apply] + _ = x := by simp_rw [Bimodule.one_lsmul, Bimodule.rsmul_one] + +@[simp] +theorem LinearMap.mem_isBimoduleMaps_iff {x : l(R,H₁ ⊗[R] H₂)} : + x ∈ LinearMap.IsBimoduleMaps R H₁ H₂ ↔ x.IsBimoduleMap := +by rfl + +theorem rmulMapLmul_mem_isBimoduleMaps (x : H₁ ⊗[R] H₂) : + rmulMapLmul x ∈ LinearMap.IsBimoduleMaps R H₁ H₂ := +by + simp_rw [LinearMap.mem_isBimoduleMaps_iff, LinearMap.isBimoduleMap_iff', + rmulMapLmul_apply_one] + +/-- The tensor product is linearly equivalent to its bimodule endomorphism submodule. -/ +@[simps] +noncomputable def TensorProduct.toIsBimoduleMap + {R : Type*} {H₁ H₂ : Type*} [CommSemiring R] [Semiring H₁] + [Semiring H₂] [Algebra R H₁] [Algebra R H₂] : + (H₁ ⊗[R] H₂) ≃ₗ[R] LinearMap.IsBimoduleMaps R H₁ H₂ where + toFun x := ⟨rmulMapLmul x, rmulMapLmul_mem_isBimoduleMaps _⟩ + invFun x := (x : l(R, H₁ ⊗[R] H₂)) 1 + map_add' _ _ := by simp only [_root_.map_add]; rfl + map_smul' _ _ := by simp only [map_smulₛₗ]; rfl + left_inv _ := by simp only [rmulMapLmul_apply_one] + right_inv f := by + simp only + congr + rw [LinearMap.isBimoduleMap_iff'.mp f.property] diff --git a/LeanPool/Monlib4/LinearAlgebra/MySpec.lean b/LeanPool/Monlib4/LinearAlgebra/MySpec.lean new file mode 100644 index 0000000000..13d2b71958 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/MySpec.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.LinearAlgebra.End + +/-! + # One lemma of the spectrum of a linear map + + This file just proves that the spectrum of a linear map is commutative. +-/ + + +theorem isUnit_comm (K E : Type _) [DivisionRing K] [AddCommGroup E] [Module K E] + [FiniteDimensional K E] (x y : E →ₗ[K] E) : IsUnit (x ∘ₗ y) ↔ IsUnit (y ∘ₗ x) := + by + simp_rw [← Module.End.mul_eq_comp] + constructor + all_goals + intro h + rw [← nonempty_invertible_iff_isUnit] at h ⊢ + refine Nonempty.intro ?_ + obtain ⟨z, hz1, hz2⟩ := Nonempty.some h + apply @invertibleMul _ _ _ _ ?_ ?_ + rw [mul_assoc, mul_eq_one_comm, mul_assoc] at hz2 + rw [← mul_assoc] at hz1 + any_goals apply Invertible.mk (z * x) hz1 hz2 + any_goals apply Invertible.mk (z * y) hz1 hz2 + all_goals + rw [mul_eq_one_comm, mul_assoc] at hz1 + rw [mul_assoc, mul_eq_one_comm] at hz2 + · exact Invertible.mk (y * z) hz2 hz1 + · exact Invertible.mk (x * z) hz2 hz1 + +theorem isUnit_neg {α : Type _} [Monoid α] [HasDistribNeg α] (x : α) : IsUnit (-x) ↔ IsUnit x := + by + constructor + all_goals + intro h + rw [← nonempty_invertible_iff_isUnit] at h ⊢ + refine Nonempty.intro ?_ + obtain ⟨z, hz1, hz2⟩ := Nonempty.some h + any_goals + rw [neg_mul_comm] at hz2 + rw [← neg_mul_comm] at hz1 + exact ⟨-z, hz1, hz2⟩ + any_goals + rw [← neg_mul_neg] at hz2 + rw [← neg_mul_neg] at hz1 + exact ⟨-z, hz1, hz2⟩ + +theorem spectrum.comm {K E : Type _} [Field K] [AddCommGroup E] [Module K E] [FiniteDimensional K E] + (x y : E →ₗ[K] E) : spectrum K (x ∘ₗ y) = spectrum K (y ∘ₗ x) := + by + ext1 u + by_cases Hu : u = 0 + · simp_rw [spectrum.mem_iff, Hu, Algebra.algebraMap_eq_smul_one, zero_smul, zero_sub, isUnit_neg, + isUnit_comm] + simp_rw [← Module.End.hasEigenvalue_iff_mem_spectrum, ← + Module.End.has_eigenvector_iff_hasEigenvalue, LinearMap.comp_apply] + constructor <;> rintro ⟨v, ⟨h, hv⟩⟩ + on_goal 1 => use y v + on_goal 2 => use x v + all_goals + rw [h, _root_.map_smul, eq_self_iff_true, true_and] + intro H + rw [H, map_zero, eq_comm, smul_eq_zero] at h + simp_rw [Hu, hv, false_or] at h diff --git a/LeanPool/Monlib4/LinearAlgebra/Nacgor.lean b/LeanPool/Monlib4/LinearAlgebra/Nacgor.lean new file mode 100644 index 0000000000..03f67d882b --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/Nacgor.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2024 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Analysis.Normed.Group.Basic +import Mathlib.Analysis.Normed.Lp.PiLp +import Mathlib.Analysis.InnerProductSpace.Basic + +/-! + # Normed additive commutative groups of rings + +This file contains the `NormedAddCommGroupOfRing` class, which bundles the +ring structure together with the normed additive commutative group structure. +-/ + +open scoped BigOperators + +/-- A ring whose additive group is a normed additive commutative group. -/ +class NormedAddCommGroupOfRing (B : Type*) extends Ring B, NormedAddCommGroup B + +attribute [instance] NormedAddCommGroupOfRing.toNormedAddCommGroup +attribute [instance] NormedAddCommGroupOfRing.toRing +attribute [instance] NormedAddCommGroupOfRing.toNorm + +/-- The algebra structure coming from compatible scalar multiplication and multiplication. -/ +@[reducible] +def Algebra.ofIsScalarTowerSmulCommClass {R A : Type*} [CommSemiring R] [Semiring A] + [Module R A] [SMulCommClass R A A] [IsScalarTower R A A] : Algebra R A := + Algebra.ofModule smul_mul_assoc mul_smul_comm + +attribute [local instance] Algebra.ofIsScalarTowerSmulCommClass + +/-- The pointwise ring with the `L^2` product norm is a normed additive group of rings. -/ +@[reducible, instance] +noncomputable def PiNormedAddCommGroupOfRing {ι : Type*} [Fintype ι] {B : ι → Type*} + [Π i, NormedAddCommGroupOfRing (B i)] : NormedAddCommGroupOfRing (Π i, B i) where + toNorm := (PiLp.normedAddCommGroupToPi (2 : ENNReal) B).toNorm + toRing := Pi.ring + toMetricSpace := (PiLp.normedAddCommGroupToPi (2 : ENNReal) B).toMetricSpace + dist_eq := (PiLp.normedAddCommGroupToPi (2 : ENNReal) B).dist_eq + +/-- The `L^2` norm on a finite product is the square root of the sum of squared norms. -/ +theorem Pi.normedAddCommGroupOfRing.norm_eq_sum {ι : Type*} [Fintype ι] {B : ι → Type*} + [Π i, NormedAddCommGroupOfRing (B i)] (x : Π i, B i) : + PiNormedAddCommGroupOfRing.norm x = Real.sqrt (∑ i, ‖x i‖ ^ 2) := by + have h2 : 0 < (2 : ENNReal).toReal := by norm_num + change ‖WithLp.toLp (2 : ENNReal) x‖ = Real.sqrt (∑ i, ‖x i‖ ^ 2) + rw [PiLp.norm_eq_sum h2] + simp [Real.sqrt_eq_rpow] diff --git a/LeanPool/Monlib4/LinearAlgebra/OfNorm.lean b/LeanPool/Monlib4/LinearAlgebra/OfNorm.lean new file mode 100644 index 0000000000..f03e45207c --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/OfNorm.lean @@ -0,0 +1,757 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.Ips.Basic +import LeanPool.Monlib4.LinearAlgebra.Ips.Ips +import LeanPool.Monlib4.LinearAlgebra.Ips.RankOne +import LeanPool.Monlib4.Preq.RCLikeLe +import Mathlib.Topology.Algebra.Module.Spaces.WeakDual +import Mathlib.Analysis.Normed.Module.Dual +import Mathlib.Analysis.InnerProductSpace.Adjoint +import Mathlib.Analysis.Convex.Extreme + +open scoped ComplexOrder + +section Ex4 + +variable {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] + +theorem cs_aux {x y : E} (hy : y ≠ 0) : + ‖x - (inner 𝕜 y x * (‖y‖ ^ 2 : ℝ)⁻¹) • y‖ ^ 2 = ‖x‖ ^ 2 - ‖inner 𝕜 x y‖ ^ 2 * (‖y‖ ^ 2)⁻¹ := + by + have : ((‖y‖ ^ 2 : ℝ) : 𝕜) ≠ 0 := + by + rw [ne_eq, RCLike.ofReal_eq_zero, sq_eq_zero_iff, norm_eq_zero] + exact hy + rw [← @inner_self_eq_norm_sq 𝕜] + simp only [inner_sub_sub_self, inner_smul_left, inner_smul_right, _root_.map_mul, inner_conj_symm] + simp_rw [inner_self_eq_norm_sq_to_K, starRingEnd_apply, + RCLike.ofReal_inv, star_inv₀, RCLike.star_def, + RCLike.conj_ofReal, mul_assoc, ← RCLike.ofReal_pow, inv_mul_cancel₀ this, mul_one] + letI : InnerProductSpace.Core 𝕜 E := InnerProductSpace.toCore + calc + RCLike.re + (((‖x‖ ^ 2 : ℝ) : 𝕜) - inner 𝕜 y x * (((‖y‖ ^ 2 : ℝ) : 𝕜)⁻¹ * inner 𝕜 x y) - + inner 𝕜 x y * (((‖y‖ ^ 2 : ℝ) : 𝕜)⁻¹ * inner 𝕜 y x) + + inner 𝕜 y x * (((‖y‖ ^ 2 : ℝ) : 𝕜)⁻¹ * inner 𝕜 x y)) = + RCLike.re (((‖x‖ ^ 2 : ℝ) : 𝕜) - inner 𝕜 x y * (((‖y‖ ^ 2 : ℝ) : 𝕜)⁻¹ * inner 𝕜 y x)) := + ?_ + _ = RCLike.re (↑(‖x‖ ^ 2) - ‖inner 𝕜 x y‖ ^ 2 * (↑(‖y‖ ^ 2))⁻¹) := ?_ + _ = ‖x‖ ^ 2 - ‖inner 𝕜 x y‖ ^ 2 * (‖y‖ ^ 2)⁻¹ := ?_ + · congr + ring_nf + · rw [mul_rotate', ← inner_conj_symm, RCLike.conj_mul, mul_comm, + ← RCLike.normSq_eq_def', RCLike.normSq_eq_def'] + simp_rw [_root_.map_sub, ← RCLike.ofReal_inv, + ← RCLike.ofReal_pow, ← RCLike.ofReal_mul] + norm_cast + · norm_cast + +-- already exists in `mathlib`... but different proof... just for fun +example {x y : E} (hx : x ≠ 0) (hy : y ≠ 0) : + ‖inner 𝕜 x y‖ = ‖x‖ * ‖y‖ ↔ ∃ α : 𝕜ˣ, x = (α : 𝕜) • y := + by + constructor + · intro h + have : inner 𝕜 y x ≠ 0 := by + intro h' + rw [inner_eq_zero_symm] at h' + rw [h', norm_zero, eq_comm, mul_eq_zero] at h + simp_rw [norm_eq_zero, hx, hy, false_or] at h + have hy' : ‖y‖ ^ 2 ≠ 0 := by + rw [ne_eq, sq_eq_zero_iff, norm_eq_zero] + exact hy + rw [← sq_eq_sq₀ (norm_nonneg _) (mul_nonneg (norm_nonneg _) (norm_nonneg _)), + mul_pow, eq_comm, ← eq_mul_inv_iff_mul_eq₀ hy', ← sub_eq_zero, ← cs_aux hy, + sq_eq_zero_iff, norm_eq_zero, sub_eq_zero] at h + use Units.mk0 (inner 𝕜 y x * ((‖y‖ : 𝕜) ^ 2)⁻¹) + (mul_ne_zero this + (by + rw [ne_eq, inv_eq_zero, sq_eq_zero_iff, RCLike.ofReal_eq_zero, norm_eq_zero] + exact hy)) + norm_cast at h ⊢ + · rintro ⟨α, rfl⟩ + simp_rw [inner_smul_left, norm_mul, norm_smul, ← inner_self_re_eq_norm, + inner_self_eq_norm_mul_norm, mul_assoc, RCLike.norm_conj] + +end Ex4 + +open RCLike + +open scoped ComplexConjugate + +variable {𝕜 X : Type _} [RCLike 𝕜] [NormedAddCommGroup X] [NormedSpace 𝕜 X] + +/-- Polarization expression used to recover an inner product from a norm. -/ +noncomputable def OfNorm.innerDef (x y : X) : 𝕜 := + 4⁻¹ * (‖x + y‖ ^ 2 - ‖x - y‖ ^ 2 + I * ‖(I : 𝕜) • x + y‖ ^ 2 - I * ‖(I : 𝕜) • x - y‖ ^ 2) + +namespace OfNorm + +theorem re_innerDef (x y : X) : re (innerDef x y : 𝕜) = 4⁻¹ * (‖x + y‖ ^ 2 - ‖x - y‖ ^ 2) := by + calc + re (innerDef x y : 𝕜) = + re + (4⁻¹ * + (‖x + y‖ ^ 2 - ‖x - y‖ ^ 2 + I * ‖(I : 𝕜) • x + y‖ ^ 2 - I * ‖(I : 𝕜) • x - y‖ ^ 2) : + 𝕜) := + rfl + _ = + (4⁻¹ : ℝ) * + re + (((‖x + y‖ ^ 2 - ‖x - y‖ ^ 2 : ℝ) : 𝕜) + + I * ((‖(I : 𝕜) • x + y‖ ^ 2 - ‖(I : 𝕜) • x - y‖ ^ 2 : ℝ) : 𝕜)) := + by + rw [mul_re] + have : im (4 : 𝕜)⁻¹ = 0 := by simp + simp only [this, MulZeroClass.zero_mul, sub_zero, mul_sub, ofReal_sub, ofReal_pow] + simp only [sub_eq_add_neg, add_assoc] + congr + · calc + re (4 : 𝕜)⁻¹ = re ((4 : ℝ) : 𝕜)⁻¹ := by + congr + norm_cast + _ = (re ((4 : ℝ) : 𝕜))⁻¹ := + by + simp_rw [inv_re, normSq_eq_def', norm_ofReal] + norm_num + _ = (4 : ℝ)⁻¹ := by simp only [ofReal_re] + _ = 4⁻¹ * (‖x + y‖ ^ 2 - ‖x - y‖ ^ 2) := by + rw [_root_.map_add, I_mul_re, ofReal_im, neg_zero, add_zero, ofReal_re] + +theorem im_eq_re_neg_i (x : 𝕜) : im x = re (-(I : 𝕜) * x) := by + simp only [neg_mul, map_neg, I_mul_re, neg_neg] + +theorem innerDef_zero_left (x : X) : (innerDef 0 x : 𝕜) = 0 := by + simp only [innerDef, smul_zero, zero_add, zero_sub, norm_neg, sub_self, MulZeroClass.mul_zero] + +theorem innerDef_i_smul_left (x y : X) : (innerDef ((I : 𝕜) • x) y : 𝕜) = (-I : 𝕜) * innerDef x y := + by + by_cases hI : (I : 𝕜) = 0 + · simp_rw [hI, zero_smul, innerDef_zero_left, neg_zero, MulZeroClass.zero_mul] + have hI' : (-I : 𝕜) * I = 1 := by rw [← inv_I, inv_mul_cancel₀ hI] + simp only [innerDef, ← mul_assoc, mul_comm (-I : 𝕜) 4⁻¹] + simp only [mul_assoc] + congr 1 + rw [smul_smul, I_mul_I_of_nonzero hI, neg_one_smul, neg_sub_left, norm_neg] + simp only [mul_add, mul_sub] + simp_rw [← mul_assoc, hI', one_mul, neg_mul] + rw [sub_neg_eq_add] + have : ‖x - y‖ = ‖-x + y‖ := by rw [← norm_neg, neg_sub', sub_eq_add_neg, neg_neg] + rw [this, add_comm x y] + ring_nf + +theorem im_innerDef_aux (x y : X) : im (innerDef x y : 𝕜) = re (innerDef ((I : 𝕜) • x) y : 𝕜) := by + rw [im_eq_re_neg_i, ← innerDef_i_smul_left] + +theorem re_innerDef_symm (x y : X) : re (innerDef x y : 𝕜) = re (innerDef y x : 𝕜) := + by + simp_rw [re_innerDef] + rw [add_comm] + congr 2 + simp only [norm_sub_rev] + +theorem im_innerDef_symm (x y : X) : im (innerDef x y : 𝕜) = -im (innerDef y x : 𝕜) := + by + simp_rw [im_innerDef_aux] + rw [re_innerDef_symm] + by_cases h : (I : 𝕜) = 0 + · simp only [re_innerDef, h, zero_smul, zero_add, add_zero, zero_sub, sub_zero, sub_self, + norm_neg, MulZeroClass.mul_zero, neg_zero] + · have := norm_I_of_ne_zero h + simp only [re_innerDef, ← neg_mul, neg_mul_comm] + congr 1 + simp only [neg_sub] + have h₁ : ∀ a : X, ‖a‖ = ‖(I : 𝕜) • a‖ := fun a => by + rw [norm_smul, norm_I_of_ne_zero h, one_mul] + rw [h₁ (y + (I : 𝕜) • x), h₁ (y - (I : 𝕜) • x)] + simp only [smul_add, smul_sub, smul_smul, I_mul_I_of_nonzero h, neg_one_smul] + simp_rw [sub_eq_add_neg, neg_neg] + +theorem innerDef_conj (x y : X) : conj (innerDef x y : 𝕜) = innerDef y x := + by + rw [← @re_add_im 𝕜 _ (innerDef x y)] + simp_rw [map_add, map_mul, conj_ofReal, conj_I] + calc + ↑(re (innerDef x y : 𝕜)) + ↑(im (innerDef x y : 𝕜)) * -(I : 𝕜) = + ↑(re (innerDef y x : 𝕜)) + ↑(-im (innerDef x y : 𝕜)) * (I : 𝕜) := + by + rw [re_innerDef_symm] + congr 1 + simp + _ = ↑(re (innerDef y x : 𝕜)) + ↑(im (innerDef y x : 𝕜)) * (I : 𝕜) := by + rw [← im_innerDef_symm] + _ = innerDef y x := re_add_im _ + +end OfNorm + +open scoped ComplexConjugate + +/-- An unbundled continuous linear map predicate. -/ +def IsContinuousLinearMap (𝕜 : Type _) [NormedField 𝕜] {E : Type _} [NormedAddCommGroup E] + [NormedSpace 𝕜 E] {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F] (f : E → F) : Prop := + IsLinearMap 𝕜 f ∧ Continuous f + +/-- Bundle an unbundled continuous linear map as a continuous linear map. -/ +def IsContinuousLinearMap.mk' {𝕜 : Type _} [NormedField 𝕜] {E : Type _} [NormedAddCommGroup E] + [NormedSpace 𝕜 E] {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F] {f : E → F} + (h : IsContinuousLinearMap 𝕜 f) : E →L[𝕜] F := + ⟨h.1.mk' f, h.2⟩ + +theorem IsContinuousLinearMap.coe_mk' {𝕜 : Type _} [NormedField 𝕜] {E : Type _} + [NormedAddCommGroup E] [NormedSpace 𝕜 E] {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F] + {f : E → F} (h : IsContinuousLinearMap 𝕜 f) : f = h.mk' := + rfl + +theorem isBoundedLinearMap_iff_isContinuousLinearMap {𝕜 E : Type _} [NontriviallyNormedField 𝕜] + [NormedAddCommGroup E] [NormedSpace 𝕜 E] {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F] + (f : E → F) : IsBoundedLinearMap 𝕜 f ↔ IsContinuousLinearMap 𝕜 f := + by + refine + ⟨fun h => ⟨IsBoundedLinearMap.toIsLinearMap h, IsBoundedLinearMap.continuous h⟩, + fun h => ?_⟩ + let f' : E →L[𝕜] F := ⟨h.1.mk' f, h.2⟩ + exact f'.isBoundedLinearMap + +private theorem linear_map.is_bounded_linear_map_iff_is_continuous {𝕜 E : Type _} + [NontriviallyNormedField 𝕜] [NormedAddCommGroup E] [NormedSpace 𝕜 E] {F : Type _} + [NormedAddCommGroup F] [NormedSpace 𝕜 F] (f : E →ₗ[𝕜] F) : + IsBoundedLinearMap 𝕜 f ↔ Continuous f := + by + rw [isBoundedLinearMap_iff_isContinuousLinearMap, IsContinuousLinearMap] + simp only [and_iff_right_iff_imp, f.isLinear, imp_true_iff] + +/-- A function has a linear norm bound. -/ +def WithBound {E : Type _} [NormedAddCommGroup E] {F : Type _} [NormedAddCommGroup F] (f : E → F) : + Prop := + ∃ M, 0 < M ∧ ∀ x : E, ‖f x‖ ≤ M * ‖x‖ + +theorem IsBoundedLinearMap.def {𝕜 E : Type _} [NontriviallyNormedField 𝕜] [NormedAddCommGroup E] + [NormedSpace 𝕜 E] {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F] {f : E → F} : + IsBoundedLinearMap 𝕜 f ↔ IsLinearMap 𝕜 f ∧ WithBound f := + ⟨fun h => ⟨h.1, h.2⟩, fun h => ⟨h.1, h.2⟩⟩ + +theorem LinearMap.withBound_iff_is_continuous {𝕜 E : Type _} [NontriviallyNormedField 𝕜] + [NormedAddCommGroup E] [NormedSpace 𝕜 E] {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F] + {f : E →ₗ[𝕜] F} : WithBound f ↔ Continuous f := + by + have := @isBoundedLinearMap_iff_isContinuousLinearMap 𝕜 _ _ _ _ _ _ _ f + simp only [IsBoundedLinearMap.def, IsContinuousLinearMap, and_congr_right_iff, f.isLinear, + true_imp_iff] at this + exact this + +theorem LinearMap.ker_coe_def {R E F : Type _} [Semiring R] [AddCommMonoid E] [AddCommMonoid F] + [Module R E] [Module R F] {f : E →ₗ[R] F} : (ker f : Set E) = {x : E | f x = 0} := + rfl + +theorem exists_dual_vector_of_ne {X : Type _} [NormedAddCommGroup X] [NormedSpace 𝕜 X] {x y : X} + (h : x ≠ y) : ∃ f : StrongDual 𝕜 X, f x ≠ f y := + by + rw [ne_eq, ← sub_eq_zero] at h + obtain ⟨f, ⟨_, hxy⟩⟩ := exists_dual_vector (𝕜 := 𝕜) (x - y) (by + rwa [norm_ne_zero_iff]) + rw [map_sub] at hxy + use f + intro H + rw [H, sub_self, eq_comm, RCLike.ofReal_eq_zero, norm_eq_zero] at hxy + contradiction + +theorem isLinearMap_zero (R : Type _) {E F : Type _} [CommSemiring R] [AddCommMonoid E] [Module R E] + [AddCommMonoid F] [Module R F] : IsLinearMap R (0 : E → F) := by + fconstructor <;> simp only [Pi.zero_apply, smul_zero, add_zero] <;> intros <;> trivial + +theorem isContinuousLinearMapZero {𝕜 E : Type _} [NormedField 𝕜] [NormedAddCommGroup E] + [NormedSpace 𝕜 E] {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F] : + IsContinuousLinearMap 𝕜 (0 : E → F) := + ⟨isLinearMap_zero 𝕜, continuous_zero⟩ + +open scoped Topology BigOperators NNReal + +theorem IsContinuousLinearMap.ofInnerSymmetricFun {X : Type _} [NormedAddCommGroup X] + [InnerProductSpace 𝕜 X] [CompleteSpace X] {f : X → X} + (h : ∀ a b : X, inner 𝕜 (f a) b = inner 𝕜 a (f b)) : IsContinuousLinearMap 𝕜 f := + by + have : IsLinearMap 𝕜 f := + { map_add := fun x y => by + apply @ext_inner_right 𝕜 + intro z + simp_rw [h, inner_add_left, h] + map_smul := fun r x => by + apply @ext_inner_right 𝕜 + intro z + simp_rw [h, inner_smul_left, h] } + let f' : X →ₗ[𝕜] X := IsLinearMap.mk' _ this + have : f = f' := rfl + simp only [this] at * + clear this + exact ⟨f'.isLinear, LinearMap.IsSymmetric.continuous h⟩ + +/-- Bilinearity for maps whose domain is a product type. -/ +structure IsBilinearMapProd (𝕜 : Type _) [NormedField 𝕜] {E : Type _} [NormedAddCommGroup E] + [NormedSpace 𝕜 E] {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F] {G : Type _} + [NormedAddCommGroup G] [NormedSpace 𝕜 G] (f : E × F → G) : Prop where + add_left : ∀ (x₁ x₂ : E) (y : F), f (x₁ + x₂, y) = f (x₁, y) + f (x₂, y) + smul_left : ∀ (c : 𝕜) (x : E) (y : F), f (c • x, y) = c • f (x, y) + add_right : ∀ (x : E) (y₁ y₂ : F), f (x, y₁ + y₂) = f (x, y₁) + f (x, y₂) + smul_right : ∀ (c : 𝕜) (x : E) (y : F), f (x, c • y) = c • f (x, y) + +/-- Linearity of a product map in its left argument. -/ +def IsLeftLinearMap (𝕜 : Type _) [NormedField 𝕜] {E : Type _} [NormedAddCommGroup E] + [NormedSpace 𝕜 E] {F : Type _} {G : Type _} [NormedAddCommGroup G] [NormedSpace 𝕜 G] + (f : E × F → G) : Prop := + ∀ b : F, IsLinearMap 𝕜 fun a => f (a, b) + +theorem isLeftLinearMap_iff {𝕜 : Type _} [NormedField 𝕜] {E : Type _} [NormedAddCommGroup E] + [NormedSpace 𝕜 E] {F : Type _} {G : Type _} [NormedAddCommGroup G] [NormedSpace 𝕜 G] + {f : E × F → G} : IsLeftLinearMap 𝕜 f ↔ ∀ b : F, IsLinearMap 𝕜 fun a => f (a, b) := + Iff.rfl + +/-- Linearity of a product map in its right argument. -/ +def IsRightLinearMap (𝕜 : Type _) [NormedField 𝕜] {E : Type _} {F : Type _} [NormedAddCommGroup F] + [NormedSpace 𝕜 F] {G : Type _} [NormedAddCommGroup G] [NormedSpace 𝕜 G] (f : E × F → G) : + Prop := + ∀ a : E, IsLinearMap 𝕜 fun b => f (a, b) + +theorem isRightLinearMap_iff {𝕜 : Type _} [NormedField 𝕜] {E : Type _} {F : Type _} + [NormedAddCommGroup F] [NormedSpace 𝕜 F] {G : Type _} [NormedAddCommGroup G] [NormedSpace 𝕜 G] + {f : E × F → G} : IsRightLinearMap 𝕜 f ↔ ∀ a : E, IsLinearMap 𝕜 fun b => f (a, b) := + Iff.rfl + +theorem isBilinearMap_iff_is_linear_map_left_right {𝕜 : Type _} [NormedField 𝕜] {E : Type _} + [NormedAddCommGroup E] [NormedSpace 𝕜 E] {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F] + {G : Type _} [NormedAddCommGroup G] [NormedSpace 𝕜 G] {f : E × F → G} : + IsBilinearMapProd 𝕜 f ↔ IsLeftLinearMap 𝕜 f ∧ IsRightLinearMap 𝕜 f := + by + constructor + · intro hf + constructor + · intro x + exact ⟨fun y z => hf.add_left y z x, fun r a => hf.smul_left r a x⟩ + · intro x + exact ⟨fun y z => hf.add_right x y z, fun r a => hf.smul_right r x a⟩ + · rintro ⟨h1, h2⟩ + fconstructor + · intro x₁ x₂ y + exact (h1 y).map_add _ _ + · intro r x y + exact (h1 y).map_smul _ _ + · intro y x₁ x₂ + exact (h2 y).map_add _ _ + · intro r x y + exact (h2 x).map_smul _ _ + +/-- Bundle a product bilinear map as a linear map into linear maps. -/ +def IsBilinearMapProd.toLmLm {𝕜 : Type _} [NormedField 𝕜] {E : Type _} [NormedAddCommGroup E] + [NormedSpace 𝕜 E] {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F] {G : Type _} + [NormedAddCommGroup G] [NormedSpace 𝕜 G] {f : E × F → G} (hf : IsBilinearMapProd 𝕜 f) : + E →ₗ[𝕜] F →ₗ[𝕜] G + where + toFun x := + { toFun := fun y => f (x, y) + map_add' := fun y z => hf.add_right x _ _ + map_smul' := fun r y => hf.smul_right r x y } + map_add' y z := by + ext x + simp only [LinearMap.add_apply] + exact hf.add_left y z x + map_smul' r z := by + ext x + simp only [LinearMap.smul_apply] + exact hf.smul_left r z x + +/-- Bundle a product map that is left-linear and right-continuous-linear. -/ +def IsLmLeftIsClmRight.toLmClm {𝕜 : Type _} [NormedField 𝕜] {E : Type _} [NormedAddCommGroup E] + [NormedSpace 𝕜 E] {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F] {G : Type _} + [NormedAddCommGroup G] [NormedSpace 𝕜 G] {f : E × F → G} + (hf₁ : ∀ y, IsLinearMap 𝕜 fun a => f (a, y)) + (hf₂ : ∀ x, IsContinuousLinearMap 𝕜 fun a => f (x, a)) : E →ₗ[𝕜] F →L[𝕜] G + where + toFun x := (hf₂ x).mk' + map_add' y z := by + ext x + simp only [ContinuousLinearMap.add_apply] + exact (hf₁ x).map_add _ _ + map_smul' r z := by + ext x + exact (hf₁ x).map_smul _ _ + +theorem IsBilinearMapProd.zero_left {𝕜 : Type _} [NormedField 𝕜] {E : Type _} [NormedAddCommGroup E] + [NormedSpace 𝕜 E] {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F] {G : Type _} + [NormedAddCommGroup G] [NormedSpace 𝕜 G] {f : E × F → G} (h : IsBilinearMapProd 𝕜 f) (y : F) : + f (0, y) = 0 := by + simp only [isBilinearMap_iff_is_linear_map_left_right] at h + exact (h.1 y).map_zero + +theorem IsBilinearMapProd.zero_right {𝕜 : Type _} [NormedField 𝕜] {E : Type _} + [NormedAddCommGroup E] + [NormedSpace 𝕜 E] {F : Type _} [NormedAddCommGroup F] [NormedSpace 𝕜 F] {G : Type _} + [NormedAddCommGroup G] [NormedSpace 𝕜 G] {f : E × F → G} (h : IsBilinearMapProd 𝕜 f) (x : E) : + f (x, 0) = 0 := by + simp only [isBilinearMap_iff_is_linear_map_left_right] at h + exact (h.2 x).map_zero + +theorem IsBilinearMapProd.eq_zero_add_self {𝕜 : Type _} [NormedField 𝕜] {E : Type _} + [NormedAddCommGroup E] [NormedSpace 𝕜 E] {F : Type _} [NormedAddCommGroup F] + [NormedSpace 𝕜 F] {G : Type _} [NormedAddCommGroup G] [NormedSpace 𝕜 G] + {f : E × F → G} (h : IsBilinearMapProd 𝕜 f) + (xy : E × F) : f xy = f (xy.1, 0) + f xy := by simp_rw [h.zero_right, zero_add] + +/-- Compatibility alias for the curried linear map associated to a bilinear map. -/ +def IsBilinearMap.toLmLm {𝕜 : Type _} [CommSemiring 𝕜] {E : Type _} + [AddCommMonoid E] [Module 𝕜 E] {F : Type _} [AddCommMonoid F] + [Module 𝕜 F] {G : Type _} [AddCommMonoid G] [Module 𝕜 G] + {f : E → F → G} (hf : IsBilinearMap 𝕜 f) : + E →ₗ[𝕜] F →ₗ[𝕜] G := + hf.toLinearMap + +theorem IsBilinearMap.zero_left {𝕜 : Type _} [CommSemiring 𝕜] {E : Type _} + [AddCommMonoid E] [Module 𝕜 E] {F : Type _} [AddCommMonoid F] + [Module 𝕜 F] {G : Type _} [AddCommMonoid G] [Module 𝕜 G] + {f : E → F → G} (h : IsBilinearMap 𝕜 f) (y : F) : + f 0 y = 0 := by + have hzero : h.toLinearMap 0 = 0 := h.toLinearMap.map_zero + exact congrFun (congrArg DFunLike.coe hzero) y + +theorem IsBilinearMap.zero_right {𝕜 : Type _} [CommSemiring 𝕜] {E : Type _} + [AddCommMonoid E] [Module 𝕜 E] {F : Type _} [AddCommMonoid F] + [Module 𝕜 F] {G : Type _} [AddCommMonoid G] [Module 𝕜 G] + {f : E → F → G} (h : IsBilinearMap 𝕜 f) (x : E) : + f x 0 = 0 := + (h.toLinearMap x).map_zero + +theorem IsBilinearMap.eq_zero_add_self {𝕜 : Type _} [CommSemiring 𝕜] + {E : Type _} [AddCommMonoid E] [Module 𝕜 E] {F : Type _} + [AddCommMonoid F] [Module 𝕜 F] {G : Type _} [AddCommMonoid G] + [Module 𝕜 G] {f : E → F → G} (h : IsBilinearMap 𝕜 f) + (x : E) (y : F) : + f x y = f x 0 + f x y := by + rw [h.zero_right, zero_add] + +open scoped ComplexOrder + +theorem IsContinuousLinearMap.to_is_lm {𝕜 X Y : Type _} [NormedField 𝕜] [NormedAddCommGroup X] + [NormedAddCommGroup Y] [NormedSpace 𝕜 X] [NormedSpace 𝕜 Y] {β : X → Y} + (hf : IsContinuousLinearMap 𝕜 β) : IsLinearMap 𝕜 β := + hf.1 + +example + --is_continuous_bilinear_map_norm_of_clm + {𝕜 X Y Z : Type _} + [RCLike 𝕜] [NormedAddCommGroup X] [NormedAddCommGroup Y] [NormedAddCommGroup Z] + [NormedSpace 𝕜 X] [NormedSpace 𝕜 Y] [NormedSpace 𝕜 Z] [CompleteSpace X] [CompleteSpace Y] + [CompleteSpace Z] (β : X →L[𝕜] Y →L[𝕜] Z) : ∃ M : ℝ, ∀ x y, ‖β x y‖ ≤ M * ‖x‖ * ‖y‖ := + by + use ‖β‖ + intro x y + apply ContinuousLinearMap.le_of_opNorm_le + exact ContinuousLinearMap.le_opNorm _ _ + +lemma Set.mem_extremePoints_iff' + {H : Type _} [AddCommMonoid H] [SMul 𝕜 H] (x : H) (y : Set H) : + x ∈ Set.extremePoints 𝕜 y ↔ + (x ∈ y ∧ + ∀ (x₁ : H), x₁ ∈ y → ∀ (x₂ : H), x₂ ∈ y → + (∃ a : 𝕜, 0 < a ∧ a < 1 ∧ a • x₁ + (1 - a) • x₂ = x) → x₁ = x ∧ x₂ = x) := by + simp only [mem_extremePoints, openSegment, Set.mem_setOf] + simp only [exists_and_left, forall_exists_index, and_imp, and_congr_right_iff] + intro h + constructor + { rintro h2 y hy z hz r hr hrr rfl + exact h2 y hy z hz r hr (1 - r) (sub_pos.mpr hrr) (add_sub_cancel _ _) rfl } + { rintro h2 y hy z hz r hr s hs hrs rfl + have hs' := calc 0 < s ↔ 0 < 1 - r := by rw [← hrs, add_sub_cancel_left] + _ ↔ r < 1 := by rw [sub_pos] + apply h2 y hy z hz r hr (hs'.mp hs) + simp only [← hrs, add_sub_cancel_left] } + +open scoped ComplexOrder +open RCLike +lemma Metric.mem_extremePoints_of_closed_unitBall_iff + {𝕜 H : Type _} [RCLike 𝕜] [NormedAddCommGroup H] [NormedSpace 𝕜 H] (x : H) : + x ∈ Set.extremePoints 𝕜 (closedBall 0 1) ↔ + (‖x‖ ≤ 1 ∧ + ∀ (x₁ : H), ‖x₁‖ ≤ 1 → ∀ (x₂ : H), ‖x₂‖ ≤ 1 → + (∃ a : 𝕜, 0 < a ∧ a < 1 ∧ a • x₁ + (1 - a) • x₂ = x) → x₁ = x ∧ x₂ = x) := +by simp_rw [Set.mem_extremePoints_iff', mem_closedBall, dist_zero_right] + +lemma Metric.mem_extremePoints_of_unitBall_iff + {𝕜 H : Type _} [RCLike 𝕜] [NormedAddCommGroup H] [NormedSpace 𝕜 H] (x : H) : + x ∈ Set.extremePoints 𝕜 (ball 0 1) ↔ + (‖x‖ < 1 ∧ + ∀ (x₁ : H), ‖x₁‖ < 1 → ∀ (x₂ : H), ‖x₂‖ < 1 → + (∃ a : 𝕜, 0 < a ∧ a < 1 ∧ a • x₁ + (1 - a) • x₂ = x) → x₁ = x ∧ x₂ = x) := +by simp_rw [Set.mem_extremePoints_iff', mem_ball, dist_zero_right] + +lemma Metric.exists_mem_closed_unitBall_of_norm_one (𝕜 H : Type _) [RCLike 𝕜] + [NormedAddCommGroup H] [NormedSpace 𝕜 H] [Nontrivial H] : + ∃ x : H, ‖x‖ = 1 ∧ x ∈ closedBall (0 : H) 1 := by +obtain ⟨x, hx⟩ : ∃ x : H, x ≠ 0 := exists_ne 0 +use (1 / ‖x‖ : 𝕜) • x +simp only [one_div, mem_closedBall, dist_zero_right, norm_smul, norm_inv] +simp only [norm_ofReal, abs_norm] +rw [inv_mul_cancel₀ (norm_ne_zero_iff.mpr hx)] +exact ⟨rfl, le_rfl⟩ + +lemma Metric.exists_mem_unitBall_of_norm_one (𝕜 H : Type _) [RCLike 𝕜] + [NormedAddCommGroup H] [NormedSpace 𝕜 H] [Nontrivial H] : + ∃ (x : H) (ε : ℝ), ‖x‖ = ε ∧ 0 < ε ∧ ε < 1 ∧ x ∈ ball (0 : H) 1 := +by + obtain ⟨x, hx⟩ : ∃ x : H, x ≠ 0 := exists_ne 0 + obtain ⟨ε, hε⟩ : ∃ r : ℝ, 0 < r ∧ r < 1 := ⟨1 / 2, by norm_num⟩ + use ((ε / ‖x‖ : ℝ) : 𝕜) • x, ε + simp only [div_eq_inv_mul, mem_ball, dist_zero_right, norm_smul] + simp only [norm_ofReal, abs_norm, abs_mul, abs_inv, abs_of_pos hε.1] + rw [mul_comm, ← mul_assoc, mul_inv_cancel₀ (norm_ne_zero_iff.mpr hx), one_mul] + exact ⟨rfl, hε.1, hε.2, hε.2⟩ + +open scoped InnerProductSpace + +theorem inner_lt_one_iff_of_norm_one {𝕜 H : Type _} [RCLike 𝕜] [NormedAddCommGroup H] + [InnerProductSpace 𝕜 H] + {x y : H} (hx : ‖x‖ = 1) (hy : ‖y‖ = 1) : + ⟪x, y⟫_𝕜 < 1 ↔ x ≠ y ∧ (re ⟪x, y⟫_𝕜 : 𝕜) = ⟪x, y⟫_𝕜 := +by + simp_rw [lt_iff_le_and_ne, ne_eq, inner_eq_one_iff_of_norm_eq_one hx hy] + -- rw [← @inner_eq_one_iff_of_norm_eq_one 𝕜 _ _ _ _ _ _ hx hy] + refine ⟨fun ⟨h1, h2⟩ => ⟨h2, ?_⟩, fun h => ⟨?_, h.1⟩⟩ + · rw [@le_def 𝕜, one_re, one_im, ← conj_eq_iff_im, conj_eq_iff_re] at h1 + exact h1.2 + · rw [← h.2, ← @RCLike.ofReal_one 𝕜, real_le_real] + calc re ⟪x, y⟫_𝕜 ≤ ‖x‖ * ‖y‖ := re_inner_le_norm _ _ + _ = 1 := by rw [hx, hy, mul_one] + +theorem re_inner_lt_one_iff_of_norm_one {𝕜 H : Type _} [RCLike 𝕜] [NormedAddCommGroup H] + [InnerProductSpace 𝕜 H] + {x y : H} (hx : ‖x‖ = 1) (hy : ‖y‖ = 1) : + re ⟪x, y⟫_𝕜 < 1 ↔ x ≠ y := +by + rw [← real_inner_eq_re_inner] + exact @inner_lt_one_iff_real_of_norm_eq_one H _ (InnerProductSpace.rclikeToReal 𝕜 H) _ _ hx hy + +theorem ne_zero_iff_nontrivial_of_mem_extremePoints_closed_unitBall + {𝕜 H : Type _} [RCLike 𝕜] [NormedAddCommGroup H] + [NormedSpace 𝕜 H] {x : H} + (hx : x ∈ Set.extremePoints 𝕜 (Metric.closedBall (0 : H) 1)) : + x ≠ 0 ↔ Nontrivial H := +by + refine ⟨fun h => ⟨⟨x, 0, h⟩⟩, fun h => ?_⟩ + simp only [Metric.mem_extremePoints_of_closed_unitBall_iff] at hx + rintro rfl + simp only [norm_zero, zero_le_one, true_and] at hx + obtain ⟨y, hy⟩ := Metric.exists_mem_closed_unitBall_of_norm_one 𝕜 H + specialize hx y hy.1.le (-y) (by rw [norm_neg]; exact hy.1.le) + ⟨(1/2 : ℝ), by simp_rw [RCLike.zero_lt_real, one_half_pos], + by simp_rw [← @RCLike.ofReal_one 𝕜, RCLike.real_lt_real]; norm_num, + by simp only [one_div, ofReal_inv, ofReal_ofNat, smul_neg, sub_smul, neg_sub, + ← add_sub_assoc, ← add_smul]; norm_num⟩ + rw [hx.1, norm_zero] at hy + exact zero_ne_one hy.1 + +theorem norm_one_of_mem_extremePoints_of_closed_unitBall {𝕜 H : Type _} [RCLike 𝕜] + [NormedAddCommGroup H] + [NormedSpace 𝕜 H] [Nontrivial H] {x : H} + (hx : x ∈ Set.extremePoints 𝕜 (Metric.closedBall (0 : H) 1)) : + ‖x‖ = 1 := by + have := (ne_zero_iff_nontrivial_of_mem_extremePoints_closed_unitBall hx).mpr (by infer_instance) + simp_rw [Metric.mem_extremePoints_of_closed_unitBall_iff] at hx + rcases hx with ⟨h1, h⟩ + by_cases hx' : ‖x‖ ≠ 1 + · specialize h ((1 / ‖x‖ : 𝕜) • x) + (by + simp_rw [norm_smul, one_div, norm_inv, norm_ofReal, abs_norm, + inv_mul_cancel₀ (norm_ne_zero_iff.mpr this), le_rfl]) + 0 (by simp_rw [norm_zero, zero_le_one]) + (⟨‖x‖, by simp_rw [RCLike.zero_lt_real]; exact norm_pos_iff.mpr this, + by simp_rw [← @RCLike.ofReal_one 𝕜, real_lt_real, lt_iff_le_and_ne]; exact ⟨h1, hx'⟩, + by simp only [one_div, smul_zero, add_zero, smul_smul, ← ofReal_inv, ← ofReal_mul, + mul_inv_cancel₀ (norm_ne_zero_iff.mpr this), ofReal_one, one_smul]⟩) + exfalso + exact this h.2.symm + rw [not_ne_iff] at hx' + exact hx' + +theorem mem_extremePoints_of_closedBall_iff_norm_eq_one + {𝕜 H : Type _} [RCLike 𝕜] [NormedAddCommGroup H] [InnerProductSpace 𝕜 H] [Nontrivial H] (x : H) : + x ∈ Set.extremePoints 𝕜 (Metric.closedBall (0 : H) 1) ↔ ‖x‖ = 1 := by + refine ⟨fun hx => norm_one_of_mem_extremePoints_of_closed_unitBall hx, fun hx => ?_⟩ + simp_rw [Metric.mem_extremePoints_of_closed_unitBall_iff] + refine ⟨by simp_rw [hx, le_rfl], fun y hy z hz ⟨α, hα₁, hα₂, hαx⟩ => ?_⟩ + let β : ℝ := re α + have : (β : 𝕜) = α := + by + simp_rw [@lt_def 𝕜, map_zero] at hα₁ + rw [← re_add_im α, ← hα₁.2, ofReal_zero, zero_mul, add_zero] + simp_rw [← this, ← @ofReal_zero 𝕜, ← @ofReal_one 𝕜, real_lt_real, ← ofReal_sub] at hα₁ hα₂ hαx + have := + calc 1 = ‖x‖ ^ 2 := by rw [hx, one_pow] + _ = ‖(β : 𝕜) • y + ((1 - β : ℝ) : 𝕜) • z‖ ^ 2 := by rw [hαx] + _ = (‖(β : 𝕜) • y‖ ^ 2 + 2 * re (⟪(β : 𝕜) • y, ((1 - β : ℝ) : 𝕜) • z⟫_𝕜) + + ‖((1 - β : ℝ) : 𝕜) • z‖ ^ 2 : ℝ) := by rw [← norm_add_pow_two] + _ = β ^ 2 * ‖y‖ ^ 2 + (2 * β * (1 - β)) * re (⟪y, z⟫_𝕜) + (1 - β) ^ 2 * ‖z‖ ^ 2 := + by + simp_rw [norm_smul, inner_smul_left, inner_smul_right, conj_ofReal, + ← mul_assoc, ← ofReal_mul, re_ofReal_mul, mul_pow, ← norm_pow, ← ofReal_pow] + simp only [norm_ofReal, abs_sq] + simp only [mul_assoc] + by_cases hyz : y = z + · rw [hyz, ← add_smul, ← ofReal_add, add_sub_cancel, ofReal_one, one_smul] at hαx + rw [hyz, and_self, hαx] + · by_cases hyzyz : ‖y‖ = 1 ∧ ‖z‖ = 1 + · simp_rw [hyzyz, one_pow, mul_one] at this + have this' : re ⟪y, z⟫_𝕜 < 1 := (re_inner_lt_one_iff_of_norm_one hyzyz.1 hyzyz.2).mpr hyz + have := calc 1 = β ^ 2 + 2 * β * (1 - β) * re ⟪y, z⟫_𝕜 + (1 - β) ^ 2 := this + _ < β ^ 2 + 2 * β * (1 - β) * 1 + (1 - β) ^ 2 := by + simp only [add_lt_add_iff_right, add_lt_add_iff_left] + apply mul_lt_mul_of_pos_left this' + apply mul_pos (mul_pos two_pos hα₁) + simp only [sub_pos, hα₂] + _ = 1 := by ring_nf + simp only [lt_irrefl] at this + · rw [not_and_or] at hyzyz + rcases hyzyz with (Hy | Hy) + on_goal 1 => have Hyy : ‖y‖ < 1 := lt_of_le_of_ne hy Hy + on_goal 2 => have Hyy : ‖z‖ < 1 := lt_of_le_of_ne hz Hy + all_goals + have := + calc 1 = ‖x‖ := hx.symm + _ = ‖(β : 𝕜) • y + ((1 - β : ℝ) : 𝕜) • z‖ := by rw [hαx] + _ ≤ ‖(β : 𝕜) • y‖ + ‖((1 - β : ℝ) : 𝕜) • z‖ := norm_add_le _ _ + _ ≤ β * ‖y‖ + (1 - β) * ‖z‖ := + by + simp_rw [norm_smul, norm_ofReal, abs_of_pos hα₁] + rw [abs_of_pos]; simp_rw [sub_pos, hα₂] + _ < β * 1 + (1 - β) * 1 := + by + try + { apply add_lt_add_of_lt_of_le + apply mul_lt_mul' le_rfl Hyy (norm_nonneg _) hα₁ + apply mul_le_mul_of_nonneg_left hz + simp_rw [sub_nonneg, le_of_lt hα₂] } + try + { apply add_lt_add_of_le_of_lt + exact mul_le_mul le_rfl hy (norm_nonneg y) (le_of_lt hα₁) + apply mul_lt_mul' le_rfl Hyy (norm_nonneg _) + simp only [sub_pos, hα₂] } + _ = 1 := by ring_nf + simp only [lt_irrefl] at this + +theorem LinearIsometry.norm_comp_toContinuousLinearMap_le + {𝕜 X Y Z : Type _} [RCLike 𝕜] [NormedAddCommGroup X] + [NormedAddCommGroup Y] [NormedAddCommGroup Z] [NormedSpace 𝕜 X] [NormedSpace 𝕜 Y] + [NormedSpace 𝕜 Z] + (f : X →ₗᵢ[𝕜] Y) (h : Y →L[𝕜] Z) : + ‖h ∘L f.toContinuousLinearMap‖ ≤ ‖h‖ := +by + apply ContinuousLinearMap.opNorm_le_bound _ (norm_nonneg _) (fun x => _) + intro x + rw [ContinuousLinearMap.comp_apply, LinearIsometry.coe_toContinuousLinearMap, ← f.norm_map x] + exact h.le_opNorm _ + +example {𝕜 X Y Z : Type _} [RCLike 𝕜] [NormedAddCommGroup X] + [NormedAddCommGroup Y] [NormedAddCommGroup Z] [NormedSpace 𝕜 X] [NormedSpace 𝕜 Y] + [NormedSpace 𝕜 Z] + (f : X ≃ₗᵢ[𝕜] Y) (h : Y →L[𝕜] Z) : + ‖h ∘L f.toLinearIsometry.toContinuousLinearMap‖ = ‖h‖ := +by + apply le_antisymm (f.toLinearIsometry.norm_comp_toContinuousLinearMap_le _) + calc + ‖h‖ = + ‖(h ∘L f.toLinearIsometry.toContinuousLinearMap) ∘L + f.symm.toLinearIsometry.toContinuousLinearMap‖ := ?_ + _ ≤ _ := f.symm.toLinearIsometry.norm_comp_toContinuousLinearMap_le _ + apply ContinuousLinearMap.opNorm_ext + intro y + simp only [ContinuousLinearMap.coe_comp', LinearIsometry.coe_toContinuousLinearMap, + LinearIsometryEquiv.coe_toLinearIsometry, Function.comp_apply, + LinearIsometryEquiv.apply_symm_apply] + +/-- Pull back continuous linear functionals along a continuous linear map. -/ +@[simps] def NormedSpace.Dual.transpose {E F : Type*} (𝕜 : Type*) [RCLike 𝕜] + [NormedAddCommGroup E] [NormedSpace 𝕜 E] + [NormedAddCommGroup F] [NormedSpace 𝕜 F] (f : E →L[𝕜] F) : + StrongDual 𝕜 F →ₗ[𝕜] StrongDual 𝕜 E := +{ toFun := fun x => x ∘L f + map_add' := fun x y => by + simp only [ContinuousLinearMap.add_comp] + map_smul' := fun c x => by + simp only [ContinuousLinearMap.smul_comp, RingHom.id_apply] } + +lemma NormedSpace.Dual.transpose_isometry + {𝕜 X Y : Type*} [RCLike 𝕜] [NormedAddCommGroup X] [NormedAddCommGroup Y] + [NormedSpace 𝕜 X] [NormedSpace 𝕜 Y] + {f : X ≃ₗᵢ[𝕜] Y} : + _root_.Isometry (NormedSpace.Dual.transpose 𝕜 f.toLinearIsometry.toContinuousLinearMap) := +by +{ + rw [AddMonoidHomClass.isometry_iff_norm] + intro x + simp_rw [NormedSpace.Dual.transpose_apply] + exact ContinuousLinearMap.opNorm_comp_linearIsometryEquiv _ _ +} + +open NormedSpace in +/-- Pull back continuous linear functionals along a linear isometry equivalence. -/ +@[simps] noncomputable def LinearEquiv.transpose {E F : Type*} (𝕜 : Type*) [RCLike 𝕜] + [NormedAddCommGroup E] [NormedSpace 𝕜 E] + [NormedAddCommGroup F] [NormedSpace 𝕜 F] + (f : E ≃ₗᵢ[𝕜] F) : + StrongDual 𝕜 F ≃ₗᵢ[𝕜] StrongDual 𝕜 E := +{ toFun := NormedSpace.Dual.transpose 𝕜 (f.toLinearIsometry).toContinuousLinearMap + invFun := NormedSpace.Dual.transpose 𝕜 (f.symm.toLinearIsometry).toContinuousLinearMap + left_inv := fun x => by + ext + simp only [Dual.transpose_apply, ContinuousLinearMap.coe_comp', + LinearIsometry.coe_toContinuousLinearMap, LinearIsometryEquiv.coe_toLinearIsometry, + Function.comp_apply, LinearIsometryEquiv.apply_symm_apply] + right_inv := fun x => by + ext + simp only [Dual.transpose_apply, ContinuousLinearMap.coe_comp', + LinearIsometry.coe_toContinuousLinearMap, LinearIsometryEquiv.coe_toLinearIsometry, + Function.comp_apply, LinearIsometryEquiv.symm_apply_apply] + map_add' := fun x y => by + simp only [map_add, Dual.transpose_apply] + map_smul' := fun c x => by + simp only [_root_.map_smul, Dual.transpose_apply, RingHom.id_apply] + norm_map' := fun x => by + simp only [coe_mk] + exact (AddMonoidHomClass.isometry_iff_norm _).mp Dual.transpose_isometry _ } + +theorem Set.subset_diff_inj {α : Type _} (s : Set α) {t u : Set α} + (h : u ⊆ t) : + s ⊆ t ↔ s \ u ⊆ t \ u := +by + simp only [Set.diff_subset_iff, union_diff_self] + rw [union_eq_self_of_subset_left h] + +lemma example_pos_commute_iff_pos_mul_of {𝕜 R : Type _} [RCLike 𝕜] [Ring R] + [PartialOrder R] [StarRing R] [StarOrderedRing R] [Algebra 𝕜 R] + (h₁ : ∀ x : R, 0 ≤ x ↔ ∃ r : R, x = star r * r) + (h₂ : ∀ x : R, 0 ≤ x ↔ IsSelfAdjoint x ∧ spectrum 𝕜 x ⊆ { a : 𝕜 | 0 ≤ a }) + {x y : R} (hx : 0 ≤ x) (hy : 0 ≤ y) : + Commute x y ↔ 0 ≤ x * y := +by + have : {(0 : 𝕜)} ⊆ {a : 𝕜 | 0 ≤ a} := + by simp only [Set.singleton_subset_iff, Set.mem_setOf_eq, le_refl] + have := fun s => Set.subset_diff_inj s this + rw [h₂, IsSelfAdjoint, star_mul, ((h₂ _).mp hx).1, ((h₂ _).mp hy).1] + constructor + · intro h + refine ⟨by rw [h], ?_⟩ + obtain ⟨a, rfl⟩ := (h₁ x).mp hx + obtain ⟨b, rfl⟩ := (h₁ y).mp hy + rw [this] + calc spectrum 𝕜 (star a * a * (star b * b)) \ {0} + = spectrum 𝕜 (a * (star b * b) * star a) \ {0} := + by nth_rw 2 [spectrum.nonzero_mul_comm]; simp_rw [mul_assoc] + _ = spectrum 𝕜 (star (b * star a) * (b * star a)) \ {0} := by + simp only [star_mul, star_star, mul_assoc] + _ ⊆ {c : 𝕜 | 0 ≤ c} \ {0} := ?_ + rw [← this] + have this : ∀ x : R, 0 ≤ star x * x := fun x => (h₁ _).mpr ⟨x, rfl⟩ + have := fun x => ((h₂ _).mp (this x)).2 + exact this _ + · intro h + exact h.1.symm diff --git a/LeanPool/Monlib4/LinearAlgebra/PiDirectSum.lean b/LeanPool/Monlib4/LinearAlgebra/PiDirectSum.lean new file mode 100644 index 0000000000..86411d5b19 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/PiDirectSum.lean @@ -0,0 +1,338 @@ +/- +Copyright (c) 2024 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Algebra.DirectSum.Module +import Mathlib.Data.Fintype.BigOperators +import Mathlib.Data.Fintype.Prod +import Mathlib.RingTheory.TensorProduct.Basic +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.BasicLemmas +import LeanPool.Monlib4.LinearAlgebra.DirectSumFromTo + +open scoped TensorProduct + +local notation x " ⊗ₘ " y => TensorProduct.map x y + +theorem DirectSum.tensor_coe_zero {R : Type _} [CommRing R] {ι₁ : Type _} {ι₂ : Type _} + {M₁ : ι₁ → Type _} {M₂ : ι₂ → Type _} [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] + [∀ i₂ : ι₂, AddCommGroup (M₂ i₂)] [∀ i₁ : ι₁, Module R (M₁ i₁)] + [∀ i₂ : ι₂, Module R (M₂ i₂)] : + ⇑(0 : DirectSum (ι₁ × ι₂) fun i : ι₁ × ι₂ => M₁ i.fst ⊗[R] M₂ i.snd) = 0 := + rfl + +theorem DirectSum.tensor_coe_add {R : Type _} [CommRing R] {ι₁ : Type _} {ι₂ : Type _} + {M₁ : ι₁ → Type _} {M₂ : ι₂ → Type _} [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] + [∀ i₂ : ι₂, AddCommGroup (M₂ i₂)] [∀ i₁ : ι₁, Module R (M₁ i₁)] + [∀ i₂ : ι₂, Module R (M₂ i₂)] + (x y : DirectSum (ι₁ × ι₂) fun i : ι₁ × ι₂ => M₁ i.fst ⊗[R] M₂ i.snd) : + ⇑(x + y : DirectSum (ι₁ × ι₂) fun i : ι₁ × ι₂ => M₁ i.fst ⊗[R] M₂ i.snd) = x + y := + rfl + +theorem DirectSum.tensor_coe_smul {R : Type _} [CommRing R] {ι₁ : Type _} {ι₂ : Type _} + {M₁ : ι₁ → Type _} {M₂ : ι₂ → Type _} [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] + [∀ i₂ : ι₂, AddCommGroup (M₂ i₂)] [∀ i₁ : ι₁, Module R (M₁ i₁)] + [∀ i₂ : ι₂, Module R (M₂ i₂)] + (x : DirectSum (ι₁ × ι₂) fun i : ι₁ × ι₂ => M₁ i.fst ⊗[R] M₂ i.snd) (r : R) : + ⇑(r • x : DirectSum (ι₁ × ι₂) fun i : ι₁ × ι₂ => M₁ i.fst ⊗[R] M₂ i.snd) = r • x := + rfl + +/-- Include one coordinate tensor factor into the tensor product of dependent function spaces. -/ +noncomputable def Pi.tensorOf {R : Type _} [CommSemiring R] {ι₁ ι₂ : Type _} + [DecidableEq ι₁] [DecidableEq ι₂] {M₁ : ι₁ → Type _} {M₂ : ι₂ → Type _} + [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] [∀ i₂ : ι₂, AddCommGroup (M₂ i₂)] + [∀ i₁ : ι₁, Module R (M₁ i₁)] [∀ i₂ : ι₂, Module R (M₂ i₂)] + (i : ι₁ × ι₂) : M₁ i.fst ⊗[R] M₂ i.snd →ₗ[R] (∀ j, M₁ j) ⊗[R] ∀ j, M₂ j := + @LinearMap.single R ι₁ _ M₁ _ _ _ i.fst ⊗ₘ @LinearMap.single R ι₂ _ M₂ _ _ _ i.snd + +/-- Project the tensor product of dependent function spaces onto one coordinate tensor factor. -/ +noncomputable def Pi.tensorProj {R : Type _} [CommSemiring R] {ι₁ ι₂ : Type _} {M₁ : ι₁ → Type _} + {M₂ : ι₂ → Type _} [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] [∀ i₂ : ι₂, AddCommGroup (M₂ i₂)] + [∀ i₁ : ι₁, Module R (M₁ i₁)] [∀ i₂ : ι₂, Module R (M₂ i₂)] (i : ι₁ × ι₂) : + ((∀ j, M₁ j) ⊗[R] ∀ j, M₂ j) →ₗ[R] M₁ i.fst ⊗[R] M₂ i.snd := + @LinearMap.proj R ι₁ _ M₁ _ _ i.fst ⊗ₘ @LinearMap.proj R ι₂ _ M₂ _ _ i.snd + +/-- The coordinatewise map from a tensor product of dependent functions to tensor factors. -/ +noncomputable def directSumTensorToFun {R : Type _} [CommSemiring R] {ι₁ : Type _} {ι₂ : Type _} + {M₁ : ι₁ → Type _} {M₂ : ι₂ → Type _} [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] + [∀ i₂ : ι₂, AddCommGroup (M₂ i₂)] [∀ i₁ : ι₁, Module R (M₁ i₁)] [∀ i₂ : ι₂, Module R (M₂ i₂)] : + ((∀ i, M₁ i) ⊗[R] ∀ i, M₂ i) →ₗ[R] ∀ i : ι₁ × ι₂, M₁ i.fst ⊗[R] M₂ i.snd + where + toFun x i := Pi.tensorProj i x + map_add' x y := by + simp only [map_add] + rfl + map_smul' r x := + by + simp only [_root_.map_smul, RingHom.id_apply] + rfl + +theorem directSumTensorToFun_apply {R : Type _} [CommSemiring R] {ι₁ : Type _} {ι₂ : Type _} + {M₁ : ι₁ → Type _} {M₂ : ι₂ → Type _} [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] + [∀ i₂ : ι₂, AddCommGroup (M₂ i₂)] [∀ i₁ : ι₁, Module R (M₁ i₁)] [∀ i₂ : ι₂, Module R (M₂ i₂)] + (x : ∀ i, M₁ i) (y : ∀ i, M₂ i) (i : ι₁ × ι₂) : + directSumTensorToFun (x ⊗ₜ[R] y) i = x i.1 ⊗ₜ[R] y i.2 := + rfl + +open scoped BigOperators + +/-- The finite-sum inverse to `directSumTensorToFun`. -/ +noncomputable def directSumTensorInvFun {R : Type _} [CommRing R] {ι₁ : Type _} {ι₂ : Type _} + [DecidableEq ι₁] [DecidableEq ι₂] [Fintype ι₁] [Fintype ι₂] + {M₁ : ι₁ → Type _} {M₂ : ι₂ → Type _} + [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] [∀ i₂ : ι₂, AddCommGroup (M₂ i₂)] + [∀ i₁ : ι₁, Module R (M₁ i₁)] [∀ i₂ : ι₂, Module R (M₂ i₂)] : + (∀ i : ι₁ × ι₂, M₁ i.fst ⊗[R] M₂ i.snd) →ₗ[R] (∀ i, M₁ i) ⊗[R] ∀ i, M₂ i + where + toFun x := ∑ i : ι₁ × ι₂, Pi.tensorOf i (x i) + map_add' x y := by simp only [map_add, Pi.add_apply, Finset.sum_add_distrib] + map_smul' r x := + by + simp only [_root_.map_smul, Pi.smul_apply, RingHom.id_apply] + rw [← Finset.smul_sum] + +theorem Function.sum_update_eq_self {ι₁ : Type _} [DecidableEq ι₁] [Fintype ι₁] {M₁ : ι₁ → Type _} + [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] (x : ∀ i, M₁ i) : + ∑ x_1 : ι₁, Function.update (0 : Π (j : ι₁), M₁ j) x_1 (x x_1) = x := + by + ext + simp only [Finset.sum_apply, Function.update, Finset.sum_dite_eq, Finset.mem_univ, if_true, + Pi.zero_apply] + +theorem directSumTensorInvFun_apply_to_fun {R : Type _} [CommRing R] {ι₁ : Type _} {ι₂ : Type _} + [DecidableEq ι₁] [DecidableEq ι₂] [Fintype ι₁] [Fintype ι₂] {M₁ : ι₁ → Type _} + {M₂ : ι₂ → Type _} [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] [∀ i₂ : ι₂, AddCommGroup (M₂ i₂)] + [∀ i₁ : ι₁, Module R (M₁ i₁)] [∀ i₂ : ι₂, Module R (M₂ i₂)] (x : (∀ i, M₁ i) ⊗[R] ∀ i, M₂ i) : + directSumTensorInvFun (directSumTensorToFun x) = x := + x.induction_on (by simp only [map_zero]) + (fun x y => by + simp only [directSumTensorInvFun, LinearMap.coe_mk] + calc + ∑ i : ι₁ × ι₂, (Pi.tensorOf i) (x i.fst ⊗ₜ[R] y i.snd) = + ∑ i : ι₁, ∑ j : ι₂, (Pi.tensorOf (i, j)) (x i ⊗ₜ[R] y j) := + by simp only [← Finset.sum_product', Finset.univ_product_univ] + _ = + ∑ x_1 : ι₁, ∑ x_2 : ι₂, + Function.update (0 : _) (x_1, x_2).fst (x x_1) ⊗ₜ[R] + Function.update (0 : _) (x_1, x_2).snd (y x_2) := + by simp only [Pi.tensorOf, TensorProduct.map_tmul]; rfl + _ = + ∑ x_1 : ι₁, ∑ x_2 : ι₂, + Function.update (0 : _) x_1 (x x_1) ⊗ₜ[R] + Function.update (0 : _) x_2 (y x_2) := rfl + _ = + (∑ x_1 : ι₁, Function.update (0 : _) x_1 (x x_1)) ⊗ₜ[R] + ∑ x_2 : ι₂, Function.update (0 : _) x_2 (y x_2) := + by simp_rw [TensorProduct.sum_tmul, TensorProduct.tmul_sum] + _ = x ⊗ₜ[R] y := by congr <;> exact @Function.sum_update_eq_self _ _ _ _ _ _) + (fun x y hx hy => by simp only [map_add, hx, hy]) + +theorem Pi.tensorProj_apply_pi_tensorOf {R : Type _} [CommRing R] {ι₁ : Type _} {ι₂ : Type _} + [DecidableEq ι₁] [DecidableEq ι₂] {M₁ : ι₁ → Type _} {M₂ : ι₂ → Type _} + [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] [∀ i₂ : ι₂, AddCommGroup (M₂ i₂)] + [∀ i₁ : ι₁, Module R (M₁ i₁)] [∀ i₂ : ι₂, Module R (M₂ i₂)] (i j : ι₁ × ι₂) + (x : ∀ i : ι₁ × ι₂, M₁ i.1 ⊗[R] M₂ i.2) : + (Pi.tensorProj i) (Pi.tensorOf j (x j)) = ite (i = j) (x i) 0 := + by + have t1 : + ∀ i j : ι₁, + (LinearMap.proj j).comp (LinearMap.single _ _ i) = (directSumFromTo i j : M₁ i →ₗ[R] M₁ j) := + fun i j => rfl + have t2 : + ∀ i j : ι₂, + (LinearMap.proj j).comp (LinearMap.single _ _ i) = (directSumFromTo i j : M₂ i →ₗ[R] M₂ j) := + fun i j => rfl + simp only [Pi.tensorOf, Pi.tensorProj, ← LinearMap.comp_apply, ← TensorProduct.map_comp, t1, t2] + split_ifs with h + · rw [h] + simp only [directSumFromTo_apply_same, TensorProduct.map_one, Module.End.one_apply] + · rw [Prod.eq_iff_fst_eq_snd_eq, not_and_or] at h + rcases h with (h | h) + · rw [directSumFromTo_apply_ne_same h, TensorProduct.map_zero_left, LinearMap.zero_apply] + · rw [directSumFromTo_apply_ne_same h, TensorProduct.map_zero_right, LinearMap.zero_apply] + +theorem directSumTensorToFun_apply_inv_fun {R : Type _} [CommRing R] {ι₁ : Type _} {ι₂ : Type _} + [DecidableEq ι₁] [DecidableEq ι₂] [Fintype ι₁] [Fintype ι₂] {M₁ : ι₁ → Type _} + {M₂ : ι₂ → Type _} [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] [∀ i₂ : ι₂, AddCommGroup (M₂ i₂)] + [∀ i₁ : ι₁, Module R (M₁ i₁)] [∀ i₂ : ι₂, Module R (M₂ i₂)] + (x : ∀ i : ι₁ × ι₂, M₁ i.1 ⊗[R] M₂ i.2) : + directSumTensorToFun (directSumTensorInvFun x) = x := + by + simp only [directSumTensorToFun, directSumTensorInvFun, LinearMap.coe_mk, map_sum, + Pi.tensorProj_apply_pi_tensorOf, Fintype.sum_prod_type, AddHom.coe_mk, map_sum] + ext + simp only [← Finset.sum_product', Finset.univ_product_univ, Finset.sum_ite_eq, + Finset.sum_apply, Finset.sum_ite_eq, Finset.mem_univ, if_true] + +/-- Linear equivalence between tensor products of finite dependent products and products of tensor +factors. -/ +@[simps] +noncomputable def directSumTensor {R : Type _} [CommRing R] {ι₁ : Type _} {ι₂ : Type _} + [DecidableEq ι₁] [DecidableEq ι₂] [Fintype ι₁] [Fintype ι₂] + {M₁ : ι₁ → Type _} {M₂ : ι₂ → Type _} + [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] [∀ i₂ : ι₂, AddCommGroup (M₂ i₂)] + [∀ i₁ : ι₁, Module R (M₁ i₁)] [∀ i₂ : ι₂, Module R (M₂ i₂)] : + ((∀ i, M₁ i) ⊗[R] ∀ i, M₂ i) ≃ₗ[R] ∀ i : ι₁ × ι₂, M₁ i.fst ⊗[R] M₂ i.snd + where + toFun := directSumTensorToFun + invFun := directSumTensorInvFun + left_inv x := directSumTensorInvFun_apply_to_fun x + right_inv x := directSumTensorToFun_apply_inv_fun x + map_add' _ _ := map_add _ _ _ + map_smul' _ _ := _root_.map_smul _ _ _ + +theorem directSumTensorToFun.map_mul {R : Type _} [CommRing R] {ι₁ : Type _} {ι₂ : Type _} + {M₁ : ι₁ → Type _} {M₂ : ι₂ → Type _} [∀ i₁ : ι₁, Ring (M₁ i₁)] + [∀ i₂ : ι₂, Ring (M₂ i₂)] + [∀ i₁ : ι₁, Algebra R (M₁ i₁)] [∀ i₂ : ι₂, Algebra R (M₂ i₂)] + (x y : (∀ i, M₁ i) ⊗[R] ∀ i, M₂ i) : + directSumTensorToFun (x * y) = directSumTensorToFun x * directSumTensorToFun y := +letI : ZeroHomClass + (((i : ι₁) → M₁ i) ⊗[R] ((i : ι₂) → M₂ i) →ₗ[R] + (i : ι₁ × ι₂) → M₁ i.1 ⊗[R] M₂ i.2) _ _ := +⟨fun x => by simp only [LinearMap.map_zero]⟩ +x.induction_on + (by + simp only [zero_mul, map_zero] + ) + (fun x₁ x₂ => + y.induction_on + (by simp only [MulZeroClass.mul_zero, map_zero]) + (fun y₁ y₂ => by + ext + simp only [Pi.mul_apply, directSumTensorToFun_apply, Algebra.TensorProduct.tmul_mul_tmul]) + (fun y₁ y₂ hy₁ hy₂ => by simp only [mul_add, map_add, hy₁, hy₂])) + (fun x₁ x₂ hx hy => by simp only [add_mul, map_add, hx, hy]) + +theorem directSumTensorToFun.map_one {R : Type _} [CommRing R] {ι₁ : Type _} {ι₂ : Type _} + {M₁ : ι₁ → Type _} {M₂ : ι₂ → Type _} [∀ i₁ : ι₁, Ring (M₁ i₁)] + [∀ i₂ : ι₂, Ring (M₂ i₂)] + [∀ i₁ : ι₁, Algebra R (M₁ i₁)] [∀ i₂ : ι₂, Algebra R (M₂ i₂)] : + directSumTensorToFun (1 : (∀ i, M₁ i) ⊗[R] ∀ i, M₂ i) = 1 := + rfl + +/-- Algebra equivalence induced by `directSumTensor` for finite dependent products. -/ +@[simps] +noncomputable def directSumTensorAlgEquiv (R : Type _) {ι₁ ι₂ : Type _} [CommRing R] + [Fintype ι₁] [Fintype ι₂] [DecidableEq ι₁] [DecidableEq ι₂] + (M₁ : ι₁ → Type _) (M₂ : ι₂ → Type _) [∀ i₁ : ι₁, Ring (M₁ i₁)] + [∀ i₂ : ι₂, Ring (M₂ i₂)] [∀ i₁ : ι₁, Algebra R (M₁ i₁)] + [∀ i₂ : ι₂, Algebra R (M₂ i₂)] : + ((∀ i, M₁ i) ⊗[R] ∀ i, M₂ i) ≃ₐ[R] ∀ i : ι₁ × ι₂, M₁ i.fst ⊗[R] M₂ i.snd + where + toFun x i := directSumTensorToFun x i + invFun x := (directSumTensorInvFun : _ →ₗ[R] _) (x : ∀ i : ι₁ × ι₂, M₁ i.fst ⊗[R] M₂ i.snd) + right_inv x := by + simp only + rw [directSumTensorToFun_apply_inv_fun] + left_inv x := by + simp only + rw [directSumTensorInvFun_apply_to_fun] + map_add' x y := by simp only [map_add] + map_mul' x y := by + ext + rw [directSumTensorToFun.map_mul] + commutes' r := by + ext + simp_rw [Algebra.algebraMap_eq_smul_one, LinearMap.map_smul, Pi.smul_apply, + directSumTensorToFun.map_one] + +theorem Pi.tensor_ext_iff {R : Type _} [CommRing R] {ι₁ : Type _} {ι₂ : Type _} + [Finite ι₁] [Finite ι₂] {M₁ : ι₁ → Type _} {M₂ : ι₂ → Type _} + [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] [∀ i₂ : ι₂, AddCommGroup (M₂ i₂)] + [∀ i₁ : ι₁, Module R (M₁ i₁)] [∀ i₂ : ι₂, Module R (M₂ i₂)] (x z : ∀ i, M₁ i) + (y w : ∀ i, M₂ i) : + x ⊗ₜ[R] y = z ⊗ₜ[R] w ↔ ∀ i j, x i ⊗ₜ[R] y j = z i ⊗ₜ[R] w j := + by + classical + letI := Fintype.ofFinite ι₁ + letI := Fintype.ofFinite ι₂ + rw [← Function.Injective.eq_iff directSumTensor.injective] + simp_rw [funext_iff, directSumTensor_apply, directSumTensorToFun_apply, Prod.forall] + +theorem Pi.tensor_ext {R : Type _} [CommRing R] {ι₁ : Type _} {ι₂ : Type _} + [Finite ι₁] [Finite ι₂] {M₁ : ι₁ → Type _} {M₂ : ι₂ → Type _} + [∀ i₁ : ι₁, AddCommGroup (M₁ i₁)] [∀ i₂ : ι₂, AddCommGroup (M₂ i₂)] + [∀ i₁ : ι₁, Module R (M₁ i₁)] [∀ i₂ : ι₂, Module R (M₂ i₂)] {x z : ∀ i, M₁ i} + (y w : ∀ i, M₂ i) : + (∀ i j, x i ⊗ₜ[R] y j = z i ⊗ₜ[R] w j) → x ⊗ₜ[R] y = z ⊗ₜ[R] w := + by + rw [Pi.tensor_ext_iff] + simp only [imp_self] + +/-- Reindex linear maps out of a product-shaped dependent family. -/ +@[simps!] +def LinearMap.piPiProd (R : Type _) {ι₁ ι₂ : Type _} [Semiring R] (φ : ι₁ → Type _) + (ψ : ι₂ → Type _) [∀ i, AddCommMonoid (φ i)] [∀ i, Module R (φ i)] + [∀ i, AddCommMonoid (ψ i)] [∀ i, Module R (ψ i)] (S : Type _) [Semiring S] + [∀ i, Module S (ψ i)] [∀ i, SMulCommClass R S (ψ i)] : + (∀ i : ι₁ × ι₂, φ i.1 →ₗ[R] ψ i.2) ≃ₗ[S] ∀ i j, φ i →ₗ[R] ψ j + where + toFun f j k := f (j, k) + invFun f i := f i.1 i.2 + map_add' f g := by + ext + rfl + map_smul' r f := by + ext + rfl + left_inv f := by + rfl + right_inv f := by + rfl + +/-- Swap the two function arguments in a doubly-indexed family of linear maps. -/ +@[simps!] +def LinearMap.piProdSwap (R : Type _) {ι₁ ι₂ : Type _} [Semiring R] (φ : ι₁ → Type _) + (ψ : ι₂ → Type _) [∀ i, AddCommMonoid (φ i)] [∀ i, Module R (φ i)] + [∀ i, AddCommMonoid (ψ i)] [∀ i, Module R (ψ i)] (S : Type _) [Semiring S] + [∀ i, Module S (ψ i)] [∀ i, SMulCommClass R S (ψ i)] : + (∀ i j, φ i →ₗ[R] ψ j) ≃ₗ[S] ∀ j i, φ i →ₗ[R] ψ j + where + toFun f j i := f i j + invFun f i j := f j i + map_add' f g := by + ext + rfl + map_smul' r f := by + ext + rfl + left_inv f := by + rfl + right_inv f := by + rfl + +/-- Linear equivalence between maps into a dependent product and dependent products of maps. -/ +@[simps!] +def LinearMap.rsum (R : Type _) {M : Type _} {ι : Type _} [Semiring R] (φ : ι → Type _) + [∀ i : ι, AddCommMonoid (φ i)] [∀ i : ι, Module R (φ i)] (S : Type _) [AddCommMonoid M] + [Module R M] [Semiring S] [∀ i, Module S (φ i)] [∀ i, SMulCommClass R S (φ i)] : + (∀ i, M →ₗ[R] φ i) ≃ₗ[S] M →ₗ[R] ∀ i, φ i + where + toFun f := LinearMap.pi f + invFun f i := LinearMap.proj i ∘ₗ f + map_add' f g := by ext; simp only [LinearMap.pi_apply, Pi.add_apply, LinearMap.add_apply] + map_smul' r f := by + ext + simp only [LinearMap.pi_apply, Pi.smul_apply, LinearMap.smul_apply, RingHom.id_apply] + left_inv f := by ext i x; simp only [LinearMap.proj_pi] + right_inv f := by + ext; simp only [LinearMap.comp_apply, LinearMap.pi_apply] + rfl + +/-- Combine `piPiProd`, `piProdSwap`, `lsum`, and `rsum` into a two-sided reindexing equivalence. -/ +@[simps!] +def LinearMap.lrsum (R : Type _) {ι₁ ι₂ : Type _} [Semiring R] (φ : ι₁ → Type _) (ψ : ι₂ → Type _) + [∀ i, AddCommMonoid (φ i)] [∀ i, Module R (φ i)] [∀ i, AddCommMonoid (ψ i)] + [∀ i, Module R (ψ i)] (S : Type _) [Fintype ι₁] [DecidableEq ι₁] [Semiring S] + [∀ i, Module S (ψ i)] [∀ i, SMulCommClass R S (ψ i)] : + (∀ i : ι₁ × ι₂, φ i.1 →ₗ[R] ψ i.2) ≃ₗ[S] (∀ i, φ i) →ₗ[R] ∀ i, ψ i := + by + let h₂ : (∀ (j : ι₂) (i : ι₁), φ i →ₗ[R] ψ j) ≃ₗ[S] ∀ j, (∀ i, φ i) →ₗ[R] ψ j := + by + apply LinearEquiv.piCongrRight + intro j + exact LinearMap.lsum R φ S + exact + (((LinearMap.piPiProd R φ ψ S).trans (LinearMap.piProdSwap R φ ψ S)).trans h₂).trans + (LinearMap.rsum R ψ S) diff --git a/LeanPool/Monlib4/LinearAlgebra/PiStarOrderedRing.lean b/LeanPool/Monlib4/LinearAlgebra/PiStarOrderedRing.lean new file mode 100644 index 0000000000..07f9a43cb1 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/PiStarOrderedRing.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2024 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Algebra.Order.Star.Basic +import Mathlib.Algebra.Group.Subgroup.Basic +import Mathlib.Data.Fintype.Pi +import Mathlib.Algebra.Star.Pi +import Mathlib.Data.Complex.Basic + +/-! + # pi.star_ordered_ring + + This file contains the definition of `pi.star_ordered_ring`. +-/ + +/-- Coordinate projection of a set of dependent functions along `Pi.single`. -/ +def Set.ofPi {ι : Type _} {B : ι → Type _} [DecidableEq ι] [∀ i, Zero (B i)] (s : Set (∀ i, B i)) : + ∀ i, Set (B i) := fun i x => Pi.single i x ∈ s + +theorem Set.pi_ofPi {ι : Type _} {B : ι → Type _} [DecidableEq ι] [∀ i, AddZeroClass (B i)] + {s : ∀ i, Set (B i)} (h : ∀ i, s i 0) : (Set.univ.pi s).ofPi = s := + by + ext i x + change Pi.single i x ∈ Set.univ.pi s ↔ x ∈ s i + constructor + · intro hi + specialize hi i + rw [Pi.single_eq_same] at hi + exact hi (Set.mem_univ i) + · intro hx j _ + by_cases hj : j = i + · rw [hj] + rw [Pi.single_eq_same] + exact hx + · rw [Pi.single_eq_of_ne hj] + exact h j + +/-- Coordinate projection of an additive submonoid of dependent functions along `Pi.single`. -/ +def AddSubmonoid.ofPi {ι : Type _} {B : ι → Type _} [DecidableEq ι] [∀ i, AddZeroClass (B i)] : + AddSubmonoid (∀ i, B i) → ∀ i, AddSubmonoid (B i) := fun h i => + { carrier := fun x => x ∈ Set.ofPi h.carrier i + zero_mem' := by + change Pi.single i 0 ∈ h.carrier + rw [Pi.single_zero] + exact h.zero_mem' + add_mem' := fun x y => by + have := h.add_mem' x y + simp only [AddSubmonoid.mem_carrier, ← Pi.single_add] at this ⊢ + exact this } + +theorem AddSubmonoid.pi_ofPi {ι : Type _} {B : ι → Type _} [DecidableEq ι] [∀ i, AddZeroClass (B i)] + (h : ∀ i, AddSubmonoid (B i)) : (AddSubmonoid.pi Set.univ h).ofPi = h := + by + ext i x + change Pi.single i x ∈ AddSubmonoid.pi Set.univ h ↔ x ∈ h i + rw [AddSubmonoid.mem_pi] + constructor + · intro hx + simpa using hx i + · intro hx j + by_cases hj : j = i + · rw [hj, Pi.single_eq_same] + intro _ + exact hx + · simp [Pi.single_eq_of_ne hj, (h j).zero_mem] + +theorem Set.ofPi_mem' {ι : Type _} {B : ι → Type _} [DecidableEq ι] [∀ i, AddZeroClass (B i)] + {s : ∀ i, Set (B i)} {S : Set (∀ i, B i)} (hs : Set.univ.pi s ⊆ S) (h : ∀ i, s i 0) (i : ι) : + s i ⊆ S.ofPi i := by + intro x hx + change Pi.single i x ∈ S + apply hs + intro j _ + by_cases hj : j = i + · rw [hj] + rw [Pi.single_eq_same] + exact hx + · rw [Pi.single_eq_of_ne hj] + exact h j + +theorem AddSubmonoid.mem_closure_pi {ι : Type _} {B : ι → Type _} + [∀ i, AddZeroClass (B i)] {s : ∀ i, Set (B i)} {x : ∀ i, B i} : + x ∈ AddSubmonoid.closure (Set.univ.pi fun i => s i) → ∀ i, x i ∈ AddSubmonoid.closure (s i) := + by + simp_rw [AddSubmonoid.mem_closure] + intro h i S hS + specialize h (AddSubmonoid.pi Set.univ fun i => AddSubmonoid.closure (s i)) + simp_rw [Set.subset_def, Set.mem_univ_pi, AddSubmonoid.pi, SetLike.mem_coe, + AddSubmonoid.mem_mk] at h + simp only [AddSubsemigroup.mem_mk, Set.mem_pi, Set.mem_univ, AddSubsemigroup.mem_carrier, + mem_toSubsemigroup, forall_true_left, AddSubmonoid.mem_closure] at h + exact h (fun y hy j K hK => hK (hy j)) i S hS + +theorem Pi.StarOrderedRing.nonneg_def {ι : Type _} {α : ι → Type _} [∀ i, NonUnitalSemiring (α i)] + [∀ i, PartialOrder (α i)] [∀ i, StarRing (α i)] [∀ i, StarOrderedRing (α i)] + (h : ∀ (i : ι) (x : α i), 0 ≤ x ↔ ∃ y, star y * y = x) (x : ∀ i, α i) : + 0 ≤ x ↔ ∃ y, star y * y = x := + by + simp_rw [Pi.le_def, Pi.zero_apply, funext_iff, Pi.mul_apply, Pi.star_apply, h] + exact + ⟨fun hx => ⟨fun i => (hx i).choose, fun i => (hx i).choose_spec⟩, + fun ⟨y, hy⟩ i => ⟨y i, hy i⟩⟩ + +instance {ι : Type _} {α : ι → Type _} [∀ i, Ring (α i)] + [∀ i, PartialOrder (α i)] [∀ i, StarRing (α i)] [∀ i, StarOrderedRing (α i)] : + CovariantClass ((i : ι) → α i) ((i : ι) → α i) + (Function.swap fun x x_1 ↦ x + x_1) fun x x_1 ↦ x ≤ x_1 := +⟨fun x y z h j => by simp_rw [Function.swap, Pi.add_apply, add_le_add_iff_right, h j]⟩ + +theorem Pi.StarOrderedRing.le_def {ι : Type _} {α : ι → Type _} [∀ i, Ring (α i)] + [∀ i, PartialOrder (α i)] [∀ i, StarRing (α i)] [∀ i, StarOrderedRing (α i)] + (h : ∀ (i : ι) (x : α i), 0 ≤ x ↔ ∃ y, star y * y = x) (x y : ∀ i, α i) : + x ≤ y ↔ ∃ z, star z * z = y - x := + by + calc + x ≤ y ↔ 0 ≤ y - x := by rw [sub_nonneg] + _ ↔ ∃ z, star z * z = y - x := ?_ + rw [← Pi.StarOrderedRing.nonneg_def] + exact h + +/-- Dependent functions over star-ordered rings are star-ordered coordinatewise. -/ +theorem Pi.starOrderedRing {ι : Type _} {B : ι → Type _} [∀ i, Ring (B i)] [∀ i, PartialOrder (B i)] + [∀ i, StarRing (B i)] [∀ i, StarOrderedRing (B i)] + (h : ∀ (i : ι) (x : B i), 0 ≤ x ↔ ∃ y, star y * y = x) : + StarOrderedRing (∀ i, B i) := +StarOrderedRing.of_le_iff + (fun a b => by + rw [Pi.StarOrderedRing.le_def h] + simp_rw [eq_sub_iff_add_eq', eq_comm]) diff --git a/LeanPool/Monlib4/LinearAlgebra/PosMapIsReal.lean b/LeanPool/Monlib4/LinearAlgebra/PosMapIsReal.lean new file mode 100644 index 0000000000..fe8bcbbdf1 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/PosMapIsReal.lean @@ -0,0 +1,1207 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.InnerAut +import LeanPool.Monlib4.LinearAlgebra.Matrix.IncludeBlock +import LeanPool.Monlib4.LinearAlgebra.InvariantSubmodule +import LeanPool.Monlib4.LinearAlgebra.Ips.MinimalProj +import LeanPool.Monlib4.LinearAlgebra.Nacgor +import Mathlib.Analysis.InnerProductSpace.StarOrder +import LeanPool.Monlib4.LinearAlgebra.OfNorm +import LeanPool.Monlib4.LinearAlgebra.Matrix.StarOrderedRing +import LeanPool.Monlib4.LinearAlgebra.Matrix.PosDefRpow +import LeanPool.Monlib4.LinearAlgebra.ToMatrixOfEquiv +import Mathlib.Analysis.InnerProductSpace.Positive +import Mathlib.Analysis.CStarAlgebra.Matrix + +variable {A : Type _} [Ring A] [StarRing A] [Algebra ℂ A] [StarModule ℂ A] [PartialOrder A] + [_root_.StarOrderedRing A] + +/-- we say a map $f \colon M_1 \to M_2$ is a positive map + if for all positive $x \in M_1$, we also get $f(x)$ is positive -/ +def LinearMap.IsPosMap + {M₁ M₂ : Type*} [Zero M₁] [Zero M₂] [PartialOrder M₁] [PartialOrder M₂] + {F : Type*} [FunLike F M₁ M₂] (f : F) : Prop := +∀ ⦃x : M₁⦄, 0 ≤ x → 0 ≤ f x + +/-- The self-adjoint real part of an element. -/ +noncomputable abbrev selfAdjointDecomposition_left + {B : Type*} [Star B] [Add B] [SMul ℂ B] (a : B) := +(1 / 2 : ℂ) • (a + star a) +local notation "aL" => selfAdjointDecomposition_left + +lemma selfAdjointDecomposition_left_one + {B : Type*} [AddCommMonoid B] [MulOneClass B] [StarMul B] [Module ℂ B] : + aL (1 : B) = 1 := +by + rw [selfAdjointDecomposition_left, star_one, ← two_smul ℂ, smul_smul] + norm_num + +/-- The self-adjoint imaginary part of an element. -/ +noncomputable abbrev selfAdjointDecomposition_right + {B : Type*} [Star B] [Sub B] [SMul ℂ B] (a : B) := +(RCLike.I : ℂ) • ((1 / 2 : ℂ) • (star a - a)) +local notation "aR" => selfAdjointDecomposition_right + +lemma selfAdjointDecomposition_right_one + {B : Type*} [AddCommGroup B] [MulOneClass B] [StarMul B] [SMulZeroClass ℂ B] : + aR (1 : B) = 0 := +by + simp_rw [selfAdjointDecomposition_right, star_one, sub_self, smul_zero] + +lemma selfAdjointDecomposition_right_eq_zero_iff + {B : Type*} [Star B] [AddGroup B] + [SMulWithZero ℂ B] [NoZeroSMulDivisors ℂ B] (a : B) : + aR a = 0 ↔ IsSelfAdjoint a := +by + rw [isSelfAdjoint_iff] + constructor + · intro h + have h1 : (1 / 2 : ℂ) • (star a - a) = 0 := + (eq_zero_or_eq_zero_of_smul_eq_zero h).resolve_left Complex.I_ne_zero + have h2 : star a - a = 0 := + (eq_zero_or_eq_zero_of_smul_eq_zero h1).resolve_left + (by norm_num : (1 / 2 : ℂ) ≠ 0) + exact sub_eq_zero.mp h2 + · intro h + simp [selfAdjointDecomposition_right, h] + +theorem selfAdjointDecomposition_left_isSelfAdjoint + {B : Type*} [AddCommMonoid B] [StarAddMonoid B] [SMul ℂ B] [StarModule ℂ B] (a : B) : + IsSelfAdjoint (aL a) := +by simp [selfAdjointDecomposition_left, isSelfAdjoint_iff, star_smul, add_comm] + +theorem selfAdjointDecomposition_right_isSelfAdjoint + {B : Type*} [AddCommGroup B] [StarAddMonoid B] + [Module ℂ B] [StarModule ℂ B] + (a : B) : + IsSelfAdjoint (aR a) := +by + simp only [selfAdjointDecomposition_right, RCLike.I_to_complex, one_div, smul_smul, + isSelfAdjoint_iff, star_smul, star_mul', RCLike.star_def, Complex.conj_I, + star_inv₀, star_ofNat, neg_mul, star_sub, star_star, neg_smul] + rw [← neg_sub, ← neg_smul, neg_smul_neg] + +theorem selfAdjointDecomposition + {B : Type*} [AddCommGroup B] [StarAddMonoid B] + [Module ℂ B] [StarModule ℂ B] (a : B) : + a = aL a + (RCLike.I : ℂ) • (aR a) := +by + simp_rw [selfAdjointDecomposition_left, selfAdjointDecomposition_right, + smul_smul, ← mul_assoc, RCLike.I, Complex.I_mul_I, smul_add, smul_sub, + neg_mul, one_mul, neg_smul, neg_sub_neg] + simp only [one_div, add_add_sub_cancel] + simp_rw [← two_smul ℂ, smul_smul] + simp only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, mul_inv_cancel₀, one_smul] + +/-- The algebra equivalence between continuous endomorphisms and linear endomorphisms +in finite-dimensional inner product spaces. -/ +noncomputable +def ContinuousLinearMap.toLinearMapAlgEquiv + {𝕜 B : Type*} [RCLike 𝕜] [NormedAddCommGroup B] + [InnerProductSpace 𝕜 B] [FiniteDimensional 𝕜 B] : + (B →L[𝕜] B) ≃ₐ[𝕜] (B →ₗ[𝕜] B) := +AlgEquiv.ofLinearEquiv LinearMap.toContinuousLinearMap.symm rfl (fun _ _ => rfl) + +lemma ContinuousLinearMap.toLinearMapAlgEquiv_apply + {𝕜 B : Type*} [RCLike 𝕜] [NormedAddCommGroup B] + [InnerProductSpace 𝕜 B] [FiniteDimensional 𝕜 B] + (f : B →L[𝕜] B) : + ContinuousLinearMap.toLinearMapAlgEquiv f = f.toLinearMap := +rfl + +lemma ContinuousLinearMap.toLinearMapAlgEquiv_symm_apply + {𝕜 B : Type*} [RCLike 𝕜] [NormedAddCommGroup B] + [InnerProductSpace 𝕜 B] [FiniteDimensional 𝕜 B] + (f : B →ₗ[𝕜] B) : + ContinuousLinearMap.toLinearMapAlgEquiv.symm f = LinearMap.toContinuousLinearMap f := +rfl + +theorem ContinuousLinearMap.spectrum_coe {𝕜 B : Type*} [RCLike 𝕜] [NormedAddCommGroup B] + [InnerProductSpace 𝕜 B] [FiniteDimensional 𝕜 B] (T : B →L[𝕜] B) : + spectrum 𝕜 T.toLinearMap = spectrum 𝕜 T := +by rw [← ContinuousLinearMap.toLinearMapAlgEquiv_apply, AlgEquiv.spectrum_eq] + +variable {B : Type*} [NormedAddCommGroup B] [InnerProductSpace ℂ B] + [FiniteDimensional ℂ B] + +open scoped MatrixOrder ComplexOrder FiniteDimensional +-- set_option synthInstance.checkSynthOrder false in +-- attribute [instance] FiniteDimensional.complete +theorem ContinuousLinearMap.nonneg_iff_isSelfAdjoint_and_nonneg_spectrum + (T : B →L[ℂ] B) : + 0 ≤ T ↔ IsSelfAdjoint T ∧ spectrum ℂ T ⊆ {a : ℂ | 0 ≤ a} := +by + rw [nonneg_iff_isPositive, ContinuousLinearMap.IsPositive.toLinearMap', + LinearMap.isPositive'_iff_isSymmetric_and_nonneg_spectrum, + isSelfAdjoint_iff_isSymmetric, spectrum_coe] + +theorem ContinuousLinearMap.nonneg_iff_exists + (T : B →L[ℂ] B) : + 0 ≤ T ↔ ∃ f, T = star f * f := +by rw [nonneg_iff_isPositive]; exact isPositive_iff_exists_adjoint_hMul_self _ + +-- def ContinuousLinearMap.StarOrderedRing : +-- _root_.StarOrderedRing (B →L[ℂ] B) := +-- StarOrderedRing.of_nonneg_iff' +-- (fun hxy z => by simp_rw [le_def, add_sub_add_left_eq_sub]; exact hxy) +-- (fun x => by +-- rw [nonneg_iff_isPositive] +-- exact ContinuousLinearMap.isPositive_iff_exists_adjoint_hMul_self _) +-- attribute [local instance] ContinuousLinearMap.StarOrderedRing + +lemma orthogonalProjection_ker_comp_eq_of_comp_eq_zero {T S : B →L[ℂ] B} (h : T * S = 0) : + orthogonalProjection' (LinearMap.ker T.toLinearMap) * S = S := +by + have : LinearMap.range S.toLinearMap ≤ LinearMap.ker T.toLinearMap := by + intro x ⟨y, hy⟩ + rw [← hy, LinearMap.mem_ker] + have hfun := congrArg (fun f : B →L[ℂ] B => f y) h + simpa [ContinuousLinearMap.mul_apply] using hfun + rw [← orthogonalProjection.range (LinearMap.ker T.toLinearMap)] at this + rw [← ContinuousLinearMap.coe_inj, ContinuousLinearMap.mul_def, + ContinuousLinearMap.coe_comp, IsIdempotentElem.comp_idempotent_iff] + · exact this + · exact ContinuousLinearMap.IsIdempotentElem.toLinearMap + (orthogonalProjection.isIdempotentElem _) + +variable {n : Type*} [Fintype n] [DecidableEq n] + +/-- matrix of orthogonalProjection -/ +noncomputable def Matrix.orthogonalProjection + (U : Submodule ℂ (EuclideanSpace ℂ n)) : + Matrix n n ℂ := +(Matrix.toEuclideanCLM (𝕜 := ℂ)).symm (orthogonalProjection' U) + +/-- The blockwise matrix of orthogonal projections for a `PiMat`. -/ +noncomputable def PiMat.orthogonalProjection + {k : Type*} {n : k → Type*} + [Π i, Fintype (n i)] [Π i, DecidableEq (n i)] + (U : Π i, Submodule ℂ (EuclideanSpace ℂ (n i))) : + PiMat ℂ k n := +fun i => Matrix.orthogonalProjection (U i) + +lemma Matrix.toEuclideanLin_symm {𝕜 n : Type*} [RCLike 𝕜] [Fintype n] [DecidableEq n] + (x : EuclideanSpace 𝕜 n →ₗ[𝕜] EuclideanSpace 𝕜 n) : + (Matrix.toEuclideanLin.symm x) = + LinearMap.toMatrix (EuclideanSpace.basisFun n 𝕜).toBasis + (EuclideanSpace.basisFun n 𝕜).toBasis x := +by + rfl + +lemma EuclideanSpace.trace_eq_matrix_trace' {𝕜 n : Type*} [RCLike 𝕜] [Fintype n] + [DecidableEq n] (f : EuclideanSpace 𝕜 n →ₗ[𝕜] EuclideanSpace 𝕜 n) : + LinearMap.trace 𝕜 _ f = Matrix.trace (Matrix.toEuclideanLin.symm f) := +by + rw [LinearMap.trace_eq_matrix_trace 𝕜 (EuclideanSpace.basisFun n 𝕜).toBasis f] + congr 1 + +theorem Matrix.coe_toEuclideanCLM_symm_eq_toEuclideanLin_symm {𝕜 n : Type*} + [RCLike 𝕜] [Fintype n] [DecidableEq n] + (A : EuclideanSpace 𝕜 n →L[𝕜] EuclideanSpace 𝕜 n) : + (toEuclideanCLM (𝕜 := 𝕜)).symm A = toEuclideanLin.symm A := +rfl + +theorem Matrix.orthogonalProjection_trace {U : Submodule ℂ (EuclideanSpace ℂ n)} : + (Matrix.orthogonalProjection U).trace = Module.finrank ℂ U := +by + rw [orthogonalProjection, Matrix.coe_toEuclideanCLM_symm_eq_toEuclideanLin_symm, + ← EuclideanSpace.trace_eq_matrix_trace'] + exact _root_.orthogonalProjection_trace _ + +theorem PiMat.orthogonalProjection_trace {k : Type*} {n : k → Type*} [Fintype k] [DecidableEq k] + [Π i, Fintype (n i)] [Π i, DecidableEq (n i)] + (U : Π i, Submodule ℂ (EuclideanSpace ℂ (n i))) : + (Matrix.blockDiagonal' (PiMat.orthogonalProjection U)).trace + = ∑ i, Module.finrank ℂ (U i) := +by + simp_rw [Matrix.trace_blockDiagonal', PiMat.orthogonalProjection, + Matrix.orthogonalProjection_trace, Nat.cast_sum] + +lemma Matrix.isIdempotentElem_toEuclideanCLM {n : Type*} [Fintype n] [DecidableEq n] + (x : Matrix n n ℂ) : + IsIdempotentElem x ↔ IsIdempotentElem (toEuclideanCLM (𝕜 := ℂ) x) := +by + simp_rw [IsIdempotentElem, ← _root_.map_mul] + exact Iff.symm (EmbeddingLike.apply_eq_iff_eq toEuclideanCLM) + +lemma Matrix.CLM_apply_orthogonalProjection {U : Submodule ℂ (EuclideanSpace ℂ n)} : + Matrix.toEuclideanCLM (𝕜 := ℂ) (Matrix.orthogonalProjection U) + = orthogonalProjection' U := +by + ext1 + simp [orthogonalProjection', orthogonalProjection] + +lemma Matrix.orthogonalProjection_ortho_eq {U : Submodule ℂ (EuclideanSpace ℂ n)} : + Matrix.orthogonalProjection Uᗮ = 1 - Matrix.orthogonalProjection U := +by + apply_fun Matrix.toEuclideanCLM (𝕜 := ℂ) + simp only [map_sub, _root_.map_one] + simp only [Matrix.CLM_apply_orthogonalProjection] + exact orthogonalProjection.orthogonal_complement_eq U + +lemma Matrix.orthogonalProjection_isPosSemidef {U : Submodule ℂ (EuclideanSpace ℂ n)} : + (Matrix.orthogonalProjection U).PosSemidef := +by + rw [posSemidef_eq_linearMap_positive', ← coe_toEuclideanCLM_eq_toEuclideanLin, + Matrix.CLM_apply_orthogonalProjection, + ← ContinuousLinearMap.IsPositive.toLinearMap', + ← ContinuousLinearMap.nonneg_iff_isPositive] + exact orthogonalProjection.is_positive + +lemma Matrix.IsHermitian.orthogonalProjection_ker_apply_self {x : Matrix n n ℂ} + (hx : x.IsHermitian) : + Matrix.orthogonalProjection (LinearMap.ker (toEuclideanCLM (𝕜 := ℂ) x).toLinearMap) * + x = 0 := +by + apply_fun Matrix.toEuclideanCLM (𝕜 := ℂ) + simp only [_root_.map_mul, map_zero] + simp only [Matrix.CLM_apply_orthogonalProjection] + ext1 + simp only [ContinuousLinearMap.mul_apply, ContinuousLinearMap.zero_apply] + simp only [orthogonalProjection'_eq, ContinuousLinearMap.coe_comp', Submodule.coe_subtypeL', + Submodule.coe_subtype, Function.comp_apply, ZeroMemClass.coe_eq_zero, + Submodule.orthogonalProjection_eq_zero_iff] + rw [ContinuousLinearMap.ker_eq_ortho_adjoint_range, Submodule.orthogonal_orthogonal, + ← ContinuousLinearMap.star_eq_adjoint] + simp only [← map_star, star_eq_conjTranspose, hx.eq] + exact LinearMap.mem_range_self _ _ + +private lemma auxaux_2 {T S : Matrix n n ℂ} (h : T * S = 0) : + Matrix.orthogonalProjection (LinearMap.ker (Matrix.toEuclideanCLM (𝕜 := ℂ) T).toLinearMap) * + S = S := +by + apply_fun Matrix.toEuclideanCLM (𝕜 := ℂ) at h ⊢ + simp only [_root_.map_mul, map_zero] at h ⊢ + simp only [Matrix.CLM_apply_orthogonalProjection] + exact orthogonalProjection_ker_comp_eq_of_comp_eq_zero h + +omit [Fintype n] [DecidableEq n] in +theorem Matrix.nonneg_def {x : Matrix n n ℂ} : + 0 ≤ x ↔ x.PosSemidef := +by rw [le_iff, sub_zero] + +/-- the positive square root of the square of a Hermitian matrix `x`, + in other words, `√(x ^ 2)` -/ +noncomputable def Matrix.IsHermitian.sqSqrt {x : Matrix n n ℂ} + (hx : x.IsHermitian) : + Matrix n n ℂ := +innerAut (hx.eigenvectorUnitary) + (Matrix.diagonal (RCLike.ofReal ∘ (fun i => √ ((hx.eigenvalues i) ^ 2 : ℝ)))) + +lemma Matrix.IsHermitian.sqSqrt_eq {x : Matrix n n ℂ} (hx : x.IsHermitian) : + hx.sqSqrt = innerAut (hx.eigenvectorUnitary) + (Matrix.diagonal (RCLike.ofReal ∘ (|hx.eigenvalues|))) := +by simp only [sqSqrt, Real.sqrt_sq_eq_abs]; rfl + +lemma Matrix.IsHermitian.sqSqrt_isPosSemidef {x : Matrix n n ℂ} (hx : x.IsHermitian) : + hx.sqSqrt.PosSemidef := +by + rw [sqSqrt_eq] + apply (innerAut_posSemidef_iff _).mpr + apply (diagonal_posSemidef_iff _).mpr + intro + rw [Function.comp_apply, Pi.zero_apply, RCLike.ofReal_nonneg, Pi.abs_apply] + exact abs_nonneg _ + +/-- the square of the positive square root of a Hermitian matrix is equal to the square of the + matrix -/ +lemma Matrix.IsHermitian.sqSqrt_sq {x : Matrix n n ℂ} (hx : x.IsHermitian) : + hx.sqSqrt ^ 2 = x ^ 2 := +by + symm + nth_rw 1 [hx.spectral_theorem''] + simp_rw [sqSqrt, innerAut.map_pow, diagonal_pow] + simp only [innerAut_coe, EmbeddingLike.apply_eq_iff_eq, diagonal_eq_diagonal_iff, + Pi.pow_apply, Function.comp_apply, ← RCLike.ofReal_pow, + Real.sq_sqrt (sq_nonneg _), implies_true] + +/-- The positive part in the decomposition of a Hermitian matrix. -/ +noncomputable def Matrix.IsHermitian.posSemidefDecomposition_left + (x : Matrix n n ℂ) [hx : Fact x.IsHermitian] := +(1 / 2 : ℂ) • (hx.out.sqSqrt + x) +/-- Notation for the positive part in the decomposition of a Hermitian matrix. -/ +notation3:80 (name := posL) x:81"₊" => + @Matrix.IsHermitian.posSemidefDecomposition_left _ _ _ x _ +lemma Matrix.IsHermitian.posSemidefDecomposition_left_isHermitian + {x : Matrix n n ℂ} [hx : Fact x.IsHermitian] : x₊.IsHermitian := +by + rw [IsHermitian, posSemidefDecomposition_left, conjTranspose_smul, + conjTranspose_add, hx.out.eq, RCLike.star_def] + simp only [one_div, map_inv₀, map_ofNat] + congr + apply (innerAut_isHermitian_iff _ _).mp _ + rw [Matrix.isHermitian_diagonal_iff] + intro i + simp only [Function.comp_apply, _root_.IsSelfAdjoint, RCLike.star_def, RCLike.conj_ofReal] + +/-- The negative part in the decomposition of a Hermitian matrix. -/ +noncomputable def Matrix.IsHermitian.posSemidefDecomposition_right + (x : Matrix n n ℂ) [hx : Fact x.IsHermitian] := +(1 / 2 : ℂ) • (hx.out.sqSqrt - x) +/-- Notation for the negative part in the decomposition of a Hermitian matrix. -/ +notation3:80 (name := posR) x:81"₋" => + Matrix.IsHermitian.posSemidefDecomposition_right x +lemma Matrix.IsHermitian.posSemidefDecomposition_right_isHermitian + {x : Matrix n n ℂ} [hx : Fact x.IsHermitian] : + x₋.IsHermitian := +by + rw [IsHermitian, posSemidefDecomposition_right, conjTranspose_smul, + conjTranspose_sub, hx.out.eq, RCLike.star_def] + simp only [one_div, map_inv₀, map_ofNat] + congr + apply (innerAut_isHermitian_iff _ _).mp _ + rw [Matrix.isHermitian_diagonal_iff] + intro i + simp only [Function.comp_apply, _root_.IsSelfAdjoint, RCLike.star_def, RCLike.conj_ofReal] + +/-- a Hermitian matrix commutes with its positive squared-square-root, + i.e., `x * √(x^2) = √(x^2) * x`. -/ +lemma Matrix.IsHermitian.commute_sqSqrt {x : Matrix n n ℂ} (hx : x.IsHermitian) : + Commute x hx.sqSqrt := +by + rw [Commute, SemiconjBy] + nth_rw 1 [hx.spectral_theorem''] + symm + nth_rw 2 [hx.spectral_theorem''] + simp only [sqSqrt, ← Matrix.innerAut.map_mul, diagonal_mul_diagonal, mul_comm] + +lemma Matrix.IsHermitian.posSemidefDecomposition_left_mul_right (x : Matrix n n ℂ) + [hx : Fact x.IsHermitian] : + x₊ * x₋ = 0 := +by + simp_rw [posSemidefDecomposition_left, posSemidefDecomposition_right, + smul_add, smul_sub, add_mul, mul_sub] + simp only [one_div, Algebra.mul_smul_comm, Algebra.smul_mul_assoc] + simp_rw [← pow_two, hx.out.commute_sqSqrt.eq] + simp only [sub_add_sub_cancel, sqSqrt_sq] + simp only [sub_self] +lemma Matrix.IsHermitian.posSemidefDecomposition_right_mul_left (x : Matrix n n ℂ) + [hx : Fact x.IsHermitian] : + x₋ * x₊ = 0 := +by + simp_rw [posSemidefDecomposition_left, posSemidefDecomposition_right, + smul_add, smul_sub, sub_mul, mul_add] + simp only [one_div, Algebra.mul_smul_comm, Algebra.smul_mul_assoc] + simp_rw [← pow_two, hx.out.commute_sqSqrt.eq] + nth_rw 1 [sqSqrt_sq] + simp only [sub_add_eq_sub_sub, add_sub_cancel_right, sub_self] + +lemma Matrix.IsHermitian.posSemidefDecomposition_eq (x : Matrix n n ℂ) [hx : Fact x.IsHermitian] : + x = x₊ - x₋ := +by + simp_rw [posSemidefDecomposition_left, posSemidefDecomposition_right, + ← smul_sub, add_sub_sub_cancel, ← two_smul ℂ, smul_smul] + norm_num + +theorem Matrix.IsHermitian.posSemidefDecomposition_posSemidef_left_right + {x : Matrix n n ℂ} (hx : Fact x.IsHermitian) : + x₊.PosSemidef ∧ x₋.PosSemidef := +by + have h := fun (a b : Matrix n n ℂ) (ha : 0 ≤ a) (hb : 0 ≤ b) + => Matrix.posSemidef_iff_commute ha hb + simp only [sub_zero, Matrix.nonneg_def] at h + have h₂ := auxaux_2 (IsHermitian.posSemidefDecomposition_left_mul_right x) + have h₃ : hx.out.sqSqrt = x₊ + x₋ := + by + simp_rw [IsHermitian.posSemidefDecomposition_left, IsHermitian.posSemidefDecomposition_right, + ← smul_add, add_add_sub_cancel, ← two_smul ℂ, smul_smul] + norm_num + have h₄ : + orthogonalProjection (LinearMap.ker (toEuclideanCLM (𝕜 := ℂ) (x₊)).toLinearMap) * + hx.out.sqSqrt = x₋ := + by + rw [h₃, mul_add, h₂, Matrix.IsHermitian.orthogonalProjection_ker_apply_self + IsHermitian.posSemidefDecomposition_left_isHermitian, zero_add] + have h₅ : x = + (1 - (2 : ℂ) • + (orthogonalProjection + (LinearMap.ker (toEuclideanCLM (𝕜 := ℂ) (x₊)).toLinearMap))) + * hx.out.sqSqrt := + by + rw [sub_mul, smul_mul_assoc, h₄, h₃, one_mul, two_smul, add_sub_add_right_eq_sub] + exact IsHermitian.posSemidefDecomposition_eq _ + have h₆ : x₊ = + (orthogonalProjection + (LinearMap.ker (toEuclideanCLM (𝕜 := ℂ) (x₊)).toLinearMap)ᗮ) + * hx.out.sqSqrt := + by + nth_rw 1 [IsHermitian.posSemidefDecomposition_left] + nth_rw 3 [h₅] + rw [Matrix.orthogonalProjection_ortho_eq] + simp_rw [sub_mul, one_mul, smul_add, smul_sub, smul_mul_assoc, + h₄, smul_smul, add_sub, ← smul_add, ← two_smul ℂ, smul_smul] + norm_num + have h₄' : x₋ = + hx.out.sqSqrt * + (orthogonalProjection (LinearMap.ker (toEuclideanCLM (𝕜 := ℂ) (x₊)).toLinearMap)) := + by rw [← IsHermitian.posSemidefDecomposition_right_isHermitian, ← h₄, + conjTranspose_mul, (IsHermitian.sqSqrt_isPosSemidef _).1.eq, + Matrix.orthogonalProjection_isPosSemidef.1.eq] + have h₆' : x₊ = + hx.out.sqSqrt * + (orthogonalProjection (LinearMap.ker (toEuclideanCLM (𝕜 := ℂ) (x₊)).toLinearMap)ᗮ) := + by + nth_rw 1 [← IsHermitian.posSemidefDecomposition_left_isHermitian, h₆] + rw [conjTranspose_mul, (IsHermitian.sqSqrt_isPosSemidef _).1.eq, + Matrix.orthogonalProjection_isPosSemidef.1.eq] + constructor + · rw [h₆', ← h _ _ (IsHermitian.sqSqrt_isPosSemidef _) + orthogonalProjection_isPosSemidef, Commute, SemiconjBy, ← h₆, ← h₆'] + · rw [h₄', ← h _ _ (IsHermitian.sqSqrt_isPosSemidef _) + orthogonalProjection_isPosSemidef, Commute, SemiconjBy, h₄, ← h₄'] + +open scoped Matrix +omit [DecidableEq n] in +theorem Matrix.IsHermitian.posSemidefDecomposition' + {x : Matrix n n ℂ} (hx : x.IsHermitian) : + ∃ a b, x = aᴴ * a - bᴴ * b := +by + classical + let hx := Fact.mk hx + simp_rw [posSemidefDecomposition_eq] + obtain ⟨α, hα⟩ := (Matrix.posSemidef_iff (x₊)).mp + (posSemidefDecomposition_posSemidef_left_right hx).1 + obtain ⟨β, hβ⟩ := (Matrix.posSemidef_iff (x₋)).mp + (posSemidefDecomposition_posSemidef_left_right hx).2 + use α, β + rw [hα, hβ] + +theorem PiMat.IsSelfAdjoint.posSemidefDecomposition {k : Type*} {n : k → Type*} + [Π i, Fintype (n i)] + {x : PiMat ℂ k n} (hx : IsSelfAdjoint x) : + ∃ a b, x = star a * a - star b * b := +by + have : ∀ i, (x i).IsHermitian := fun i => + by + rw [IsSelfAdjoint, funext_iff] at hx + simp_rw [Pi.star_apply, Matrix.star_eq_conjTranspose] at hx + exact hx i + have := fun i => Matrix.IsHermitian.posSemidefDecomposition' (this i) + let a : PiMat ℂ k n := + fun i => (this i).choose + let b : PiMat ℂ k n := + fun i => (this i).choose_spec.choose + have hab : ∀ i, x i = star (a i) * (a i) - star (b i) * (b i) := + fun i => (this i).choose_spec.choose_spec + use a, b + ext1 + simp only [Pi.sub_apply, Pi.mul_apply, Pi.star_apply, hab] + +open ContinuousLinearMap in +theorem IsSelfAdjoint.isPositiveDecomposition + {x : B →L[ℂ] B} (hx : IsSelfAdjoint x) : + ∃ a b, x = star a * a - star b * b := +by + let e := stdOrthonormalBasis ℂ B + have hx' : Matrix.IsHermitian (e.toMatrix x.toLinearMap) := + by + rw [Matrix.IsHermitian, ← Matrix.star_eq_conjTranspose, ← map_star] + congr + rw [isSelfAdjoint_iff_isSymmetric, LinearMap.isSymmetric_iff_isSelfAdjoint] at hx + exact hx + obtain ⟨a, b, hab⟩ := hx'.posSemidefDecomposition' + let a' : B →L[ℂ] B := LinearMap.toContinuousLinearMap (e.toMatrix.symm a) + let b' : B →L[ℂ] B := LinearMap.toContinuousLinearMap (e.toMatrix.symm b) + use a', b' + apply_fun e.toMatrix.symm at hab + simp_rw [StarAlgEquiv.symm_apply_apply, map_sub, map_mul, ← Matrix.star_eq_conjTranspose, + map_star] at hab + calc x = LinearMap.toContinuousLinearMap (x.toLinearMap) := rfl + _ = LinearMap.toContinuousLinearMap (star (e.toMatrix.symm a)) * a' - + LinearMap.toContinuousLinearMap (star (e.toMatrix.symm b)) * b' := ?_ + _ = star a' * a' - star b' * b' := rfl + · rw [hab, ← toLinearMapAlgEquiv_symm_apply, map_sub, map_mul] + rfl + +universe u + +/-- Data exhibiting a star algebra as equivalent to a finite product of matrix algebras. -/ +structure isEquivToPiMat (A : Type u) [Add A] [Mul A] [Star A] [SMul ℂ A] where + /-- The index type for the product of matrix algebras. -/ + k : Type u + /-- The matrix index type in each summand. -/ + -- hn₁ : Fintype n + -- hn₂ : DecidableEq n + rk : k → Type u + /-- Finiteness of each matrix index type. -/ + hrk₁ : Π i, Fintype (rk i) + /-- Decidable equality for each matrix index type. -/ + hrk₂ : Π i, DecidableEq (rk i) + /-- The star algebra equivalence to the product of matrix algebras. -/ + φ : A ≃⋆ₐ[ℂ] PiMat ℂ k rk +-- attribute [instance] isEquivToPiMat.hn₁ +-- attribute [instance] isEquivToPiMat.hn₂ +attribute [instance] isEquivToPiMat.hrk₁ +attribute [instance] isEquivToPiMat.hrk₂ + +/-- Matrices are trivially equivalent to a one-summand product of matrix algebras. -/ +noncomputable def Matrix.isEquivToPiMat : + isEquivToPiMat (Matrix n n ℂ) := +let f : Matrix n n ℂ ≃⋆ₐ[ℂ] PiMat ℂ PUnit (fun _ => n) := +{ toFun := fun x _ => x + invFun := fun x => x default + left_inv := fun x => rfl + right_inv := fun x => funext (fun i => by cases i; rfl) + map_mul' := fun x y => rfl + map_add' := fun x y => rfl + map_smul' := fun x y => rfl + map_star' := fun x => rfl } +{ k := PUnit + rk := fun _ => n + φ := f + hrk₁ := fun i ↦ by infer_instance + hrk₂ := fun i ↦ by infer_instance } + +omit [StarModule ℂ A] [PartialOrder A] [StarOrderedRing A] in +theorem IsSelfAdjoint.isPositiveDecomposition_of_starAlgEquiv_piMat + (hφ : isEquivToPiMat A) + {x : A} (hx : _root_.IsSelfAdjoint x) : + ∃ a b, x = star a * a - star b * b := +by + have : IsSelfAdjoint (hφ.φ x) := by + rw [IsSelfAdjoint, ← map_star, hx] + obtain ⟨α, β, h⟩ := PiMat.IsSelfAdjoint.posSemidefDecomposition this + use hφ.φ.symm α, hφ.φ.symm β + apply_fun hφ.φ + simp_rw [h, map_sub, map_mul, map_star, StarAlgEquiv.apply_symm_apply] + +omit [Fintype n] [DecidableEq n] in +/-- if a map preserves positivity, then it is star-preserving -/ +theorem Matrix.isReal_of_isPosMap + [Finite n] + {K : Type*} + [Ring K] [StarRing K] [PartialOrder K] [Algebra ℂ K] [StarOrderedRing K] [StarModule ℂ K] + {φ : Matrix n n ℂ →ₗ[ℂ] K} (hφ : LinearMap.IsPosMap φ) : + LinearMap.IsReal φ := +by + classical + letI := Fintype.ofFinite n + intro x + rw [selfAdjointDecomposition x] + let L := aL x + have hL : L = aL x := rfl + let R := aR x + have hR : R = aR x := rfl + rw [← hL, ← hR] + simp only [star_add, map_add, star_smul, _root_.map_smul] + repeat rw [selfAdjointDecomposition_left_isSelfAdjoint _] + suffices h2 : ∀ a (_ : _root_.IsSelfAdjoint a), + φ (star a) = star (φ a) + by + rw [← h2 _ (selfAdjointDecomposition_left_isSelfAdjoint _), + ← h2 _ (selfAdjointDecomposition_right_isSelfAdjoint _), + selfAdjointDecomposition_left_isSelfAdjoint, + selfAdjointDecomposition_right_isSelfAdjoint] + intro x hx + obtain ⟨a, b, rfl⟩ := Matrix.IsHermitian.posSemidefDecomposition' hx + simp only [star_sub, star_mul, star_star, map_sub, ← star_eq_conjTranspose] + rw [IsSelfAdjoint.of_nonneg (hφ (star_mul_self_nonneg a)), + IsSelfAdjoint.of_nonneg (hφ (star_mul_self_nonneg b))] + +theorem StarNonUnitalAlgHom.toLinearMap_apply + {R A B : Type*} [Semiring R] [NonUnitalNonAssocSemiring A] + [Module R A] [NonUnitalNonAssocSemiring B] [Module R B] + [Star A] [Star B] + (f : A →⋆ₙₐ[R] B) (x : A) : (f : A →ₗ[R] B) x = f x := rfl + +theorem LinearMap.isPosMap_iff_star_mul_self_nonneg {A K : Type*} + [NonUnitalSemiring A] [PartialOrder A] [StarRing A] [StarOrderedRing A] + [NonUnitalSemiring K] [PartialOrder K] [StarRing K] [StarOrderedRing K] + (hA : ∀ ⦃a : A⦄, 0 ≤ a ↔ ∃ b, a = star b * b) + {F : Type*} [FunLike F A K] {f : F} : + LinearMap.IsPosMap f ↔ ∀ a : A, 0 ≤ f (star a * a) := +by + refine ⟨fun h a => h (star_mul_self_nonneg _), fun h a => ?_⟩ + · rw [hA] + rintro ⟨b, rfl⟩ + exact h _ + +theorem LinearMap.isPosMap_iff_comp_starAlgEquiv + {K A B : Type*} + [Mul K] [Mul A] [Mul B] [Star K] [Star A] [Star B] + [Zero A] [Zero B] [Zero K] + [PartialOrder A] [PartialOrder B] [PartialOrder K] + (hA : ∀ ⦃a : A⦄, 0 ≤ a ↔ ∃ b, a = star b * b) + (hB : ∀ ⦃a : B⦄, 0 ≤ a ↔ ∃ b, a = star b * b) + {F S : Type*} [FunLike F A K] {φ : F} + [EquivLike S B A] [MulEquivClass S B A] [StarHomClass S B A] + (ψ : S) : + LinearMap.IsPosMap φ ↔ ∀ ⦃x⦄, 0 ≤ x → 0 ≤ φ (ψ x) := +by + simp_rw [IsPosMap, hA, hB] + simp only [forall_exists_index, forall_eq_apply_imp_iff, map_mul, + map_star] + refine ⟨fun h _ => h _, fun h x => ?_⟩ + simpa using h (EquivLike.inv ψ x) + +theorem LinearMap.isReal_iff_comp_starEquiv + {K A B : Type*} + [Star K] [Star A] [Star B] + {F S : Type*} [FunLike F A K] [EquivLike S B A] [StarHomClass S B A] + {φ : F} (ψ : S) : + LinearMap.IsReal φ ↔ ∀ x, φ (ψ (star x)) = star (φ (ψ x)) := +by + simp_rw [map_star] + constructor + · intro h _ + exact h _ + · intro h x + simpa using h (EquivLike.inv ψ x) + +/-- if a map preserves positivity, then it is star-preserving -/ +theorem isReal_of_isPosMap + {K : Type*} + [Ring K] [StarRing K] [PartialOrder K] [Algebra ℂ K] [StarOrderedRing K] [StarModule ℂ K] + {φ : (B →L[ℂ] B) →ₗ[ℂ] K} (hφ : LinearMap.IsPosMap φ) : + LinearMap.IsReal φ := +by + intro x + rw [selfAdjointDecomposition x] + let L := aL x + have hL : L = aL x := rfl + let R := aR x + have hR : R = aR x := rfl + rw [← hL, ← hR] + simp only [star_add, map_add, star_smul, map_smul] + repeat rw [selfAdjointDecomposition_left_isSelfAdjoint _] + suffices h2 : ∀ a (_ : IsSelfAdjoint a), + φ (star a) = star (φ a) + by rw [← h2 _ (selfAdjointDecomposition_left_isSelfAdjoint _), + ← h2 _ (selfAdjointDecomposition_right_isSelfAdjoint _), + selfAdjointDecomposition_left_isSelfAdjoint, + selfAdjointDecomposition_right_isSelfAdjoint] + intro x hx + obtain ⟨a, b, rfl⟩ := hx.isPositiveDecomposition + simp only [star_sub, star_mul, star_star, map_sub] + rw [IsSelfAdjoint.of_nonneg (hφ (star_mul_self_nonneg a)), + IsSelfAdjoint.of_nonneg (hφ (star_mul_self_nonneg b))] + +theorem isReal_of_isPosMap_of_starAlgEquiv_piMat + (hφ : isEquivToPiMat A) + {K : Type*} + [Ring K] [StarRing K] [PartialOrder K] [Algebra ℂ K] [StarOrderedRing K] [StarModule ℂ K] + {f : A →ₗ[ℂ] K} (hf : LinearMap.IsPosMap f) : + LinearMap.IsReal f := +by + intro x + rw [selfAdjointDecomposition x] + let L := aL x + have hL : L = aL x := rfl + let R := aR x + have hR : R = aR x := rfl + rw [← hL, ← hR] + simp only [star_add, map_add, star_smul, map_smul] + repeat rw [selfAdjointDecomposition_left_isSelfAdjoint _] + suffices h2 : ∀ a (_ : IsSelfAdjoint a), + f (star a) = star (f a) + by rw [← h2 _ (selfAdjointDecomposition_left_isSelfAdjoint _), + ← h2 _ (selfAdjointDecomposition_right_isSelfAdjoint _), + selfAdjointDecomposition_left_isSelfAdjoint, + selfAdjointDecomposition_right_isSelfAdjoint] + intro x hx + obtain ⟨a, b, rfl⟩ := hx.isPositiveDecomposition_of_starAlgEquiv_piMat hφ + simp only [star_sub, star_mul, star_star, map_sub] + rw [IsSelfAdjoint.of_nonneg (hf (star_mul_self_nonneg a)), + IsSelfAdjoint.of_nonneg (hf (star_mul_self_nonneg b))] + +/-- a $^*$-homomorphism from $A$ to $B$ is a positive map -/ +theorem starMulHom_isPosMap + {A K : Type*} + [Semiring A] [PartialOrder A] [StarRing A] [StarOrderedRing A] + [Semiring K] [PartialOrder K] [StarRing K] [StarOrderedRing K] + (hA : ∀ ⦃a : A⦄, 0 ≤ a ↔ ∃ b, a = star b * b) + {F : Type*} [FunLike F A K] [StarHomClass F A K] [MulHomClass F A K] + (f : F) : + LinearMap.IsPosMap f := +by + intro a ha + obtain ⟨b, rfl⟩ := hA.mp ha + rw [map_mul, map_star] + exact star_mul_self_nonneg _ + +theorem NonUnitalAlgHom.isPosMap_iff_isReal_of_nonUnitalStarAlgEquiv_piMat + (hφ : isEquivToPiMat A) + (hA : ∀ ⦃a : A⦄, 0 ≤ a ↔ ∃ b, a = star b * b) + {K : Type*} + [Ring K] [StarRing K] [PartialOrder K] [Algebra ℂ K] [StarOrderedRing K] [StarModule ℂ K] + {f : A →ₙₐ[ℂ] K} : + LinearMap.IsPosMap f ↔ LinearMap.IsReal f := +by + have : LinearMap.IsPosMap f ↔ LinearMap.IsPosMap (f : A →ₗ[ℂ] K) := by rfl + refine ⟨fun h => isReal_of_isPosMap_of_starAlgEquiv_piMat hφ (this.mp h), fun h => ?_⟩ + let f' : A →⋆ₙₐ[ℂ] K := NonUnitalStarAlgHom.mk f h + exact starMulHom_isPosMap hA f' + +theorem Matrix.innerAut.map_zpow {n : Type*} [Fintype n] [DecidableEq n] + {𝕜 : Type*} [RCLike 𝕜] (U : ↥(Matrix.unitaryGroup n 𝕜)) (x : Matrix n n 𝕜) (z : ℤ) : + (Matrix.innerAut U) x ^ z = (Matrix.innerAut U) (x ^ z) := +by + induction z using Int.induction_on + · exact map_pow U x 0 + · rename_i i _ + exact map_pow U x (↑i + 1) + · rename_i i _ + calc (innerAut U x ^ (-(i:ℤ)-1)) + = (innerAut U x ^ (i + 1))⁻¹ := + by rw [← Matrix.zpow_neg_natCast, neg_sub_left, add_comm]; rfl + _ = (innerAut U (x ^ (i + 1)))⁻¹ := by rw [innerAut.map_pow] + _ = innerAut U ((x ^ (i + 1))⁻¹) := by rw [map_inv] + _ = innerAut U (x ^ (-(i:ℤ)-1)) := by + rw [← Matrix.zpow_neg_natCast, neg_sub_left, add_comm]; rfl + +lemma Matrix.inv_diagonal' {R n : Type*} [Field R] + [Fintype n] [DecidableEq n] + (d : n → R) [Invertible d] : + (Matrix.diagonal d)⁻¹ = Matrix.diagonal d⁻¹ := +by + haveI := Matrix.diagonalInvertible d + rw [← invOf_eq_nonsing_inv, invOf_diagonal_eq] + simp only [diagonal_eq_diagonal_iff, Pi.inv_apply] + intro + refine eq_inv_of_mul_eq_one_left ?h + rw [← Pi.mul_apply, invOf_mul_self] + rfl + +theorem Matrix.diagonal_zpow + {𝕜 : Type*} [Field 𝕜] (x : n → 𝕜) [Invertible x] (z : ℤ) : + (Matrix.diagonal x) ^ z = Matrix.diagonal (x ^ z) := +by + induction z using Int.induction_on + · simp only [zpow_zero]; rfl + · norm_cast + exact diagonal_pow x _ + · rename_i i _ + rw [neg_sub_left, add_comm] + calc diagonal x ^ (-((i : ℤ)+1)) = (diagonal x ^ (-((i + 1 : ℕ) : ℤ))) := rfl + _ = (diagonal x ^ (i + 1))⁻¹ := by rw [Matrix.zpow_neg_natCast] + _ = (diagonal (x ^ (i + 1)))⁻¹ := by rw [diagonal_pow] + _ = diagonal ((x ^ (i + 1))⁻¹) := by rw [inv_diagonal'] + _ = diagonal ((x ^ ((i : ℤ) + 1))⁻¹) := by norm_cast + _ = diagonal (x ^ (-((i:ℤ)+1))) := by + rw [← _root_.zpow_neg, neg_add] + +theorem Matrix.PosDef.rpow_zpow {𝕜 : Type*} [RCLike 𝕜] + {Q : Matrix n n 𝕜} (hQ : Q.PosDef) (r : ℝ) (z : ℤ) : + (hQ.rpow r) ^ z = hQ.rpow (r * (z : ℝ)) := +by + have := PosDef.rpow.isPosDef hQ r + rw [hQ.rpow_eq, innerAut_posDef_iff, Matrix.PosDef.diagonal_iff] at this + have : Invertible (RCLike.ofReal ∘ (hQ.1.eigenvalues ^ r) : n → 𝕜) := + by + simp only [Function.comp_apply, Pi.pow_apply, RCLike.ofReal_pos] at this + use RCLike.ofReal ∘ (hQ.1.eigenvalues ^ (-r)) + <;> + { ext i + simp only [Pi.mul_apply, Function.comp_apply, Pi.pow_apply, Pi.one_apply, + ← RCLike.ofReal_mul] + rw [← Real.rpow_add (hQ.eigenvalues_pos _)] + simp only [neg_add_cancel, add_neg_cancel, Real.rpow_zero, RCLike.ofReal_one] } + simp_rw [rpow_eq, innerAut.map_zpow, diagonal_zpow] + simp only [innerAut_coe, EmbeddingLike.apply_eq_iff_eq, diagonal_eq_diagonal_iff, + Pi.pow_apply, Function.comp_apply, ← RCLike.ofReal_zpow] + intro i + rw [Real.rpow_mul (le_of_lt (hQ.eigenvalues_pos i))] + norm_cast + +theorem Matrix.PosDef.rpow_eq_pow {𝕜 : Type*} [RCLike 𝕜] + {Q : Matrix n n 𝕜} (hQ : Q.PosDef) (r : ℕ) : + hQ.rpow r = Q ^ r := +by + nth_rw 2 [hQ.1.spectral_theorem''] + simp only [innerAut.map_pow, diagonal_pow] + rw [rpow_eq] + simp only [innerAut_coe, EmbeddingLike.apply_eq_iff_eq, diagonal_eq_diagonal_iff, + Function.comp_apply, Pi.pow_apply, Real.rpow_natCast, + RCLike.ofReal_pow, implies_true] + +theorem Matrix.PosDef.rpow_eq_zpow {𝕜 : Type*} [RCLike 𝕜] + {Q : Matrix n n 𝕜} (hQ : Q.PosDef) (r : ℤ) : + hQ.rpow r = Q ^ r := +by + letI := PosDef.eigenvaluesInvertible' hQ + nth_rw 2 [hQ.1.spectral_theorem''] + simp only [innerAut.map_zpow, diagonal_zpow] + rw [rpow_eq] + simp only [innerAut_coe, EmbeddingLike.apply_eq_iff_eq, diagonal_eq_diagonal_iff, + Function.comp_apply, Pi.pow_apply, Real.rpow_intCast, + RCLike.ofReal_zpow, implies_true] + +theorem Matrix.PosDef.rpow_rzpow {𝕜 : Type*} [RCLike 𝕜] + {Q : Matrix n n 𝕜} (hQ : Q.PosDef) (r : ℝ) (z : ℤ) : + (PosDef.rpow.isPosDef hQ r).rpow z = hQ.rpow (r * (z : ℝ)) := +by rw [rpow_eq_zpow, rpow_zpow] + +theorem Matrix.PosDef.eq_zpow_of_zpow_inv_eq {𝕜 : Type*} [RCLike 𝕜] + {Q R : Matrix n n 𝕜} (hQ : Q.PosDef) + {z : ℤ} (hz : z ≠ 0) + (h : hQ.rpow (z⁻¹) = R) : Q = R ^ z := +by + have : (hQ.rpow z⁻¹) ^ (z : ℤ) = R ^ (z : ℤ) := by rw [h] + rw [rpow_zpow, inv_mul_cancel₀ (Int.cast_ne_zero.mpr hz), rpow_one_eq_self] at this + exact this + +theorem Matrix.PosDef.eq_of_zpow_inv_eq_zpow_inv {𝕜 : Type*} [RCLike 𝕜] + {Q R : Matrix n n 𝕜} (hQ : Q.PosDef) (hR : R.PosDef) + {r : ℤ} (hr : r ≠ 0) (hQR : hQ.rpow r⁻¹ = hR.rpow r⁻¹) : Q = R := +by + have := eq_zpow_of_zpow_inv_eq hQ hr hQR + rw [rpow_zpow, inv_mul_cancel₀ (Int.cast_ne_zero.mpr hr), + rpow_one_eq_self] at this + exact this + +theorem selfAdjointDecomposition_ext_iff + {B : Type*} [AddCommGroup B] [StarAddMonoid B] + [Module ℂ B] [StarModule ℂ B] (a b : B) : + a = b ↔ aL a = aL b ∧ aR a = aR b := +by + refine ⟨fun h => by simp [h], fun h => ?_⟩ + rw [selfAdjointDecomposition a, h.1, h.2] + exact Eq.symm (selfAdjointDecomposition b) + +theorem selfAdjointDecomposition_left_of + {B : Type*} [AddCommGroup B] [StarAddMonoid B] + [Module ℂ B] [StarModule ℂ B] (a b : B) + (ha : IsSelfAdjoint a) (hb : IsSelfAdjoint b) : + aL (a + Complex.I • b) = a := +by + rw [selfAdjointDecomposition_left, star_add, star_smul, ha, hb, + Complex.star_def, Complex.conj_I, neg_smul, add_add_add_comm, add_neg_cancel, add_zero, + ← two_smul ℂ, smul_smul] + norm_num + +theorem selfAdjointDecomposition_right_of + {B : Type*} [AddCommGroup B] [StarAddMonoid B] + [Module ℂ B] [StarModule ℂ B] (a b : B) + (ha : IsSelfAdjoint a) (hb : IsSelfAdjoint b) : + aR (a + Complex.I • b) = b := +by + rw [selfAdjointDecomposition_right, star_add, star_smul, ha, hb, + Complex.star_def, Complex.conj_I, neg_smul, sub_eq_add_neg, + neg_add, add_add_add_comm, add_neg_cancel, zero_add, ← two_smul ℂ] + simp only [smul_smul, smul_neg] + simp only [RCLike.I_to_complex, one_div, isUnit_iff_ne_zero, ne_eq, OfNat.ofNat_ne_zero, + not_false_eq_true, IsUnit.inv_mul_cancel_left, Complex.I_mul_I, neg_smul, one_smul, neg_neg] + +theorem complex_decomposition_mul_decomposition + {B : Type*} [Ring B] [StarRing B] + [Module ℂ B] [StarModule ℂ B] [IsScalarTower ℂ B B] + [SMulCommClass ℂ B B] (a b c d : B) : + (a + Complex.I • b) * (c + Complex.I • d) + = (a * c - b * d) + Complex.I • (b * c + a * d) := +by + simp only [mul_add, add_mul, sub_eq_add_neg, smul_add] + simp only [add_assoc] + congr 1 + simp only [smul_mul_assoc, mul_smul_comm] + nth_rw 1 [← add_assoc, add_comm] + congr 1 + simp only [smul_smul, Complex.I_mul_I, neg_smul, one_smul] + +theorem selfAdjointDecomposition_left_mul_self + {B : Type*} [Ring B] [StarRing B] + [Module ℂ B] [StarModule ℂ B] [IsScalarTower ℂ B B] + [SMulCommClass ℂ B B] (a : B) : + aL (a * a) = aL a * aL a - aR a * aR a := +by + nth_rw 2 [selfAdjointDecomposition a] + nth_rw 1 [selfAdjointDecomposition a] + have : (aL a + RCLike.I • aR a) * (aL a + RCLike.I • aR a) + = _ := + complex_decomposition_mul_decomposition _ _ _ _ + rw [this, selfAdjointDecomposition_left_of] + all_goals { simp only [isSelfAdjoint_iff, star_sub, star_mul, + isSelfAdjoint_iff.mp (selfAdjointDecomposition_left_isSelfAdjoint _), + isSelfAdjoint_iff.mp (selfAdjointDecomposition_right_isSelfAdjoint _), + star_add, add_comm] } +theorem selfAdjointDecomposition_right_mul_self + {B : Type*} [Ring B] [StarRing B] + [Module ℂ B] [StarModule ℂ B] [IsScalarTower ℂ B B] + [SMulCommClass ℂ B B] (a : B) : + aR (a * a) = aR a * aL a + aL a * aR a := +by + nth_rw 2 [selfAdjointDecomposition a] + nth_rw 1 [selfAdjointDecomposition a] + have : (aL a + RCLike.I • aR a) * (aL a + RCLike.I • aR a) + = _ := + complex_decomposition_mul_decomposition _ _ _ _ + rw [this, selfAdjointDecomposition_right_of] + all_goals { simp only [isSelfAdjoint_iff, star_sub, star_mul, + isSelfAdjoint_iff.mp (selfAdjointDecomposition_left_isSelfAdjoint _), + isSelfAdjoint_iff.mp (selfAdjointDecomposition_right_isSelfAdjoint _), + star_add, add_comm] } + +theorem isStarNormal_iff_selfAdjointDecomposition_commute + {B : Type*} [Ring B] [StarRing B] + [Module ℂ B] [StarModule ℂ B] [IsScalarTower ℂ B B] + [SMulCommClass ℂ B B] (p : B) : + IsStarNormal p ↔ Commute (aL p) (aR p) := +by + let a := aL p + let b := aR p + have h : p = a + Complex.I • b := selfAdjointDecomposition _ + have h₁ : p * star p = (a ^ 2 + b ^ 2) + Complex.I • (b * a - a * b) := + by + rw [h, star_add] + nth_rw 2 [star_smul] + rw [Complex.star_def, Complex.conj_I, neg_smul, ← smul_neg, + complex_decomposition_mul_decomposition, + selfAdjointDecomposition_left_isSelfAdjoint, selfAdjointDecomposition_right_isSelfAdjoint, + mul_neg, sub_neg_eq_add, mul_neg, sub_eq_add_neg] + simp only [pow_two] + rfl + have h₂ : star p * p = (a ^ 2 + b ^ 2) + Complex.I • (a * b - b * a) := + by + rw [h, star_add] + nth_rw 2 [star_smul] + rw [Complex.star_def, Complex.conj_I, neg_smul, ← smul_neg, + complex_decomposition_mul_decomposition, + selfAdjointDecomposition_left_isSelfAdjoint, selfAdjointDecomposition_right_isSelfAdjoint, + neg_mul, sub_neg_eq_add, neg_mul] + simp_rw [sub_eq_add_neg, pow_two] + nth_rw 3 [add_comm] + have h₃ := + calc IsStarNormal p ↔ p * star p = star p * p := + by rw [isStarNormal_iff, commute_iff_eq, eq_comm] + _ ↔ Complex.I • (b * a - a * b) = Complex.I • (a * b - b * a) := + by rw [h₁, h₂, add_left_cancel_iff] + _ ↔ b * a - a * b = a * b - b * a := smul_right_inj Complex.I_ne_zero + _ ↔ (2 : ℂ) • (b * a) = (2 : ℂ) • (a * b) := + by simp only [two_smul, sub_eq_iff_eq_add, sub_add_eq_add_sub, eq_sub_iff_add_eq] + _ ↔ b * a = a * b := smul_right_inj two_ne_zero + _ ↔ a * b = b * a := eq_comm + exact h₃ + +theorem isSelfAdjoint_iff_selfAdjointDecomposition_right_eq_zero + {B : Type*} [Ring B] [StarRing B] + [Module ℂ B] [StarModule ℂ B] [IsScalarTower ℂ B B] + [SMulCommClass ℂ B B] (p : B) : + IsSelfAdjoint p ↔ aR p = 0 := +by + simp only [isSelfAdjoint_iff, RCLike.I_to_complex, isUnit_iff_ne_zero, ne_eq, Complex.I_ne_zero, + not_false_eq_true, IsUnit.smul_eq_zero, one_div, inv_eq_zero, OfNat.ofNat_ne_zero, sub_eq_zero] + +theorem IsIdempotentElem.isSelfAdjoint_iff_isStarNormal + {V : Type*} [NormedAddCommGroup V] [InnerProductSpace ℂ V] + (p : V →L[ℂ] V) (hp : IsIdempotentElem p) [CompleteSpace V] : + IsSelfAdjoint p ↔ IsStarNormal p := +by + constructor + · intro h + rw [isStarNormal_iff, h] + · intro h + have h : IsStarNormal (1 - p) := + by + { simp only [isStarNormal_iff, commute_iff_eq, star_sub, star_one, + mul_sub, sub_mul, mul_one, one_mul] + simp only [sub_eq_add_neg, add_assoc, neg_add, neg_neg] + rw [(isStarNormal_iff _).mp h] + rw [← add_assoc, add_add_add_comm, add_assoc] } + have := (ContinuousLinearMap.IsStarNormal.norm_eq_adjoint _).mp h + have := + calc + p = Star.star p * p ↔ ∀ x, ‖(p - (Star.star p * p)) x‖ = 0 := by + simp only [norm_eq_zero, ContinuousLinearMap.sub_apply, sub_eq_zero] + rw [@ContinuousLinearMap.ext_iff] + _ ↔ ∀ x, ‖(ContinuousLinearMap.adjoint (1 - p)) (p x)‖ = 0 := by + simp only [← ContinuousLinearMap.star_eq_adjoint, star_sub, star_one, + ContinuousLinearMap.sub_apply, ContinuousLinearMap.mul_apply] + rfl + _ ↔ ∀ x, ‖(1 - p) (p x)‖ = 0 := by simp only [this] + _ ↔ ∀ x, ‖(p - p * p) x‖ = 0 := by simp + _ ↔ p - p * p = 0 := by + simp only [norm_eq_zero, ContinuousLinearMap.ext_iff, ContinuousLinearMap.zero_apply] + _ ↔ IsIdempotentElem p := by simp only [sub_eq_zero, IsIdempotentElem, eq_comm] + rw [this.mpr hp] + exact IsSelfAdjoint.star_mul_self _ + +open scoped InnerProductSpace +theorem LinearMap.IsPositive'.add_ker_eq_inf_ker + {𝕜 V : Type*} [RCLike 𝕜] [NormedAddCommGroup V] [InnerProductSpace 𝕜 V] + [FiniteDimensional 𝕜 V] {S T : V →ₗ[𝕜] V} (hS : S.IsPositive') (hT : T.IsPositive') : + LinearMap.ker (S + T) = LinearMap.ker S ⊓ LinearMap.ker T := +by + ext x + simp only [LinearMap.mem_ker, LinearMap.add_apply, Submodule.mem_inf] + refine ⟨fun h => ?_, fun h => by rw [h.1, h.2, add_zero]⟩ + rw [eq_comm, ← sub_eq_iff_eq_add, eq_comm, zero_sub] at h + rw [h, neg_eq_zero, and_self] + have : ⟪x, S x⟫_𝕜 = 0 := le_antisymm + (by rw [h, inner_neg_right, neg_le, neg_zero]; exact hT.2 x) + (hS.2 x) + obtain ⟨f, rfl⟩ := (LinearMap.isPositive'_iff_exists_adjoint_hMul_self _).mp hS + simp only [Module.End.mul_apply, LinearMap.adjoint_inner_right, inner_self_eq_zero] at this + simp only [Module.End.mul_apply, this, map_zero, zero_eq_neg] at h + exact h + +theorem mem_unitary_iff_isStarNormal_and_decomposition_left_sq_add_right_sq_eq_one + {B : Type*} [Ring B] [StarRing B] + [Module ℂ B] [StarModule ℂ B] [IsScalarTower ℂ B B] + [SMulCommClass ℂ B B] (a : B) : + a ∈ unitary B ↔ IsStarNormal a ∧ (aL a) ^ 2 + (aR a) ^ 2 = 1 := +by + have this1 := + calc a * star a = (aL a + Complex.I • aR a) * star (aL a + Complex.I • aR a) := + by simp_rw [← RCLike.I_to_complex, ← selfAdjointDecomposition] + _ = (aL a * aL a + aR a * aR a) + Complex.I • ((aR a * aL a) - (aL a * aR a)) := + by + rw [star_add] + nth_rw 2 [star_smul] + rw [Complex.star_def, Complex.conj_I, neg_smul, + isSelfAdjoint_iff.mp (selfAdjointDecomposition_left_isSelfAdjoint _), + isSelfAdjoint_iff.mp (selfAdjointDecomposition_right_isSelfAdjoint _), + ← smul_neg] + simp_rw [complex_decomposition_mul_decomposition, mul_neg, sub_neg_eq_add, + sub_eq_add_neg] + _ = ((aL a) ^ 2 + (aR a) ^ 2) + Complex.I • (aR a * aL a - aL a * aR a) := + by simp only [pow_two, smul_sub] + rw [Unitary.mem_iff] + constructor + · intro h + have : Commute (aL a) (aR a) := + by rw [← isStarNormal_iff_selfAdjointDecomposition_commute, isStarNormal_iff, commute_iff_eq, + h.1, h.2] + simp_rw [isStarNormal_iff_selfAdjointDecomposition_commute, this, true_and] + rw [this1, this, sub_self, smul_zero, add_zero] at h + exact h.2 + · rintro ⟨h1, h2⟩ + rw [(isStarNormal_iff _).mp h1, and_self, this1, h2, add_comm] + apply add_eq_of_eq_sub + rw [sub_self, smul_eq_zero, sub_eq_zero] + right + exact ((isStarNormal_iff_selfAdjointDecomposition_commute _).mp h1).symm + +theorem LinearMap.exists_scalar_isometry_iff_preserves_ortho_of_ne_zero + {𝕜 V W : Type*} [RCLike 𝕜] + [NormedAddCommGroup V] [InnerProductSpace 𝕜 V] + [NormedAddCommGroup W] [InnerProductSpace 𝕜 W] + (hV : 0 < Module.finrank 𝕜 V) + {T : V →ₗ[𝕜] W} (hT : T ≠ 0) : + (∃ (α : 𝕜ˣ), Isometry ((α : 𝕜) • T)) + ↔ + ∀ x y, ⟪x, y⟫_𝕜 = 0 → ⟪T x, T y⟫_𝕜 = 0 := +by + haveI : Nontrivial V := Module.nontrivial_of_finrank_pos hV + constructor + · rintro ⟨α, h⟩ x y hxy + have : ⟪T x, T y⟫_𝕜 = 0 ↔ ⟪((α : 𝕜) • T) x, ((α : 𝕜) • T) y⟫_𝕜 = 0 := + by + simp_rw [LinearMap.smul_apply, inner_smul_right, inner_smul_left, + ← mul_assoc, RCLike.mul_conj, mul_eq_zero, sq_eq_zero_iff, + RCLike.ofReal_eq_zero, norm_eq_zero] + simp only [Units.ne_zero, false_or] + rw [this, (isometry_iff_inner _).mp h, hxy] + · intro h + haveI : FiniteDimensional 𝕜 V := Module.finite_of_finrank_pos hV + let e := stdOrthonormalBasis 𝕜 V + have : ∀ i j, ⟪e i + e j, e i - e j⟫_𝕜 = 0 := + fun i j => by + simp only [inner_add_left, inner_sub_right, + orthonormal_iff_ite.mp (e.orthonormal)] + simp only [↓reduceIte, eq_comm] + ring + have h' : ∀ i j, ⟪T (e i), T (e j)⟫_𝕜 = + if i = j then ((‖T (e i)‖ ^ 2) : 𝕜) else 0 := + fun i j => by + split_ifs with h' + · simp only [h', inner_self_eq_norm_sq_to_K] + · apply h + simp only [orthonormal_iff_ite.mp (e.orthonormal), h', reduceIte] + have this' := fun i j => h _ _ (this i j) + simp only [map_add, map_sub, inner_add_left, inner_sub_right, h', + reduceIte, add_ite, ite_add, eq_comm, ite_sub_ite] at this' + simp only [sub_self, add_zero, zero_add] at this' + simp_rw [@eq_comm _ (0 : 𝕜), ite_eq_iff, and_true, sub_eq_zero] at this' + let α : ℝ := ‖T (e ⟨0, hV⟩)‖ + simp only [← RCLike.ofReal_pow, RCLike.ofReal_inj, + sq_eq_sq₀ (norm_nonneg _) (norm_nonneg _)] at this' + have hα : ∀ i, α = ‖T (e i)‖ := fun i => by + by_cases hi : i = ⟨0, hV⟩ + · rw [hi] + · specialize this' ⟨0, hV⟩ i + simp only [hi, eq_comm, false_or, not_false_iff, true_and] at this' + simp only [α, this'] + have : ∀ x, ‖T x‖ = α * ‖x‖ := + fun x => by + simp_rw [hα ⟨0, hV⟩] + rw [← sq_eq_sq₀ (norm_nonneg _) (mul_nonneg (norm_nonneg _) (norm_nonneg _)), + ← RCLike.ofReal_inj (K := 𝕜), RCLike.ofReal_pow, + mul_pow, RCLike.ofReal_mul, RCLike.ofReal_pow, ← hα, RCLike.ofReal_pow] + rw [← OrthonormalBasis.sum_repr e x] + simp_rw [← inner_self_eq_norm_sq_to_K] + simp only [map_sum, map_smul, sum_inner, inner_smul_left, + inner_sum, inner_smul_right, h', mul_ite, mul_zero, + Finset.sum_ite_eq', Finset.mem_univ, if_true, ← hα] + simp only [← mul_assoc, RCLike.mul_conj, orthonormal_iff_ite.mp (e.orthonormal), + mul_boole, Finset.sum_ite_eq', Finset.mem_univ, if_true] + simp_rw [← Finset.sum_mul, mul_comm] + have hα' : α = 0 ↔ T = 0 := + by + constructor + · intro h + simp_rw [h, zero_mul, norm_eq_zero] at this + ext x + simp only [LinearMap.zero_apply, this] + · intro h + simp only [h, LinearMap.zero_apply, norm_zero, @eq_comm _ (0 : ℝ), + mul_eq_zero, norm_eq_zero] at this + obtain ⟨x, hx⟩ : ∃ x : V, x ≠ 0 := by exact exists_ne 0 + specialize this x + simp only [hx, or_false] at this + exact this + simp only [hT, iff_false, ← ne_eq] at hα' + have hα'' : (α : 𝕜) ≠ 0 := by simp only [ne_eq, algebraMap.coe_eq_zero_iff, hα', + not_false_iff] + use ((Units.mk0 α hα'')⁻¹ : 𝕜ˣ) + rw [isometry_iff_norm] + intro x + simp only [LinearMap.smul_apply, norm_smul, this] + simp only [Units.val_inv_eq_inv_val, Units.val_mk0, norm_inv, RCLike.norm_ofReal] + simp only [abs_of_nonneg (norm_nonneg _), + ← hα, α, ← mul_assoc, inv_mul_cancel₀ hα', one_mul] + +theorem LinearMap.exists_scalar_isometry_iff_preserves_ortho + {𝕜 V : Type*} [RCLike 𝕜] + [NormedAddCommGroup V] [InnerProductSpace 𝕜 V] + [Module.Finite 𝕜 V] + {T : V →ₗ[𝕜] V} : + (∃ (α : 𝕜) (S : V →ₗᵢ[𝕜] V), T = α • S.toLinearMap) + ↔ + ∀ x y, ⟪x, y⟫_𝕜 = 0 → ⟪T x, T y⟫_𝕜 = 0 := +by + constructor + · rintro ⟨α, S, h⟩ x y hxy + simp only [h, LinearMap.smul_apply, inner_smul_left, inner_smul_right, + LinearIsometry.coe_toLinearMap, LinearIsometry.inner_map_map, hxy, mul_zero] + · intro h + by_cases hT : T = 0 + · rw [hT] + use 0, 1 + simp only [zero_smul] + · by_cases hV : Module.rank 𝕜 V = 0 + · rw [rank_zero_iff_forall_zero] at hV + simp only [LinearMap.ext_iff, + hV, implies_true, exists_true_iff_nonempty] + use 0, 0 + simp only [norm_zero, hV, implies_true] + · simp only [← pos_iff_ne_zero] at hV + rw [rank_pos_iff_nontrivial] at hV + have : 0 < Module.finrank 𝕜 V := Module.finrank_pos + obtain ⟨α, hα⟩ := + (LinearMap.exists_scalar_isometry_iff_preserves_ortho_of_ne_zero this hT).mpr h + use (α⁻¹ : 𝕜ˣ), ⟨((α : 𝕜) • T), (isometry_iff_norm _).mp hα⟩ + simp only [Units.val_inv_eq_inv_val, ne_eq, Units.ne_zero, not_false_eq_true, + inv_smul_smul₀] + +theorem LinearMap.isSymmetric_adjoint_mul_self' + {𝕜 V W : Type*} [RCLike 𝕜] [NormedAddCommGroup V] [InnerProductSpace 𝕜 V] + [NormedAddCommGroup W] [InnerProductSpace 𝕜 W] + [FiniteDimensional 𝕜 V] [FiniteDimensional 𝕜 W] + (T : V →ₗ[𝕜] W) : + IsSymmetric (LinearMap.adjoint T ∘ₗ T) := +by + intro x y + simp only [coe_comp, Function.comp_apply, adjoint_inner_left, adjoint_inner_right] diff --git a/LeanPool/Monlib4/LinearAlgebra/QuantumSet.lean b/LeanPool/Monlib4/LinearAlgebra/QuantumSet.lean new file mode 100644 index 0000000000..fe4c8dfa4e --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/QuantumSet.lean @@ -0,0 +1,16 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Basic +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.DeltaForm +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Instances +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.PhiMap +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Pi +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.QIso +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.SchurMul +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.SchurMulTensor +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Subset +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Symm +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.TensorProduct diff --git a/LeanPool/Monlib4/LinearAlgebra/QuantumSet/Basic.lean b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/Basic.lean new file mode 100644 index 0000000000..fea051ba6f --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/Basic.lean @@ -0,0 +1,1014 @@ +/- +Copyright (c) 2024 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import Mathlib.Analysis.InnerProductSpace.Adjoint +import Mathlib.Analysis.InnerProductSpace.Orthonormal +import Mathlib.Analysis.InnerProductSpace.PiL2 +import Mathlib.Analysis.RCLike.Basic +import Mathlib.Data.Complex.Basic +import Mathlib.LinearAlgebra.FiniteDimensional.Basic +import Mathlib.LinearAlgebra.TensorProduct.Basis +import Mathlib.Tactic.Ring +import LeanPool.Monlib4.LinearAlgebra.Coalgebra.FiniteDimensional +import LeanPool.Monlib4.LinearAlgebra.Ips.MulOp +import LeanPool.Monlib4.LinearAlgebra.Ips.OpUnop +import LeanPool.Monlib4.LinearAlgebra.LmulRmul + +/-! +# Quantum Sets + +This file ports the structural core of upstream `Monlib.LinearAlgebra.QuantumSet.Basic`: +star algebras with modular automorphisms, inner-product algebras, quantum sets, +the base quantum set on `ℂ`, modular inner-product identities, the coalgebra +comultiplication on `ℂ`, and the `Psi`/`Upsilon` equivalences used by +downstream quantum-graph files. +-/ + +/-- A star algebra over `ℂ` equipped with a real-parameter modular automorphism group. -/ +class starAlgebra (A : Type _) extends + Ring A, Algebra ℂ A, StarRing A, StarModule ℂ A where + /-- The modular automorphism `σ_r` as an algebra equivalence. -/ + modAut : Π _ : ℝ, A ≃ₐ[ℂ] A + /-- The modular automorphisms compose additively in the real parameter. -/ + modAut_trans : ∀ r s, (modAut r).trans (modAut s) = modAut (r + s) + /-- Star changes the sign of the modular parameter. -/ + modAut_star : ∀ r x, star (modAut r x) = modAut (-r) (star x) + +attribute [instance] starAlgebra.toRing +attribute [instance] starAlgebra.toAlgebra +attribute [instance] starAlgebra.toStarRing +attribute [instance] starAlgebra.toStarModule +attribute [simp] starAlgebra.modAut_trans +attribute [simp] starAlgebra.modAut_star +export starAlgebra (modAut) + +theorem starAlgebra.modAut_zero {A : Type*} [hA : starAlgebra A] : + hA.modAut 0 = 1 := by + ext x + have := hA.modAut_trans 0 1 + rw [zero_add, AlgEquiv.ext_iff] at this + specialize this x + apply_fun (modAut 1).symm at this + simp only [AlgEquiv.trans_apply, AlgEquiv.symm_apply_apply] at this + exact this + +@[simp] +theorem starAlgebra.modAut_apply_modAut {A : Type*} [ha : starAlgebra A] + (t r : ℝ) (a : A) : + ha.modAut t (ha.modAut r a) = ha.modAut (t + r) a := by + rw [← AlgEquiv.trans_apply, starAlgebra.modAut_trans, add_comm] + +@[simp] +theorem starAlgebra.modAut_symm {A : Type*} [ha : starAlgebra A] (r : ℝ) : + (ha.modAut r).symm = ha.modAut (-r) := by + ext + apply_fun (ha.modAut r) using AlgEquiv.injective _ + simp only [AlgEquiv.apply_symm_apply, modAut_apply_modAut, add_neg_cancel, ha.modAut_zero] + rfl + +attribute [simp] starAlgebra.modAut_zero + +/-- A star algebra whose ring additive group carries a compatible complex inner product. -/ +class InnerProductAlgebra (A : Type*) [starAlgebra A] + extends Norm A, MetricSpace A, Inner ℂ A where + norm_smul_le : ∀ (c : ℂ) (x : A), ‖c • x‖ ≤ ‖c‖ * ‖x‖ + norm_sq_eq_inner : ∀ x : A, ‖x‖ ^ 2 = RCLike.re (inner x x) + dist_eq : ∀ x y : A, dist x y = ‖-x + y‖ := by aesop + conj_symm : ∀ x y : A, starRingEnd ℂ (inner y x) = inner x y + add_left : ∀ x y z : A, inner (x + y) z = inner x z + inner y z + smul_left : ∀ x y : A, ∀ r : ℂ, inner (r • x) y = starRingEnd ℂ r * inner x y + +noncomputable instance InnerProductAlgebra.toNormedAddCommGroup {A : Type*} + [starAlgebra A] [InnerProductAlgebra A] : + NormedAddCommGroup A where + dist_eq := InnerProductAlgebra.dist_eq + +noncomputable instance InnerProductAlgebra.toNormedAddCommGroupOfRing {A : Type*} + [starAlgebra A] [InnerProductAlgebra A] : + NormedAddCommGroupOfRing A where + dist_eq := InnerProductAlgebra.dist_eq + +noncomputable instance InnerProductAlgebra.toNormedSpace {A : Type*} [starAlgebra A] + [InnerProductAlgebra A] : + NormedSpace ℂ A where + toModule := inferInstance + norm_smul_le := InnerProductAlgebra.norm_smul_le + +instance InnerProductAlgebra.toNormSMulClass {A : Type*} [starAlgebra A] + [InnerProductAlgebra A] : + NormSMulClass ℂ A := + NormedSpace.toNormSMulClass + +noncomputable instance InnerProductAlgebra.toInnerProductSpace {A : Type*} + [starAlgebra A] [InnerProductAlgebra A] : + InnerProductSpace ℂ A where + toNormedSpace := InnerProductAlgebra.toNormedSpace + norm_sq_eq_re_inner := InnerProductAlgebra.norm_sq_eq_inner + conj_inner_symm := InnerProductAlgebra.conj_symm + add_left := InnerProductAlgebra.add_left + smul_left := InnerProductAlgebra.smul_left + +open scoped InnerProductSpace +open scoped TensorProduct + +/-- A finite-dimensional quantum set with a modular automorphism and fixed orthonormal basis. -/ +class QuantumSet (A : Type _) [ha : starAlgebra A] + extends InnerProductAlgebra A where + /-- The modular automorphism is symmetric for the quantum-set inner product. -/ + modAut_isSymmetric : ∀ r x y, ⟪ha.modAut r x, y⟫_ℂ = ⟪x, ha.modAut r y⟫_ℂ + /-- The modular exponent used in the KMS identities. -/ + k : ℝ + inner_star_left : ∀ x y z : A, ⟪x * y, z⟫_ℂ = ⟪y, ha.modAut (-k) (star x) * z⟫_ℂ + inner_conj_left : ∀ x y z : A, ⟪x * y, z⟫_ℂ = ⟪x, z * ha.modAut (-k-1) (star y)⟫_ℂ + /-- The index type of the fixed orthonormal basis. -/ + n : Type* + /-- The fixed basis index type is finite. -/ + n_isFintype : Fintype n + /-- The fixed basis index type has decidable equality. -/ + n_isDecidableEq : DecidableEq n + /-- A fixed orthonormal basis of the quantum set. -/ + onb : OrthonormalBasis n ℂ A + +attribute [instance] QuantumSet.toInnerProductAlgebra +attribute [reducible, instance] QuantumSet.n_isFintype +attribute [reducible, instance] QuantumSet.n_isDecidableEq +attribute [simp] QuantumSet.inner_star_left +attribute [simp] QuantumSet.modAut_isSymmetric + +export QuantumSet (n onb k) + +variable {A : Type*} [ha : _root_.starAlgebra A] + +/-- The fixed basis index type of a quantum set is finite. -/ +instance n_isFinite [QuantumSet A] : Finite (n A) := by + infer_instance + +/-- A quantum set is finite-dimensional over `ℂ` via its fixed orthonormal basis. -/ +instance QuantumSet.toFinite [hA : QuantumSet A] : + Module.Finite ℂ A := by + exact Module.Finite.of_basis hA.onb.toBasis + +lemma QuantumSet.modAut_isSelfAdjoint [hA : QuantumSet A] (r : ℝ) : + IsSelfAdjoint (ha.modAut r).toLinearMap := by + rw [← LinearMap.isSymmetric_iff_isSelfAdjoint] + exact modAut_isSymmetric _ + +alias QuantumSet.modAut_apply_modAut := starAlgebra.modAut_apply_modAut + +lemma QuantumSet.inner_conj [QuantumSet A] (a b : A) : + ⟪a, b⟫_ℂ = ⟪star b, ha.modAut (-(2 * k A) - 1) (star a)⟫_ℂ := +calc + ⟪a, b⟫_ℂ = ⟪1 * a, b⟫_ℂ := by rw [one_mul] + _ = ⟪1, b * ha.modAut (-k A - 1) (star a)⟫_ℂ := by rw [inner_conj_left] + _ = starRingEnd ℂ ⟪b * ha.modAut (-k A - 1) (star a), 1⟫_ℂ := by + rw [inner_conj_symm] + _ = starRingEnd ℂ ⟪ha.modAut (-k A - 1) (star a), ha.modAut (-k A) (star b)⟫_ℂ := by + rw [inner_star_left, mul_one] + _ = ⟪star b, ha.modAut (-(2 * k A) - 1) (star a)⟫_ℂ := by + rw [inner_conj_symm, modAut_isSymmetric, modAut_apply_modAut] + ring_nf + +lemma QuantumSet.inner_conj' [QuantumSet A] (a b : A) : + ⟪a, b⟫_ℂ = ⟪ha.modAut (-(2 * k A) - 1) (star b), star a⟫_ℂ := by + rw [inner_conj, modAut_isSymmetric] + +lemma QuantumSet.inner_modAut_right_conj [QuantumSet A] (a b : A) : + ⟪a, ha.modAut (-k A) (star b)⟫_ℂ = + ⟪b, ha.modAut (-k A - 1) (star a)⟫_ℂ := by + nth_rw 1 [← one_mul a] + rw [inner_conj_left, ← inner_star_left, mul_one] + +lemma QuantumSet.inner_conj'' [QuantumSet A] (a b : A) : + ⟪a, b⟫_ℂ = + ⟪ha.modAut ((-(2 * k A) - 1) / 2) (star b), + ha.modAut ((-(2 * k A) - 1) / 2) (star a)⟫_ℂ := +calc + ⟪a, b⟫_ℂ = ⟪ha.modAut (-(2 * k A) - 1) (star b), star a⟫_ℂ := by + rw [inner_conj'] + _ = ⟪ha.modAut ((-(2 * k A) - 1) / 2) + (ha.modAut ((-(2 * k A) - 1) / 2) (star b)), star a⟫_ℂ := by + rw [modAut_apply_modAut] + norm_num + _ = ⟪ha.modAut ((-(2 * k A) - 1) / 2) (star b), + ha.modAut ((-(2 * k A) - 1) / 2) (star a)⟫_ℂ := by + rw [modAut_isSymmetric] + +section Complex + +noncomputable instance Complex.starAlgebra : starAlgebra ℂ where + modAut _ := 1 + modAut_trans _ _ := rfl + modAut_star _ _ := rfl + +noncomputable instance : InnerProductAlgebra ℂ where + norm_smul_le _ _ := norm_smul_le _ _ + norm_sq_eq_inner := norm_sq_eq_re_inner + dist_eq x y := by + rw [dist_eq_norm'] + congr 1 + abel + conj_symm := inner_conj_symm + add_left := inner_add_left + smul_left := inner_smul_left + +noncomputable instance Complex.quantumSet : QuantumSet ℂ where + modAut_isSymmetric _ _ _ := rfl + k := 0 + inner_star_left x y z := by + simp_rw [RCLike.inner_apply, modAut, RCLike.star_def, AlgEquiv.one_apply, mul_comm, map_mul] + ring + inner_conj_left x y z := by + simp_rw [RCLike.inner_apply, modAut, map_mul, RCLike.star_def, AlgEquiv.one_apply, mul_comm z] + rw [mul_assoc, mul_comm] + n := Fin 1 + n_isFintype := Fin.fintype 1 + n_isDecidableEq := inferInstance + onb := by + refine (Module.Basis.singleton (Fin 1) ℂ).toOrthonormalBasis (orthonormal_iff_ite.mpr ?_) + intro i j + simp_rw [Fin.fin_one_eq_zero, Module.Basis.singleton_apply, + RCLike.inner_apply, map_one, mul_one, if_true] + +theorem RCLike.inner_tmul {𝕜 : Type*} [RCLike 𝕜] (x y z w : 𝕜) : + ⟪x ⊗ₜ[𝕜] y, z ⊗ₜ[𝕜] w⟫_𝕜 = ⟪x * y, z * w⟫_𝕜 := by + simp only [TensorProduct.inner_tmul, inner_apply, map_mul] + rw [mul_mul_mul_comm] + +theorem TensorProduct.singleton_tmul + {R : Type*} {E : Type*} {F : Type*} [CommSemiring R] + [AddCommGroup E] [Module R E] [AddCommGroup F] [Module R F] + (x : E ⊗[R] F) (b₁ : Module.Basis (Fin 1) R E) (b₂ : Module.Basis (Fin 1) R F) : + ∃ (a : E) (b : F), x = a ⊗ₜ[R] b := by + use (b₁.tensorProduct b₂).repr x (0, 0) • b₁ 0, b₂ 0 + have := TensorProduct.of_basis_eq_span x b₁ b₂ + simp only [Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Finset.sum_singleton] at this + rw [← TensorProduct.smul_tmul'] + exact this + +theorem RCLike.inner_tensor_apply {𝕜 : Type*} [RCLike 𝕜] (x y : 𝕜 ⊗[𝕜] 𝕜) : + ⟪x, y⟫_𝕜 = ⟪LinearMap.mul' 𝕜 _ x, LinearMap.mul' 𝕜 _ y⟫_𝕜 := by + obtain ⟨α, β, rfl⟩ := + x.singleton_tmul (Module.Basis.singleton (Fin 1) 𝕜) (Module.Basis.singleton (Fin 1) 𝕜) + obtain ⟨α2, β2, rfl⟩ := + y.singleton_tmul (Module.Basis.singleton (Fin 1) 𝕜) (Module.Basis.singleton (Fin 1) 𝕜) + simp only [LinearMap.mul'_apply, RCLike.inner_tmul] + +@[simp] +theorem QuantumSet.complex_modAut : + Complex.starAlgebra.modAut = 1 := +rfl + +theorem QuantumSet.complex_comul : + (Coalgebra.comul : ℂ →ₗ[ℂ] ℂ ⊗[ℂ] ℂ) = (TensorProduct.lid ℂ ℂ).symm.toLinearMap := by + ext + rw [TensorProduct.inner_ext_iff'] + intro a b + rw [Coalgebra.comul_eq_mul_adjoint, LinearMap.adjoint_inner_left, LinearMap.mul'_apply] + simp [RCLike.inner_apply] + +end Complex + +/-- Modular automorphisms preserve the coalgebra structure of a quantum set. -/ +theorem QuantumSet.modAut_isCoalgHom + {A : Type*} [hA : starAlgebra A] [QuantumSet A] (r : ℝ) : + LinearMap.IsCoalgHom (AlgEquiv.toLinearMap (hA.modAut r)) := by + rw [← modAut_isSelfAdjoint, LinearMap.star_eq_adjoint] + simp_rw [LinearMap.isCoalgHom_iff, Coalgebra.counit_eq_unit_adjoint, + Coalgebra.comul_eq_mul_adjoint, ← TensorProduct.map_adjoint, ← LinearMap.adjoint_comp, + Function.Injective.eq_iff (LinearEquiv.injective _), TensorProduct.ext_iff', + LinearMap.ext_iff, LinearMap.comp_apply, TensorProduct.map_tmul, LinearMap.mul'_apply] + simp only [Algebra.linearMap_apply, AlgEquiv.toLinearMap_apply, map_mul, implies_true, + and_true, Algebra.algebraMap_eq_smul_one, map_smul, map_one] + +/-- A quantum set carries the Frobenius algebra structure induced by its coalgebra. -/ +@[reducible, instance] +noncomputable def QuantumSet.isFrobeniusAlgebra [QuantumSet A] : + FrobeniusAlgebra ℂ A := + FiniteDimensionalCoAlgebra_isFrobeniusAlgebra_of + ⟨fun x => ha.modAut (-k A) (star x), fun x y z => inner_star_left x y z⟩ + +variable {B : Type*} [hb : _root_.starAlgebra B] + +theorem lmul_adjoint [hB : QuantumSet B] (a : B) : + LinearMap.adjoint (lmul a : B →ₗ[ℂ] B) = lmul (modAut (-hB.k) (star a)) := by + rw [LinearMap.ext_iff_inner_map] + intro u + simp_rw [LinearMap.adjoint_inner_left, lmul_apply, + QuantumSet.inner_star_left, + starAlgebra.modAut_star, star_star, neg_neg, QuantumSet.modAut_apply_modAut, neg_add_cancel, + starAlgebra.modAut_zero, AlgEquiv.one_apply] + +lemma QuantumSet.inner_eq_counit' [QuantumSet B] : + (⟪(1 : B), ·⟫_ℂ) = Coalgebra.counit := by + simp_rw [Coalgebra.counit] + ext + apply ext_inner_left ℂ + intro a + simp_rw [LinearMap.adjoint_inner_right, Algebra.linearMap_apply, + Algebra.algebraMap_eq_smul_one, inner_smul_left] + rw [RCLike.inner_apply'] + +lemma QuantumSet.inner_eq_counit [QuantumSet B] (x y : B) : + ⟪x, y⟫_ℂ = Coalgebra.counit (star x * modAut (k B) y) := by + simp_rw [← inner_eq_counit'] + nth_rw 2 [← inner_conj_symm] + rw [inner_star_left, star_star, inner_conj_symm, mul_one, + modAut_isSymmetric, modAut_apply_modAut, neg_add_cancel, hb.modAut_zero, + AlgEquiv.one_apply] + +open Coalgebra in +theorem counit_mul_modAut_symm' [hA : QuantumSet A] (a b : A) (r : ℝ) : + counit (a * ha.modAut r b) = (counit (ha.modAut (r + 1) b * a) : ℂ) := by + simp_rw [← QuantumSet.inner_eq_counit'] + nth_rw 1 [← inner_conj_symm] + simp_rw [hA.inner_conj_left, one_mul, ha.modAut_star, QuantumSet.modAut_apply_modAut, + inner_conj_symm, ← neg_add_eq_sub, ← neg_add, ← ha.modAut_star, + QuantumSet.inner_eq_counit', hA.inner_eq_counit, star_star] + calc + counit ((modAut (1 + k A + r)) b * (modAut (k A)) a) + = counit (modAut (k A) (modAut (1 + r) b * a)) := by + simp_rw [map_mul, QuantumSet.modAut_apply_modAut] + ring_nf + _ = counit (modAut (r + 1) b * a) := by + rw [← AlgEquiv.toLinearMap_apply, ← LinearMap.comp_apply, + (QuantumSet.modAut_isCoalgHom _).1, add_comm] + +theorem rmul_adjoint [hB : QuantumSet B] (a : B) : + LinearMap.adjoint (rmul a : B →ₗ[ℂ] B) = + rmul (modAut (-hB.k - 1) (star a)) := by + rw [LinearMap.ext_iff_inner_map] + intro u + simp_rw [LinearMap.adjoint_inner_left, rmul_apply] + nth_rw 1 [← inner_conj_symm] + rw [hB.inner_conj_left, inner_conj_symm] + +theorem counit_comp_mul_comp_rTensor_modAut [QuantumSet A] : + Coalgebra.counit ∘ₗ LinearMap.mul' ℂ A ∘ₗ LinearMap.rTensor A (modAut 1).toLinearMap + = Coalgebra.counit ∘ₗ LinearMap.mul' ℂ A ∘ₗ (TensorProduct.comm ℂ _ _).toLinearMap := by + apply TensorProduct.ext' + intro x y + simp only [LinearMap.comp_apply, LinearMap.rTensor_tmul, LinearEquiv.coe_coe, + TensorProduct.comm_tmul, LinearMap.mul'_apply, AlgEquiv.toLinearMap_apply] + have := counit_mul_modAut_symm' y x 0 + rw [zero_add, ha.modAut_zero, AlgEquiv.one_apply] at this + exact this.symm + +theorem counit_comp_mul_comp_lTensor_modAut [QuantumSet A] : + Coalgebra.counit ∘ₗ LinearMap.mul' ℂ A ∘ₗ LinearMap.lTensor A (modAut (-1)).toLinearMap + = Coalgebra.counit ∘ₗ LinearMap.mul' ℂ A ∘ₗ (TensorProduct.comm ℂ _ _).toLinearMap := by + apply TensorProduct.ext' + intro x y + simp only [LinearMap.comp_apply, LinearMap.lTensor_tmul, LinearEquiv.coe_coe, + TensorProduct.comm_tmul, LinearMap.mul'_apply, AlgEquiv.toLinearMap_apply, + counit_mul_modAut_symm', neg_add_cancel, ha.modAut_zero, AlgEquiv.one_apply] + +namespace QuantumSet + +open scoped TensorProduct + +/-- The matrix-coordinate map used to identify linear maps with a tensor product. -/ +noncomputable def Psi_toFun [hA : QuantumSet A] [hB : QuantumSet B] + (t r : ℝ) : + (A →ₗ[ℂ] B) →ₗ[ℂ] (B ⊗[ℂ] Aᵐᵒᵖ) where + toFun x := + ∑ a, ∑ b, + (LinearMap.toMatrix hA.onb.toBasis hB.onb.toBasis) x a b • + hb.modAut t (hB.onb a) ⊗ₜ[ℂ] MulOpposite.op (star (ha.modAut r (hA.onb b))) + map_add' x y := by simp_rw [map_add, Matrix.add_apply, add_smul, Finset.sum_add_distrib] + map_smul' r x := by + simp_rw [_root_.map_smul, Matrix.smul_apply, smul_eq_mul, ← smul_smul, ← Finset.smul_sum, + RingHom.id_apply] + +theorem Psi_toFun_apply [hA : QuantumSet A] [hB : QuantumSet B] + (t r : ℝ) (b : A) (a : B) : + Psi_toFun t r (rankOne ℂ a b).toLinearMap = + hb.modAut t a ⊗ₜ[ℂ] MulOpposite.op (star (ha.modAut r b)) := by + simp_rw [Psi_toFun, LinearMap.coe_mk, AddHom.coe_mk, + LinearMap.toMatrix_apply, OrthonormalBasis.coe_toBasis_repr_apply, + OrthonormalBasis.repr_apply_apply, + ContinuousLinearMap.coe_coe, rankOne_apply, inner_smul_right, OrthonormalBasis.coe_toBasis, + mul_comm ⟪b, _⟫_ℂ, ← TensorProduct.smul_tmul_smul, ← MulOpposite.op_smul, + ← inner_conj_symm b, starRingEnd_apply, ← star_smul, + ← _root_.map_smul, ← TensorProduct.tmul_sum, ← TensorProduct.sum_tmul, + ← Finset.op_sum, ← star_sum, ← map_sum, ← OrthonormalBasis.repr_apply_apply, + OrthonormalBasis.sum_repr] + +local notation "|" a "⟩⟨" b "|" => @rankOne ℂ _ _ _ _ _ _ _ a b + +/-- The inverse coordinate map to `QuantumSet.Psi_toFun`. -/ +noncomputable def Psi_invFun [hA : QuantumSet A] [hB : QuantumSet B] + (t r : ℝ) : + (A ⊗[ℂ] Bᵐᵒᵖ) →ₗ[ℂ] (B →ₗ[ℂ] A) where + toFun x := + ∑ a, ∑ b, + (hA.onb.toBasis.tensorProduct hB.onb.toBasis.mulOpposite).repr x (a, b) • + (↑|ha.modAut (-t) (hA.onb a)⟩⟨hb.modAut (-r) (star (hB.onb b))|) + map_add' x y := by simp_rw [_root_.map_add, Finsupp.add_apply, add_smul, Finset.sum_add_distrib] + map_smul' r x := by + simp_rw [_root_.map_smul, Finsupp.smul_apply, smul_eq_mul, ← smul_smul, ← Finset.smul_sum, + RingHom.id_apply] + +theorem Psi_invFun_apply [hA : QuantumSet A] [hB : QuantumSet B] + (t r : ℝ) (x : A) (y : Bᵐᵒᵖ) : + Psi_invFun t r (x ⊗ₜ[ℂ] y) = + |ha.modAut (-t) x⟩⟨hb.modAut (-r) (star (MulOpposite.unop y))| := by + simp_rw [Psi_invFun, LinearMap.coe_mk, AddHom.coe_mk, + Module.Basis.tensorProduct_repr_tmul_apply, + smul_eq_mul, mul_comm, + ← rankOne_lm_smul_smul, ← rankOne_lm_sum_sum, ← + _root_.map_smul, ← star_smul, Basis.mulOpposite_repr_apply, ← map_sum, ← star_sum, + OrthonormalBasis.coe_toBasis_repr_apply, OrthonormalBasis.sum_repr] + +theorem Psi_left_inv [hA : QuantumSet A] [hB : QuantumSet B] + (t r : ℝ) (x : B) (y : A) : + Psi_invFun (A := B) (B := A) t r (Psi_toFun t r |x⟩⟨y|) = + (|x⟩⟨y|).toLinearMap := by + simp_rw [Psi_toFun_apply, Psi_invFun_apply, MulOpposite.unop_op, star_star, modAut_apply_modAut, + neg_add_cancel, starAlgebra.modAut_zero] + simp only [AlgEquiv.one_apply] + +theorem Psi_right_inv [hA : QuantumSet A] [hB : QuantumSet B] + (t r : ℝ) (x : B) (y : Aᵐᵒᵖ) : + Psi_toFun (A := A) (B := B) t r + (Psi_invFun (A := B) (B := A) t r (x ⊗ₜ[ℂ] y)) = + x ⊗ₜ[ℂ] y := by + rw [Psi_invFun_apply, Psi_toFun_apply] + simp_rw [modAut_apply_modAut, add_neg_cancel, starAlgebra.modAut_zero] + simp only [AlgEquiv.one_apply, star_star, MulOpposite.op_unop] + +/-- The linear equivalence between maps and tensors used in the quantum-set formalism. -/ +@[simps] +noncomputable def Psi [hA : QuantumSet A] [hB : QuantumSet B] + (t r : ℝ) : (A →ₗ[ℂ] B) ≃ₗ[ℂ] (B ⊗[ℂ] Aᵐᵒᵖ) where + toFun x := Psi_toFun t r x + invFun x := Psi_invFun (A := B) (B := A) t r x + left_inv x := by + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne x + simp only [map_sum, Psi_left_inv] + right_inv x := by + obtain ⟨α, β, rfl⟩ := x.eq_span + simp only [Psi_right_inv, map_sum] + map_add' x y := by simp_rw [map_add] + map_smul' r x := by + simp_rw [_root_.map_smul] + rfl + +end QuantumSet + +open QuantumSet + +theorem LinearMap.adjoint_real_eq [hA : QuantumSet A] [hB : QuantumSet B] + (f : A →ₗ[ℂ] B) : + (LinearMap.adjoint f).real = + (ha.modAut (2 * hA.k + 1)).toLinearMap ∘ₗ + (LinearMap.adjoint f.real) ∘ₗ (hb.modAut (-(2 * hB.k) - 1)).toLinearMap := by + ext x + apply ext_inner_right ℂ + intro u + calc + ⟪(LinearMap.adjoint f).real x, u⟫_ℂ + = ⟪f (ha.modAut (-(2 * hA.k) - 1) (star u)), star x⟫_ℂ := by + rw [LinearMap.real_apply, QuantumSet.inner_conj'] + simp only [star_star] + rw [LinearMap.adjoint_inner_right] + _ = ⟪hb.modAut (-(2 * hB.k) - 1) x, + star (f (ha.modAut (-(2 * hA.k) - 1) (star u)))⟫_ℂ := by + rw [QuantumSet.inner_conj'] + simp + _ = ⟪((ha.modAut (2 * hA.k + 1)).toLinearMap ∘ₗ LinearMap.adjoint f.real ∘ₗ + (hb.modAut (-(2 * hB.k) - 1)).toLinearMap) x, u⟫_ℂ := by + symm + simp only [LinearMap.comp_apply, AlgEquiv.toLinearMap_apply] + rw [QuantumSet.modAut_isSymmetric] + rw [LinearMap.adjoint_inner_left] + simp only [LinearMap.real_apply, starAlgebra.modAut_star] + ring_nf + +lemma QuantumSet.modAut_adjoint [QuantumSet A] (r : ℝ) : + LinearMap.adjoint (ha.modAut r).toLinearMap = (ha.modAut r).toLinearMap := by + rw [← LinearMap.isSelfAdjoint_iff'] + exact QuantumSet.modAut_isSelfAdjoint r + +theorem QuantumSet.modAut_real [QuantumSet A] (r : ℝ) : + (ha.modAut r).toLinearMap.real = (ha.modAut (-r)).toLinearMap := by + ext + simp_rw [LinearMap.real_apply, AlgEquiv.toLinearMap_apply, ha.modAut_star, star_star] + +local notation "|" a "⟩⟨" b "|" => @rankOne ℂ _ _ _ _ _ _ _ a b + +lemma rankOne_real [QuantumSet A] [hB : QuantumSet B] (a : A) (b : B) : + LinearMap.real |a⟩⟨b| = + (|star a⟩⟨hb.modAut (-(2 * hB.k) - 1) (star b)|).toLinearMap := by + ext x + simp only [ContinuousLinearMap.coe_coe, LinearMap.real_apply, rankOne_apply, star_smul] + rw [QuantumSet.inner_conj, star_star] + simp only [← starRingEnd_apply, inner_conj_symm] + +open LinearMap in +lemma _root_.QuantumSet.rTensor_mul_comp_lTensor_comul_eq_comul_comp_mul + [QuantumSet A] : + rTensor A (mul' ℂ A) ∘ₗ (TensorProduct.assoc ℂ _ _ _).symm.toLinearMap + ∘ₗ lTensor A (Coalgebra.comul) = + Coalgebra.comul ∘ₗ mul' ℂ A := by + exact FrobeniusAlgebra.rTensor_mul_comp_lTensor_comul_eq_comul_comp_mul + (R := ℂ) (A := A) + +open LinearMap in +lemma _root_.QuantumSet.lTensor_mul_comp_rTensor_comul_eq_comul_comp_mul + [QuantumSet A] : + lTensor A (mul' ℂ A) ∘ₗ (TensorProduct.assoc ℂ _ _ _).toLinearMap + ∘ₗ rTensor A (Coalgebra.comul) = + Coalgebra.comul ∘ₗ mul' ℂ A := by + exact FrobeniusAlgebra.lTensor_mul_comp_rTensor_comul_eq_comul_comp_mul + (R := ℂ) (A := A) + +open scoped TensorProduct +open LinearMap in +theorem _root_.QuantumSet.rTensor_counit_mul_comp_comm_comp_rTensor_comul_unit_eq_modAut_one + [QuantumSet A] : + (TensorProduct.lid ℂ A).toLinearMap + ∘ₗ rTensor A (Coalgebra.counit ∘ₗ mul' ℂ A) + ∘ₗ (TensorProduct.assoc ℂ _ _ _).symm.toLinearMap + ∘ₗ lTensor A (TensorProduct.comm ℂ _ _).toLinearMap + ∘ₗ (TensorProduct.assoc ℂ _ _ _).toLinearMap + ∘ₗ rTensor A (Coalgebra.comul ∘ₗ Algebra.linearMap ℂ A) + ∘ₗ (TensorProduct.lid ℂ A).symm.toLinearMap = + (ha.modAut 1).toLinearMap := by + ext + apply ext_inner_left ℂ + intro + simp only [coe_comp, LinearEquiv.coe_coe, Function.comp_apply, + TensorProduct.lid_symm_apply, rTensor_tmul, Algebra.linearMap_apply, map_one, + AlgEquiv.toLinearMap_apply] + obtain ⟨α, β, h⟩ := TensorProduct.eq_span (Coalgebra.comul 1 : A ⊗[ℂ] A) + simp_rw [← h, TensorProduct.sum_tmul, map_sum, inner_sum] + simp only [TensorProduct.assoc_tmul, lTensor_tmul, LinearEquiv.coe_coe, + TensorProduct.comm_tmul, TensorProduct.assoc_symm_tmul, rTensor_tmul, + LinearMap.comp_apply, mul'_apply, ← QuantumSet.inner_eq_counit', + TensorProduct.lid_tmul, inner_smul_right, ← inner_conj_symm (1 : A), + QuantumSet.inner_conj_left, one_mul] + simp_rw [inner_conj_symm, ← TensorProduct.inner_tmul, ← inner_sum, h, + Coalgebra.comul_eq_mul_adjoint, LinearMap.adjoint_inner_right, mul'_apply, + QuantumSet.inner_star_left, starAlgebra.modAut_star, modAut_apply_modAut, neg_sub, + sub_neg_eq_add, mul_one, star_star] + ring_nf + +open LinearMap in +theorem _root_.QuantumSet.lTensor_counit_mul_comp_comm_comp_lTensor_comul_unit_eq_modAut_neg_one + [QuantumSet A] : + (TensorProduct.rid ℂ A).toLinearMap + ∘ₗ lTensor A (Coalgebra.counit ∘ₗ mul' ℂ A) + ∘ₗ (TensorProduct.assoc ℂ _ _ _).toLinearMap + ∘ₗ rTensor A (TensorProduct.comm ℂ _ _).toLinearMap + ∘ₗ (TensorProduct.assoc ℂ _ _ _).symm.toLinearMap + ∘ₗ lTensor A (Coalgebra.comul ∘ₗ Algebra.linearMap ℂ A) + ∘ₗ (TensorProduct.rid ℂ A).symm.toLinearMap = + (ha.modAut (-1)).toLinearMap := by + ext + apply ext_inner_left ℂ + intro + simp only [coe_comp, LinearEquiv.coe_coe, Function.comp_apply, + TensorProduct.rid_symm_apply, lTensor_tmul, Algebra.linearMap_apply, map_one, + AlgEquiv.toLinearMap_apply] + obtain ⟨α, β, h⟩ := TensorProduct.eq_span (Coalgebra.comul 1 : A ⊗[ℂ] A) + simp_rw [← h, TensorProduct.tmul_sum, map_sum, inner_sum] + simp only [TensorProduct.assoc_tmul, lTensor_tmul, LinearEquiv.coe_coe, + TensorProduct.comm_tmul, TensorProduct.assoc_symm_tmul, rTensor_tmul, + LinearMap.comp_apply, mul'_apply, ← QuantumSet.inner_eq_counit', + TensorProduct.rid_tmul, inner_smul_right, ← inner_conj_symm (1 : A), + QuantumSet.inner_star_left, mul_one] + simp_rw [inner_conj_symm, mul_comm, ← TensorProduct.inner_tmul, ← inner_sum, h, + Coalgebra.comul_eq_mul_adjoint, LinearMap.adjoint_inner_right, mul'_apply, + QuantumSet.inner_conj_left, one_mul, starAlgebra.modAut_star, neg_neg, + modAut_apply_modAut, star_star] + ring_nf + +open LinearMap in +lemma _root_.QuantumSet.counit_tensor_star_left_eq_bra [QuantumSet A] (x : A) : + Coalgebra.counit ∘ mul' ℂ A ∘ ((modAut (-k A)) (star x) ⊗ₜ[ℂ] ·) = + bra ℂ x := by + ext + simp only [Function.comp_apply, mul'_apply, innerSL_apply_apply] + nth_rw 1 [← (QuantumSet.modAut_isCoalgHom (A := A) (r := k A)).1] + simp only [LinearMap.comp_apply, AlgEquiv.toLinearMap_apply, map_mul, + modAut_apply_modAut, add_neg_cancel, starAlgebra.modAut_zero, AlgEquiv.one_apply] + exact Eq.symm (QuantumSet.inner_eq_counit _ _) + +open LinearMap in +lemma _root_.QuantumSet.mul_comp_tensor_left_unit_eq_ket [QuantumSet A] (x : A) : + mul' ℂ A ∘ (x ⊗ₜ[ℂ] ·) ∘ Algebra.linearMap ℂ A = ket ℂ x := by + ext + simp only [Function.comp_apply, Algebra.linearMap_apply, mul'_apply, ket_apply_apply, + Algebra.algebraMap_eq_smul_one, mul_smul_one] + +open LinearMap starAlgebra in +lemma _root_.QuantumSet.rTensor_bra_comul_unit_eq_ket_star [hA : QuantumSet A] (x : A) : + (TensorProduct.lid ℂ _).toLinearMap + ∘ₗ (rTensor A (bra ℂ x)) ∘ₗ Coalgebra.comul ∘ₗ Algebra.linearMap ℂ A = + ket ℂ (modAut (-hA.k) (star x)) := by + ext + apply ext_inner_left ℂ + intro + simp only [coe_comp, LinearEquiv.coe_coe, Function.comp_apply, Algebra.linearMap_apply, + map_one, ContinuousLinearMap.coe_coe, ket_apply_apply, one_smul] + obtain ⟨α, β, h⟩ := TensorProduct.eq_span (Coalgebra.comul 1 : A ⊗[ℂ] A) + simp_rw [← h, map_sum, inner_sum, rTensor_tmul, ContinuousLinearMap.coe_coe, + bra_apply_apply, TensorProduct.lid_tmul, inner_smul_right, ← TensorProduct.inner_tmul, + ← inner_sum, h, Coalgebra.comul_eq_mul_adjoint, adjoint_inner_right, mul'_apply, + QuantumSet.inner_star_left, mul_one] + +open LinearMap starAlgebra in +lemma _root_.QuantumSet.rTensor_bra_comul_unit_eq_ket_star' [hA : QuantumSet A] (x : A) : + (TensorProduct.lid ℂ _).toLinearMap + ∘ₗ (rTensor A (bra ℂ (modAut (-hA.k) x))) ∘ₗ Coalgebra.comul + ∘ₗ Algebra.linearMap ℂ A = + ket ℂ (star x) := by + rw [QuantumSet.rTensor_bra_comul_unit_eq_ket_star, modAut_star, + starAlgebra.modAut_apply_modAut, neg_neg, neg_add_cancel, modAut_zero] + rfl + +open LinearMap in +lemma _root_.QuantumSet.counit_mul_rTensor_ket_eq_bra_star [hA : QuantumSet A] (x : A) : + Coalgebra.counit ∘ₗ mul' ℂ A ∘ₗ (rTensor A (ket ℂ x)) + ∘ₗ (TensorProduct.lid ℂ _).symm.toLinearMap = + bra ℂ (modAut (-hA.k) (star x)) := by + apply_fun LinearMap.adjoint using LinearEquiv.injective _ + simp only [adjoint_comp, TensorProduct.lid_symm_adjoint, rTensor_adjoint] + simp only [ContinuousLinearMap.linearMap_adjoint, ket_adjoint_eq_bra, + bra_adjoint_eq_ket, ← Coalgebra.comul_eq_mul_adjoint, + Coalgebra.counit_eq_unit_adjoint, adjoint_adjoint, comp_assoc] + rw [← QuantumSet.rTensor_bra_comul_unit_eq_ket_star x] + congr + ext + rfl + +theorem ket_real {𝕜 A : Type*} [RCLike 𝕜] [NormedAddCommGroup A] + [InnerProductSpace 𝕜 A] [StarAddMonoid A] [StarModule 𝕜 A] (x : A) : + LinearMap.real (ket 𝕜 x) = (ket 𝕜 (star x)).toLinearMap := by + ext + simp only [LinearMap.real_apply, star_one, ContinuousLinearMap.coe_coe, ket_one_apply] + +theorem bra_real [hA : QuantumSet A] (x : A) : + LinearMap.real (bra ℂ x) = + (bra ℂ (ha.modAut (-(2 * hA.k) - 1) (star x))).toLinearMap := by + ext + simp only [LinearMap.real_apply, ContinuousLinearMap.coe_coe, bra_apply_apply, + RCLike.star_def, inner_conj_symm] + rw [QuantumSet.inner_conj, star_star, QuantumSet.modAut_isSymmetric] + +theorem ket_toMatrix {𝕜 A : Type*} [RCLike 𝕜] [NormedAddCommGroup A] + [InnerProductSpace 𝕜 A] {ι : Type*} [Finite ι] (b : Module.Basis ι 𝕜 A) (x : A) : + LinearMap.toMatrix (Module.Basis.singleton Unit 𝕜) b (ket 𝕜 x) = + Matrix.replicateCol Unit (b.repr x) := by + letI := Fintype.ofFinite ι + ext + simp only [Matrix.replicateCol_apply, LinearMap.toMatrix_apply, + Module.Basis.singleton_apply, ContinuousLinearMap.coe_coe, ket_apply_apply, one_smul] + +open scoped Matrix +theorem bra_toMatrix {𝕜 A : Type*} [RCLike 𝕜] [NormedAddCommGroup A] + [InnerProductSpace 𝕜 A] {ι : Type*} [Fintype ι] [DecidableEq ι] + (b : OrthonormalBasis ι 𝕜 A) (x : A) : + LinearMap.toMatrix b.toBasis (Module.Basis.singleton Unit 𝕜) (bra 𝕜 x) = + (Matrix.replicateCol Unit (b.repr x))ᴴ := by + ext + simp only [Matrix.conjTranspose_replicateCol, Matrix.replicateRow_apply, Pi.star_apply, + RCLike.star_def, LinearMap.toMatrix_apply, OrthonormalBasis.coe_toBasis, + ContinuousLinearMap.coe_coe, innerSL_apply_apply, Module.Basis.singleton_repr, + OrthonormalBasis.repr_apply_apply, inner_conj_symm] + +open Matrix in +theorem lmul_toMatrix_apply {n : Type*} [Fintype n] [DecidableEq n] + (x : n → ℂ) (i j : n) : + LinearMap.toMatrix' (LinearMap.mulLeft ℂ x) i j = ite (i = j) (x i) 0 := by + by_cases h : i = j + · subst j + simp [LinearMap.toMatrix'_apply, LinearMap.mulLeft_apply] + · simp [LinearMap.toMatrix'_apply, LinearMap.mulLeft_apply, h] + +theorem rankOne_trace {𝕜 A : Type*} [RCLike 𝕜] [NormedAddCommGroup A] + [InnerProductSpace 𝕜 A] [Module.Finite 𝕜 A] (x y : A) : + LinearMap.trace 𝕜 A (rankOne 𝕜 x y).toLinearMap = ⟪y, x⟫_𝕜 := by + rw [← ket_bra_eq_rankOne, ContinuousLinearMap.coe_comp, LinearMap.trace_comp_comm', + ← ContinuousLinearMap.coe_comp, bra_ket_apply] + rw [LinearMap.trace_eq_matrix_trace 𝕜 (Module.Basis.singleton Unit 𝕜), ket_toMatrix, + Matrix.trace] + simp only [Finset.univ_unique, PUnit.default_eq_unit, Matrix.diag_apply, + Matrix.replicateCol_apply, Module.Basis.singleton_repr, Finset.sum_const, + Finset.card_singleton, one_smul] + +lemma _root_.LinearMap.apply_eq_id {R M : Type*} [Semiring R] [AddCommMonoid M] + [Module R M] {f : M →ₗ[R] M} : + (∀ x, f x = x) ↔ f = 1 := by + simp_rw [LinearMap.ext_iff, Module.End.one_apply] + +theorem _root_.QuantumSet.starAlgEquiv_is_isometry_tfae [QuantumSet A] [QuantumSet B] + (f : A ≃⋆ₐ[ℂ] B) : + List.TFAE + [ LinearMap.adjoint f.toLinearMap = f.symm.toLinearMap, + ∀ x y, ⟪f x, f y⟫_ℂ = ⟪x, y⟫_ℂ, + ∀ x, ‖f x‖ = ‖x‖, + Isometry f ] := by + tfae_have 3 ↔ 1 := by + simp_rw [@norm_eq_sqrt_re_inner ℂ, Real.sqrt_inj inner_self_nonneg inner_self_nonneg, + ← @RCLike.ofReal_inj ℂ, @inner_self_re ℂ, ← @sub_eq_zero _ _ _ ⟪_, _⟫_ℂ] + have : + ∀ x y, + ⟪f x, f y⟫_ℂ - ⟪x, y⟫_ℂ = + ⟪(LinearMap.adjoint f.toLinearMap ∘ₗ f.toLinearMap - 1) x, y⟫_ℂ := by + intro x y + simp only [LinearMap.sub_apply, Module.End.one_apply, inner_sub_left, + LinearMap.comp_apply, LinearMap.adjoint_inner_left, StarAlgEquiv.toLinearMap_apply] + simp_rw [this, inner_map_self_eq_zero, sub_eq_zero, StarAlgEquiv.comp_eq_iff, + LinearMap.one_comp] + rw [tfae_3_iff_1] + simp_rw [← StarAlgEquiv.toLinearMap_apply, ← LinearMap.adjoint_inner_left, + ← ext_inner_left_iff, ← LinearMap.comp_apply, _root_.LinearMap.apply_eq_id, + StarAlgEquiv.comp_eq_iff, LinearMap.one_comp] + rw [AddMonoidHomClass.isometry_iff_norm] + tfae_finish + +theorem _root_.QuantumSet.starAlgEquiv_isometry_iff_adjoint_eq_symm + [QuantumSet A] [QuantumSet B] {f : A ≃⋆ₐ[ℂ] B} : + Isometry f ↔ LinearMap.adjoint f.toLinearMap = f.symm.toLinearMap := + List.TFAE.out (QuantumSet.starAlgEquiv_is_isometry_tfae f) 3 0 + +theorem QuantumSet.starAlgEquiv_isometry_iff_coalgHom [hA : QuantumSet A] [hB : QuantumSet B] + (gns₁ : hA.k = 0) (gns₂ : hB.k = 0) {f : A ≃⋆ₐ[ℂ] B} : + Isometry f ↔ Coalgebra.counit ∘ₗ f.toLinearMap = Coalgebra.counit := by + simp_rw [isometry_iff_inner, QuantumSet.inner_eq_counit, ← map_star f, + LinearMap.ext_iff, LinearMap.comp_apply, StarAlgEquiv.toLinearMap_apply, + gns₁, gns₂, starAlgebra.modAut_zero, AlgEquiv.one_apply, ← map_mul] + refine ⟨fun h x => ?_, fun h x y => h _⟩ + rw [← one_mul x, ← star_one] + exact h _ _ + +theorem _root_.StarAlgEquiv.isReal {R A B : Type*} [Semiring R] + [AddCommMonoid A] [AddCommMonoid B] [Mul A] [Mul B] [Module R A] + [Module R B] [Star A] [Star B] (f : A ≃⋆ₐ[R] B) : + LinearMap.IsReal f.toLinearMap := by + intro x + simp only [StarAlgEquiv.toLinearMap_apply, map_star] + +theorem _root_.AlgEquiv.linearMap_comp_eq_iff + {R E₁ E₂ E₃ : Type*} [CommSemiring R] [Semiring E₁] [Semiring E₂] + [AddCommMonoid E₃] [Algebra R E₁] [Algebra R E₂] [Module R E₃] + (f : E₁ ≃ₐ[R] E₂) (x : E₂ →ₗ[R] E₃) (y : E₁ →ₗ[R] E₃) : + x ∘ₗ f.toLinearMap = y ↔ x = y ∘ₗ f.symm.toLinearMap := by + aesop + +theorem _root_.AlgEquiv.comp_linearMap_eq_iff + {R E₁ E₂ E₃ : Type*} [CommSemiring R] [Semiring E₁] [Semiring E₂] + [AddCommMonoid E₃] [Algebra R E₁] [Algebra R E₂] [Module R E₃] + (f : E₁ ≃ₐ[R] E₂) (x : E₃ →ₗ[R] E₁) (y : E₃ →ₗ[R] E₂) : + f.toLinearMap ∘ₗ x = y ↔ x = f.symm.toLinearMap ∘ₗ y := by + aesop + +theorem _root_.QuantumSet.starAlgEquiv_commutes_with_modAut_of_isometry + [QuantumSet A] [QuantumSet B] {f : A ≃⋆ₐ[ℂ] B} (hf : Isometry f) : + (modAut ((2 * k A) + 1)).trans f.toAlgEquiv = + f.toAlgEquiv.trans (modAut ((2 * k B) + 1)) := by + rw [QuantumSet.starAlgEquiv_isometry_iff_adjoint_eq_symm] at hf + have := LinearMap.adjoint_real_eq f.toLinearMap + rw [← neg_sub] at this + simp only [sub_neg_eq_add, LinearMap.real_of_isReal (StarAlgEquiv.isReal _), hf] at this + simp only [← LinearMap.comp_assoc, ← starAlgebra.modAut_symm, + ← AlgEquiv.linearMap_comp_eq_iff] at this + apply_fun LinearMap.adjoint at this + simp only [LinearMap.adjoint_comp, ← hf, LinearMap.adjoint_adjoint, + QuantumSet.modAut_adjoint] at this + simp only [LinearMap.ext_iff, LinearMap.comp_apply, StarAlgEquiv.toLinearMap_apply, + AlgEquiv.toLinearMap_apply] at this + simp only [AlgEquiv.ext_iff, AlgEquiv.trans_apply, StarAlgEquiv.coe_toAlgEquiv] + nth_rw 2 [add_comm] + exact fun x => (this x).symm + +theorem _root_.QuantumSet.starAlgEquiv_commutes_with_modAut_of_isometry' + [QuantumSet A] [QuantumSet B] {f : A ≃⋆ₐ[ℂ] B} (hf : Isometry f) : + f.toLinearMap.comp (modAut ((2 * k A) + 1)).toLinearMap = + (modAut ((2 * k B) + 1)).toLinearMap.comp f.toLinearMap := by + have := QuantumSet.starAlgEquiv_commutes_with_modAut_of_isometry hf + simp only [AlgEquiv.ext_iff, AlgEquiv.trans_apply, LinearMap.ext_iff, + LinearMap.comp_apply, StarAlgEquiv.coe_toAlgEquiv, StarAlgEquiv.toLinearMap_apply, + AlgEquiv.toLinearMap_apply] at this ⊢ + exact this + +theorem QuantumSet.Psi_apply_one_one [QuantumSet A] [QuantumSet B] (t r : ℝ) : + QuantumSet.Psi t r (rankOne ℂ (1 : B) (1 : A)) = (1 : B ⊗[ℂ] Aᵐᵒᵖ) := by + simp only [Psi_apply, Psi_toFun_apply, _root_.map_one, + star_one, MulOpposite.op_one, Algebra.TensorProduct.one_def] + +theorem QuantumSet.Psi_symm_apply_one [QuantumSet A] [QuantumSet B] (t r : ℝ) : + (QuantumSet.Psi t r).symm (1 : A ⊗[ℂ] Bᵐᵒᵖ) = rankOne ℂ (1 : A) (1 : B) := by + rw [← QuantumSet.Psi_apply_one_one t r, LinearEquiv.symm_apply_apply] + +/-- The `Psi` equivalence with tensor factors swapped back from the opposite space. -/ +@[simps!] +noncomputable abbrev Upsilon [QuantumSet A] [QuantumSet B] : + (A →ₗ[ℂ] B) ≃ₗ[ℂ] (A ⊗[ℂ] B) := + (Psi 0 (k A + 1)).trans ((tenSwap ℂ).trans (LinearEquiv.lTensor _ (unop ℂ))) + +theorem Upsilon_apply_one_one [QuantumSet A] [QuantumSet B] : + Upsilon (rankOne ℂ (1 : B) (1 : A)) = (1 : A ⊗[ℂ] B) := by + rw [Upsilon, LinearEquiv.trans_apply, QuantumSet.Psi_apply_one_one] + rfl + +theorem Upsilon_symm_apply_one [QuantumSet A] [QuantumSet B] : + Upsilon.symm (1 : A ⊗[ℂ] B) = rankOne ℂ (1 : B) (1 : A) := by + rw [← Upsilon_apply_one_one, LinearEquiv.symm_apply_apply] + +private noncomputable def tenSwap_Psi_aux [QuantumSet A] [QuantumSet B] : + (A →ₗ[ℂ] B) →ₗ[ℂ] (B ⊗[ℂ] Aᵐᵒᵖ) where + toFun f := + tenSwap ℂ ((LinearMap.lTensor A ((op ℂ).toLinearMap ∘ₗ f)) (Coalgebra.comul 1)) + map_add' x y := by + rw [LinearMap.comp_add, LinearMap.lTensor_add, LinearMap.add_apply] + exact (tenSwap ℂ).map_add _ _ + map_smul' r x := by + rw [LinearMap.comp_smul, LinearMap.lTensor_smul, LinearMap.smul_apply] + exact (tenSwap ℂ).map_smulₛₗ r _ + +private lemma tenSwap_Psi_aux_apply [QuantumSet A] [QuantumSet B] (f : A →ₗ[ℂ] B) : + tenSwap_Psi_aux f = + tenSwap ℂ + ((LinearMap.lTensor A ((op ℂ).toLinearMap ∘ₗ f)) (Coalgebra.comul 1)) := + rfl + +theorem tenSwap_lTensor_comul_one_eq_Psi [QuantumSet A] [QuantumSet B] (f : A →ₗ[ℂ] B) : + tenSwap ℂ ((LinearMap.lTensor A ((op ℂ).toLinearMap ∘ₗ f)) (Coalgebra.comul 1)) = + Psi 0 (k A + 1) f := by + rw [← tenSwap_Psi_aux_apply, ← LinearEquiv.coe_toLinearMap] + revert f + rw [← LinearMap.ext_iff] + apply LinearMap.ext_of_rank_one' + intro x y + rw [TensorProduct.inner_ext_iff'] + intro a b + simp only [LinearEquiv.coe_coe, Psi_apply, Psi_toFun_apply, tenSwap_Psi_aux_apply, + starAlgebra.modAut_zero, AlgEquiv.one_apply] + obtain ⟨α, β, h⟩ := TensorProduct.eq_span (Coalgebra.comul 1 : A ⊗[ℂ] A) + rw [← h] + simp_rw [map_sum, LinearMap.lTensor_tmul, LinearMap.comp_apply, + LinearEquiv.coe_toLinearMap, op_apply, tenSwap_apply', ContinuousLinearMap.coe_coe, + rankOne_apply, ← TensorProduct.smul_tmul', sum_inner, inner_smul_left, + inner_conj_symm, TensorProduct.inner_tmul, MulOpposite.inner_eq, + MulOpposite.unop_op, mul_comm _ (_ * _), mul_assoc, ← Finset.mul_sum, + ← TensorProduct.inner_tmul, ← sum_inner, h, Coalgebra.comul_eq_mul_adjoint, + LinearMap.adjoint_inner_left, LinearMap.mul'_apply, TensorProduct.inner_tmul, + inner_eq_counit, star_star, star_one, one_mul, map_mul, ← counit_mul_modAut_symm'] + +private noncomputable def map_op_comul_one_aux [QuantumSet A] [QuantumSet B] : + (A →ₗ[ℂ] B) →ₗ[ℂ] (B ⊗[ℂ] Aᵐᵒᵖ) where + toFun f := (TensorProduct.map f (op ℂ).toLinearMap) (Coalgebra.comul 1) + map_add' x y := by simp only [TensorProduct.map_add_left, LinearMap.add_apply] + map_smul' r x := by + simp only [TensorProduct.map_smul_left, LinearMap.smul_apply] + rfl + +private lemma map_op_comul_one_aux_apply [QuantumSet A] [QuantumSet B] + (f : A →ₗ[ℂ] B) : + map_op_comul_one_aux f = + (TensorProduct.map f (op ℂ).toLinearMap) (Coalgebra.comul 1) := + rfl + +theorem map_op_comul_one_eq_Psi [QuantumSet A] [QuantumSet B] (f : A →ₗ[ℂ] B) : + (TensorProduct.map f (op ℂ).toLinearMap) (Coalgebra.comul 1) = + Psi 0 (k A) f := by + rw [← map_op_comul_one_aux_apply, ← LinearEquiv.coe_toLinearMap] + revert f + rw [← LinearMap.ext_iff] + apply LinearMap.ext_of_rank_one' + intro x y + rw [TensorProduct.inner_ext_iff'] + intro a b + simp only [LinearEquiv.coe_coe, Psi_apply, Psi_toFun_apply, map_op_comul_one_aux_apply, + starAlgebra.modAut_zero, AlgEquiv.one_apply] + obtain ⟨α, β, h⟩ := TensorProduct.eq_span (Coalgebra.comul 1 : A ⊗[ℂ] A) + rw [← h] + simp_rw [map_sum, sum_inner, TensorProduct.map_tmul, TensorProduct.inner_tmul, + ContinuousLinearMap.coe_coe, rankOne_apply, inner_smul_left, inner_conj_symm, + MulOpposite.inner_eq, LinearEquiv.coe_toLinearMap, op_apply, + MulOpposite.unop_op, mul_assoc, mul_comm ⟪x, _⟫_ℂ, ← mul_assoc, + ← Finset.sum_mul, ← TensorProduct.inner_tmul, ← sum_inner, h, + Coalgebra.comul_eq_mul_adjoint, LinearMap.adjoint_inner_left, + LinearMap.mul'_apply, TensorProduct.inner_tmul, inner_eq_counit, star_star, + star_one, one_mul, map_mul] + +theorem _root_.tenSwap_apply_lTensor {R A B C : Type*} + [CommSemiring R] [AddCommMonoid A] [AddCommMonoid C] [Module R A] + [AddCommMonoid B] [Module R B] [Module R C] (f : B →ₗ[R] C) + (x : A ⊗[R] Bᵐᵒᵖ) : + (tenSwap R) ((LinearMap.lTensor A f.op) x) = + (LinearMap.rTensor _ f) (tenSwap R x) := by + refine x.induction_on ?_ ?_ ?_ + · simp only [map_zero] + · intro a b + simp only [LinearMap.lTensor_tmul, LinearMap.op_apply, tenSwap_apply, + LinearMap.rTensor_tmul] + rfl + · intro x y hx hy + simp only [map_add, hx, hy] + +theorem Psi_inv_comp_swap_lTensor_op_comp_comul_eq_rmul [QuantumSet A] : + (Psi 0 (k A + 1)).symm.toLinearMap + ∘ₗ (tenSwap ℂ).toLinearMap + ∘ₗ (LinearMap.lTensor A (op ℂ).toLinearMap) + ∘ₗ Coalgebra.comul = + rmul := by + ext x y + apply ext_inner_left ℂ + intro z + simp only [LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, Psi_symm_apply] + obtain ⟨α, β, h⟩ := TensorProduct.eq_span (Coalgebra.comul x : A ⊗[ℂ] A) + rw [← h] + simp_rw [map_sum, LinearMap.sum_apply, inner_sum, LinearMap.lTensor_tmul, + LinearEquiv.coe_toLinearMap, op_apply, tenSwap_apply', Psi_invFun_apply, + ContinuousLinearMap.coe_coe, rankOne_apply, neg_zero, starAlgebra.modAut_zero, + AlgEquiv.one_apply, MulOpposite.unop_op, inner_smul_right, neg_add, + ← inner_conj_symm _ y, ← sub_eq_add_neg, ← QuantumSet.inner_modAut_right_conj, + inner_conj_symm, ← TensorProduct.inner_tmul, ← inner_sum, h, + Coalgebra.comul_eq_mul_adjoint, LinearMap.adjoint_inner_right, + LinearMap.mul'_apply, rmul_apply, QuantumSet.inner_star_left, + starAlgebra.modAut_star, modAut_apply_modAut, add_neg_cancel, + starAlgebra.modAut_zero, star_star, AlgEquiv.one_apply] + +private noncomputable def rmulMapLmul_apply_Upsilon_aux [QuantumSet A] [QuantumSet B] : + (A →ₗ[ℂ] B) →ₗ[ℂ] ((A ⊗[ℂ] B) →ₗ[ℂ] (A ⊗[ℂ] B)) where + toFun x := (LinearMap.lTensor _ (LinearMap.mul' ℂ B)) + ∘ₗ (TensorProduct.assoc _ _ _ _).toLinearMap + ∘ₗ (LinearMap.rTensor _ (LinearMap.lTensor _ x)) + ∘ₗ LinearMap.rTensor _ (Coalgebra.comul) + map_add' _ _ := by simp only [LinearMap.lTensor_add, LinearMap.rTensor_add, + LinearMap.comp_add, LinearMap.add_comp] + map_smul' _ _ := by + simp only [LinearMap.lTensor_smul, LinearMap.rTensor_smul, + LinearMap.comp_smul, LinearMap.smul_comp] + rfl + +private lemma rmulMapLmul_apply_Upsilon_aux_apply [QuantumSet A] [QuantumSet B] + (x : A →ₗ[ℂ] B) : + rmulMapLmul_apply_Upsilon_aux x = + (LinearMap.lTensor _ (LinearMap.mul' ℂ B)) + ∘ₗ (TensorProduct.assoc _ _ _ _).toLinearMap + ∘ₗ (LinearMap.rTensor _ (LinearMap.lTensor _ x)) + ∘ₗ LinearMap.rTensor _ (Coalgebra.comul) := + rfl + +lemma Upsilon_rankOne [QuantumSet A] [QuantumSet B] (a : A) (b : B) : + Upsilon (rankOne ℂ a b).toLinearMap = (modAut (-k B - 1) (star b)) ⊗ₜ[ℂ] a := by + rw [Upsilon_apply, QuantumSet.Psi_toFun_apply, TensorProduct.comm_tmul, + TensorProduct.map_tmul, LinearEquiv.lTensor_tmul, starAlgebra.modAut_star, + starAlgebra.modAut_zero] + ring_nf + rfl + +lemma Upsilon_symm_tmul [QuantumSet A] [QuantumSet B] (a : A) (b : B) : + Upsilon.symm (a ⊗ₜ[ℂ] b) = + (rankOne ℂ b (modAut (-k A - 1) (star a))).toLinearMap := by + rw [Upsilon_symm_apply] + simp only [LinearEquiv.lTensor_symm_tmul, LinearEquiv.symm_symm, op_apply, + TensorProduct.map_tmul, LinearEquiv.coe_coe, unop_apply, MulOpposite.unop_op, + TensorProduct.comm_tmul, QuantumSet.Psi_invFun_apply, starAlgebra.modAut_zero, neg_zero] + ring_nf + rfl + +lemma rmulMapLmul_apply_Upsilon_eq [QuantumSet A] [QuantumSet B] (x : A →ₗ[ℂ] B) : + rmulMapLmul (Upsilon x) = + (LinearMap.lTensor _ (LinearMap.mul' ℂ B)) + ∘ₗ (TensorProduct.assoc _ _ _ _).toLinearMap + ∘ₗ (LinearMap.rTensor _ (LinearMap.lTensor _ x)) + ∘ₗ LinearMap.rTensor _ (Coalgebra.comul) := by + symm + rw [← rmulMapLmul_apply_Upsilon_aux_apply, ← LinearEquiv.coe_toLinearMap, ← LinearMap.comp_apply] + revert x + rw [← LinearMap.ext_iff] + apply LinearMap.ext_of_rank_one' + intro x y + rw [TensorProduct.ext_iff'] + intro a b + rw [TensorProduct.inner_ext_iff', rmulMapLmul_apply_Upsilon_aux_apply] + intro c d + obtain ⟨α, β, h⟩ := TensorProduct.eq_span (Coalgebra.comul a : A ⊗[ℂ] A) + simp_rw [LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, LinearEquiv.trans_apply, + Psi_apply, LinearEquiv.TensorProduct.map_apply, LinearMap.rTensor_tmul, + Psi_toFun_apply, TensorProduct.comm_tmul, + TensorProduct.map_tmul, ← h, map_sum, TensorProduct.sum_tmul, + map_sum, sum_inner] + simp only [LinearMap.lTensor_tmul, ContinuousLinearMap.coe_coe, rankOne_apply_apply_apply, + TensorProduct.tmul_smul, starAlgebra.modAut_star, neg_add_rev, + LinearEquiv.coe_coe, unop_apply, MulOpposite.unop_op, starAlgebra.modAut_zero, + AlgEquiv.one_apply, op_apply, LinearEquiv.lTensor_tmul, + ← TensorProduct.smul_tmul', map_smul, inner_smul_left, inner_conj_symm, + TensorProduct.assoc_tmul, TensorProduct.inner_tmul] + simp_rw [← mul_assoc, ← Finset.sum_mul, mul_comm ⟪β _, _⟫_ℂ, + ← TensorProduct.inner_tmul, ← sum_inner, h, + Coalgebra.comul_eq_mul_adjoint, LinearMap.adjoint_inner_left, + LinearMap.mul'_apply, rmulMapLmul_apply, TensorProduct.map_tmul, + TensorProduct.inner_tmul, rmul_apply, neg_add_eq_sub] + nth_rw 2 [QuantumSet.inner_conj_left] + simp_rw [starAlgebra.modAut_star, modAut_apply_modAut, star_star, + add_neg_cancel, starAlgebra.modAut_zero] + rfl diff --git a/LeanPool/Monlib4/LinearAlgebra/QuantumSet/DeltaForm.lean b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/DeltaForm.lean new file mode 100644 index 0000000000..3718bd72d1 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/DeltaForm.lean @@ -0,0 +1,32 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Basic +import Mathlib.RingTheory.Coalgebra.Basic + +open scoped ComplexOrder + +open Coalgebra + +/-- Delta-form quantum sets satisfy `m ∘ comul = δ • 1` for a positive scalar `δ`. -/ +class QuantumSetDeltaForm (A : Type*) [starAlgebra A] [QuantumSet A] [CoalgebraStruct ℂ A] where + /-- The positive delta scalar. -/ + delta : ℂ + /-- Positivity of the delta scalar. -/ + delta_pos : 0 < delta + /-- Multiplication after comultiplication is scalar multiplication by delta. -/ + mul_comp_comul_eq : LinearMap.mul' ℂ A ∘ₗ Coalgebra.comul = delta • 1 + +/-- In delta form, `m ∘ comul` is invertible. -/ +@[reducible, instance] +noncomputable def QuantumSet.DeltaForm.mul_comp_comul_isInvertible {A : Type*} [starAlgebra A] + [QuantumSet A] [CoalgebraStruct ℂ A] [FiniteDimensional ℂ A] [hA2 : QuantumSetDeltaForm A] : + Invertible (LinearMap.mul' ℂ A ∘ₗ Coalgebra.comul) := +by + apply IsUnit.invertible + rw [LinearMap.isUnit_iff_ker_eq_bot, hA2.mul_comp_comul_eq, LinearMap.ker_smul, + Module.End.one_eq_id, LinearMap.ker_id] + exact ne_of_gt hA2.delta_pos diff --git a/LeanPool/Monlib4/LinearAlgebra/QuantumSet/Instances.lean b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/Instances.lean new file mode 100644 index 0000000000..b1fd75de2c --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/Instances.lean @@ -0,0 +1,820 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Basic +import LeanPool.Monlib4.LinearAlgebra.Ips.MatIps +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Pi +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.DeltaForm +-- import LeanPool.Monlib4.LinearAlgebra.Ips.Frob + +variable {n : Type*} [Fintype n] [DecidableEq n] {φ : Module.Dual ℂ (Matrix n n ℂ)} + +open Matrix + +open scoped Functional + +theorem Module.Dual.IsFaithfulPosMap.sig_trans_sig [hφ : φ.IsFaithfulPosMap] (x y : ℝ) : + (sig hφ x).trans (sig hφ y) = sig hφ (x + y) := + by + ext1 + simp_rw [AlgEquiv.trans_apply, + sig_apply, ← mul_assoc, PosDef.rpow_mul_rpow, + mul_assoc, PosDef.rpow_mul_rpow, neg_add, add_comm] + +open scoped ComplexOrder + +omit [Fintype n] [DecidableEq n] in +theorem PosDef.smul {𝕜 : Type*} [RCLike 𝕜] + {x : Matrix n n 𝕜} (hx : x.PosDef) (α : NNRealˣ) : + ((((α : NNReal) : ℝ) : 𝕜) • x).PosDef := + Matrix.PosDef.smul hx (RCLike.ofReal_pos.mpr (NNReal.coe_pos.mpr (Units.zero_lt α))) + +theorem posSemidefOne_smul_rpow {𝕜 : Type*} [RCLike 𝕜] + {n : Type _} [Fintype n] [DecidableEq n] (α : NNReal) (r : ℝ) : + (Matrix.PosSemidef.smul (Matrix.PosSemidef.one : PosSemidef (1 : Matrix n n 𝕜)) + (RCLike.ofReal_nonneg.mpr (NNReal.coe_nonneg α)) : + PosSemidef ((((α : NNReal) : ℝ) : 𝕜) • 1 : Matrix n n 𝕜)).rpow r + = ((((α : NNReal) : ℝ) ^ r : ℝ) : 𝕜) • 1 := +by + rw [PosSemidef.rpow, IsHermitian.rpow, innerAut_eq_iff, _root_.map_smul, innerAut_apply_one] + symm + nth_rw 1 [← diagonal_one] + rw [← diagonal_smul] + rw [diagonal_eq_diagonal_iff] + intro i + simp_rw [Pi.smul_apply, Function.comp_apply, Pi.pow_apply] + rw [← RCLike.ofReal_one, smul_eq_mul, ← RCLike.ofReal_mul, + RCLike.ofReal_inj, IsHermitian.eigenvalues_eq', + smul_mulVec_assoc, one_mulVec, dotProduct_smul, + ← RCLike.real_smul_eq_coe_smul, RCLike.smul_re, + Real.mul_rpow (NNReal.coe_nonneg _) _] + all_goals + simp_rw [dotProduct, Pi.star_apply, transpose_apply, ← conjTranspose_apply, + ← mul_apply, IsHermitian.eigenvectorMatrix_conjTranspose_mul, one_apply_eq, + RCLike.one_re] + · simp only [mul_one, Real.one_rpow] + · simp only [zero_le_one] + +theorem posDefOne_smul_rpow {𝕜 : Type*} [RCLike 𝕜] + {n : Type _} [Fintype n] [DecidableEq n] (α : NNRealˣ) (r : ℝ) : + (Matrix.PosDef.smul (Matrix.posDefOne : PosDef (1 : Matrix n n 𝕜)) + (RCLike.ofReal_pos.mpr (NNReal.coe_pos.mpr (Units.zero_lt α))) : + PosDef ((((α : NNReal) : ℝ) : 𝕜) • 1 : Matrix n n 𝕜)).rpow r + = ((((α : NNReal) : ℝ) ^ r : ℝ) : 𝕜) • 1 := +by + rw [PosDef.rpow_eq, innerAut_eq_iff, _root_.map_smul, innerAut_apply_one] + symm + nth_rw 1 [← diagonal_one] + rw [← diagonal_smul] + rw [diagonal_eq_diagonal_iff] + intro i + simp_rw [Pi.smul_apply, Function.comp_apply, Pi.pow_apply] + rw [← RCLike.ofReal_one, smul_eq_mul, ← RCLike.ofReal_mul, + RCLike.ofReal_inj, IsHermitian.eigenvalues_eq', + smul_mulVec_assoc, one_mulVec, dotProduct_smul, + ← RCLike.real_smul_eq_coe_smul, RCLike.smul_re, + Real.mul_rpow (NNReal.coe_nonneg _) _] + all_goals + simp_rw [dotProduct, Pi.star_apply, transpose_apply, ← conjTranspose_apply, + ← mul_apply, IsHermitian.eigenvectorMatrix_conjTranspose_mul, one_apply_eq, + RCLike.one_re] + · simp only [mul_one, Real.one_rpow] + · simp only [zero_le_one] + +theorem Module.Dual.IsFaithfulPosMap.sig_zero [hφ : φ.IsFaithfulPosMap] : + sig hφ 0 = 1 := +by + ext1 + simp only [sig_apply, neg_zero, PosDef.rpow_zero, one_mul, mul_one, + AlgEquiv.one_apply] + +lemma AlgEquiv.apply_eq_id {R M : Type*} [CommSemiring R] + [Semiring M] [Algebra R M] {f : M ≃ₐ[R] M} : + (∀ (x : M), f x = x) ↔ f = 1 := +by simp only [AlgEquiv.ext_iff, AlgEquiv.one_apply] + +theorem Matrix.PosDef.rpow_neg_eq_inv_rpow {𝕜 : Type*} [RCLike 𝕜] {n : + Type _} [Fintype n] [DecidableEq n] + {Q : Matrix n n 𝕜} (hQ : Q.PosDef) (r : ℝ) : + hQ.rpow (-r) = (hQ.rpow r)⁻¹ := +by + haveI := (PosDef.rpow.isPosDef hQ r).invertible + letI := Matrix.PosDef.eigenvaluesInvertible' hQ + simp_rw [rpow_eq, innerAut.map_inv] + haveI : Invertible (RCLike.ofReal ∘ (hQ.1.eigenvalues ^ r) : n → 𝕜) := + { invOf := (RCLike.ofReal ∘ (hQ.1.eigenvalues ^ (-r)) : n → 𝕜) + invOf_mul_self := by + ext + simp only [Pi.mul_apply, Function.comp_apply, Pi.pow_apply, Pi.one_apply] + simp only [← RCLike.ofReal_mul] + rw [← Real.rpow_add (eigenvalues_pos hQ _), neg_add_cancel, Real.rpow_zero, + RCLike.ofReal_one] + mul_invOf_self := by + ext + simp only [Pi.mul_apply, Function.comp_apply, Pi.pow_apply, Pi.one_apply] + simp only [← RCLike.ofReal_mul] + rw [← Real.rpow_add (eigenvalues_pos hQ _), add_neg_cancel, Real.rpow_zero, + RCLike.ofReal_one] } + rw [Matrix.inv_diagonal'] + congr + ext i + simp only [Function.comp_apply, Pi.pow_apply, Pi.inv_apply] + rw [Real.rpow_neg (le_of_lt (eigenvalues_pos hQ i)), RCLike.ofReal_inv] + +theorem _root_.RCLike.pos_toNNReal_units {𝕜 : Type*} [RCLike 𝕜] (r : 𝕜) : + 0 < r ↔ ∃ s : NNRealˣ, r = (((s : NNReal) : ℝ) : 𝕜) := +by + refine ⟨fun h => ?_, fun ⟨s, hs⟩ => by + simp only [hs, RCLike.ofReal_pos, NNReal.coe_pos, + Units.zero_lt]⟩ + use Units.mk0 ⟨RCLike.re r, le_of_lt (RCLike.pos_def.mp h).1⟩ + (ne_of_gt (RCLike.pos_def.mp h).1) + simpa [Units.val_mk0, NNReal.coe_mk] using + (RCLike.conj_eq_iff_re.mp (RCLike.conj_eq_iff_im.mpr (RCLike.pos_def.mp h).2)).symm +theorem _root_.RCLike.nonneg_toNNReal {𝕜 : Type*} [RCLike 𝕜] (r : 𝕜) : + 0 ≤ r ↔ ∃ s : NNReal, r = (((s : NNReal) : ℝ) : 𝕜) := +by + refine ⟨fun h => ?_, fun ⟨s, hs⟩ => by + simp only [hs, RCLike.ofReal_nonneg, NNReal.zero_le_coe]⟩ + use Real.toNNReal (RCLike.re r) + nth_rw 1 [← (RCLike.nonneg_def'.mp h).1] + simp only [algebraMap.coe_inj] + rw [Real.toNNReal_of_nonneg ((RCLike.nonneg_def.mp h).1)] + rfl + +theorem _root_.Matrix.smulPosDef_isPosDef_iff {𝕜 : Type*} [RCLike 𝕜] {n : + Type _} [Finite n] + [H : Nonempty n] + {Q : Matrix n n 𝕜} (hQ : Q.PosDef) (r : 𝕜) : + (r • Q).PosDef ↔ 0 < r := +by + classical + letI : Fintype n := Fintype.ofFinite n + let j : n := H.some + let a : n → 𝕜 := fun i => if i = j then 1 else 0 + have ha2 : a ≠ 0 := by + intro h + have := congrFun h j + simp [a] at this + refine ⟨fun h => ?_, fun h => ?_⟩ + · have h2' := (Matrix.posDef_iff_dotProduct_mulVec.mp h).2 + simp_rw [smul_mulVec_assoc, dotProduct_smul, smul_eq_mul] at h2' + specialize h2' (x := a) ha2 + obtain ⟨b, hb, hb2⟩ := RCLike.pos_iff_exists_ofReal.mp + (hQ.dotProduct_mulVec_pos ha2) + rw [← hb2] at h2' + rw [mul_comm, RCLike.pos_def, RCLike.re_ofReal_mul, RCLike.im_ofReal_mul, + mul_pos_iff] at h2' + simp_rw [hb, true_and, not_lt_of_gt hb, false_and, or_false, + mul_eq_zero, ne_of_gt hb, false_or] at h2' + exact RCLike.pos_def.mpr h2' + · obtain ⟨s, rfl⟩ := (RCLike.pos_toNNReal_units r).mp h + exact PosDef.smul hQ _ + +theorem smul_onePosDef_rpow_eq {𝕜 : Type*} [RCLike 𝕜] + {n : Type _} [Fintype n] [DecidableEq n] {α : 𝕜} + (h : ((α : 𝕜) • (1 : Matrix n n 𝕜)).PosDef) (r : ℝ) : + h.rpow r = ((RCLike.re α ^ r : ℝ) : 𝕜) • 1 := +by + by_cases H : IsEmpty n + · simp only [← Matrix.ext_iff] + simp only [IsEmpty.forall_iff, smul_apply] + · rw [not_isEmpty_iff] at H + have := (smulPosDef_isPosDef_iff + (Matrix.posDefOne : PosDef (1 : Matrix n n 𝕜)) α).mp h + let p : NNRealˣ := Units.mk0 ⟨RCLike.re α, le_of_lt (RCLike.pos_def.mp this).1⟩ + (ne_of_gt (RCLike.pos_def.mp this).1) + have : α = (((p : NNReal) : ℝ) : 𝕜) := by + rw [← RCLike.conj_eq_iff_re.mp (RCLike.conj_eq_iff_im.mpr (RCLike.pos_def.mp this).2)] + rfl + -- rw [this] at h + rw [PosDef.rpow_cast h _ (by rw [this]), posDefOne_smul_rpow] + exact rfl + +theorem _root_.Matrix.smulPosSemidef_isPosSemidef_iff {𝕜 : Type*} [RCLike 𝕜] {n : + Type _} [Finite n] + {Q : Matrix n n 𝕜} (hQ : Q.PosSemidef) (r : 𝕜) : + (r • Q).PosSemidef ↔ 0 ≤ r ∨ Q = 0 := +by + classical + letI : Fintype n := Fintype.ofFinite n + by_cases hr : r = 0 + · simp only [hr, zero_smul, le_refl, true_or, PosSemidef.zero] + · by_cases hQQ : Q = 0 + · simp_rw [hQQ, smul_zero, or_true, PosSemidef.zero] + · simp only [hQQ, or_false] + rw [Matrix.posSemidef_iff_dotProduct_mulVec, IsHermitian, conjTranspose_smul, hQ.1.eq] + rw [← sub_eq_zero, ← sub_smul, smul_eq_zero, sub_eq_zero] + simp_rw [smul_mulVec_assoc, dotProduct_smul, + RCLike.nonneg_def (K := 𝕜), ← RCLike.conj_eq_iff_im, + starRingEnd_apply, star_smul, smul_eq_mul, RCLike.mul_re, + (RCLike.nonneg_def.mp (hQ.dotProduct_mulVec_nonneg _)), mul_zero, sub_zero, + mul_nonneg_iff, RCLike.nonneg_def.mp (hQ.dotProduct_mulVec_nonneg _), and_true, + ← star_dotProduct, star_mulVec, hQ.1.eq, ← dotProduct_mulVec] + simp only [hQQ, or_false] + constructor + · rintro ⟨h, h2⟩ + rw [← Matrix.IsHermitian.eigenvalues_eq_zero_iff hQ.1] at hQQ + simp only [funext_iff, Pi.zero_apply, not_forall] at hQQ + obtain ⟨i, hi⟩ := hQQ + specialize h2 (hQ.1.eigenvectorMatrixᵀ i) + rw [← IsHermitian.eigenvalues_eq'] at h2 + nth_rw 3 [le_iff_eq_or_lt] at h2 + simp only [hi, not_lt_of_ge (hQ.eigenvalues_nonneg _), + and_false, or_false, h, and_true] at h2 + exact ⟨h2, h⟩ + · simp only [RCLike.star_def, mul_eq_mul_right_iff, and_imp] + intro h hi + refine ⟨hi, ?_⟩ + simp only [h, true_or, true_and, hi, implies_true] + +theorem smul_onePosSemidef_rpow_eq {𝕜 : Type*} [RCLike 𝕜] + {n : Type _} [Fintype n] [DecidableEq n] {α : 𝕜} + (h : ((α : 𝕜) • (1 : Matrix n n 𝕜)).PosSemidef) (r : ℝ) : + h.rpow r = ((RCLike.re α ^ r : ℝ) : 𝕜) • 1 := +by + by_cases H : IsEmpty n + · simp only [← Matrix.ext_iff] + simp only [IsEmpty.forall_iff, smul_apply] + · rw [not_isEmpty_iff] at H + have := (smulPosSemidef_isPosSemidef_iff + (Matrix.PosSemidef.one : PosSemidef (1 : Matrix n n 𝕜)) α).mp h + simp only [one_ne_zero, or_false] at this + obtain ⟨s, rfl⟩ := (RCLike.nonneg_toNNReal α).mp this + rw [posSemidefOne_smul_rpow] + simp only [RCLike.ofReal_re] + +theorem _root_.Matrix.smul_one_inv {𝕜 : Type*} [RCLike 𝕜] + {n : Type _} [Fintype n] [DecidableEq n] {s : NNRealˣ} : + ((((s : NNReal) : ℝ) : 𝕜) • (1 : Matrix n n 𝕜))⁻¹ + = (((s⁻¹ : NNReal) : ℝ) : 𝕜) • 1 := +by + simp only [NNReal.coe_inv, RCLike.ofReal_inv] + letI : Invertible (((s : NNReal) : ℝ) : 𝕜) := by + use (((s⁻¹ : NNReal) : ℝ) : 𝕜) <;> aesop + rw [Matrix.inv_smul] + · simp only [invOf_eq_inv, inv_one] + · simp only [det_one, isUnit_iff_ne_zero, ne_eq, one_ne_zero, not_false_eq_true] + +theorem _root_.Matrix.PosDef.commutes_iff_rpow_commutes {𝕜 : Type*} [RCLike 𝕜] + {n : Type _} [Fintype n] [DecidableEq n] {Q : Matrix n n 𝕜} (hQ : Q.PosDef) (r : ℝˣ) : + (∀ x, Commute x (hQ.rpow (r : ℝ))) ↔ ∀ x, Commute x Q := +by + by_cases H : IsEmpty n + · simp only [commute_iff_eq, ← Matrix.ext_iff] + simp only [IsEmpty.forall_iff, implies_true] + · rw [not_isEmpty_iff] at H + simp_rw [commutes_with_all_iff] + constructor + · rintro ⟨α, hα⟩ + have hα' := hα + obtain ⟨s, rfl⟩ := (RCLike.pos_toNNReal_units α).mp ((smulPosDef_isPosDef_iff + (Matrix.posDefOne : PosDef (1 : Matrix n n 𝕜)) α).mp + (by rw [← hα']; exact PosDef.rpow.isPosDef _ _)) + rw [PosDef.rpow_eq, innerAut_eq_iff, _root_.map_smul, + innerAut_apply_one, smul_one_eq_diagonal, diagonal_eq_diagonal_iff] at hα + simp_rw [Function.comp_apply, Pi.pow_apply] at hα + simp only [algebraMap.coe_inj] at hα + use ((RCLike.re (((s : NNReal) : ℝ) : 𝕜) ^ ((1 / r) : ℝ) : ℝ) : 𝕜) + have : ∀ i, hQ.1.eigenvalues i = ((s : NNReal) : ℝ) ^ (1/r : ℝ) := + by + intro i + rw [← hα i, one_div, Real.rpow_rpow_inv (le_of_lt (PosDef.eigenvalues_pos hQ _)) + (Units.ne_zero r)] + rw [IsHermitian.spectral_theorem'' hQ.1] + rw [innerAut_eq_iff, _root_.map_smul, innerAut_apply_one, smul_one_eq_diagonal, + diagonal_eq_diagonal_iff] + simp only [Function.comp_apply, RCLike.ofReal_re, one_div, algebraMap.coe_inj] + simp only [this, one_div, implies_true] + · rintro ⟨α, hα⟩ + use ((RCLike.re α ^ (r : ℝ) : ℝ) : 𝕜) + rw [PosDef.rpow_cast hQ _ hα, smul_onePosDef_rpow_eq] + +theorem Module.Dual.IsPosMap.isTracial_iff + {n : Type _} [Fintype n] [DecidableEq n] + {φ : Module.Dual ℂ (Matrix n n ℂ)} (hφ : φ.IsPosMap) : + φ.IsTracial ↔ ∃ α : ℂ, φ.matrix = α • 1 := +by + have := isTracial_pos_map_iff_of_matrix φ + simp only [hφ, true_and] at this + rw [this] + constructor + · rintro ⟨α, h⟩ + exact ⟨((α : ℝ) : ℂ), h⟩ + · rintro ⟨α, h⟩ + by_cases H : (1 : Matrix n n ℂ) = 0 + · use 0 + simp only [NNReal.coe_zero, Complex.ofReal_zero, h, H, smul_zero] + · use Real.toNNReal (RCLike.re α) + rw [h] + congr + have := smulPosSemidef_isPosSemidef_iff + (Matrix.PosSemidef.one : PosSemidef (1 : Matrix n n ℂ)) α + simp_rw [H, or_false, ← h, (isPosMap_iff_of_matrix _).mp hφ, true_iff] at this + simp_rw [Real.toNNReal_of_nonneg (RCLike.nonneg_def.mp this).1] + simp only [NNReal.coe_mk] + exact (RCLike.nonneg_def'.mp this).1.symm + +/-- `σ_k = 1` iff either `k = 0` or `φ` is tracial -/ +theorem sig_eq_id_iff [hφ : φ.IsFaithfulPosMap] (k : ℝ) : + sig hφ k = 1 ↔ k = 0 ∨ φ.IsTracial := +by + by_cases hk : k = 0 + · simp_rw [hk, true_or, iff_true, Module.Dual.IsFaithfulPosMap.sig_zero] + · by_cases H : IsEmpty n + · simp only [Module.Dual.IsTracial, Module.Dual.apply, + trace_iff, AlgEquiv.ext_iff, sig_apply, + ← Matrix.ext_iff] + simp only [AlgEquiv.one_apply, IsEmpty.forall_iff, implies_true, Finset.univ_eq_empty, + Finset.sum_empty, or_true] + · rw [not_isEmpty_iff] at H + let nk : ℝˣ := Units.mk0 k hk + have nk2 : k = (nk : ℝ) := rfl + simp_rw [hk, false_or, nk2] + rw [(Module.Dual.IsPosMap.isTracial_iff hφ.1)] + refine ⟨fun h => ?_, ?_⟩ + on_goal 2 => + rintro ⟨α, hα⟩ + ext1 + rw [sig_apply] + simp_rw [PosDef.rpow_cast hφ.matrixIsPosDef _ hα] + simp_rw [smul_onePosDef_rpow_eq] + have := (smulPosDef_isPosDef_iff + (Matrix.posDefOne : PosDef (1 : Matrix n n ℂ)) α).mp + (by rw [← hα]; exact hφ.matrixIsPosDef) + simp_rw [smul_mul_assoc, one_mul, mul_smul_comm, mul_one, + smul_smul, ← RCLike.ofReal_mul] + rw [← Real.rpow_add (RCLike.pos_def.mp this).1, neg_add_cancel, + Real.rpow_zero] + simp_rw [algebraMap.coe_one, one_smul, AlgEquiv.one_apply] + by_cases Hy : ∃ α : ℂ, hφ.matrixIsPosDef.rpow k = α • 1 + · rw [← commutes_with_all_iff, + ← Matrix.PosDef.commutes_iff_rpow_commutes hφ.matrixIsPosDef nk, commutes_with_all_iff] + exact Hy + · have this1 := calc (∀ x, Commute x (hφ.matrixIsPosDef.rpow k)) + ↔ (∀ x, x * hφ.matrixIsPosDef.rpow k = hφ.matrixIsPosDef.rpow k * x) := Iff.rfl + _ ↔ (∀ x, hφ.matrixIsPosDef.rpow (-k) * x * hφ.matrixIsPosDef.rpow k = x) := by + haveI := (PosDef.rpow.isPosDef hφ.matrixIsPosDef k).invertible + simp_rw [PosDef.rpow_neg_eq_inv_rpow, + ← Matrix.inv_mul_eq_iff_eq_mul_of_invertible, mul_assoc] + _ ↔ (∀ x, sig hφ k x = x) := Iff.rfl + _ ↔ sig hφ k = 1 := AlgEquiv.apply_eq_id + rw [← commutes_with_all_iff, this1] at Hy + contradiction + +theorem Module.Dual.pi_isTracial_iff {k : Type*} [Fintype k] + {s : k → Type*} + [∀ i, Fintype (s i)] + {φ : Π i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} : + (Module.Dual.pi φ).IsTracial ↔ ∀ i, (φ i).IsTracial := +by + classical + constructor + · intro h i x y + specialize h (includeBlock x) (includeBlock y) + simp [Module.Dual.pi_apply, includeBlock_hMul_includeBlock] at h + simpa only [← Module.Dual.pi_apply, Module.Dual.pi.apply_single_block'] using h + · intro h x y + simp [h _ _] + +/-- The modular star-algebra structure on matrices induced by a faithful positive functional. -/ +@[reducible] +noncomputable def Matrix.isStarAlgebra [hφ : φ.IsFaithfulPosMap] : + starAlgebra (Matrix n n ℂ) where + modAut := sig hφ + modAut_trans := Module.Dual.IsFaithfulPosMap.sig_trans_sig + modAut_star r x := by + simp_rw [sig_apply, star_mul, star_eq_conjTranspose, + neg_neg, (Matrix.PosDef.rpow.isPosDef _ _).1.eq, + mul_assoc] + +@[reducible, instance] +noncomputable def Module.Dual.IsFaithfulPosMap.innerProductAlgebra [hφ : φ.IsFaithfulPosMap] : + @InnerProductAlgebra (Matrix n n ℂ) (Matrix.isStarAlgebra (φ := φ)) := by + letI : starAlgebra (Matrix n n ℂ) := Matrix.isStarAlgebra (φ := φ) + exact withMatrixInner[φ] { + -- norm_smul_le _ _ := by rw [← norm_smul] + norm_smul_le := norm_smul_le + norm_sq_eq_inner := norm_sq_eq_re_inner (𝕜 := ℂ) + dist_eq x y := by + rw [dist_eq_norm'] + congr 1 + abel + conj_symm := inner_conj_symm + add_left := inner_add_left + smul_left := inner_smul_left } + +@[reducible, instance] +noncomputable +def Module.Dual.IsFaithfulPosMap.quantumSet [hφ : φ.IsFaithfulPosMap] : + @QuantumSet (Matrix n n ℂ) (Matrix.isStarAlgebra (φ := φ)) := by + letI : starAlgebra (Matrix n n ℂ) := Matrix.isStarAlgebra (φ := φ) + exact withMatrixInner[φ] { + -- modAut r := hφ.sig r + -- modAut_trans r s := sig_trans_sig _ _ + -- modAut_zero := by + -- ext1 + -- exact Module.Dual.IsFaithfulPosMap.sig_zero _ _ + -- modAut_star r x := sig_conjTranspose _ _ _ + modAut_isSymmetric r x y := by + simp_rw [← AlgEquiv.toLinearMap_apply, modAut, AlgEquiv.toLinearMap_apply, sig_apply, + mul_assoc] + rw [inner_left_hMul, inner_right_conj] + simp_rw [(PosDef.rpow.isPosDef _ _).1.eq] + nth_rw 2 [← PosDef.rpow_one_eq_self hφ.matrixIsPosDef] + nth_rw 1 [← PosDef.rpow_neg_one_eq_inv_self hφ.matrixIsPosDef] + simp_rw [PosDef.rpow_mul_rpow, mul_assoc] + ring_nf + k := 0 + -- modAut_isCoalgHom r := Module.Dual.IsFaithfulPosMap.sig_isCoalgHom _ _ + inner_star_left x y z := by simp_rw [neg_zero, + inner_left_hMul, star_eq_conjTranspose, + modAut, sig_apply, neg_zero, PosDef.rpow_zero, one_mul, mul_one] + inner_conj_left x y z := by + simp_rw [neg_zero, zero_sub, + Module.Dual.IsFaithfulPosMap.inner_right_conj, + modAut, sig_apply, neg_neg, + PosDef.rpow_one_eq_self, PosDef.rpow_neg_one_eq_inv_self] + rfl + n := n × n + n_isFintype := by infer_instance + n_isDecidableEq := by infer_instance + onb := hφ.orthonormalBasis } + +/-- Elaborate a term using the matrix quantum-set structure induced by a faithful +positive functional. -/ +syntax "withMatrixQuantum[" term "] " term : term +macro_rules + | `(withMatrixQuantum[$φ] $p) => + `(letI := Matrix.isStarAlgebra (φ := $φ) + letI := Module.Dual.IsFaithfulPosMap.quantumSet (φ := $φ) + letI := Module.Dual.NormedAddCommGroup $φ + letI := (Module.Dual.NormedAddCommGroup + $φ).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI := (Module.Dual.NormedAddCommGroup $φ).toSeminormedAddCommGroup + letI := Module.Dual.InnerProductSpace (φ := $φ) + $p) + + -- map_one' := rfl + -- map_mul' x y := _root_.map_mul _ _ _ + -- map_zero' := _root_.map_zero _ + -- map_add' := _root_.map_add _ + -- commutes' := Algebra.commutes + -- smul_def' r x := by ext; simp [Matrix.scalar, Algebra.smul_def r] + +section MatrixPsi + +open scoped TensorProduct + +variable {p : Type*} [Fintype p] [DecidableEq p] + {ψ : Module.Dual ℂ (Matrix p p ℂ)} + +/-- Matrix-specialized `Psi` equivalence for faithful positive functionals. -/ +noncomputable def Module.Dual.IsFaithfulPosMap.psi + (hφ : φ.IsFaithfulPosMap) [hψ : ψ.IsFaithfulPosMap] (t r : ℝ) : + (Matrix n n ℂ →ₗ[ℂ] Matrix p p ℂ) ≃ₗ[ℂ] + (Matrix p p ℂ ⊗[ℂ] (Matrix n n ℂ)ᵐᵒᵖ) := by + letI : φ.IsFaithfulPosMap := hφ + letI : starAlgebra (Matrix n n ℂ) := Matrix.isStarAlgebra (φ := φ) + letI : QuantumSet (Matrix n n ℂ) := + Module.Dual.IsFaithfulPosMap.quantumSet (φ := φ) + letI : starAlgebra (Matrix p p ℂ) := Matrix.isStarAlgebra (φ := ψ) + letI : QuantumSet (Matrix p p ℂ) := + Module.Dual.IsFaithfulPosMap.quantumSet (φ := ψ) + exact QuantumSet.Psi (A := Matrix n n ℂ) (B := Matrix p p ℂ) t r + +end MatrixPsi + +variable {k : Type*} [Fintype k] [DecidableEq k] {s : k → Type*} [Π i, Fintype (s i)] + [Π i, DecidableEq (s i)] {ψ : Π i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} + +-- theorem Module.Dual.pi.IsFaithfulPosMap.sig_trans_sig (hψ : ∀ i, (ψ i).IsFaithfulPosMap) +-- (x y : ℝ) : +-- (Module.Dual.pi.IsFaithfulPosMap.sig hψ x).trans (Module.Dual.pi.IsFaithfulPosMap.sig hψ y) = +-- Module.Dual.pi.IsFaithfulPosMap.sig hψ (x + y) := +-- by rw [Moudle.Dual.Pi.IsFaithfulPosMap.sig_trans_sig, add_comm] + +-- theorem Module.Dual.pi.IsFaithfulPosMap.sig_isSymmetric (hψ : ∀ i, (ψ i).IsFaithfulPosMap) +-- (r : ℝ) (x y : PiMat ℂ k s) : +-- ⟪sig hψ r x, y⟫_ℂ = ⟪x, sig hψ r y⟫_ℂ := +-- by rw [← AlgEquiv.toLinearMap_apply, ← sig_adjoint, LinearMap.adjoint_inner_left, + -- AlgEquiv.toLinearMap_apply] + +private noncomputable def piSig (hψ : ∀ i, (ψ i).IsFaithfulPosMap) + (z : ℝ) : PiMat ℂ k s ≃ₐ[ℂ] PiMat ℂ k s where + toFun x i := sig (hψ i) z (x i) + invFun x i := (sig (hψ i) z).symm (x i) + left_inv x := by + funext i + exact (sig (hψ i) z).left_inv (x i) + right_inv x := by + funext i + exact (sig (hψ i) z).right_inv (x i) + map_mul' x y := by + funext i + exact map_mul (sig (hψ i) z) (x i) (y i) + map_add' x y := by + funext i + exact map_add (sig (hψ i) z) (x i) (y i) + commutes' r := by + funext i + exact AlgEquiv.commutes (sig (hψ i) z) r + +omit [Fintype k] [DecidableEq k] in +@[simp] +private theorem piSig_apply (hψ : ∀ i, (ψ i).IsFaithfulPosMap) + (z : ℝ) (x : PiMat ℂ k s) (i : k) : + piSig hψ z x i = sig (hψ i) z (x i) := + rfl + +omit [Fintype k] [DecidableEq k] in +private theorem piSig_trans_sig [hψ : ∀ i, (ψ i).IsFaithfulPosMap] (x y : ℝ) : + (piSig hψ x).trans (piSig hψ y) = piSig hψ (x + y) := by + ext a i j l + change sig (hψ i) y (sig (hψ i) x (a i)) j l = + sig (hψ i) (x + y) (a i) j l + rw [← AlgEquiv.trans_apply, Module.Dual.IsFaithfulPosMap.sig_trans_sig] + +omit [Fintype k] [DecidableEq k] in +private theorem piSig_star (hψ : ∀ i, (ψ i).IsFaithfulPosMap) + (z : ℝ) (x : PiMat ℂ k s) : + star (piSig hψ z x) = piSig hψ (-z) (star x) := by + funext i + change star (sig (hψ i) z (x i)) = sig (hψ i) (-z) (star (x i)) + simp [sig_apply, star_eq_conjTranspose, neg_neg, + (Matrix.PosDef.rpow.isPosDef (hψ i).matrixIsPosDef z).1.eq, + (Matrix.PosDef.rpow.isPosDef (hψ i).matrixIsPosDef (-z)).1.eq, + mul_assoc] + +/-- The modular star-algebra structure on a finite product of matrix blocks. -/ +@[reducible] +noncomputable def PiMat.isStarAlgebra [_hψ : ∀ i, (ψ i).IsFaithfulPosMap] : + starAlgebra (PiMat ℂ k s) where + modAut := piSig _hψ + modAut_trans := piSig_trans_sig + modAut_star := piSig_star _hψ + + +-- attribute [-instance] Pi.module.Dual.isNormedAddCommGroupOfRing +@[reducible, instance] +noncomputable +def Module.Dual.pi.IsFaithfulPosMap.innerProductAlgebra + [∀ i, (ψ i).IsFaithfulPosMap] : + @InnerProductAlgebra (PiMat ℂ k s) (PiMat.isStarAlgebra (ψ := ψ)) := +by + letI : starAlgebra (PiMat ℂ k s) := PiMat.isStarAlgebra (ψ := ψ) + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := + Module.Dual.PiNormedAddCommGroup (φ := ψ) + letI : _root_.SeminormedAddCommGroup (PiMat ℂ k s) := + (Module.Dual.PiNormedAddCommGroup (φ := ψ)).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := + Module.Dual.pi.InnerProductSpace (φ := ψ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (ψ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := ψ i) + exact + { toNorm := (Module.Dual.PiNormedAddCommGroup (φ := ψ)).toNorm + toMetricSpace := (Module.Dual.PiNormedAddCommGroup (φ := ψ)).toMetricSpace + inner := fun x y => @inner ℂ (PiMat ℂ k s) _ x y + norm_smul_le := by + intro c x + letI : InnerProductSpace.Core ℂ (PiMat ℂ k s) := + Module.Dual.PiInnerProductCore (φ := ψ) + letI : NormedSpace ℂ (PiMat ℂ k s) := + InnerProductSpace.Core.toNormedSpace + exact NormedSpace.norm_smul_le c x + norm_sq_eq_inner := by + intro x + exact norm_sq_eq_re_inner (𝕜 := ℂ) x + dist_eq := by + intro x y + simpa [sub_eq_add_neg, add_comm] using + (Module.Dual.PiNormedAddCommGroup (φ := ψ)).dist_eq x y + conj_symm := by + intro x y + exact inner_conj_symm x y + add_left := by + intro x y z + exact inner_add_left x y z + smul_left := by + intro x y r + exact inner_smul_left x y r } +-- letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := by infer_instance +-- letI : _root_.NormedSpace ℂ (PiMat ℂ k s) := by infer_instance +-- letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := by infer_instance +-- { norm_smul_le := fun r x => by +-- rw [← norm_smul_le] + -- exact @norm_smul_le ℂ (PiMat ℂ k s) _ _ _ _ r x + -- rw [norm_eq_sqrt_inner (𝕜 := ℂ), inner_smul_left, inner_smul_right] + -- simp only [RCLike.re_to_complex, Complex.norm_eq_abs, ← mul_assoc, + -- Complex.conj_mul', ← Complex.ofReal_pow, Complex.re_ofReal_mul] + -- rw [Real.sqrt_mul (pow_two_nonneg _), Real.sqrt_sq, norm_eq_sqrt_inner (𝕜 := ℂ)] + -- rfl + -- simp only [apply_nonneg] + -- norm_sq_eq_inner := norm_sq_eq_inner (𝕜 := ℂ) + -- conj_symm := inner_conj_symm + -- add_left := inner_add_left + -- smul_left := inner_smul_left } + +-- set_option synthInstance.checkSynthOrder false in +@[reducible, instance] +noncomputable instance Module.Dual.pi.IsFaithfulPosMap.quantumSet + [hψ : Π i, (ψ i).IsFaithfulPosMap] : + @QuantumSet (PiMat ℂ k s) (PiMat.isStarAlgebra (ψ := ψ)) := by + letI : starAlgebra (PiMat ℂ k s) := PiMat.isStarAlgebra (ψ := ψ) + exact withPiInner[ψ] + { k := 0 + modAut_isSymmetric r x y := by + rw [inner_pi_eq_sum, inner_pi_eq_sum] + apply Finset.sum_congr rfl + intro i _ + letI : starAlgebra (Matrix (s i) (s i) ℂ) := Matrix.isStarAlgebra (φ := ψ i) + letI : QuantumSet (Matrix (s i) (s i) ℂ) := + Module.Dual.IsFaithfulPosMap.quantumSet (φ := ψ i) + exact QuantumSet.modAut_isSymmetric (A := Matrix (s i) (s i) ℂ) r (x i) (y i) + inner_star_left x y z := by + rw [inner_pi_eq_sum, inner_pi_eq_sum] + apply Finset.sum_congr rfl + intro i _ + change inner ℂ ((x i) * (y i)) (z i) = + inner ℂ (y i) ((piSig hψ (-0) (star x)) i * z i) + simp only [neg_zero, piSig_apply, Pi.star_apply, sig_apply, + PosDef.rpow_zero, one_mul, mul_one, star_eq_conjTranspose] + exact Module.Dual.IsFaithfulPosMap.inner_left_hMul (φ := ψ i) (x i) (y i) (z i) + inner_conj_left x y z := by + rw [inner_pi_eq_sum, inner_pi_eq_sum] + apply Finset.sum_congr rfl + intro i _ + change inner ℂ ((x i) * (y i)) (z i) = + inner ℂ (x i) (z i * (piSig hψ (-0 - 1) (star y)) i) + simp only [neg_zero, zero_sub, piSig_apply, Pi.star_apply, sig_apply, + neg_neg, PosDef.rpow_one_eq_self, PosDef.rpow_neg_one_eq_inv_self, + star_eq_conjTranspose] + exact Module.Dual.IsFaithfulPosMap.inner_right_conj (hψ i) (x i) (y i) (z i) + n := Σ i, (s i) × (s i) + n_isFintype := by infer_instance + n_isDecidableEq := by infer_instance + onb := Module.Dual.pi.IsFaithfulPosMap.orthonormalBasis hψ } + +/-- Elaborate a term using the product quantum-set structure induced by faithful +positive functionals on matrix blocks. -/ +syntax "withPiQuantum[" term "] " term : term +macro_rules + | `(withPiQuantum[$ψ] $p) => + `(letI := PiMat.isStarAlgebra (ψ := $ψ) + letI := Module.Dual.pi.IsFaithfulPosMap.quantumSet (ψ := $ψ) + letI := Module.Dual.PiNormedAddCommGroup (φ := $ψ) + letI := (Module.Dual.PiNormedAddCommGroup (φ := + $ψ)).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI := (Module.Dual.PiNormedAddCommGroup (φ := $ψ)).toSeminormedAddCommGroup + letI := Module.Dual.pi.InnerProductSpace (φ := $ψ) + $p) + + -- modAut r := (Module.Dual.pi.IsFaithfulPosMap.sig hψ r : PiMat ℂ k s ≃ₐ[ℂ] PiMat ℂ k s) + -- modAut_trans r s := Module.Dual.pi.IsFaithfulPosMap.sig_trans_sig hψ _ _ + -- modAut_zero := Module.Dual.pi.IsFaithfulPosMap.sig_zero' + -- modAut_star r x := Module.Dual.pi.IsFaithfulPosMap.sig_star _ _ _ + -- modAut_isSymmetric r x y := + -- by simp only; exact Module.Dual.pi.IsFaithfulPosMap.sig_isSymmetric hψ _ _ _ + -- -- modAut_isCoalgHom r := + -- -- by simp only; exact Module.Dual.pi.IsFaithfulPosMap.sig_isCoalgHom hψ r + -- k := 0 + -- inner_star_left x y z := by + -- simp_rw [neg_zero, sig_zero, inner_left_hMul] + -- inner_conj_left x y z := by + -- simp_rw [neg_zero, zero_sub, Module.Dual.pi.IsFaithfulPosMap.inner_right_conj'] + -- commutes' a f := by ext1; simp only [RingHom.coe_mk, MonoidHom.coe_mk, Pi.mul_apply] + -- smul_def' a f := by ext1; simp only [Pi.smul_apply, RingHom.coe_mk, MonoidHom.coe_mk, + -- Pi.mul_apply] + +open scoped TensorProduct BigOperators Kronecker Matrix + +theorem LinearMap.mul'_comp_mul'_adjoint_of_delta_form {φ : Module.Dual ℂ (Matrix n n ℂ)} + [hφ : φ.IsFaithfulPosMap] : + letI : starAlgebra (Matrix n n ℂ) := Matrix.isStarAlgebra (φ := φ) + letI : QuantumSet (Matrix n n ℂ) := + Module.Dual.IsFaithfulPosMap.quantumSet (φ := φ) + letI : Coalgebra ℂ (Matrix n n ℂ) := Coalgebra.ofFiniteDimensionalHilbertAlgebra + LinearMap.mul' ℂ (Matrix n n ℂ) ∘ₗ Coalgebra.comul = φ.matrix⁻¹.trace • 1 := +by + letI : starAlgebra (Matrix n n ℂ) := Matrix.isStarAlgebra (φ := φ) + letI : QuantumSet (Matrix n n ℂ) := + Module.Dual.IsFaithfulPosMap.quantumSet (φ := φ) + letI : Coalgebra ℂ (Matrix n n ℂ) := Coalgebra.ofFiniteDimensionalHilbertAlgebra + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := + Module.Dual.InnerProductSpace (φ := φ) + change LinearMap.mul' ℂ (Matrix n n ℂ) ∘ₗ + LinearMap.adjoint (LinearMap.mul' ℂ (Matrix n n ℂ)) = φ.matrix⁻¹.trace • 1 + rw [Qam.Nontracial.mul_comp_mul_adjoint] + +theorem LinearMap.pi_mul'_comp_mul'_adjoint_of_delta_form [∀ i, Nontrivial (s i)] {δ : ℂ} + {φ : Π i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} + [hφ : ∀ i, (φ i).IsFaithfulPosMap] (hφ₂ : ∀ i, (φ i).matrix⁻¹.trace = δ) : + letI : starAlgebra (PiMat ℂ k s) := PiMat.isStarAlgebra (ψ := φ) + letI : QuantumSet (PiMat ℂ k s) := + Module.Dual.pi.IsFaithfulPosMap.quantumSet (ψ := φ) + letI : ∀ i, starAlgebra (Matrix (s i) (s i) ℂ) := + fun i => Matrix.isStarAlgebra (φ := φ i) + letI : ∀ i, QuantumSet (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.IsFaithfulPosMap.quantumSet (φ := φ i) + letI : ∀ i, Coalgebra ℂ (Matrix (s i) (s i) ℂ) := + fun _ => Coalgebra.ofFiniteDimensionalHilbertAlgebra + letI : CoalgebraStruct ℂ (PiMat ℂ k s) := inferInstance + LinearMap.mul' ℂ (PiMat ℂ k s) ∘ₗ Coalgebra.comul = δ • 1 := +by + letI : starAlgebra (PiMat ℂ k s) := PiMat.isStarAlgebra (ψ := φ) + letI : QuantumSet (PiMat ℂ k s) := + Module.Dual.pi.IsFaithfulPosMap.quantumSet (ψ := φ) + letI : ∀ i, starAlgebra (Matrix (s i) (s i) ℂ) := + fun i => Matrix.isStarAlgebra (φ := φ i) + letI : ∀ i, QuantumSet (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.IsFaithfulPosMap.quantumSet (φ := φ i) + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := + Module.Dual.PiNormedAddCommGroup (φ := φ) + letI : _root_.SeminormedAddCommGroup (PiMat ℂ k s) := + (Module.Dual.PiNormedAddCommGroup (φ := φ)).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := + Module.Dual.pi.InnerProductSpace (φ := φ) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (φ i) + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (s i) (s i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := φ i) + letI : ∀ i, Coalgebra ℂ (Matrix (s i) (s i) ℂ) := + fun _ => Coalgebra.ofFiniteDimensionalHilbertAlgebra + letI : CoalgebraStruct ℂ (PiMat ℂ k s) := inferInstance + ext i a j r c + rw [LinearMap.comp_assoc, Pi.comul_comp_single] + simp_rw [LinearMap.comp_apply] + change + (LinearMap.mul' ℂ (PiMat ℂ k s)) + ((TensorProduct.map + (Matrix.includeBlock : Matrix (s i) (s i) ℂ →ₗ[ℂ] PiMat ℂ k s) + (Matrix.includeBlock : Matrix (s i) (s i) ℂ →ₗ[ℂ] PiMat ℂ k s)) + (Coalgebra.comul a)) j r c = + (δ • Matrix.includeBlock a : PiMat ℂ k s) j r c + rw [LinearMap.pi_mul'_apply_includeBlock] + rw [show LinearMap.mul' ℂ (Matrix (s i) (s i) ℂ) (Coalgebra.comul a) = δ • a by + rw [← LinearMap.comp_apply, LinearMap.mul'_comp_mul'_adjoint_of_delta_form (φ := φ i), + hφ₂ i] + rfl] + simp [Matrix.includeBlock_apply, Pi.smul_apply] + +theorem Qam.Nontracial.delta_pos [Nonempty n] {φ : Module.Dual ℂ (Matrix n n ℂ)} + [hφ : φ.IsFaithfulPosMap] : 0 < φ.matrix⁻¹.trace := +by + exact Matrix.PosDef.trace_pos (Matrix.PosDef.inv hφ.matrixIsPosDef) + +omit [Fintype k] [DecidableEq k] in +theorem Pi.Qam.Nontracial.delta_ne_zero [Nonempty k] [∀ i, Nontrivial (s i)] {δ : ℂ} + {φ : Π i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} + [hφ : ∀ i, (φ i).IsFaithfulPosMap] (hφ₂ : ∀ i, (φ i).matrix⁻¹.trace = δ) : 0 < δ := +by + let j : k := Classical.arbitrary k + rw [← hφ₂ j] + exact Qam.Nontracial.delta_pos + +/-- The delta-form quantum-set structure for a single matrix algebra. -/ +@[reducible] +noncomputable +def Matrix.quantumSetDeltaForm [Nonempty n] {φ : Module.Dual ℂ (Matrix n n ℂ)} + [hφ : φ.IsFaithfulPosMap] := by + letI : starAlgebra (Matrix n n ℂ) := Matrix.isStarAlgebra (φ := φ) + letI : QuantumSet (Matrix n n ℂ) := + Module.Dual.IsFaithfulPosMap.quantumSet (φ := φ) + letI : _root_.NormedAddCommGroup (Matrix n n ℂ) := Module.Dual.NormedAddCommGroup φ + letI : _root_.InnerProductSpace ℂ (Matrix n n ℂ) := + Module.Dual.InnerProductSpace (φ := φ) + letI : Coalgebra ℂ (Matrix n n ℂ) := Coalgebra.ofFiniteDimensionalHilbertAlgebra + exact show QuantumSetDeltaForm (Matrix n n ℂ) from + { delta := φ.matrix⁻¹.trace + delta_pos := Qam.Nontracial.delta_pos + mul_comp_comul_eq := by + exact LinearMap.mul'_comp_mul'_adjoint_of_delta_form (φ := φ) } + +/-- The delta-form quantum-set structure for a finite product of matrix algebras. -/ +@[reducible] +noncomputable def PiMat.quantumSetDeltaForm [Nonempty k] [∀ i, Nontrivial (s i)] {d : ℂ} + {φ : Π i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} + [hφ : ∀ i, (φ i).IsFaithfulPosMap] [hφ₂ : Fact (∀ i, (φ i).matrix⁻¹.trace = d)] := by + letI : starAlgebra (PiMat ℂ k s) := PiMat.isStarAlgebra (ψ := φ) + letI : QuantumSet (PiMat ℂ k s) := + Module.Dual.pi.IsFaithfulPosMap.quantumSet (ψ := φ) + letI : _root_.NormedAddCommGroup (PiMat ℂ k s) := + Module.Dual.PiNormedAddCommGroup (φ := φ) + letI : _root_.SeminormedAddCommGroup (PiMat ℂ k s) := + (Module.Dual.PiNormedAddCommGroup (φ := φ)).toSeminormedAddCommGroup + letI : _root_.InnerProductSpace ℂ (PiMat ℂ k s) := + Module.Dual.pi.InnerProductSpace (φ := φ) + letI : Coalgebra ℂ (PiMat ℂ k s) := Coalgebra.ofFiniteDimensionalHilbertAlgebra + exact show QuantumSetDeltaForm (PiMat ℂ k s) from + { delta := d + delta_pos := Pi.Qam.Nontracial.delta_ne_zero hφ₂.out + mul_comp_comul_eq := by + change LinearMap.mul' ℂ (PiMat ℂ k s) ∘ₗ + LinearMap.adjoint (LinearMap.mul' ℂ (PiMat ℂ k s)) = d • 1 + exact (LinearMap.pi_mul'_comp_mul'_adjoint_eq_smul_id_iff + (k := k) (s := s) (ψ := φ) d).mpr hφ₂.out } diff --git a/LeanPool/Monlib4/LinearAlgebra/QuantumSet/PhiMap.lean b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/PhiMap.lean new file mode 100644 index 0000000000..d9fbc65cd1 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/PhiMap.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2024 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Basic +import LeanPool.Monlib4.LinearAlgebra.MyBimodule + +/-! +# The Phi Map + +This file packages the upstream `Upsilon` equivalence as a bimodule-map +equivalence and records the one-vector inner-product identities used by +downstream quantum graph files. +-/ + +/-- The `Upsilon` equivalence viewed through the tensor-product bimodule map API. -/ +noncomputable abbrev PhiMap {A B : Type*} [starAlgebra B] [starAlgebra A] [QuantumSet A] + [QuantumSet B] := + (Upsilon (A := A) (B := B)).trans TensorProduct.toIsBimoduleMap + +/-- Applying `PhiMap` is applying `Upsilon` and then coercing to a bimodule map. -/ +lemma PhiMap_apply {A B : Type*} [starAlgebra B] [starAlgebra A] [QuantumSet A] + [QuantumSet B] (f : A →ₗ[ℂ] B) : + PhiMap f = TensorProduct.toIsBimoduleMap (Upsilon f) := +rfl + +open scoped InnerProductSpace + +/-- Mapping the unit and then pairing with the unit agrees with applying `Psi` first. -/ +theorem oneInner_map_one_eq_oneInner_Psi_map + {A B : Type*} [starAlgebra B] [starAlgebra A] [hA : QuantumSet A] [hB : QuantumSet B] + (f : A →ₗ[ℂ] B) (r t : ℝ) : + ⟪1, f 1⟫_ℂ = ⟪1, QuantumSet.Psi r t f⟫_ℂ := +by + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne f + simp_rw [map_sum, LinearMap.sum_apply, inner_sum] + congr + ext1 i + simp_rw [QuantumSet.Psi_apply, QuantumSet.Psi_toFun_apply, ContinuousLinearMap.coe_coe, + rankOne_apply, inner_smul_right, Algebra.TensorProduct.one_def, TensorProduct.inner_tmul, + ← MulOpposite.op_one, MulOpposite.inner_eq', starAlgebra.modAut_star, + ← AlgEquiv.toLinearMap_apply, ← LinearMap.adjoint_inner_left, + QuantumSet.modAut_adjoint, AlgEquiv.toLinearMap_apply, map_one, + QuantumSet.inner_eq_counit', QuantumSet.inner_eq_counit, map_one, mul_one, mul_comm] + +/-- Mapping the unit and pairing with the unit agrees after applying `PhiMap`. -/ +lemma oneInner_map_one_eq_oneInner_PhiMap_map_one + {A B : Type*} [starAlgebra B] [starAlgebra A] [hA : QuantumSet A] [hB : QuantumSet B] + (f : A →ₗ[ℂ] B) : + ⟪1, f 1⟫_ℂ = ⟪1, ((PhiMap f : (TensorProduct ℂ A B →ₗ[ℂ] TensorProduct ℂ A B)) 1)⟫_ℂ := +by + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne f + simp_rw [map_sum, LinearMap.IsBimoduleMap.sum_coe, + LinearMap.sum_apply, inner_sum] + congr + ext1 i + simp_rw [PhiMap_apply, Upsilon_rankOne, TensorProduct.toIsBimoduleMap_apply_coe, + rmulMapLmul_apply_one, ContinuousLinearMap.coe_coe, rankOne_apply, + Algebra.TensorProduct.one_def, TensorProduct.inner_tmul, inner_smul_right] + rw [← one_mul (modAut _ _), ← QuantumSet.inner_conj_left, one_mul] diff --git a/LeanPool/Monlib4/LinearAlgebra/QuantumSet/Pi.lean b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/Pi.lean new file mode 100644 index 0000000000..eb8cc37970 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/Pi.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import Mathlib.Algebra.Algebra.TransferInstance + +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Basic + +/-! +# Quantum Sets on Finite Products + +This file restores the finite-product quantum set instance from upstream +`Monlib.LinearAlgebra.QuantumSet.Pi`. +-/ + +open scoped BigOperators InnerProductSpace + +section Pi + +variable {ι : Type*} {A : ι -> Type*} + +/-- The `L²` finite product of quantum sets. -/ +abbrev PiQ (A : ι -> Type*) := + PiLp 2 A + +variable [hA : (i : ι) -> starAlgebra (A i)] + +@[reducible, default_instance] +noncomputable instance : Ring (PiQ A) := + (WithLp.equiv (2 : ENNReal) ((i : ι) -> A i)).ring + +@[reducible, default_instance] +noncomputable instance : Algebra ℂ (PiQ A) := + Equiv.algebra ℂ (WithLp.equiv (2 : ENNReal) ((i : ι) -> A i)) + +instance : Star (PiQ A) where + star x := WithLp.toLp (2 : ENNReal) (star x.ofLp) + +@[simp] +lemma PiLp.star_apply (x : PiQ A) (i : ι) : + (star x) i = star (x i) := + rfl + +@[simp] +lemma PiLp.mul_apply_quantum (x y : PiQ A) (i : ι) : + (x * y) i = x i * y i := + rfl + +lemma PiLp.mul_apply (x y : PiQ A) (i : ι) : + (x * y) i = x i * y i := + PiLp.mul_apply_quantum x y i + +instance : StarRing (PiQ A) where + star_involutive x := by + ext i + change star (star (x i)) = x i + rw [star_star] + star_mul x y := by + ext i + change star (x i * y i) = star (y i) * star (x i) + rw [star_mul] + star_add x y := by + ext i + change star (x i + y i) = star (x i) + star (y i) + rw [star_add] + +instance : StarModule ℂ (PiQ A) where + star_smul c x := by + ext i + change star (c • x i) = star c • star (x i) + rw [star_smul] + +/-- The pointwise modular automorphism on a finite product quantum set. -/ +noncomputable def Pi.modAut (r : ℝ) : PiQ A ≃ₐ[ℂ] PiQ A := + let e : PiQ A ≃ₐ[ℂ] ((i : ι) -> A i) := + Equiv.algEquiv ℂ (WithLp.equiv (2 : ENNReal) ((i : ι) -> A i)) + e.trans ((AlgEquiv.piCongrRight fun i => (hA i).modAut r).trans e.symm) + +@[simp] +lemma Pi.modAut_apply (r : ℝ) (x : PiQ A) (i : ι) : + Pi.modAut r x i = (hA i).modAut r (x i) := + rfl + +@[reducible, instance] +noncomputable def piStarAlgebra : starAlgebra (PiQ A) where + modAut r := Pi.modAut r + modAut_trans r s := by + ext x i + simp [starAlgebra.modAut_apply_modAut, add_comm] + modAut_star r x := by + ext i + simp [starAlgebra.modAut_star] + +@[simp] +lemma piStarAlgebra_modAut_apply (r : ℝ) (x : PiQ A) (i : ι) : + piStarAlgebra.modAut r x i = (hA i).modAut r (x i) := + rfl + +variable [hQ : (i : ι) -> QuantumSet (A i)] +variable [Fintype ι] + +noncomputable instance piInnerProductAlgebra : InnerProductAlgebra (PiQ A) where + norm_smul_le := norm_smul_le + norm_sq_eq_inner := norm_sq_eq_re_inner + dist_eq x y := by + rw [dist_eq_norm'] + congr 1 + ext i + simp [sub_eq_add_neg, add_comm] + conj_symm := inner_conj_symm + add_left := inner_add_left + smul_left := inner_smul_left + +theorem piInnerProductAlgebra_inner_apply (a b : PiQ A) : + ⟪a, b⟫_ℂ = ∑ i, ⟪a i, b i⟫_ℂ := by + rw [PiLp.inner_apply] + +theorem piInnerProductAlgebra.inner_apply (a b : PiQ A) : + ⟪a, b⟫_ℂ = ∑ i, ⟪a i, b i⟫_ℂ := + piInnerProductAlgebra_inner_apply a b + +noncomputable instance Pi.quantumSet [Fact (∀ i, (hQ i).k = 0)] : QuantumSet (PiQ A) where + modAut_isSymmetric r x y := by + rw [piInnerProductAlgebra_inner_apply, piInnerProductAlgebra_inner_apply] + apply Finset.sum_congr rfl + intro i _ + rw [piStarAlgebra_modAut_apply, piStarAlgebra_modAut_apply, + QuantumSet.modAut_isSymmetric] + k := 0 + inner_star_left x y z := by + rw [piInnerProductAlgebra_inner_apply, piInnerProductAlgebra_inner_apply] + apply Finset.sum_congr rfl + intro i _ + rw [PiLp.mul_apply_quantum, PiLp.mul_apply_quantum, piStarAlgebra_modAut_apply, + PiLp.star_apply] + have hk : (hQ i).k = 0 := (Fact.out : ∀ i, (hQ i).k = 0) i + have h := (hQ i).inner_star_left (x i) (y i) (z i) + rw [hk] at h + exact h + inner_conj_left x y z := by + rw [piInnerProductAlgebra_inner_apply, piInnerProductAlgebra_inner_apply] + apply Finset.sum_congr rfl + intro i _ + rw [PiLp.mul_apply_quantum, PiLp.mul_apply_quantum, piStarAlgebra_modAut_apply, + PiLp.star_apply] + have hk : (hQ i).k = 0 := (Fact.out : ∀ i, (hQ i).k = 0) i + simpa [hk] using (hQ i).inner_conj_left (x i) (y i) (z i) + n := (i : ι) × n (A i) + n_isFintype := by + letI : (i : ι) -> Fintype (n (A i)) := fun i => (hQ i).n_isFintype + infer_instance + n_isDecidableEq := Classical.typeDecidableEq ((i : ι) × n (A i)) + onb := by + letI : (i : ι) -> Fintype (n (A i)) := fun i => (hQ i).n_isFintype + exact Pi.orthonormalBasis fun i => (hQ i).onb + +end Pi diff --git a/LeanPool/Monlib4/LinearAlgebra/QuantumSet/QIso.lean b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/QIso.lean new file mode 100644 index 0000000000..c70fc6ee6f --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/QIso.lean @@ -0,0 +1,532 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Basic + +local notation "lT" => LinearMap.lTensor +local notation "rT" => LinearMap.rTensor + +open scoped InnerProductSpace TensorProduct + +variable {B₁ B₂ : Type*} [starAlgebra B₁] [starAlgebra B₂] + [QuantumSet B₁] [QuantumSet B₂] + +/-- The unit-preservation expression for a quantum function. -/ +noncomputable abbrev QFun.map_unit' {H : Type*} + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)) := +P ∘ₗ (rT _ (Algebra.linearMap ℂ _)) + ∘ₗ (TensorProduct.lid ℂ _).symm.toLinearMap + +/-- The multiplication-preservation expression for a quantum function. -/ +noncomputable abbrev QFun.map_mul' {H : Type*} + [NormedAddCommGroup H] [InnerProductSpace ℂ H] + (P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)) := +(lT _ (LinearMap.mul' ℂ B₂)) + ∘ₗ (TensorProduct.assoc ℂ _ _ _).toLinearMap + ∘ₗ (rT _ P) + ∘ₗ (TensorProduct.assoc ℂ _ _ _).symm.toLinearMap + ∘ₗ (lT _ P) + +/-- The reality condition expression for a quantum function. -/ +noncomputable abbrev QFun.map_real' {H : Type*} + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [FiniteDimensional ℂ H] + (P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)) := +(rT _ ((TensorProduct.lid ℂ _).toLinearMap + ∘ₗ (rT _ (Coalgebra.counit ∘ₗ LinearMap.mul' ℂ _)) + ∘ₗ (TensorProduct.assoc ℂ _ _ _).symm.toLinearMap)) + ∘ₗ (TensorProduct.assoc ℂ _ _ _).symm.toLinearMap + ∘ₗ (lT B₁ (((LinearMap.rTensor B₂ (LinearMap.adjoint P))) + ∘ₗ (TensorProduct.assoc ℂ _ _ _).symm.toLinearMap)) + ∘ₗ (TensorProduct.assoc ℂ _ _ _).toLinearMap + ∘ₗ (lT (B₁ ⊗[ℂ] H) ((Coalgebra.comul ∘ₗ Algebra.linearMap ℂ B₂))) + ∘ₗ (TensorProduct.rid ℂ (B₁ ⊗[ℂ] H)).symm.toLinearMap + +/-- A quantum function between quantum sets, encoded as a linear map with unit, +multiplication, and reality compatibility. -/ +class QFun (H : Type*) + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [FiniteDimensional ℂ H] + (P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)) : + Prop where + map_unit : QFun.map_unit' P + = (lT _ (Algebra.linearMap ℂ _)) ∘ₗ (TensorProduct.rid ℂ _).symm.toLinearMap + map_mul : QFun.map_mul' P + = P ∘ₗ (rT _ (LinearMap.mul' ℂ B₁)) + ∘ₗ (TensorProduct.assoc ℂ _ _ _).symm.toLinearMap + map_real : QFun.map_real' P = P + +lemma TensorProduct.rid_symm_adjoint {𝕜 E : Type*} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] : + LinearMap.adjoint (TensorProduct.rid 𝕜 E).symm.toLinearMap = + (TensorProduct.rid 𝕜 E).toLinearMap := +by rw [← LinearMap.adjoint_adjoint (TensorProduct.rid 𝕜 E).toLinearMap, TensorProduct.rid_adjoint] + +variable {H : Type*} + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [FiniteDimensional ℂ H] + +lemma QFun.adjoint_eq + {P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)} (hp : QFun H P) : + LinearMap.adjoint P = + (TensorProduct.rid ℂ _).toLinearMap + ∘ₗ (lT _ (Coalgebra.counit ∘ₗ LinearMap.mul' ℂ _)) + ∘ₗ (TensorProduct.assoc ℂ _ _ _).symm.toLinearMap + ∘ₗ (lT _ (((TensorProduct.assoc ℂ _ _ _).toLinearMap + ∘ₗ (rT _ P)))) + ∘ₗ (TensorProduct.assoc ℂ _ _ _).toLinearMap + ∘ₗ (rT _ ((TensorProduct.assoc ℂ _ _ _).toLinearMap + ∘ₗ (rT _ (Coalgebra.comul ∘ₗ Algebra.linearMap ℂ _)) + ∘ₗ (TensorProduct.lid ℂ _).symm.toLinearMap)) := +by + simp_rw [Coalgebra.comul_eq_mul_adjoint, Coalgebra.counit_eq_unit_adjoint] + nth_rw 1 [← LinearMap.adjoint_adjoint (LinearMap.mul' ℂ B₂)] + nth_rw 1 [← LinearMap.adjoint_adjoint (Algebra.linearMap ℂ B₁)] + simp_rw [← LinearMap.adjoint_comp, ← LinearMap.lTensor_adjoint, ← LinearMap.rTensor_adjoint] + simp_rw [← TensorProduct.lid_adjoint, ← TensorProduct.assoc_adjoint] + nth_rw 4 [← TensorProduct.assoc_symm_adjoint] + nth_rw 3 [← TensorProduct.assoc_symm_adjoint] + simp_rw [← LinearMap.adjoint_comp, ← LinearMap.rTensor_adjoint] + nth_rw 2 [← LinearMap.adjoint_adjoint P] + rw [← LinearMap.rTensor_adjoint] + nth_rw 2 [← TensorProduct.assoc_symm_adjoint] + simp_rw [← LinearMap.adjoint_comp, ← LinearMap.lTensor_adjoint, ← LinearMap.adjoint_comp] + rw [← TensorProduct.rid_symm_adjoint] + simp only [← LinearMap.adjoint_comp] + simp_rw [← Coalgebra.comul_eq_mul_adjoint, LinearMap.comp_assoc] + nth_rw 1 [← hp.map_real] + simp only [QFun.map_real', Coalgebra.counit_eq_unit_adjoint] + congr <;> exact IsScalarTower.Algebra.ext_iff.mpr fun r ↦ congrFun rfl + +/-- The counit-preservation expression for a quantum function. -/ +noncomputable abbrev QFun.map_counit' (P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)) := +(TensorProduct.rid ℂ _).toLinearMap ∘ₗ (lT H Coalgebra.counit) ∘ₗ P + +/-- The comultiplication-preservation expression for a quantum function. -/ +noncomputable abbrev QFun.map_comul' (P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)) := +(rT B₂ P) + ∘ₗ (TensorProduct.assoc ℂ _ _ _).symm.toLinearMap + ∘ₗ (lT B₁ P) + ∘ₗ (TensorProduct.assoc ℂ _ _ _).toLinearMap + ∘ₗ (rT H Coalgebra.comul) + +/-- A quantum function is quantum-bijective when it also preserves counit and +comultiplication. -/ +class QFun.qBijective + {P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)} (hp : QFun H P) : + Prop where + map_counit : QFun.map_counit' P = (TensorProduct.lid ℂ H).toLinearMap ∘ₗ (rT H Coalgebra.counit) + map_comul : QFun.map_comul' P + = (TensorProduct.assoc ℂ _ _ _).symm.toLinearMap ∘ₗ (lT H Coalgebra.comul) ∘ₗ P + + +section +variable {R : Type*} [CommSemiring R] + +local notation "m" => LinearMap.mul' R +local notation "ϰ" => TensorProduct.assoc R +local notation "τ" => TensorProduct.lid R +local notation "τ'" => TensorProduct.rid R +local notation x " ⊗ₘ " y => TensorProduct.map x y + +theorem LinearMap.comp_rid_eq_rid_comp_rTensor {M M₂ : Type*} [AddCommMonoid M] [Module R M] + [AddCommMonoid M₂] [Module R M₂] (f : M →ₗ[R] M₂) : + f ∘ₗ (τ' M).toLinearMap = (τ' M₂).toLinearMap ∘ₗ (rT R f) := +by ext; simp + +theorem LinearMap.rTensor_lid_symm_comp_eq_assoc_symm_comp_lTensor_comp_lid_symm + {M₁ M₂ M₃ M₄ : Type*} + [AddCommMonoid M₁] [AddCommMonoid M₂] [AddCommMonoid M₃] [AddCommMonoid M₄] + [Module R M₁] [Module R M₂] [Module R M₃] [Module R M₄] + (f : M₁ ⊗[R] M₂ →ₗ[R] M₃ ⊗[R] M₄) : + (rT M₄ (τ _).symm.toLinearMap) ∘ₗ f + = (ϰ _ _ _).symm.toLinearMap ∘ₗ (lT _ f) ∘ₗ (τ _).symm.toLinearMap := +by + ext a b + obtain ⟨S, hS⟩ := TensorProduct.exists_finset (R := R) (f (a ⊗ₜ[R] b)) + simp [hS, TensorProduct.tmul_sum] + +theorem LinearMap.rTensor_tensor_eq_assoc_comp_rTensor_rTensor_comp_assoc_symm + {A B C D : Type*} [AddCommMonoid A] + [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] (x : A →ₗ[R] D) : + rT (B ⊗[R] C) x = + (ϰ _ _ _).toLinearMap + ∘ₗ rT C (rT B x) + ∘ₗ (ϰ A B C).symm.toLinearMap := +by + rw [← TensorProduct.assoc_symm_comp_rTensor, ← LinearMap.comp_assoc, + LinearEquiv.comp_coe, LinearEquiv.symm_trans_self] + rfl +theorem LinearMap.rTensor_rTensor_eq_assoc_symm_comp_rTensor_comp_assoc + {A B C D : Type*} [AddCommMonoid A] + [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] (x : A →ₗ[R] D) : + rT C (rT B x) = (ϰ _ _ _).symm.toLinearMap ∘ₗ (rT _ x) ∘ₗ (ϰ _ _ _).toLinearMap := +by + rw [rTensor_tensor_eq_assoc_comp_rTensor_rTensor_comp_assoc_symm] + ext + simp + +theorem TensorProduct.lTensor_lTensor_comp_assoc {A B C D : Type*} + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] (x : A →ₗ[R] D) : + lT B (lT C x) ∘ₗ (ϰ _ _ _).toLinearMap = (ϰ _ _ _).toLinearMap ∘ₗ lT _ x := +by ext; simp + +theorem LinearMap.rTensor_assoc_symm_comp_assoc_symm {A B C D : Type*} [AddCommMonoid A] + [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] : + rT D (ϰ A B C).symm.toLinearMap ∘ₗ (ϰ A (B ⊗[R] C) D).symm.toLinearMap + = (ϰ (A ⊗[R] B) C D).symm.toLinearMap ∘ₗ (ϰ A B (C ⊗[R] D)).symm.toLinearMap + ∘ₗ (lT A (ϰ B C D).toLinearMap) := +by ext; simp + +theorem rid_tensor {A B : Type*} [AddCommMonoid A] [Module R A] [AddCommMonoid B] [Module R B] : + (τ' (TensorProduct R A B)).toLinearMap = lT A (τ' B).toLinearMap ∘ₗ (ϰ A B R).toLinearMap := +by ext; simp + +theorem FrobeniusAlgebra.snake_equation_2 {A : Type*} [Semiring A] [FrobeniusAlgebra R A] : + (τ' _).toLinearMap ∘ₗ (lT _ (Coalgebra.counit ∘ₗ LinearMap.mul' R _)) + ∘ₗ (ϰ _ _ _).toLinearMap ∘ₗ (rT _ (Coalgebra.comul ∘ₗ Algebra.linearMap R _)) + ∘ₗ (τ A).symm.toLinearMap + = 1 := +by + nth_rw 2 [← LinearMap.comp_assoc] + nth_rw 2 [← LinearMap.comp_assoc] + nth_rw 2 [LinearMap.comp_assoc] + rw [lTensor_counit_mul_comp_rTensor_comul_unit] + ext + simp + +end + +local notation "ϰ" => TensorProduct.assoc ℂ +local notation "τ" => TensorProduct.lid ℂ +local notation "τ'" => TensorProduct.rid ℂ +local notation "η" => Algebra.linearMap ℂ + +theorem QFun.self_comp_adjoint_eq_id_of_map_comul + {P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)} (hp : QFun H P) + (h : QFun.map_comul' P = (ϰ _ _ _).symm.toLinearMap ∘ₗ (lT H Coalgebra.comul) ∘ₗ P) : + P ∘ₗ LinearMap.adjoint P = 1 := +by + rw [QFun.adjoint_eq hp] + simp only [← LinearMap.comp_assoc] + rw [LinearMap.comp_rid_eq_rid_comp_rTensor] + simp only [LinearMap.comp_assoc, rTensor_comp_lTensor'] + rw [LinearMap.rTensor_tensor_eq_assoc_comp_rTensor_rTensor_comp_assoc_symm] + simp only [LinearMap.rTensor_comp, LinearMap.lTensor_comp, LinearMap.comp_assoc] + rw [← LinearMap.comp_assoc _ _ (ϰ (B₁ ⊗[ℂ] H) _ _).symm.toLinearMap] + rw [← LinearMap.comp_assoc (lT B₁ (rT B₂ P) ∘ₗ _ ∘ₗ _ ∘ₗ _ ∘ₗ _), + LinearMap.comp_assoc (lT _ _) _ _] + rw [← LinearMap.rTensor_assoc_symm_comp_assoc_symm] + rw [← LinearMap.comp_assoc _ _ (rT B₂ (rT _ _)), + ← LinearMap.comp_assoc _ _ (rT B₂ (rT _ _)), + ← LinearMap.rTensor_comp] + rw [LinearMap.comp_assoc, ← LinearMap.comp_assoc _ _ (ϰ _ _ _).symm.toLinearMap] + rw [← TensorProduct.rTensor_lTensor_comp_assoc_symm, + LinearMap.comp_assoc, ← LinearMap.comp_assoc _ _ (ϰ _ _ _).symm.toLinearMap, + LinearEquiv.comp_coe, LinearEquiv.self_trans_symm, + LinearEquiv.refl_toLinearMap, LinearMap.id_comp] + simp only [LinearMap.comp_assoc, ← LinearMap.rTensor_comp] + simp only [← LinearMap.comp_assoc] at h ⊢ + rw [h] + simp only [LinearMap.comp_assoc, hp.1] + rw [← LinearMap.comp_assoc _ _ (lT (H ⊗[ℂ] B₂) _), + ← LinearMap.lTensor_comp, ← LinearMap.comp_assoc _ _ (lT H _), + ← LinearMap.lTensor_comp, ← LinearMap.comp_assoc _ _ (lT _ _)] + ext a b + simp only [TensorProduct.AlgebraTensorModule.curry_apply, LinearMap.restrictScalars_self, + TensorProduct.curry_apply, LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, + LinearMap.rTensor_tmul, TensorProduct.rid_symm_apply, LinearMap.lTensor_tmul, + Algebra.linearMap_apply, map_one, Module.End.one_apply] + obtain ⟨S, hS⟩ := TensorProduct.exists_finset (R := ℂ) (Coalgebra.comul (1 : B₂)) + rw [hS] + simp only [TensorProduct.sum_tmul, TensorProduct.tmul_sum, map_sum, LinearMap.comp_apply, + TensorProduct.assoc_tmul, TensorProduct.assoc_symm_tmul, LinearMap.lTensor_tmul, + LinearMap.mul'_apply, TensorProduct.rid_tmul] + simp_rw [TensorProduct.smul_tmul', TensorProduct.smul_tmul, ← TensorProduct.tmul_sum] + congr + simp_rw [← TensorProduct.rid_tmul, + ← LinearMap.mul'_apply (R := ℂ) (A := B₂), ← LinearMap.comp_apply, + ← LinearMap.lTensor_tmul, ← TensorProduct.assoc_tmul, + ← LinearEquiv.coe_toLinearMap, ← map_sum] + rw [← TensorProduct.sum_tmul, ← hS] + have := @FrobeniusAlgebra.lTensor_counit_mul_comp_rTensor_comul_unit (R := ℂ) (A := B₂) + _ _ (QuantumSet.isFrobeniusAlgebra (A := B₂)) + simp only [TensorProduct.ext_iff', LinearMap.comp_apply, LinearMap.rTensor_tmul, + LinearEquiv.coe_coe, TensorProduct.comm_tmul, Algebra.linearMap_apply, + Algebra.algebraMap_eq_smul_one] at this + specialize this 1 + simp only [one_smul] at this + simp [this] + +theorem QFun.adjoint_comp_self_eq_id_of_map_counit + {P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)} (hp : QFun H P) + (h : QFun.map_counit' P = (τ H).toLinearMap ∘ₗ (rT H Coalgebra.counit)) : + LinearMap.adjoint P ∘ₗ P = 1 := +by + rw [QFun.adjoint_eq hp] + simp only [LinearMap.rTensor_comp, LinearMap.lTensor_comp, LinearMap.comp_assoc] + rw [LinearMap.rTensor_lid_symm_comp_eq_assoc_symm_comp_lTensor_comp_lid_symm, + ← LinearMap.comp_assoc (_ ∘ₗ (τ _).symm.toLinearMap) _ (rT _ (rT _ _)), + ← TensorProduct.assoc_symm_comp_rTensor] + simp only [LinearMap.comp_assoc] + rw [← LinearMap.comp_assoc _ (ϰ B₁ H B₂).symm.toLinearMap, + ← TensorProduct.assoc_symm_comp_rTensor, + ← LinearMap.comp_assoc _ _ (rT _ (η B₁)), + LinearMap.rTensor_comp_lTensor, ← LinearMap.lTensor_comp_rTensor] + simp only [LinearMap.comp_assoc] + rw [← LinearMap.comp_assoc (_ ∘ₗ _) (lT B₁ P) (rT (H ⊗[ℂ] B₂) _), + LinearMap.rTensor_comp_lTensor, ← LinearMap.lTensor_comp_rTensor] + have : + (ϰ B₁ (B₁ ⊗[ℂ] H) B₂).toLinearMap + ∘ₗ rT B₂ (ϰ B₁ B₁ H).toLinearMap + ∘ₗ (ϰ (B₁ ⊗[ℂ] B₁) H B₂).symm.toLinearMap + = lT _ (ϰ _ _ _).symm.toLinearMap ∘ₗ (ϰ _ _ _).toLinearMap := + by + apply TensorProduct.ext_fourfold' + intro a b c d + simp + calc (τ' (B₁ ⊗[ℂ] H)).toLinearMap ∘ₗ lT (B₁ ⊗[ℂ] H) Coalgebra.counit + ∘ₗ lT (B₁ ⊗[ℂ] H) (LinearMap.mul' ℂ B₂) + ∘ₗ (ϰ B₁ H (B₂ ⊗[ℂ] B₂)).symm.toLinearMap + ∘ₗ lT B₁ (ϰ H B₂ B₂).toLinearMap + ∘ₗ lT B₁ (rT B₂ P) + ∘ₗ (ϰ B₁ (B₁ ⊗[ℂ] H) B₂).toLinearMap + ∘ₗ rT B₂ (ϰ B₁ B₁ H).toLinearMap + ∘ₗ (ϰ (B₁ ⊗[ℂ] B₁) H B₂).symm.toLinearMap + ∘ₗ lT (B₁ ⊗[ℂ] B₁) P + ∘ₗ rT (B₁ ⊗[ℂ] H) Coalgebra.comul + ∘ₗ rT (B₁ ⊗[ℂ] H) (η B₁) ∘ₗ (τ (B₁ ⊗[ℂ] H)).symm.toLinearMap + = (τ' (B₁ ⊗[ℂ] H)).toLinearMap ∘ₗ lT (B₁ ⊗[ℂ] H) Coalgebra.counit + ∘ₗ ((ϰ _ _ _).symm.toLinearMap ∘ₗ lT _ (lT _ (LinearMap.mul' ℂ B₂))) + ∘ₗ (lT _ ((ϰ H _ _).toLinearMap ∘ₗ rT B₂ P)) + ∘ₗ (lT _ (ϰ _ _ _).symm.toLinearMap ∘ₗ (ϰ _ _ _).toLinearMap) + ∘ₗ lT _ P + ∘ₗ rT (B₁ ⊗[ℂ] H) Coalgebra.comul + ∘ₗ rT (B₁ ⊗[ℂ] H) (η B₁) ∘ₗ (τ (B₁ ⊗[ℂ] H)).symm.toLinearMap := + by + rw [TensorProduct.assoc_symm_comp_lTensor_lTensor, ← this] + simp only [LinearMap.lTensor_comp, LinearMap.comp_assoc] + _ = (τ' (B₁ ⊗[ℂ] H)).toLinearMap ∘ₗ lT (B₁ ⊗[ℂ] H) Coalgebra.counit + ∘ₗ (ϰ _ _ _).symm.toLinearMap + ∘ₗ lT _ (lT _ (LinearMap.mul' ℂ B₂) ∘ₗ (ϰ _ _ _).toLinearMap ∘ₗ rT _ P + ∘ₗ (ϰ _ _ _).symm.toLinearMap) + ∘ₗ (lT _ (lT _ P) ∘ₗ (ϰ _ _ _).toLinearMap) + ∘ₗ rT (B₁ ⊗[ℂ] H) Coalgebra.comul + ∘ₗ rT (B₁ ⊗[ℂ] H) (η B₁) ∘ₗ (τ (B₁ ⊗[ℂ] H)).symm.toLinearMap := + by + rw [TensorProduct.lTensor_lTensor_comp_assoc] + simp only [LinearMap.lTensor_comp, LinearMap.comp_assoc] + _ = (τ' (B₁ ⊗[ℂ] H)).toLinearMap ∘ₗ lT (B₁ ⊗[ℂ] H) Coalgebra.counit + ∘ₗ (ϰ _ _ _).symm.toLinearMap + ∘ₗ lT _ (lT _ (LinearMap.mul' ℂ B₂) ∘ₗ (ϰ _ _ _).toLinearMap ∘ₗ rT _ P + ∘ₗ (ϰ _ _ _).symm.toLinearMap ∘ₗ lT _ P) + ∘ₗ (ϰ _ _ _).toLinearMap + ∘ₗ rT (B₁ ⊗[ℂ] H) Coalgebra.comul + ∘ₗ rT (B₁ ⊗[ℂ] H) (η B₁) ∘ₗ (τ (B₁ ⊗[ℂ] H)).symm.toLinearMap := + by + simp only [LinearMap.lTensor_comp, LinearMap.comp_assoc] + _ = (τ' (B₁ ⊗[ℂ] H)).toLinearMap ∘ₗ (lT (B₁ ⊗[ℂ] H) Coalgebra.counit + ∘ₗ (ϰ _ _ _).symm.toLinearMap) + ∘ₗ lT _ (P ∘ₗ (rT _ (LinearMap.mul' ℂ B₁)) ∘ₗ (ϰ _ _ _).symm.toLinearMap) + ∘ₗ (ϰ _ _ _).toLinearMap + ∘ₗ rT (B₁ ⊗[ℂ] H) Coalgebra.comul + ∘ₗ rT (B₁ ⊗[ℂ] H) (η B₁) ∘ₗ (τ (B₁ ⊗[ℂ] H)).symm.toLinearMap := + by + simp only [hp.map_mul, LinearMap.comp_assoc] + _ = lT _ (τ' _).toLinearMap ∘ₗ ((ϰ _ _ _).toLinearMap ∘ₗ (ϰ _ _ _).symm.toLinearMap) + ∘ₗ lT _ (lT _ Coalgebra.counit ∘ₗ P ∘ₗ (rT _ (LinearMap.mul' ℂ B₁)) + ∘ₗ (ϰ _ _ _).symm.toLinearMap) + ∘ₗ (ϰ _ _ _).toLinearMap + ∘ₗ rT (B₁ ⊗[ℂ] H) (Coalgebra.comul ∘ₗ η B₁) + ∘ₗ (τ (B₁ ⊗[ℂ] H)).symm.toLinearMap := + by + simp only [← TensorProduct.assoc_symm_comp_lTensor_lTensor, rid_tensor, + LinearMap.lTensor_comp, LinearMap.rTensor_comp, LinearMap.comp_assoc] + _ = lT _ (((τ' _).toLinearMap ∘ₗ lT _ Coalgebra.counit ∘ₗ P) + ∘ₗ (rT _ (LinearMap.mul' ℂ B₁)) ∘ₗ (ϰ _ _ _).symm.toLinearMap) + ∘ₗ (ϰ _ _ _).toLinearMap + ∘ₗ rT (B₁ ⊗[ℂ] H) (Coalgebra.comul ∘ₗ η B₁) + ∘ₗ (τ (B₁ ⊗[ℂ] H)).symm.toLinearMap := + by + simp only [LinearEquiv.comp_coe, LinearEquiv.symm_trans_self, + LinearEquiv.refl_toLinearMap, LinearMap.id_comp, LinearMap.lTensor_comp, + LinearMap.comp_assoc] + _ = lT _ (((τ H).toLinearMap ∘ₗ (rT H Coalgebra.counit)) + ∘ₗ (rT _ (LinearMap.mul' ℂ B₁)) ∘ₗ (ϰ _ _ _).symm.toLinearMap) + ∘ₗ (ϰ _ _ _).toLinearMap + ∘ₗ rT (B₁ ⊗[ℂ] H) (Coalgebra.comul ∘ₗ η B₁) + ∘ₗ (τ (B₁ ⊗[ℂ] H)).symm.toLinearMap := + by simp [h] + _ = rT H ((τ' _).toLinearMap ∘ₗ (lT _ (Coalgebra.counit ∘ₗ LinearMap.mul' ℂ _)) + ∘ₗ (ϰ _ _ _).toLinearMap ∘ₗ (rT _ (Coalgebra.comul ∘ₗ η _)) + ∘ₗ (τ _).symm.toLinearMap) := + by + ext + obtain ⟨S, hS⟩ := TensorProduct.exists_finset (R := ℂ) (Coalgebra.comul (1 : B₁)) + simp only [TensorProduct.AlgebraTensorModule.curry_apply, LinearMap.restrictScalars_self, + TensorProduct.curry_apply, LinearMap.coe_comp, LinearEquiv.coe_coe, + Function.comp_apply, TensorProduct.lid_symm_apply, LinearMap.rTensor_tmul, + Algebra.linearMap_apply, map_one] + rw [hS] + simp [TensorProduct.sum_tmul, map_sum, TensorProduct.smul_tmul] + _ = rT H 1 := + by + convert congrArg (rT H) (@FrobeniusAlgebra.snake_equation_2 ℂ _ B₁ _ + (QuantumSet.isFrobeniusAlgebra (A := B₁))) using 2 + congr 4 + ext r + simp [Algebra.linearMap_apply, Algebra.algebraMap_eq_smul_one] + _ = 1 := by ext; simp + +theorem QFun.map_counit_of_adjoint_comp_self_eq_id + {P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)} (hp : QFun H P) (h : LinearMap.adjoint P ∘ₗ P = 1) : + map_counit' P = (τ H).toLinearMap ∘ₗ (rT H Coalgebra.counit) := +by + have := + calc LinearMap.adjoint P ∘ₗ (lT H (η B₂) ∘ₗ (τ' H).symm.toLinearMap) + = LinearMap.adjoint P ∘ₗ (P ∘ₗ rT H (η _) ∘ₗ (τ H).symm.toLinearMap) := + by rw [← hp.map_unit] + _ = rT H (η _) ∘ₗ (τ H).symm.toLinearMap := + by rw [← LinearMap.comp_assoc, h, LinearMap.one_comp] + apply_fun LinearMap.adjoint at this + simp only [LinearMap.adjoint_comp, LinearMap.lTensor_adjoint, LinearMap.rTensor_adjoint, + ← TensorProduct.rid_adjoint, LinearMap.adjoint_adjoint, ← TensorProduct.lid_adjoint, + LinearMap.comp_assoc] at this + rw [← sub_eq_zero] at this ⊢ + simp only [map_counit', Coalgebra.counit_eq_unit_adjoint] + rw [← this] + congr <;> ext <;> simp + +lemma LinearMap.lTensor_one {R M₁ M₂ : Type*} [CommSemiring R] [AddCommMonoid M₁] [AddCommMonoid M₂] + [Module R M₁] [Module R M₂] : + lT M₁ (1 : M₂ →ₗ[R] M₂) = 1 := +by ext; simp +lemma LinearMap.rTensor_one {R M₁ M₂ : Type*} [CommSemiring R] [AddCommMonoid M₁] [AddCommMonoid M₂] + [Module R M₁] [Module R M₂] : + rT M₁ (1 : M₂ →ₗ[R] M₂) = 1 := +by ext; simp + +theorem QFun.map_comul_of_inv_eq_adjoint + {P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)} (hp : QFun H P) (h₁ : P ∘ₗ LinearMap.adjoint P = 1) + (h₂ : LinearMap.adjoint P ∘ₗ P = 1) : + map_comul' P = (ϰ _ _ _).symm.toLinearMap ∘ₗ (lT H Coalgebra.comul) ∘ₗ P := +by + have : LinearMap.adjoint P ∘ₗ map_mul' P ∘ₗ (lT B₁ (LinearMap.adjoint P)) + ∘ₗ (ϰ _ _ _).toLinearMap ∘ₗ (rT B₂ (LinearMap.adjoint P)) = LinearMap.adjoint (map_comul' P) := + by + rw [hp.map_mul] + simp_rw [← LinearMap.comp_assoc, h₂, LinearMap.one_comp, ← LinearMap.lTensor_adjoint, + ← LinearMap.rTensor_adjoint, Coalgebra.comul_eq_mul_adjoint] + rw [← TensorProduct.assoc_adjoint] + nth_rw 2 [← TensorProduct.assoc_symm_adjoint] + nth_rw 1 [← LinearMap.adjoint_adjoint (LinearMap.mul' ℂ B₁)] + rw [← LinearMap.rTensor_adjoint] + simp only [← LinearMap.adjoint_comp, LinearMap.comp_assoc] + simp_all [map_mul', LinearMap.comp_assoc] + rw [← LinearMap.comp_assoc _ _ (lT B₁ P), ← LinearMap.lTensor_comp, h₁, LinearMap.lTensor_one, + LinearMap.one_comp, ← LinearMap.comp_assoc _ _ (ϰ _ _ _).symm.toLinearMap, + LinearEquiv.comp_coe, LinearEquiv.self_trans_symm] at this + simp only [LinearEquiv.refl_toLinearMap] at this + rw [LinearMap.id_comp, ← LinearMap.rTensor_comp, h₁, LinearMap.rTensor_one, + LinearMap.comp_one] at this + apply_fun LinearMap.adjoint at this + simp only [LinearMap.adjoint_comp, LinearMap.adjoint_adjoint] at this + simpa only [map_comul', TensorProduct.assoc_adjoint, TensorProduct.assoc_symm_adjoint, + LinearMap.lTensor_adjoint, LinearMap.rTensor_adjoint, Coalgebra.comul_eq_mul_adjoint, + LinearMap.adjoint_adjoint, LinearMap.comp_assoc] using this.symm + +theorem QFun.qBijective_iff_inv_eq_adjoint + {P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)} (hp : QFun H P) : + hp.qBijective ↔ P ∘ₗ LinearMap.adjoint P = 1 ∧ LinearMap.adjoint P ∘ₗ P = 1 := +⟨fun h => ⟨hp.self_comp_adjoint_eq_id_of_map_comul h.2, + hp.adjoint_comp_self_eq_id_of_map_counit h.1⟩, + fun ⟨h1, h2⟩ => ⟨hp.map_counit_of_adjoint_comp_self_eq_id h2, + hp.map_comul_of_inv_eq_adjoint h1 h2⟩⟩ + +/-- The linear equivalence induced by a quantum-bijective quantum function. -/ +noncomputable def QFun.qBijective.toLinearEquiv + {P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)} [hp : QFun H P] + (h : hp.qBijective) : + (B₁ ⊗[ℂ] H) ≃ₗ[ℂ] (H ⊗[ℂ] B₂) where + toLinearMap := P + invFun := LinearMap.adjoint P + left_inv _ := by + simp only [LinearMap.toFun_eq_coe, ← LinearMap.comp_apply] + rw [(hp.qBijective_iff_inv_eq_adjoint.mp h).2, Module.End.one_apply] + right_inv _ := by + simp only [LinearMap.toFun_eq_coe, ← LinearMap.comp_apply] + rw [(hp.qBijective_iff_inv_eq_adjoint.mp h).1, Module.End.one_apply] + +lemma QFun.qBijective.toLinearEquiv_toLinearMap + {P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)} [hp : QFun H P] + (h : hp.qBijective) : + h.toLinearEquiv.toLinearMap = P := +rfl + +lemma QFun.qBijective.toLinearEquiv_symm_toLinearMap + {P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)} [hp : QFun H P] + (h : hp.qBijective) : + h.toLinearEquiv.symm.toLinearMap = LinearMap.adjoint P := +rfl + +theorem QFun.qBijective_iso_id + {P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)} [hp : QFun H P] (h : hp.qBijective) : + h.toLinearEquiv.toLinearMap ∘ₗ + (rT _ 1) ∘ₗ h.toLinearEquiv.symm.toLinearMap = lT _ 1 := +by + ext + simp [LinearMap.rTensor_one, LinearMap.lTensor_one] + +theorem rankOne_one_one_eq : + ContinuousLinearMap.toLinearMap (rankOne ℂ (1 : B₁) (1 : B₂)) = η B₁ ∘ₗ Coalgebra.counit := +by + rw [Coalgebra.counit_eq_bra_one] + ext + simp [Algebra.algebraMap_eq_smul_one] + +lemma QFun.map_unit'' {P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)} (hp : QFun H P) : + P ∘ₗ rT H (η B₁) = lT H (η B₂) ∘ₗ (TensorProduct.comm ℂ _ _).toLinearMap := +calc P ∘ₗ rT H (η B₁) = lT H (η B₂) ∘ₗ ((τ' _).symm.toLinearMap ∘ₗ (τ _).toLinearMap) := + by + rw [← LinearMap.comp_assoc, ← hp.map_unit, map_unit'] + simp only [LinearMap.comp_assoc, LinearEquiv.comp_coe, LinearEquiv.self_trans_symm] + rfl + _ = lT H (η B₂) ∘ₗ (TensorProduct.comm ℂ _ _).toLinearMap := by ext; simp + +lemma QFun.counit_map_adjoint {P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)} (hp : QFun H P) : + (rT _ Coalgebra.counit) ∘ₗ LinearMap.adjoint P + = (TensorProduct.comm ℂ _ _).symm.toLinearMap ∘ₗ lT _ Coalgebra.counit := +calc (rT _ Coalgebra.counit) ∘ₗ LinearMap.adjoint P + = LinearMap.adjoint (P ∘ₗ (rT _ (η B₁))) := + by + rw [Coalgebra.counit_eq_unit_adjoint, ← LinearMap.rTensor_adjoint, + LinearMap.adjoint_comp] + congr; ext; rfl + _ = LinearMap.adjoint (lT H (η B₂) ∘ₗ (TensorProduct.comm ℂ _ _).toLinearMap) := + by rw [hp.map_unit''] + _ = (TensorProduct.comm ℂ _ _).symm.toLinearMap ∘ₗ lT _ Coalgebra.counit := + by + rw [LinearMap.adjoint_comp, LinearMap.lTensor_adjoint, + Coalgebra.counit_eq_unit_adjoint, TensorProduct.comm_adjoint] + congr; ext; rfl + +/-- for any `qBijective` function `P`, + we get `P ∘ (|1⟩⟨1| ⊗ id) ∘ adjoint P = (id ⊗ |1⟩⟨1|)`. -/ +theorem QFun.qBijective_iso_rankOne_one_one + {P : (B₁ ⊗[ℂ] H) →ₗ[ℂ] (H ⊗[ℂ] B₂)} [hp : QFun H P] (h : hp.qBijective) : + h.toLinearEquiv.toLinearMap ∘ₗ (rT _ (rankOne ℂ (1 : B₁) (1 : B₁))) + ∘ₗ h.toLinearEquiv.symm.toLinearMap + = lT _ (rankOne ℂ (1 : B₂) (1 : B₂)) := +by + rw [rankOne_one_one_eq, LinearMap.rTensor_comp, + h.toLinearEquiv_toLinearMap, h.toLinearEquiv_symm_toLinearMap, + LinearMap.comp_assoc, hp.counit_map_adjoint, ← LinearMap.comp_assoc, hp.map_unit''] + nth_rw 1 [LinearMap.comp_assoc] + nth_rw 2 [← LinearMap.comp_assoc] + rw [LinearEquiv.comp_coe, LinearEquiv.symm_trans_self, LinearEquiv.refl_toLinearMap, + LinearMap.id_comp, ← LinearMap.lTensor_comp, rankOne_one_one_eq] diff --git a/LeanPool/Monlib4/LinearAlgebra/QuantumSet/SchurMul.lean b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/SchurMul.lean new file mode 100644 index 0000000000..8a26545b47 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/SchurMul.lean @@ -0,0 +1,423 @@ +/- +Copyright (c) 2024 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Basic +import Mathlib.RingTheory.Coalgebra.Basic +import Mathlib.RingTheory.Coalgebra.Hom + +/-! +# Schur Product Operator + +This file ports the definition of the upstream `Monlib.LinearAlgebra.QuantumSet.SchurMul` +operator. The deeper upstream Schur-product theorem stack depends on the finite-dimensional +Hilbert-algebra coalgebra instance and tensor-product infrastructure that are not yet recovered +in the current monlib4 slice. +-/ + +open scoped TensorProduct BigOperators + +local notation "m" x => LinearMap.mul' ℂ x +local notation x " ⊗ₘ " y => TensorProduct.map x y + +open Coalgebra + +/-- Schur product `x •ₛ y := m ∘ (x ⊗ y) ∘ comul`. -/ +@[simps] +noncomputable def schurMul {B C : Type*} + [AddCommMonoid B] [NonUnitalNonAssocSemiring C] + [Module ℂ B] [Module ℂ C] [CoalgebraStruct ℂ B] + [SMulCommClass ℂ C C] [IsScalarTower ℂ C C] : + (B →ₗ[ℂ] C) →ₗ[ℂ] (B →ₗ[ℂ] C) →ₗ[ℂ] (B →ₗ[ℂ] C) where + toFun x := + { toFun := fun y => (m C) ∘ₗ (x ⊗ₘ y) ∘ₗ comul + map_add' := fun _ _ => by + simp only [TensorProduct.map_add_right, LinearMap.add_comp, LinearMap.comp_add] + map_smul' := fun _ _ => by + simp only [TensorProduct.map_smul_right, LinearMap.smul_comp, LinearMap.comp_smul, + RingHom.id_apply] } + map_add' x y := by + simp only [TensorProduct.map_add_left, LinearMap.add_comp, LinearMap.comp_add, + LinearMap.ext_iff, LinearMap.add_apply, LinearMap.coe_mk] + intro _ _ + rfl + map_smul' r x := by + simp only [TensorProduct.map_smul_left, LinearMap.smul_comp, LinearMap.comp_smul, + LinearMap.ext_iff, LinearMap.smul_apply, LinearMap.coe_mk, RingHom.id_apply] + intro _ _ + rfl + +@[inherit_doc schurMul] +notation3:80 (name := schurMulNotation) x:81 " •ₛ " y:80 => schurMul x y + +theorem nonUnitalAlgHom_comp_mul {R A B : Type*} [CommSemiring R] [Semiring A] + [Semiring B] [Algebra R A] [Algebra R B] (f : A →ₙₐ[R] B) : + (LinearMapClass.linearMap f) ∘ₗ LinearMap.mul' R A = + (LinearMap.mul' R B) ∘ₗ + ((LinearMapClass.linearMap f) ⊗ₘ (LinearMapClass.linearMap f)) := by + rw [TensorProduct.ext_iff'] + intro a b + simp only [LinearMap.comp_apply, LinearMap.mul'_apply, TensorProduct.map_tmul] + exact NonUnitalAlgHom.map_mul f a b + +theorem algHom_comp_mul {R A B : Type*} [CommSemiring R] [Semiring A] + [Semiring B] [Algebra R A] [Algebra R B] (f : A →ₐ[R] B) : + f.toLinearMap ∘ₗ LinearMap.mul' R A = + (LinearMap.mul' R B) ∘ₗ (f.toLinearMap ⊗ₘ f.toLinearMap) := + by simpa using nonUnitalAlgHom_comp_mul f.toNonUnitalAlgHom + +attribute [local instance] Algebra.ofIsScalarTowerSmulCommClass + +variable {A B : Type*} + [NormedAddCommGroupOfRing A] [NormedAddCommGroupOfRing B] + [InnerProductSpace ℂ A] [InnerProductSpace ℂ B] + [SMulCommClass ℂ A A] [SMulCommClass ℂ B B] + [IsScalarTower ℂ A A] [IsScalarTower ℂ B B] + [FiniteDimensional ℂ A] [FiniteDimensional ℂ B] + +omit [FiniteDimensional ℂ B] in +theorem schurMul.apply_rankOne (a c : B) (b d : A) : + (rankOne ℂ a b).toLinearMap •ₛ (rankOne ℂ c d).toLinearMap = + (rankOne ℂ (a * c) (b * d) : A →L[ℂ] B).toLinearMap := by + rw [schurMul, LinearMap.ext_iff] + intro x + apply ext_inner_right ℂ + intro u + simp only [ContinuousLinearMap.coe_coe, LinearMap.coe_mk, AddHom.coe_mk, + rankOne_apply, LinearMap.comp_apply] + obtain ⟨α, β, h⟩ := TensorProduct.eq_span (Coalgebra.comul x : A ⊗[ℂ] A) + rw [← h] + simp_rw [map_sum, TensorProduct.map_tmul, ContinuousLinearMap.coe_coe, + rankOne_apply, LinearMap.mul'_apply, smul_mul_smul_comm, + ← TensorProduct.inner_tmul, ← Finset.sum_smul, ← inner_sum, h, + Coalgebra.comul_eq_mul_adjoint, LinearMap.adjoint_inner_right, + LinearMap.mul'_apply] + +omit [FiniteDimensional ℂ B] in +theorem schurMul.apply_ket (a b : B) : + (ket ℂ a) •ₛ (ket ℂ b) = (ket ℂ (a * b)).toLinearMap := by + simp only [schurMul_apply_apply, QuantumSet.complex_comul] + ext + simp only [LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, + TensorProduct.lid_symm_apply, TensorProduct.map_tmul, ContinuousLinearMap.coe_coe, + ket_apply_apply, one_smul, LinearMap.mul'_apply] + +section TensorRankOne + +variable {𝕜 B C : Type*} [RCLike 𝕜] [NormedAddCommGroup B] [NormedAddCommGroup C] + [InnerProductSpace 𝕜 B] [InnerProductSpace 𝕜 C] + [FiniteDimensional 𝕜 B] [FiniteDimensional 𝕜 C] + +omit [FiniteDimensional 𝕜 B] [FiniteDimensional 𝕜 C] in +theorem bra_tmul (a : B) (b : C) : + (bra 𝕜 (a ⊗ₜ[𝕜] b)).toLinearMap = + (TensorProduct.lid 𝕜 _).toLinearMap ∘ₗ + TensorProduct.map (bra 𝕜 a).toLinearMap (bra 𝕜 b).toLinearMap := by + ext + simp only [TensorProduct.AlgebraTensorModule.curry_apply, TensorProduct.curry_apply, + LinearMap.coe_restrictScalars, TensorProduct.map_tmul, ContinuousLinearMap.coe_coe, + innerSL_apply_apply, LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, + TensorProduct.inner_tmul, TensorProduct.lid_tmul] + rfl + +omit [FiniteDimensional 𝕜 B] [FiniteDimensional 𝕜 C] in +theorem bra_map_bra (a : B) (b : C) : + TensorProduct.map (bra 𝕜 a).toLinearMap (bra 𝕜 b).toLinearMap = + (TensorProduct.lid 𝕜 _).symm.toLinearMap ∘ₗ + (bra 𝕜 (a ⊗ₜ[𝕜] b)).toLinearMap := by + rw [bra_tmul, ← LinearMap.comp_assoc] + simp only [LinearEquiv.comp_coe, LinearEquiv.self_trans_symm, LinearEquiv.refl_toLinearMap, + LinearMap.id_comp] + +omit [FiniteDimensional 𝕜 B] [FiniteDimensional 𝕜 C] in +theorem ket_tmul (a : B) (b : C) : + (ket 𝕜 (a ⊗ₜ[𝕜] b)).toLinearMap = + TensorProduct.map (ket 𝕜 a).toLinearMap (ket 𝕜 b).toLinearMap ∘ₗ + (TensorProduct.lid 𝕜 _).symm.toLinearMap := by + ext + simp only [ContinuousLinearMap.coe_coe, ket_one_apply, LinearMap.coe_comp, + LinearEquiv.coe_coe, Function.comp_apply, TensorProduct.lid_symm_apply, + TensorProduct.map_tmul] + +omit [FiniteDimensional 𝕜 B] [FiniteDimensional 𝕜 C] in +theorem ket_map_ket (a : B) (b : C) : + TensorProduct.map (ket 𝕜 a).toLinearMap (ket 𝕜 b).toLinearMap = + (ket 𝕜 (a ⊗ₜ[𝕜] b)).toLinearMap ∘ₗ (TensorProduct.lid 𝕜 _).toLinearMap := by + rw [ket_tmul, LinearMap.comp_assoc] + simp only [LinearEquiv.comp_coe, LinearEquiv.self_trans_symm, LinearEquiv.refl_toLinearMap, + LinearMap.comp_id] + +end TensorRankOne + +theorem bra_comp_linearMap {𝕜 E₁ E₂ : Type*} [RCLike 𝕜] + [NormedAddCommGroup E₁] [InnerProductSpace 𝕜 E₁] [NormedAddCommGroup E₂] + [InnerProductSpace 𝕜 E₂] [FiniteDimensional 𝕜 E₁] [FiniteDimensional 𝕜 E₂] + (x : E₂) (f : E₁ →ₗ[𝕜] E₂) : + (bra 𝕜 x).toLinearMap.comp f = (bra 𝕜 (LinearMap.adjoint f x)).toLinearMap := + letI := FiniteDimensional.complete 𝕜 E₁ + letI := FiniteDimensional.complete 𝕜 E₂ + calc + (bra 𝕜 x).toLinearMap ∘ₗ f = + ((bra 𝕜 x) ∘L LinearMap.toContinuousLinearMap f).toLinearMap := rfl + _ = + (bra 𝕜 + (ContinuousLinearMap.adjoint (LinearMap.toContinuousLinearMap f) x)).toLinearMap := by + rw [bra_comp_continuousLinearMap] + _ = (bra 𝕜 (LinearMap.adjoint f x)).toLinearMap := rfl + +theorem linearMap_comp_ket {𝕜 E₁ E₂ : Type*} [RCLike 𝕜] + [NormedAddCommGroup E₁] [InnerProductSpace 𝕜 E₁] [NormedAddCommGroup E₂] + [InnerProductSpace 𝕜 E₂] (x : E₁) (f : E₁ →ₗ[𝕜] E₂) : + f ∘ₗ (ket 𝕜 x).toLinearMap = (ket 𝕜 (f x)).toLinearMap := by + ext + simp only [LinearMap.coe_comp, ContinuousLinearMap.coe_coe, Function.comp_apply, + ket_apply_apply, one_smul] + +theorem mul_comp_lid_symm {R : Type*} [CommSemiring R] : + LinearMap.mul' R R ∘ₗ (TensorProduct.lid R R).symm.toLinearMap = LinearMap.id := by + aesop + +theorem schurMul.apply_bra (a b : B) : + (bra ℂ a) •ₛ (bra ℂ b) = (bra ℂ (a * b)).toLinearMap := by + rw [schurMul_apply_apply, bra_map_bra, LinearMap.comp_assoc, bra_comp_linearMap, + Coalgebra.comul_eq_mul_adjoint, LinearMap.adjoint_adjoint, LinearMap.mul'_apply, + ← LinearMap.comp_assoc, mul_comp_lid_symm] + rfl + +omit [FiniteDimensional ℂ B] in +theorem schurMul.comp_apply_of {C : Type*} + [NormedAddCommGroupOfRing C] [InnerProductSpace ℂ C] [SMulCommClass ℂ C C] + [IsScalarTower ℂ C C] [FiniteDimensional ℂ C] (δ : ℂ) + (hAδ : Coalgebra.comul ∘ₗ LinearMap.mul' ℂ A = δ • LinearMap.id) + (a b : A →ₗ[ℂ] B) (c d : C →ₗ[ℂ] A) : + (a •ₛ b) ∘ₗ (c •ₛ d) = δ • ((a ∘ₗ c) •ₛ (b ∘ₗ d)) := by + calc + (a •ₛ b) ∘ₗ (c •ₛ d) = + (m _) ∘ₗ (a ⊗ₘ b) ∘ₗ (Coalgebra.comul ∘ₗ (m A)) ∘ₗ (c ⊗ₘ d) ∘ₗ + Coalgebra.comul := by + simp_rw [schurMul_apply_apply, LinearMap.comp_assoc] + _ = δ • (m _) ∘ₗ ((a ⊗ₘ b) ∘ₗ (c ⊗ₘ d)) ∘ₗ Coalgebra.comul := by + simp_rw [hAδ, LinearMap.smul_comp, LinearMap.comp_smul, LinearMap.id_comp, + LinearMap.comp_assoc] + _ = δ • (a ∘ₗ c) •ₛ (b ∘ₗ d) := by + rw [← TensorProduct.map_comp] + rfl + +theorem schurMul_one_one_right (x : A →ₗ[ℂ] B) : + x •ₛ (rankOne ℂ (1 : B) (1 : A)).toLinearMap = x := by + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne x + simp_rw [map_sum, LinearMap.sum_apply, schurMul.apply_rankOne, mul_one] + +theorem schurMul_one_one_left (x : A →ₗ[ℂ] B) : + (rankOne ℂ (1 : B) (1 : A)).toLinearMap •ₛ x = x := by + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne x + simp_rw [map_sum, schurMul.apply_rankOne, one_mul] + +theorem schurMul_one_right_rankOne (a b : A) : + (rankOne ℂ a b).toLinearMap •ₛ (1 : A →ₗ[ℂ] A) = + lmul a ∘ₗ LinearMap.adjoint (lmul b) := by + let e := stdOrthonormalBasis ℂ A + calc + (rankOne ℂ a b).toLinearMap •ₛ (1 : A →ₗ[ℂ] A) + = (rankOne ℂ a b).toLinearMap •ₛ + (∑ i, (rankOne ℂ (e i) (e i)).toLinearMap) := by + rw [rankOne.sum_orthonormalBasis_eq_id_lm e] + _ = ∑ i, (rankOne ℂ (a * e i) (b * e i)).toLinearMap := by + rw [map_sum] + apply Finset.sum_congr rfl + intro i _ + rw [schurMul.apply_rankOne] + _ = ∑ i, lmul a ∘ₗ + ((rankOne ℂ (e i) (e i)).toLinearMap ∘ₗ LinearMap.adjoint (lmul b)) := by + apply Finset.sum_congr rfl + intro i _ + rw [LinearMap.rankOne_comp', LinearMap.comp_rankOne] + rfl + _ = lmul a ∘ₗ + ((∑ i, (rankOne ℂ (e i) (e i)).toLinearMap) ∘ₗ + LinearMap.adjoint (lmul b)) := by + rw [← LinearMap.comp_sum, ← LinearMap.sum_comp] + _ = lmul a ∘ₗ LinearMap.adjoint (lmul b) := by + rw [rankOne.sum_orthonormalBasis_eq_id_lm e] + ext x + rfl + +theorem schurMul_one_left_rankOne (a b : A) : + (1 : A →ₗ[ℂ] A) •ₛ (rankOne ℂ a b).toLinearMap = + rmul a ∘ₗ LinearMap.adjoint (rmul b) := by + let e := stdOrthonormalBasis ℂ A + calc + (1 : A →ₗ[ℂ] A) •ₛ (rankOne ℂ a b).toLinearMap + = (∑ i, (rankOne ℂ (e i) (e i)).toLinearMap) •ₛ + (rankOne ℂ a b).toLinearMap := by + rw [rankOne.sum_orthonormalBasis_eq_id_lm e] + _ = ∑ i, (rankOne ℂ (e i * a) (e i * b)).toLinearMap := by + rw [map_sum, LinearMap.sum_apply] + apply Finset.sum_congr rfl + intro i _ + rw [schurMul.apply_rankOne] + _ = ∑ i, rmul a ∘ₗ + ((rankOne ℂ (e i) (e i)).toLinearMap ∘ₗ LinearMap.adjoint (rmul b)) := by + apply Finset.sum_congr rfl + intro i _ + rw [LinearMap.rankOne_comp', LinearMap.comp_rankOne] + rfl + _ = rmul a ∘ₗ + ((∑ i, (rankOne ℂ (e i) (e i)).toLinearMap) ∘ₗ + LinearMap.adjoint (rmul b)) := by + rw [← LinearMap.comp_sum, ← LinearMap.sum_comp] + _ = rmul a ∘ₗ LinearMap.adjoint (rmul b) := by + rw [rankOne.sum_orthonormalBasis_eq_id_lm e] + ext x + rfl + +theorem schurMul_adjoint (x y : A →ₗ[ℂ] B) : + LinearMap.adjoint (x •ₛ y) = LinearMap.adjoint x •ₛ LinearMap.adjoint y := by + simp_rw [schurMul, Coalgebra.comul_eq_mul_adjoint] + simp only [LinearMap.coe_mk, AddHom.coe_mk, LinearMap.adjoint_comp, + LinearMap.adjoint_adjoint, TensorProduct.map_adjoint, LinearMap.comp_assoc] + +theorem schurMul_real {A B : Type*} [starAlgebra A] [starAlgebra B] + [QuantumSet A] [QuantumSet B] (x y : A →ₗ[ℂ] B) : + LinearMap.real (x •ₛ y : A →ₗ[ℂ] B) = + LinearMap.real y •ₛ LinearMap.real x := by + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne x + obtain ⟨γ, ζ, rfl⟩ := LinearMap.exists_sum_rankOne y + simp only [map_sum, LinearMap.real_sum, LinearMap.sum_apply, schurMul.apply_rankOne] + simp_rw [rankOne_real, schurMul.apply_rankOne, ← map_mul, ← StarMul.star_mul] + rw [Finset.sum_comm] + +theorem Psi.schurMul {A B : Type*} [starAlgebra A] [starAlgebra B] + [hA : QuantumSet A] [QuantumSet B] (r₁ r₂ : ℝ) (f g : A →ₗ[ℂ] B) : + hA.Psi r₁ r₂ (f •ₛ g) = hA.Psi r₁ r₂ f * hA.Psi r₁ r₂ g := by + suffices ∀ (a c : B) (b d : A), + hA.Psi r₁ r₂ ((rankOne ℂ a b).toLinearMap •ₛ (rankOne ℂ c d).toLinearMap) = + hA.Psi r₁ r₂ (rankOne ℂ a b).toLinearMap * + hA.Psi r₁ r₂ (rankOne ℂ c d).toLinearMap by + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne f + obtain ⟨γ, δ, rfl⟩ := LinearMap.exists_sum_rankOne g + simp only [map_sum, LinearMap.sum_apply, Finset.mul_sum, Finset.sum_mul] + apply Finset.sum_congr rfl + intro i _ + apply Finset.sum_congr rfl + intro j _ + exact this (α j) (γ i) (β j) (δ i) + intro a c b d + rw [schurMul.apply_rankOne] + repeat rw [QuantumSet.Psi_apply] + repeat rw [QuantumSet.Psi_toFun_apply] + simp only [Algebra.TensorProduct.tmul_mul_tmul, map_mul, star_mul] + rfl + +theorem schurMul_assoc {A B : Type*} [starAlgebra A] [starAlgebra B] + [hA : QuantumSet A] [QuantumSet B] (f g h : A →ₗ[ℂ] B) : + (f •ₛ g) •ₛ h = f •ₛ (g •ₛ h) := by + apply_fun hA.Psi 0 0 using LinearEquiv.injective _ + simp_rw [Psi.schurMul, mul_assoc] + +theorem comul_comp_nonUnitalAlgHom_adjoint (f : A →ₙₐ[ℂ] B) : + Coalgebra.comul ∘ₗ LinearMap.adjoint (LinearMapClass.linearMap f) = + ((LinearMap.adjoint (LinearMapClass.linearMap f)) ⊗ₘ + (LinearMap.adjoint (LinearMapClass.linearMap f))) ∘ₗ Coalgebra.comul := by + simp_rw [Coalgebra.comul_eq_mul_adjoint, ← TensorProduct.map_adjoint, + ← LinearMap.adjoint_comp, nonUnitalAlgHom_comp_mul f] + +theorem comul_comp_algHom_adjoint (f : A →ₐ[ℂ] B) : + Coalgebra.comul ∘ₗ LinearMap.adjoint f.toLinearMap = + ((LinearMap.adjoint f.toLinearMap) ⊗ₘ (LinearMap.adjoint f.toLinearMap)) ∘ₗ + Coalgebra.comul := by + simpa using comul_comp_nonUnitalAlgHom_adjoint f.toNonUnitalAlgHom + +theorem schurMul_nonUnitalAlgHom_comp_coalgHom {C D : Type*} + [Semiring C] [Semiring D] + [Module ℂ C] [Module ℂ D] + [SMulCommClass ℂ C C] [SMulCommClass ℂ D D] + [IsScalarTower ℂ C C] [IsScalarTower ℂ D D] + (g : C →ₙₐ[ℂ] D) (f : A →ₗc[ℂ] B) (x y : B →ₗ[ℂ] C) : + ((LinearMapClass.linearMap g) ∘ₗ x ∘ₗ f.toLinearMap) •ₛ + ((LinearMapClass.linearMap g) ∘ₗ y ∘ₗ f.toLinearMap) = + (LinearMapClass.linearMap g) ∘ₗ (x •ₛ y) ∘ₗ f.toLinearMap := by + simp_rw [schurMul_apply_apply, ← LinearMap.comp_assoc, nonUnitalAlgHom_comp_mul, + LinearMap.comp_assoc, ← f.map_comp_comul] + congr 1 + simp_rw [← LinearMap.comp_assoc] + congr 1 + simp_rw [TensorProduct.map_comp] + +theorem schurMul_algHom_comp_coalgHom {C D : Type*} + [Semiring C] [Semiring D] + [Module ℂ C] [Module ℂ D] + [SMulCommClass ℂ C C] [SMulCommClass ℂ D D] + [IsScalarTower ℂ C C] [IsScalarTower ℂ D D] + (g : C →ₐ[ℂ] D) (f : A →ₗc[ℂ] B) (x y : B →ₗ[ℂ] C) : + (g.toLinearMap ∘ₗ x ∘ₗ f.toLinearMap) •ₛ (g.toLinearMap ∘ₗ y ∘ₗ f.toLinearMap) = + g.toLinearMap ∘ₗ (x •ₛ y) ∘ₗ f.toLinearMap := by + simpa using schurMul_nonUnitalAlgHom_comp_coalgHom g.toNonUnitalAlgHom f x y + +theorem schurMul_nonUnitalAlgHom_comp_nonUnitalAlgHom_adjoint {C D : Type*} + [Semiring C] [Semiring D] + [Module ℂ C] [Module ℂ D] + [SMulCommClass ℂ C C] [SMulCommClass ℂ D D] + [IsScalarTower ℂ C C] [IsScalarTower ℂ D D] + (g : C →ₙₐ[ℂ] D) (f : B →ₙₐ[ℂ] A) (x y : B →ₗ[ℂ] C) : + ((LinearMapClass.linearMap g) ∘ₗ x ∘ₗ + (LinearMap.adjoint (LinearMapClass.linearMap f))) •ₛ + ((LinearMapClass.linearMap g) ∘ₗ y ∘ₗ + (LinearMap.adjoint (LinearMapClass.linearMap f))) = + (LinearMapClass.linearMap g) ∘ₗ (x •ₛ y) ∘ₗ + LinearMap.adjoint (LinearMapClass.linearMap f) := by + simp_rw [schurMul_apply_apply, ← LinearMap.comp_assoc, nonUnitalAlgHom_comp_mul, + LinearMap.comp_assoc, comul_comp_nonUnitalAlgHom_adjoint] + congr 1 + simp_rw [← LinearMap.comp_assoc] + congr 1 + simp_rw [TensorProduct.map_comp] + +theorem schurMul_algHom_comp_algHom_adjoint {C D : Type*} + [Semiring C] [Semiring D] + [Module ℂ C] [Module ℂ D] + [SMulCommClass ℂ C C] [SMulCommClass ℂ D D] + [IsScalarTower ℂ C C] [IsScalarTower ℂ D D] + (g : C →ₐ[ℂ] D) (f : B →ₐ[ℂ] A) (x y : B →ₗ[ℂ] C) : + (g.toLinearMap ∘ₗ x ∘ₗ LinearMap.adjoint f.toLinearMap) •ₛ + (g.toLinearMap ∘ₗ y ∘ₗ LinearMap.adjoint f.toLinearMap) = + g.toLinearMap ∘ₗ (x •ₛ y) ∘ₗ LinearMap.adjoint f.toLinearMap := by + simpa using schurMul_nonUnitalAlgHom_comp_nonUnitalAlgHom_adjoint + g.toNonUnitalAlgHom f.toNonUnitalAlgHom x y + +protected lemma QuantumSet.schurMul_algHom_comp_algHom_adjoint {A B C D : Type*} + [starAlgebra A] [starAlgebra B] [QuantumSet A] [QuantumSet B] + [starAlgebra C] [starAlgebra D] [QuantumSet C] [QuantumSet D] + (g : C →ₐ[ℂ] D) (f : B →ₐ[ℂ] A) (x y : B →ₗ[ℂ] C) : + (g.toLinearMap ∘ₗ x ∘ₗ LinearMap.adjoint f.toLinearMap) •ₛ + (g.toLinearMap ∘ₗ y ∘ₗ LinearMap.adjoint f.toLinearMap) = + g.toLinearMap ∘ₗ (x •ₛ y) ∘ₗ LinearMap.adjoint f.toLinearMap := + schurMul_nonUnitalAlgHom_comp_nonUnitalAlgHom_adjoint + g.toNonUnitalAlgHom f.toNonUnitalAlgHom x y + +theorem schurMul_one_iff_one_schurMul_of_isReal {A B : Type*} + [starAlgebra A] [starAlgebra B] [QuantumSet A] [QuantumSet B] + {x y z : A →ₗ[ℂ] B} + (hx : LinearMap.IsReal x) (hy : LinearMap.IsReal y) (hz : LinearMap.IsReal z) : + x •ₛ y = z ↔ y •ₛ x = z := by + rw [LinearMap.real_inj_eq, schurMul_real, x.isReal_iff.mp hx, y.isReal_iff.mp hy, + z.isReal_iff.mp hz] + +theorem schurMul_reflexive_of_isReal {A : Type*} [starAlgebra A] [QuantumSet A] + {x : A →ₗ[ℂ] A} (hx : LinearMap.IsReal x) : + x •ₛ 1 = 1 ↔ 1 •ₛ x = 1 := + schurMul_one_iff_one_schurMul_of_isReal hx LinearMap.isRealOne LinearMap.isRealOne + +theorem schurMul_irreflexive_of_isReal {A : Type*} [starAlgebra A] [QuantumSet A] + {x : A →ₗ[ℂ] A} (hx : LinearMap.IsReal x) : + x •ₛ 1 = 0 ↔ 1 •ₛ x = 0 := + schurMul_one_iff_one_schurMul_of_isReal hx LinearMap.isRealOne LinearMap.isRealZero + +lemma schurIdempotent_iff_Psi_isIdempotentElem {A B : Type*} + [starAlgebra A] [starAlgebra B] [hA : QuantumSet A] [QuantumSet B] + (f : A →ₗ[ℂ] B) (t r : ℝ) : + f •ₛ f = f ↔ IsIdempotentElem (hA.Psi t r f) := by + simp_rw [IsIdempotentElem, ← Psi.schurMul, + Function.Injective.eq_iff (LinearEquiv.injective _)] diff --git a/LeanPool/Monlib4/LinearAlgebra/QuantumSet/SchurMulTensor.lean b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/SchurMulTensor.lean new file mode 100644 index 0000000000..c6b1a613b4 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/SchurMulTensor.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2024 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.SchurMul +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.TensorProduct +import Mathlib.RingTheory.Coalgebra.TensorProduct + +/-! +# Schur Multiplication on Tensor Products + +This file relates Schur multiplication on tensor-product coalgebras to the +fourfold tensor shuffle used by the Monlib4 quantum-set tensor product. +-/ + +open scoped TensorProduct + +/-- The Mathlib tensor-product factor swap agrees with Monlib4's tensor shuffle. -/ +lemma TensorProduct.AlgebraTensorModule.tensorTensorTensorComm_eq_swap_middle_tensor + {R A B C D : Type*} [CommSemiring R] + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] : + (TensorProduct.AlgebraTensorModule.tensorTensorTensorComm R R R R A B C D) = + swap_middle_tensor R A B C D := +by + rw [← LinearEquiv.toLinearMap_inj] + apply TensorProduct.ext_fourfold' + simp + +/-- Schur multiplication commutes with tensoring linear maps. -/ +theorem TensorProduct.map_schurMul {A B C D : Type*} + [AddCommMonoid A] [Semiring B] + [AddCommMonoid C] [Semiring D] + [Module ℂ A] [Module ℂ B] + [Module ℂ C] [Module ℂ D] + [Coalgebra ℂ A] [Coalgebra ℂ C] + [SMulCommClass ℂ B B] + [SMulCommClass ℂ D D] + [IsScalarTower ℂ B B] + [IsScalarTower ℂ D D] + {f h : A →ₗ[ℂ] B} {g k : C →ₗ[ℂ] D} : + (map f g) •ₛ (map h k) = map (f •ₛ h) (g •ₛ k) := +by + rw [schurMul_apply_apply, TensorProduct.comul_def, LinearMap.mul'_tensorProduct, + TensorProduct.AlgebraTensorModule.tensorTensorTensorComm_eq_swap_middle_tensor] + simp only [LinearMap.comp_assoc] + rw [← LinearMap.comp_assoc _ _ (swap_middle_tensor _ _ _ _ _).toLinearMap] + nth_rw 2 [← LinearMap.comp_assoc, LinearMap.comp_assoc, ← swap_middle_tensor_symm] + rw [swap_middle_tensor_map_conj] + simp only [← LinearMap.comp_assoc, ← TensorProduct.map_comp, + TensorProduct.AlgebraTensorModule.map_eq] + rfl diff --git a/LeanPool/Monlib4/LinearAlgebra/QuantumSet/Subset.lean b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/Subset.lean new file mode 100644 index 0000000000..7efbeeb85f --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/Subset.lean @@ -0,0 +1,579 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Basic +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.TensorProduct +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.SchurMul + +/-- Type synonym for a quantum set with its modular exponent shifted to `k`. -/ +def QuantumSet.toSubset (k : ℝ) (A : Type*) : Type _ := + let _ : ℝ := k + A + +/-- The tautological equivalence from a type to its shifted quantum-set synonym. -/ +def QuantumSet.toSubset_equiv (k : ℝ) {A : Type*} : + A ≃ QuantumSet.toSubset k A := Equiv.refl _ + +/-- Abbreviation for the shifted quantum-set type synonym. -/ +abbrev QuantumSet.subset (k : ℝ) (A : Type*) : Type _ := QuantumSet.toSubset k A + +variable {new_k : ℝ} +instance (A : Type*) [h : Inhabited A] : Inhabited (QuantumSet.subset new_k A) := h +instance {A : Type*} [h : Ring A] : Ring (QuantumSet.subset new_k A) := h +instance {A : Type*} [Ring A] [h : Algebra ℂ A] : Algebra ℂ (QuantumSet.subset new_k A) := h +instance {A : Type*} [h : Star A] : Star (QuantumSet.subset new_k A) := h +instance {A : Type*} [h : SMul ℂ A] : SMul ℂ (QuantumSet.subset new_k A) := h +instance {A : Type*} [Ring A] [h : StarRing A] : StarRing (QuantumSet.subset new_k A) := h +instance {A : Type*} [Star A] [SMul ℂ A] [h : StarModule ℂ A] : + StarModule ℂ (QuantumSet.subset new_k A) := h + +/-- The tautological algebra equivalence from a type to its shifted quantum-set synonym. -/ +def QuantumSet.toSubset_algEquiv (k : ℝ) {A : Type*} [Ring A] [Algebra ℂ A] : + A ≃ₐ[ℂ] QuantumSet.subset k A := + AlgEquiv.refl +lemma QuantumSet.toSubset_algEquiv_eq_toSubset_equiv {A : Type*} [Ring A] [Algebra ℂ A] + (x : A) : + QuantumSet.toSubset_algEquiv new_k x = QuantumSet.toSubset_equiv new_k x := rfl +lemma QuantumSet.toSubset_algEquiv_symm_eq_toSubset_equiv {A : Type*} [Ring A] [Algebra ℂ A] + (x : QuantumSet.subset new_k A) : + (toSubset_algEquiv new_k).symm x = (toSubset_equiv new_k).symm x := rfl + +variable {A : Type*} [ha : starAlgebra A] + +instance QuantumSet.subsetStarAlgebra (k : ℝ) : + _root_.starAlgebra (QuantumSet.subset k A) where + modAut r := (toSubset_algEquiv k).symm.trans ((ha.modAut r).trans (toSubset_algEquiv k)) + modAut_trans := ha.modAut_trans + modAut_star := ha.modAut_star + +lemma QuantumSet.subsetStarAlgebra_modAut_apply (r : ℝ) (x : QuantumSet.subset new_k A) : + (QuantumSet.subsetStarAlgebra new_k).modAut r x = + (toSubset_equiv new_k) (ha.modAut r ((toSubset_equiv new_k).symm x)) := rfl +lemma QuantumSet.subsetStarAlgebra_modAut_apply' (r : ℝ) (x : A) : + (QuantumSet.subsetStarAlgebra new_k).modAut r (toSubset_equiv new_k x) = + (toSubset_equiv new_k) (ha.modAut r x) := + rfl +lemma QuantumSet.subsetStarAlgebra_modAut_apply'' (r : ℝ) (x : QuantumSet.subset new_k A) : + ((toSubset_equiv new_k).symm + (((QuantumSet.subsetStarAlgebra new_k).modAut r + : subset new_k A ≃ₐ[ℂ] subset new_k A) x : subset new_k A) : A) = + ((ha.modAut r ((toSubset_equiv new_k).symm x : A)) : A) := rfl + +/-- The normed additive group structure induced by shifting the quantum-set inner product. -/ +@[reducible] +noncomputable def QuantumSet.subset_normedAddCommGroup [hA : QuantumSet A] + (new_k : ℝ) : + letI : starAlgebra (QuantumSet.subset new_k A) := QuantumSet.subsetStarAlgebra new_k + NormedAddCommGroup (QuantumSet.subset new_k A) := + letI : starAlgebra (subset new_k A) := QuantumSet.subsetStarAlgebra new_k + @InnerProductSpace.Core.toNormedAddCommGroup ℂ (subset new_k A) _ _ _ + { inner := fun x y => + hA.inner ((toSubset_equiv new_k).symm x) + (ha.modAut (new_k + -hA.k) ((toSubset_equiv new_k).symm y)) + conj_inner_symm := fun _ _ => by simp only [inner_conj_symm, QuantumSet.modAut_isSymmetric] + re_inner_nonneg := fun _ => by + rw [← add_halves (new_k + -k A), ← QuantumSet.modAut_apply_modAut, + ← QuantumSet.modAut_isSymmetric, ← norm_sq_eq_re_inner] + exact sq_nonneg _ + definite := fun _ => by + rw [← add_halves (new_k + -k A), ← QuantumSet.modAut_apply_modAut, + ← QuantumSet.modAut_isSymmetric, inner_self_eq_zero, + AlgEquiv.map_eq_zero_iff] + exact fun h => h + add_left := fun _ _ _ => by simp only [← inner_add_left]; rfl + smul_left := fun _ _ _ => by simp only [← inner_smul_left]; rfl } +/-- The inner product space structure induced by shifting the quantum-set inner product. -/ +@[reducible] +noncomputable def QuantumSet.subset_innerProductSpace (hA : QuantumSet A) (new_k : ℝ) : + letI := hA.subset_normedAddCommGroup new_k + InnerProductSpace ℂ (subset new_k A) := +letI : starAlgebra (subset new_k A) := QuantumSet.subsetStarAlgebra new_k +InnerProductSpace.ofCore _ + +-- theorem GNS.normedAddCommGroup.norm_eq [hA : QuantumSet A] (x : qS_GNS A) : +-- GNS.normedAddCommGroup.norm (x : qS_GNS A) = ‖modAut (- (hA.k / 2)) (x : A)‖ := +-- rfl + +/-- The inner product algebra structure induced by shifting the quantum-set inner product. -/ +@[reducible] +noncomputable def QuantumSet.subset_innerProductAlgebra (hA : QuantumSet A) + (new_k : ℝ) : + letI : starAlgebra (subset new_k A) := QuantumSet.subsetStarAlgebra new_k + InnerProductAlgebra (subset new_k A) := +letI : starAlgebra (subset new_k A) := QuantumSet.subsetStarAlgebra new_k +letI := hA.subset_normedAddCommGroup new_k +letI := hA.subset_innerProductSpace new_k +{ norm_sq_eq_inner := fun _ => by + simp only [← norm_sq_eq_re_inner] + norm_smul_le := fun c x => + NormedSpace.norm_smul_le (𝕜 := ℂ) (E := subset new_k A) c x + conj_symm := inner_conj_symm + add_left := inner_add_left + smul_left := inner_smul_left } + +lemma QuantumSet.subset_inner_eq [hA : QuantumSet A] (new_k : ℝ) (x y : subset new_k A) : + letI : starAlgebra (subset new_k A) := QuantumSet.subsetStarAlgebra new_k + (hA.subset_innerProductAlgebra new_k).inner x y + = hA.inner ((toSubset_equiv new_k).symm x : A) + (ha.modAut (new_k + -hA.k) ((toSubset_equiv new_k).symm y)) := +rfl +lemma QuantumSet.inner_eq_subset_inner [hA : QuantumSet A] (new_k : ℝ) (x y : A) : + letI : starAlgebra (subset new_k A) := QuantumSet.subsetStarAlgebra _ + hA.inner x y + = (hA.subset_innerProductAlgebra new_k).inner + (toSubset_equiv new_k x) (toSubset_equiv new_k (ha.modAut (hA.k + -new_k) y)) := +by + rw [subset_inner_eq] + simp_rw [Equiv.symm_apply_apply, QuantumSet.modAut_apply_modAut] + ring_nf + rw [starAlgebra.modAut_zero]; rfl + +open scoped InnerProductSpace +/-- A shifted quantum-set synonym inherits a quantum-set structure with exponent `new_k`. -/ +@[reducible] +noncomputable def QuantumSet.instSubset (hA : QuantumSet A) (new_k : ℝ) : + letI : starAlgebra (subset new_k A) := QuantumSet.subsetStarAlgebra _ + QuantumSet (subset new_k A) := +letI st : starAlgebra (subset new_k A) := QuantumSet.subsetStarAlgebra _ +letI gns := hA.subset_innerProductAlgebra new_k +let to_ := @toSubset_equiv new_k A +{ modAut_isSymmetric := fun r x y => by + calc gns.inner (st.modAut r x) y + = hA.inner (to_.symm (st.modAut r x)) + (ha.modAut (new_k + -hA.k) (to_.symm y)) := rfl + _ = hA.inner (ha.modAut r (to_.symm x)) + (ha.modAut (new_k + -hA.k) (to_.symm y)) := rfl + _ = hA.inner (to_.symm x) + (ha.modAut (new_k + -hA.k) (ha.modAut r (to_.symm y))) := by + simp_rw [modAut_isSymmetric, modAut_apply_modAut, add_comm] + _ = hA.inner (to_.symm x) + (ha.modAut (new_k + -hA.k) (to_.symm (st.modAut r y))) := rfl + _ = gns.inner x (st.modAut r y) := rfl + k := new_k + inner_star_left := fun x y z => + by + calc gns.inner (x * y) z + = hA.inner (to_.symm (x * y)) + (ha.modAut (new_k + -hA.k) (to_.symm z)) := rfl + _ = hA.inner (to_.symm x * to_.symm y) + (ha.modAut (new_k + -hA.k) (to_.symm z)) := by rfl + _ = hA.inner (to_.symm y) + (ha.modAut (-hA.k) (to_.symm (star x) * ha.modAut new_k (to_.symm z))) := by + rw [inner_star_left, add_comm, map_mul, modAut_apply_modAut]; rfl + _ = hA.inner (to_.symm y) + (ha.modAut (new_k + -hA.k) + (ha.modAut (-new_k) (to_.symm (star x)) + * to_.symm z)) := by + simp_rw [map_mul, modAut_apply_modAut, add_comm, neg_add_cancel_left] + _ = gns.inner y (st.modAut (- new_k) (star x) * z) := rfl + inner_conj_left := fun x y z => + calc gns.inner (x * y) z + = hA.inner (to_.symm x * to_.symm y) + (ha.modAut (new_k + -hA.k) (to_.symm z)) := rfl + _ = hA.inner (to_.symm x) + (ha.modAut (new_k + -hA.k) ((to_.symm z) + * ha.modAut (-new_k + -1) (to_.symm (star y)))) := by + simp_rw [inner_conj_left, map_mul, modAut_apply_modAut] + ring_nf + rfl + _ = gns.inner x (z * st.modAut (-new_k + -1) (star y)) := rfl + n := n A + n_isFintype := QuantumSet.n_isFintype + n_isDecidableEq := QuantumSet.n_isDecidableEq + onb := by + let b := + (toSubset_algEquiv new_k).toLinearEquiv.symm.trans + ((modAut ((new_k / 2) + - (k A / 2))).toLinearEquiv.trans + (hA.onb.repr).toLinearEquiv) + refine Module.Basis.toOrthonormalBasis + (Module.Basis.ofEquivFun + (b.trans (WithLp.linearEquiv 2 ℂ (n A → ℂ)))) ?_ + rw [orthonormal_iff_ite] + intro i j + rw [subset_inner_eq, ← add_halves (new_k + -k A), ← QuantumSet.modAut_apply_modAut, + ← QuantumSet.modAut_isSymmetric] + simp_rw [b, Module.Basis.coe_ofEquivFun] + simp only [WithLp.coe_symm_linearEquiv, PiLp.toLp_single, LinearEquiv.trans_symm, + LinearEquiv.trans_apply, ← AlgEquiv.toLinearEquiv_symm, + AlgEquiv.toLinearEquiv_apply, AlgEquiv.symm_symm, toSubset_algEquiv_eq_toSubset_equiv, + Equiv.symm_apply_apply, add_div, neg_div, AlgEquiv.apply_symm_apply] + calc + ⟪hA.onb.repr.symm (EuclideanSpace.single i (1 : ℂ)), + hA.onb.repr.symm (EuclideanSpace.single j (1 : ℂ))⟫_ℂ + = if i = j then (1 : ℂ) else 0 := by + simp only [OrthonormalBasis.repr_symm_single, orthonormal_iff_ite.mp hA.onb.orthonormal] } + +open QuantumSet in +/-- Transport a linear map between quantum sets to shifted quantum-set synonyms. -/ +noncomputable abbrev LinearMap.toSubsetQuantumSet {B : Type*} [starAlgebra B] + [QuantumSet A] [QuantumSet B] (f : A →ₗ[ℂ] B) (sk₁ sk₂ : ℝ) : + subset sk₁ A →ₗ[ℂ] subset sk₂ B := + (toSubset_algEquiv sk₂).toLinearMap ∘ₗ f ∘ₗ + (toSubset_algEquiv sk₁).symm.toLinearMap +open QuantumSet in +/-- Transport a shifted linear map back to the original quantum sets. -/ +noncomputable abbrev LinearMap.ofSubsetQuantumSet {B : Type*} [starAlgebra B] + [QuantumSet A] [QuantumSet B] (sk₁ sk₂ : ℝ) + (f : subset sk₁ A →ₗ[ℂ] subset sk₂ B) : + A →ₗ[ℂ] B := + (toSubset_algEquiv sk₂).symm.toLinearMap ∘ₗ f ∘ₗ + (toSubset_algEquiv sk₁).toLinearMap + +theorem QuantumSet.toSubset_algEquiv_adjoint [hA : QuantumSet A] (sk₁ : ℝ) : + letI := hA.instSubset sk₁ + LinearMap.adjoint (toSubset_algEquiv sk₁ : A ≃ₐ[ℂ] subset sk₁ A).toLinearMap + = (ha.modAut (sk₁ + -k A)).toLinearMap ∘ₗ (toSubset_algEquiv sk₁).symm.toLinearMap := +by + ext1 x + apply ext_inner_left ℂ + intro y + simp_rw [LinearMap.adjoint_inner_right, AlgEquiv.toLinearMap_apply] + rw [subset_inner_eq] + rfl +theorem QuantumSet.toSubset_algEquiv_symm_adjoint [hA : QuantumSet A] (sk₁ : ℝ) : + letI := hA.instSubset sk₁ + LinearMap.adjoint (toSubset_algEquiv sk₁ : A ≃ₐ[ℂ] subset sk₁ A).symm.toLinearMap + = (toSubset_algEquiv sk₁).toLinearMap ∘ₗ (ha.modAut (-sk₁ + k A)).toLinearMap := +by + ext1 x + letI := hA.instSubset sk₁ + apply ext_inner_left ℂ + intro y + simp_rw [LinearMap.adjoint_inner_right, AlgEquiv.toLinearMap_apply] + rw [subset_inner_eq] + simp_rw [LinearMap.comp_apply, AlgEquiv.toLinearMap_apply, + toSubset_algEquiv_eq_toSubset_equiv, Equiv.symm_apply_apply, + modAut_apply_modAut] + ring_nf + simp only [starAlgebra.modAut_zero, AlgEquiv.one_apply]; rfl + +open QuantumSet in +lemma LinearMap.toSubsetQuantumSet_apply {B : Type*} [starAlgebra B] + [QuantumSet A] [QuantumSet B] (f : A →ₗ[ℂ] B) (sk₁ sk₂ : ℝ) (x : subset sk₁ A) : + f.toSubsetQuantumSet sk₁ sk₂ x = toSubset_equiv sk₂ (f ((toSubset_equiv sk₁).symm x)) := rfl + +open QuantumSet in +theorem LinearMap.toSubsetQuantumSet_adjoint_apply {B : Type*} [hb : starAlgebra B] + [hA : QuantumSet A] [hB : QuantumSet B] + (f : A →ₗ[ℂ] B) (sk₁ sk₂ : ℝ) : + letI := hA.instSubset sk₁ + letI := hB.instSubset sk₂ + (LinearMap.adjoint (f.toSubsetQuantumSet sk₁ sk₂)) = + ((ha.modAut (-sk₁ + hA.k)).toLinearMap + ∘ₗ (LinearMap.adjoint f) + ∘ₗ (hb.modAut (sk₂ + -hB.k)).toLinearMap).toSubsetQuantumSet sk₂ sk₁ := +by + simp_rw [toSubsetQuantumSet, LinearMap.adjoint_comp, + toSubset_algEquiv_symm_adjoint, toSubset_algEquiv_adjoint, + LinearMap.comp_assoc] + +open QuantumSet in +theorem LinearMap.ofSubsetQuantumSet_adjoint_apply {B : Type*} [hb : starAlgebra B] + [hA : QuantumSet A] [hB : QuantumSet B] + (sk₁ sk₂ : ℝ) (f : subset sk₁ A →ₗ[ℂ] subset sk₂ B) : + letI := hA.instSubset sk₁ + letI := hB.instSubset sk₂ + (LinearMap.adjoint (f.ofSubsetQuantumSet sk₁ sk₂)) = + (ha.modAut (sk₁ + -hA.k)).toLinearMap + ∘ₗ (LinearMap.adjoint f).ofSubsetQuantumSet sk₂ sk₁ + ∘ₗ (hb.modAut (-sk₂ + hB.k)).toLinearMap := +by + letI := hA.instSubset sk₁ + letI := hB.instSubset sk₂ + simp_rw [ofSubsetQuantumSet, LinearMap.adjoint_comp, + toSubset_algEquiv_symm_adjoint, toSubset_algEquiv_adjoint, + LinearMap.comp_assoc] + +theorem rankOne_toSubsetQuantumSet {B : Type*} [hb : starAlgebra B] + [hA : QuantumSet A] [hB : QuantumSet B] + (sk₁ sk₂ : ℝ) (a : B) (b : A) : + letI := hA.instSubset sk₁ + letI := hB.instSubset sk₂ + (rankOne ℂ a b).toLinearMap.toSubsetQuantumSet sk₁ sk₂ + = (rankOne ℂ (QuantumSet.toSubset_equiv sk₂ a) + (QuantumSet.toSubset_equiv sk₁ (ha.modAut (-sk₁ + k A) b))).toLinearMap := +by + letI := hA.instSubset sk₁ + letI := hB.instSubset sk₂ + rw [LinearMap.toSubsetQuantumSet, LinearMap.rankOne_comp, + LinearMap.comp_rankOne, QuantumSet.toSubset_algEquiv_symm_adjoint] + simp_rw [LinearMap.comp_apply, AlgEquiv.toLinearMap_apply] + rfl + +open QuantumSet in +theorem rankOne_ofSubsetQuantumSet {B : Type*} [starAlgebra B] + [hA : QuantumSet A] [hB : QuantumSet B] (sk₁ sk₂ : ℝ) + (a : subset sk₂ B) (b : subset sk₁ A) : + letI := hA.instSubset sk₁ + letI := hB.instSubset sk₂ + (rankOne ℂ a b).ofSubsetQuantumSet sk₁ sk₂ + = (rankOne ℂ ((toSubset_equiv sk₂).symm a) + (ha.modAut (sk₁ + -k A) ((toSubset_equiv sk₁).symm b))).toLinearMap := +by + letI := hA.instSubset sk₁ + letI := hB.instSubset sk₂ + rw [LinearMap.ofSubsetQuantumSet, LinearMap.rankOne_comp, + LinearMap.comp_rankOne, QuantumSet.toSubset_algEquiv_adjoint] + simp_rw [LinearMap.comp_apply, AlgEquiv.toLinearMap_apply] + rfl + +@[simp] +theorem QuantumSet.subset_k {A : Type*} [starAlgebra A] [h : QuantumSet A] (r : ℝ) : + letI := QuantumSet.instSubset h r + k (QuantumSet.subset r A) = r := +rfl + +@[simp] +theorem QuantumSet.subset_n {A : Type*} [starAlgebra A] [h : QuantumSet A] (r : ℝ) : + letI := QuantumSet.instSubset h r + n (QuantumSet.subset r A) = n A := +rfl + +open scoped TensorProduct +/-- The tautological algebra equivalence between tensor products of shifted synonyms. -/ +noncomputable def QuantumSet.subset_tensor_algEquiv {A B : Type*} [starAlgebra A] + [starAlgebra B] (r : ℝ) : + (QuantumSet.subset r A ⊗[ℂ] QuantumSet.subset r B) ≃ₐ[ℂ] + QuantumSet.subset r (A ⊗[ℂ] B) := +(AlgEquiv.TensorProduct.map + (QuantumSet.toSubset_algEquiv r).symm + (QuantumSet.toSubset_algEquiv r).symm).trans +(QuantumSet.toSubset_algEquiv r) +theorem QuantumSet.subset_tensor_algEquiv_tmul {A B : Type*} [starAlgebra A] [starAlgebra B] + (r : ℝ) (x : QuantumSet.subset r A) (y : QuantumSet.subset r B) : + QuantumSet.subset_tensor_algEquiv r (x ⊗ₜ[ℂ] y) + = QuantumSet.toSubset_algEquiv r + ((QuantumSet.toSubset_algEquiv r).symm x ⊗ₜ[ℂ] (QuantumSet.toSubset_algEquiv r).symm y) := +rfl +theorem QuantumSet.subset_tensor_algEquiv_symm_tmul {A B : Type*} [starAlgebra A] [starAlgebra B] + (r : ℝ) (a : A) (b : B) : + (QuantumSet.subset_tensor_algEquiv r).symm (QuantumSet.toSubset_algEquiv r (a ⊗ₜ[ℂ] b)) + = (QuantumSet.toSubset_algEquiv r) + ((QuantumSet.toSubset_algEquiv r a) ⊗ₜ[ℂ] (QuantumSet.toSubset_algEquiv r b)) := +rfl + +theorem LinearMap.mul'_quantumSet_subset_eq {A : Type*} [starAlgebra A] [QuantumSet A] + (r : ℝ) : + LinearMap.mul' ℂ (QuantumSet.subset r A) = (QuantumSet.toSubset_algEquiv r).toLinearMap + ∘ₗ (LinearMap.mul' ℂ A) + ∘ₗ (TensorProduct.map + (QuantumSet.toSubset_algEquiv r).symm.toLinearMap + (QuantumSet.toSubset_algEquiv r).symm.toLinearMap) := +by + ext x y + simp [AlgEquiv.toLinearMap_apply] + +theorem QuantumSet.subset_tensor_algEquiv_adjoint + {A B : Type*} [starAlgebra A] [starAlgebra B] [QuantumSet A] [QuantumSet B] + [h : Fact (k A = k B)] (r : ℝ) : + letI h1 := QuantumSet.instSubset (A := A) (by infer_instance) r; + letI h2 := QuantumSet.instSubset (A := B) (by infer_instance) r; + letI h3 := QuantumSet.tensorProduct (h := h); + letI := QuantumSet.tensorProduct (hA := h1) (hB := h2) (h := Fact.mk rfl); + letI := QuantumSet.instSubset (A := A ⊗[ℂ] B) h3 r; + LinearMap.adjoint (QuantumSet.subset_tensor_algEquiv (A := A) (B := B) r).toLinearMap + = (QuantumSet.subset_tensor_algEquiv r).symm.toLinearMap := +by + simp only [QuantumSet.subset_tensor_algEquiv, AlgEquiv.trans_toLinearMap, + AlgEquiv.TensorProduct.map_toLinearMap] + letI h1 := QuantumSet.instSubset (A := A) (by infer_instance) r + letI h2 := QuantumSet.instSubset (A := B) (by infer_instance) r + letI h3 := QuantumSet.tensorProduct (h := h) + letI := QuantumSet.tensorProduct (hA := h1) (hB := h2) (h := Fact.mk rfl) + letI := QuantumSet.instSubset (A := A ⊗[ℂ] B) h3 r + refine (LinearMap.adjoint_comp + (QuantumSet.toSubset_algEquiv r : A ⊗[ℂ] B ≃ₐ[ℂ] subset r (A ⊗[ℂ] B)).toLinearMap + (TensorProduct.map (QuantumSet.toSubset_algEquiv r).symm.toLinearMap + (QuantumSet.toSubset_algEquiv r).symm.toLinearMap)).trans ?_ + simp only [TensorProduct.map_adjoint, QuantumSet.toSubset_algEquiv_symm_adjoint, + QuantumSet.toSubset_algEquiv_adjoint r, modAut_tensor, QuantumSet.tensorProduct.k_eq₁, + ← h.out, AlgEquiv.TensorProduct.map_toLinearMap] + change (TensorProduct.map + ((QuantumSet.toSubset_algEquiv r).toLinearMap ∘ₗ (modAut (-r + k A)).toLinearMap) + ((QuantumSet.toSubset_algEquiv r).toLinearMap ∘ₗ (modAut (-r + k A)).toLinearMap) ∘ₗ + TensorProduct.map (modAut (r + -k A)).toLinearMap + (modAut (r + -k A)).toLinearMap) ∘ₗ + (QuantumSet.toSubset_algEquiv r).symm.toLinearMap = _ + rw [← TensorProduct.map_comp] + simp only [AlgEquiv.coe_comp (e := modAut _)] + have hmodA : + (modAut (A := A) (r + -k A)).trans + ((modAut (A := A) (-r + k A)).trans (QuantumSet.toSubset_algEquiv r)) = + QuantumSet.toSubset_algEquiv r := by + ext x + simp only [AlgEquiv.trans_apply, QuantumSet.modAut_apply_modAut] + ring_nf + simp only [starAlgebra.modAut_zero, AlgEquiv.one_apply] + have hmodB : + (modAut (A := B) (r + -k A)).trans + ((modAut (A := B) (-r + k A)).trans (QuantumSet.toSubset_algEquiv r)) = + QuantumSet.toSubset_algEquiv r := by + ext x + simp only [AlgEquiv.trans_apply, QuantumSet.modAut_apply_modAut] + ring_nf + simp only [starAlgebra.modAut_zero, AlgEquiv.one_apply] + simp only [hmodA, hmodB] + rfl + +theorem QuantumSet.comul_subset_eq {A : Type*} [starAlgebra A] [QuantumSet A] (r : ℝ) : + letI := QuantumSet.instSubset (A := A) (by infer_instance) r + letI : Fact (k A = k A) := Fact.mk rfl + Coalgebra.comul (R := ℂ) (A := QuantumSet.subset r A) + = (TensorProduct.map (QuantumSet.toSubset_algEquiv r).toLinearMap + (QuantumSet.toSubset_algEquiv r).toLinearMap) + ∘ₗ + (Coalgebra.comul (R := ℂ) (A := A)) + ∘ₗ (toSubset_algEquiv r).symm.toLinearMap := +by + letI := QuantumSet.instSubset (A := A) (by infer_instance) r + letI : Fact (k A = k A) := Fact.mk rfl + letI hh := QuantumSet.tensorProduct (A := A) (B := A) (h := Fact.mk rfl) + letI := QuantumSet.instSubset (A := A ⊗[ℂ] A) (by infer_instance) r + simp only [Coalgebra.comul_eq_mul_adjoint, LinearMap.mul'_quantumSet_subset_eq] + simp only [LinearMap.adjoint_comp, TensorProduct.map_adjoint, + toSubset_algEquiv_symm_adjoint, toSubset_algEquiv_adjoint] + simp only [← LinearMap.comp_assoc] + congr 1 + simp only [LinearMap.comp_assoc, ← Coalgebra.comul_eq_mul_adjoint, + ← (QuantumSet.modAut_isCoalgHom _).2, TensorProduct.map_comp, + ← AlgEquiv.TensorProduct.map_toLinearMap, ← modAut_tensor] + congr 1 + rw [← LinearMap.comp_assoc] + rw [AlgEquiv.coe_comp, starAlgebra.modAut_trans] + ring_nf + simp only [starAlgebra.modAut_zero, AlgEquiv.one_toLinearMap, LinearMap.one_comp] + +theorem schurMul_toSubsetQuantumSet {A B : Type*} [starAlgebra A] [starAlgebra B] + [QuantumSet A] [QuantumSet B] + {f : A →ₗ[ℂ] B} (r₁ r₂ : ℝ) : + letI := QuantumSet.instSubset (A := A) (by infer_instance) r₁; + letI := QuantumSet.instSubset (A := B) (by infer_instance) r₂; + (f.toSubsetQuantumSet r₁ r₂ •ₛ f.toSubsetQuantumSet r₁ r₂) = + (f •ₛ f).toSubsetQuantumSet r₁ r₂ := +by + simp only [schurMul_apply_apply] + simp only [QuantumSet.comul_subset_eq] + nth_rw 2 [← LinearMap.comp_assoc] + rw [← TensorProduct.map_comp, LinearMap.mul'_quantumSet_subset_eq] + simp only [LinearMap.toSubsetQuantumSet, LinearMap.comp_assoc] + simp only [← LinearMap.comp_assoc, ← TensorProduct.map_comp, AlgEquiv.symm_comp_toLinearMap, + LinearMap.id_comp, LinearMap.comp_id] + +theorem LinearMap.toSubsetQuantumSet_inj + {A B : Type*} [starAlgebra A] [starAlgebra B] [QuantumSet A] [QuantumSet B] + {f g : A →ₗ[ℂ] B} (r₁ r₂ : ℝ) : + f.toSubsetQuantumSet r₁ r₂ = g.toSubsetQuantumSet r₁ r₂ ↔ f = g := +by rfl + +theorem QuantumSet.toSubset_equiv_isReal {A : Type*} [Star A] (r : ℝ) : + LinearMap.IsReal (QuantumSet.toSubset_equiv r (A := A)) := +fun _ => rfl +theorem QuantumSet.toSubset_equiv_symm_isReal {A : Type*} [Star A] (r : ℝ) : + LinearMap.IsReal (QuantumSet.toSubset_equiv r (A := A)).symm := +fun _ => rfl + +theorem LinearMap.toSubsetQuantumSet_isReal_iff + {A B : Type*} [starAlgebra A] [starAlgebra B] [QuantumSet A] [QuantumSet B] + {f : A →ₗ[ℂ] B} (r₁ r₂ : ℝ) : + letI := QuantumSet.instSubset (A := A) (by infer_instance) r₁; + letI := QuantumSet.instSubset (A := B) (by infer_instance) r₂; + LinearMap.IsReal (f.toSubsetQuantumSet r₁ r₂) ↔ LinearMap.IsReal f := +by + simp only [LinearMap.IsReal, LinearMap.toSubsetQuantumSet_apply, + ← QuantumSet.toSubset_equiv_isReal (A := B) r₂ _, + QuantumSet.toSubset_equiv_symm_isReal (A := _) r₁ _] + rfl + +variable {A : Type*} [starAlgebra A] [hA : QuantumSet A] + +theorem QuantumSet.toSubset_onb (r : ℝ) (i : n A) : + letI := hA.instSubset r; + this.onb i = + toSubset_algEquiv r (modAut ((k A / 2) + -(r / 2)) (hA.onb i)) := +by + letI := hA.instSubset r + simp [onb] + +lemma QuantumSet.comul_of_subset (r : ℝ) : + letI := hA.instSubset r; + Coalgebra.comul (R := ℂ) (A := A) = + (TensorProduct.map (toSubset_algEquiv r).symm.toLinearMap + (toSubset_algEquiv r).symm.toLinearMap) + ∘ₗ Coalgebra.comul (R := ℂ) + ∘ₗ (toSubset_algEquiv r).toLinearMap := +by + rw [← AlgEquiv.TensorProduct.map_toLinearMap, + ← AlgEquiv.TensorProduct.map_symm, ← AlgEquiv.comp_linearMap_eq_iff, + eq_comm, AlgEquiv.linearMap_comp_eq_iff, AlgEquiv.TensorProduct.map_toLinearMap, + LinearMap.comp_assoc] + exact comul_subset_eq r + +theorem QuantumSet.toSubset_algEquiv_isReal + {A : Type*} [Ring A] [Algebra ℂ A] [Star A] (r : ℝ) : + LinearMap.IsReal (QuantumSet.toSubset_algEquiv r (A := A)) := +fun _ => rfl + +theorem QuantumSet.innerOne_map_one_toSubset_eq + {A B : Type*} [starAlgebra A] [starAlgebra B] [QuantumSet A] [QuantumSet B] + (r₁ r₂ : ℝ) {f : A →ₗ[ℂ] B} : + letI := QuantumSet.instSubset (A := B) (by infer_instance) r₂ + ⟪1, f 1⟫_ℂ = ⟪1, (f.toSubsetQuantumSet r₁ r₂) 1⟫_ℂ := +by + simp only [LinearMap.coe_comp, Function.comp_apply, AlgEquiv.toLinearMap_apply, map_one] + rw [← AlgEquiv.toLinearMap_apply] + letI := QuantumSet.instSubset (A := B) (by infer_instance) r₂ + nth_rw 2 [← LinearMap.adjoint_inner_left] + rw [toSubset_algEquiv_adjoint, LinearMap.comp_apply] + simp only [AlgEquiv.toLinearMap_apply, map_one] + +instance {A : Type*} [hA : PartialOrder A] (r : ℝ) : + PartialOrder (QuantumSet.subset r A) := +hA +instance {A : Type*} [hA : NonUnitalNonAssocSemiring A] (r : ℝ) : + NonUnitalNonAssocSemiring (QuantumSet.subset r A) := +hA +instance {A : Type*} [hA : NonUnitalSemiring A] (r : ℝ) : + NonUnitalSemiring (QuantumSet.subset r A) := +hA +instance {A : Type*} [NonUnitalNonAssocSemiring A] [hA : StarRing A] (r : ℝ) : + StarRing (QuantumSet.subset r A) := +hA +instance {A : Type*} [NonUnitalSemiring A] [PartialOrder A] [StarRing A] + [hA : StarOrderedRing A] (r : ℝ) : + StarOrderedRing (QuantumSet.subset r A) := +hA +instance {A : Type*} [hA : Nontrivial A] (r : ℝ) : + Nontrivial (QuantumSet.subset r A) := +hA + +theorem QuantumSet.normOne_toSubset {A : Type*} [starAlgebra A] [QuantumSet A] (r : ℝ) : + letI := QuantumSet.instSubset (A := A) (by infer_instance) r + ‖(1 : A)‖ = ‖(1 : QuantumSet.subset r A)‖ := +by + letI := QuantumSet.instSubset (A := A) (by infer_instance) r + simp_rw [norm_eq_sqrt_re_inner (𝕜 := ℂ), QuantumSet.subset_inner_eq, + ← QuantumSet.toSubset_algEquiv_symm_eq_toSubset_equiv, map_one] + +instance {A : Type*} [h : AddCommMonoid A] (r : ℝ) : + AddCommMonoid (QuantumSet.subset r A) := + h + +instance {A : Type*} [AddCommMonoid A] [h : Module ℂ A] (r : ℝ) : + Module ℂ (QuantumSet.subset r A) := + h + +theorem LinearMap.toSubsetQuantumSet_eq_iff {A B : Type*} [ha : starAlgebra A] + [starAlgebra B] [hA : QuantumSet A] [hB : QuantumSet B] (sk₁ : ℝ) (sk₂ : ℝ) + (f : A →ₗ[ℂ] B) : + letI := hA.instSubset sk₁ + letI := hB.instSubset sk₂ + ∀ g : QuantumSet.subset sk₁ A →ₗ[ℂ] QuantumSet.subset sk₂ B, + f.toSubsetQuantumSet sk₁ sk₂ = g ↔ f = g.ofSubsetQuantumSet sk₁ sk₂ := +by + letI := hA.instSubset sk₁ + letI := hB.instSubset sk₂ + intro g + rfl diff --git a/LeanPool/Monlib4/LinearAlgebra/QuantumSet/Symm.lean b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/Symm.lean new file mode 100644 index 0000000000..384d0808d7 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/Symm.lean @@ -0,0 +1,436 @@ +/- +Copyright (c) 2024 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.IsReal +-- import LeanPool.Monlib4.LinearAlgebra.MyIps.Nontracial +import LeanPool.Monlib4.LinearAlgebra.Ips.OpUnop +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Basic +import LeanPool.Monlib4.LinearAlgebra.Ips.MulOp +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.FiniteDimensional + +/-! +# Symmetry Maps for Quantum Sets + +This file restores the upstream symmetry map on linear maps between quantum +sets, together with its interaction with modular automorphisms and `Psi`. +-/ + +/-- The symmetry map sends a linear map to the adjoint of its real conjugate. -/ +@[simps] +noncomputable def symmMap (R : Type _) [RCLike R] (M₁ M₂ : Type _) [NormedAddCommGroup M₁] + [NormedAddCommGroup M₂] + [InnerProductSpace R M₁] [InnerProductSpace R M₂] [StarAddMonoid M₁] + [StarAddMonoid M₂] [StarModule R M₁] [StarModule R M₂] [FiniteDimensional R M₁] + [FiniteDimensional R M₂] : + (M₁ →ₗ[R] M₂) ≃ₗ[R] M₂ →ₗ[R] M₁ + where + toFun f := LinearMap.adjoint (LinearMap.real f) + invFun f := (LinearMap.adjoint f).real + left_inv f := by simp only [LinearMap.adjoint_adjoint, LinearMap.real_real] + right_inv f := by simp only [LinearMap.real_real, LinearMap.adjoint_adjoint] + map_add' f g := by simp only [LinearMap.real_add, map_add] + map_smul' c f := by + simp only [LinearMap.real_smul, LinearMap.adjoint_smul, starRingEnd_self_apply, + RingHom.id_apply] + +theorem symmMap_real {R : Type _} [RCLike R] {M : Type _} [NormedAddCommGroup M] + [InnerProductSpace R M] [StarAddMonoid M] [StarModule R M] [FiniteDimensional R M] : + LinearMap.real (symmMap R M M : (M →ₗ[R] M) →ₗ[R] M →ₗ[R] M) = + (symmMap R M M).symm := + by + ext1 f + simp_rw [LinearMap.real_apply, LinearEquiv.coe_coe, LinearMap.star_eq_adjoint, + symmMap_apply, LinearMap.adjoint_adjoint] + rfl + +open scoped TensorProduct Matrix + +-- variable {n : Type _} [Fintype n] [DecidableEq n] {s : n → Type _} [∀ i, Fintype (s i)] +-- [∀ i, DecidableEq (s i)] {ψ : ∀ i, Module.Dual ℂ (Matrix (s i) (s i) ℂ)} +-- {n₂ : Type _} [Fintype n₂] [DecidableEq n₂] {s₂ : n₂ → Type _} [∀ i, Fintype (s₂ i)] +-- [∀ i, DecidableEq (s₂ i)] {φ : ∀ i, Module.Dual ℂ (Matrix (s₂ i) (s₂ i) ℂ)} + +-- local notation "𝔹" => PiMat ℂ n s +-- local notation "𝔹₂" => PiMat ℂ n₂ s₂ + +local notation "|" x "⟩⟨" y "|" => @rankOne ℂ _ _ _ _ _ _ _ x y + +local notation "m" x => LinearMap.mul' ℂ x + +local notation "η" x => Algebra.linearMap ℂ x + +local notation x " ⊗ₘ " y => TensorProduct.map x y + +local notation "υ" => TensorProduct.assoc ℂ + +-- local notation "υ⁻¹" x y z => + -- LinearEquiv.toLinearMap (LinearEquiv.symm (TensorProduct.assoc ℂ x y z)) + +local notation x "ϰ" y => + LinearEquiv.toLinearMap (TensorProduct.comm ℂ x y) + +local notation x "ϰ⁻¹" y => + LinearEquiv.toLinearMap (LinearEquiv.symm (TensorProduct.comm ℂ x y)) + +local notation "τ" x => + LinearEquiv.toLinearMap (TensorProduct.lid ℂ x) + +local notation "τ⁻¹" x => + LinearEquiv.toLinearMap (LinearEquiv.symm (TensorProduct.lid ℂ x)) + +local notation "id" x => (1 : x →ₗ[ℂ] x) + +variable {A B : Type*} [ha : starAlgebra A] [hb : starAlgebra B] + [hA : QuantumSet A] [hB : QuantumSet B] + +theorem symmMap_rankOne_apply (a : A) (b : B) : + symmMap _ _ _ (|a⟩⟨b| : B →ₗ[ℂ] A) = + |hb.modAut (-(2*hB.k)-1) (star b)⟩⟨star a| := +letI := FiniteDimensional.complete ℂ A +letI := FiniteDimensional.complete ℂ B +by rw [symmMap_apply, rankOne_real, ContinuousLinearMap.linearMap_adjoint, rankOne_adjoint] + +theorem symmMap_symm_rankOne_apply (a : A) (b : B) : + (symmMap _ _ _).symm (|a⟩⟨b| : B →ₗ[ℂ] A) = + |star b⟩⟨ha.modAut (-(2*hA.k)-1) (star a)| := +letI := FiniteDimensional.complete ℂ A +letI := FiniteDimensional.complete ℂ B +by rw [symmMap_symm_apply, ContinuousLinearMap.linearMap_adjoint, rankOne_adjoint, rankOne_real] + +open scoped BigOperators + +open TensorProduct + +open Coalgebra LinearMap in +private noncomputable def symmMapAux : + (A →ₗ[ℂ] B) →ₗ[ℂ] (B →ₗ[ℂ] A) := +{ toFun := fun x => + (modAut (-k A)).toLinearMap + ∘ₗ (TensorProduct.rid ℂ _).toLinearMap + ∘ₗ (lTensor _ (counit ∘ₗ m _)) + ∘ₗ (υ _ _ _).toLinearMap + ∘ₗ (rTensor _ (lTensor _ x)) + ∘ₗ (rTensor _ (comul ∘ₗ Algebra.linearMap ℂ _)) + ∘ₗ (τ⁻¹ _) + ∘ₗ (modAut (k B)).toLinearMap + map_add' := fun x y => by simp only [lTensor_add, rTensor_add, comp_add, add_comp] + map_smul' := fun r x => by simp only [lTensor_smul, rTensor_smul, RingHom.id_apply, + comp_smul, smul_comp] } +open Coalgebra LinearMap in +private lemma symmMapAux_apply (f : A →ₗ[ℂ] B) : + symmMapAux f = (modAut (-k A)).toLinearMap + ∘ₗ (TensorProduct.rid ℂ _).toLinearMap + ∘ₗ (lTensor _ (counit ∘ₗ m _)) + ∘ₗ (υ _ _ _).toLinearMap + ∘ₗ (rTensor _ (lTensor _ f)) + ∘ₗ (rTensor _ (comul ∘ₗ Algebra.linearMap ℂ _)) + ∘ₗ (τ⁻¹ _) + ∘ₗ (modAut (k B)).toLinearMap := +rfl + +open scoped InnerProductSpace + +open Coalgebra LinearMap in +theorem symmMap_eq (f : A →ₗ[ℂ] B) : + (symmMap ℂ A _) f = (modAut (-k A)).toLinearMap + ∘ₗ (TensorProduct.rid ℂ _).toLinearMap + ∘ₗ (lTensor _ (counit ∘ₗ m _)) + ∘ₗ (υ _ _ _).toLinearMap + ∘ₗ (rTensor _ (lTensor _ f)) + ∘ₗ (rTensor _ (comul ∘ₗ Algebra.linearMap ℂ _)) + ∘ₗ (τ⁻¹ _) + ∘ₗ (modAut (k B)).toLinearMap := +by + rw [← symmMapAux_apply] + revert f + rw [← LinearEquiv.coe_toLinearMap, ← LinearMap.ext_iff] + apply ext_of_rank_one' + intro x y + rw [LinearEquiv.coe_toLinearMap, symmMap_rankOne_apply, eq_comm, LinearMap.ext_iff] + intro a + apply ext_inner_right ℂ + intro b + obtain ⟨α, β, this⟩ := TensorProduct.eq_span (comul (1 : A) : A ⊗[ℂ] A) + simp_rw [symmMapAux_apply, LinearMap.comp_apply, LinearEquiv.coe_coe, lid_symm_apply, + rTensor_tmul, LinearMap.comp_apply, Algebra.linearMap_apply, Algebra.algebraMap_eq_smul_one, + one_smul] + rw [← this] + simp_rw [_root_.map_sum, lTensor_tmul, sum_tmul, _root_.map_sum, assoc_tmul, + lTensor_tmul, rid_tmul, sum_inner, LinearMap.comp_apply, ContinuousLinearMap.coe_coe, + rankOne_apply, ← smul_tmul', _root_.map_smul, + ← inner_eq_counit', smul_eq_mul, LinearMap.mul'_apply, inner_smul_left, + starRingEnd_apply, star_mul, ← starRingEnd_apply, inner_conj_symm, mul_assoc, + ← Finset.mul_sum, mul_comm ⟪_, y⟫_ℂ, + ← LinearMap.adjoint_inner_right, QuantumSet.modAut_adjoint, + ← inner_tmul, ← sum_inner, this, comul_eq_mul_adjoint, + adjoint_inner_left, mul'_apply, inner_tmul, QuantumSet.inner_star_left, + ← inner_conj_symm (1 : A), QuantumSet.inner_conj_left, mul_one, one_mul, inner_conj_symm] + nth_rw 1 [← LinearMap.adjoint_inner_right] + nth_rw 2 [← LinearMap.adjoint_inner_left] + simp_rw [QuantumSet.modAut_adjoint, AlgEquiv.toLinearMap_apply, QuantumSet.modAut_apply_modAut, + add_neg_cancel, starAlgebra.modAut_zero, AlgEquiv.one_apply, two_mul, neg_add, add_sub_assoc] + +open Coalgebra LinearMap in +private noncomputable def symmMapSymmAux : + (A →ₗ[ℂ] B) →ₗ[ℂ] (B →ₗ[ℂ] A) := +{ toFun := fun x => (modAut (k A)).toLinearMap + ∘ₗ (TensorProduct.lid ℂ A).toLinearMap + ∘ₗ (rTensor _ (counit ∘ₗ m _)) + ∘ₗ (rTensor _ (lTensor _ x)) + ∘ₗ (υ _ _ _).symm.toLinearMap + ∘ₗ (lTensor _ (comul ∘ₗ Algebra.linearMap ℂ _)) + ∘ₗ (TensorProduct.rid ℂ _).symm.toLinearMap + ∘ₗ (modAut (-k B)).toLinearMap + map_add' := fun x y => by simp only [lTensor_add, rTensor_add, comp_add, add_comp] + map_smul' := fun r x => by simp only [lTensor_smul, rTensor_smul, RingHom.id_apply, + comp_smul, smul_comp] } +open Coalgebra LinearMap in +private lemma symmMapSymmAux_apply + (f : A →ₗ[ℂ] B) : + symmMapSymmAux f = (modAut (k A)).toLinearMap + ∘ₗ (TensorProduct.lid ℂ A).toLinearMap + ∘ₗ (rTensor _ (counit ∘ₗ m _)) + ∘ₗ (rTensor _ (lTensor _ f)) + ∘ₗ (υ _ _ _).symm.toLinearMap + ∘ₗ (lTensor _ (comul ∘ₗ Algebra.linearMap ℂ _)) + ∘ₗ (TensorProduct.rid ℂ _).symm.toLinearMap + ∘ₗ (modAut (-k B)).toLinearMap := +rfl + +open LinearMap Coalgebra in +theorem symmMap_symm_eq (f : A →ₗ[ℂ] B) : + (symmMap ℂ _ _).symm f = + (modAut (k A)).toLinearMap + ∘ₗ (TensorProduct.lid ℂ A).toLinearMap + ∘ₗ (rTensor _ (counit ∘ₗ m _)) + ∘ₗ (rTensor _ (lTensor _ f)) + ∘ₗ (υ _ _ _).symm.toLinearMap + ∘ₗ (lTensor _ (comul ∘ₗ Algebra.linearMap ℂ _)) + ∘ₗ (TensorProduct.rid ℂ _).symm.toLinearMap + ∘ₗ (modAut (-k B)).toLinearMap := + by + rw [← symmMapSymmAux_apply] + revert f + rw [← LinearEquiv.coe_toLinearMap, ← LinearMap.ext_iff] + apply ext_of_rank_one' + intro x y + rw [LinearEquiv.coe_toLinearMap, symmMap_symm_rankOne_apply, eq_comm, LinearMap.ext_iff] + intro a + apply ext_inner_right ℂ + intro b + obtain ⟨α, β, this⟩ := TensorProduct.eq_span (comul (1 : A) : A ⊗[ℂ] A) + simp_rw [symmMapSymmAux_apply, LinearMap.comp_apply, LinearEquiv.coe_coe, rid_symm_apply, + lTensor_tmul, LinearMap.comp_apply, Algebra.linearMap_apply, Algebra.algebraMap_eq_smul_one, + one_smul] + rw [← this] + simp_rw [tmul_sum, _root_.map_sum, assoc_symm_tmul, rTensor_tmul, + lTensor_tmul, comp_apply, lid_tmul, sum_inner, mul'_apply, + ContinuousLinearMap.coe_coe, rankOne_apply, mul_smul_comm, _root_.map_smul, + ← inner_eq_counit', smul_eq_mul, inner_smul_left, starRingEnd_apply, + star_mul, ← starRingEnd_apply, inner_conj_symm, mul_assoc, + ← Finset.mul_sum, + ← LinearMap.adjoint_inner_right, QuantumSet.modAut_adjoint, + ← inner_tmul, ← sum_inner, this, comul_eq_mul_adjoint, + adjoint_inner_left, mul'_apply, inner_tmul, QuantumSet.inner_star_left, + mul_one, ← inner_conj_symm (1 : A), QuantumSet.inner_star_left, mul_one, inner_conj_symm] + nth_rw 1 [QuantumSet.inner_conj] + rw [← LinearMap.adjoint_inner_left, QuantumSet.modAut_adjoint] + simp_rw [AlgEquiv.toLinearMap_apply, starAlgebra.modAut_star, neg_neg, star_star, + QuantumSet.modAut_apply_modAut, add_neg_cancel, starAlgebra.modAut_zero, AlgEquiv.one_apply] + +open Coalgebra in +theorem counit_map_mul_eq_counit_mul_modAut_conj_symmMap (f : A →ₗ[ℂ] B) (x : A) (y : B) : + counit (f x * y) = (counit (x * (modAut (k A) ((symmMap _ _ _ f) (modAut (-k B) y)))) : ℂ) := + calc counit (f x * y) = ⟪star (f x), modAut (-k B) y⟫_ℂ := + by rw [QuantumSet.inner_eq_counit, star_star, QuantumSet.modAut_apply_modAut, add_neg_cancel, + starAlgebra.modAut_zero, AlgEquiv.one_apply] + _ = ⟪f.real (star x), modAut (-k B) y⟫_ℂ := + by rw [LinearMap.real_apply, star_star] + _ = ⟪star x, symmMap _ _ _ f (modAut (-k B) y)⟫_ℂ := + by rw [symmMap_apply, LinearMap.adjoint_inner_right] + _ = counit (x * (modAut (k A) ((symmMap _ _ _ f) (modAut (-k B) y)))) := + by rw [hA.inner_eq_counit, star_star] + +theorem LinearMap.adjoint_eq_iff + {𝕜 E F : Type*} [RCLike 𝕜] [NormedAddCommGroup E] [NormedAddCommGroup F] + [InnerProductSpace 𝕜 E] [InnerProductSpace 𝕜 F] [FiniteDimensional 𝕜 E] + [FiniteDimensional 𝕜 F] (A : E →ₗ[𝕜] F) (B : F →ₗ[𝕜] E) : + LinearMap.adjoint A = B ↔ A = LinearMap.adjoint B := +by apply Iff.intro <;> rintro rfl <;> simp [adjoint_adjoint] + +open Coalgebra in +theorem symmMap_eq_conj_modAut_tfae (f : B →ₗ[ℂ] B) : + List.TFAE + [symmMap _ _ _ f = (modAut (-k B)).toLinearMap ∘ₗ f ∘ₗ (modAut (k B)).toLinearMap, + f.real = (modAut (k B)).toLinearMap ∘ₗ LinearMap.adjoint f ∘ₗ (modAut (-k B)).toLinearMap, + ∀ x y, counit (f x * y) = (counit (x * f y) : ℂ)] := +by + tfae_have 1 ↔ 2 := by + simp_rw [symmMap_apply, LinearMap.adjoint_eq_iff, LinearMap.adjoint_comp, + QuantumSet.modAut_adjoint, LinearMap.comp_assoc] + tfae_have 1 → 3 := by + intro h x y + simp_rw [counit_map_mul_eq_counit_mul_modAut_conj_symmMap] + simp_rw [h, LinearMap.comp_apply, AlgEquiv.toLinearMap_apply, QuantumSet.modAut_apply_modAut, + add_neg_cancel, starAlgebra.modAut_zero, AlgEquiv.one_apply] + tfae_have 3 → 2 := by + intro h + rw [LinearMap.ext_iff_inner_map] + intro u + rw [hB.inner_eq_counit, LinearMap.real_apply, star_star, h] + simp_rw [LinearMap.comp_apply, ← LinearMap.adjoint_inner_right, + QuantumSet.modAut_adjoint, LinearMap.adjoint_adjoint, + QuantumSet.inner_eq_counit, AlgEquiv.toLinearMap_apply, + QuantumSet.modAut_apply_modAut, add_neg_cancel, starAlgebra.modAut_zero, + AlgEquiv.one_apply] + tfae_finish + +open Coalgebra in +theorem symmMap_eq_self_tfae (f : B →ₗ[ℂ] B) (gns : hB.k = 0) : + List.TFAE + [symmMap _ _ _ f = f, + (symmMap _ _ _).symm f = f, + f.real = LinearMap.adjoint f, + ∀ x y : B, counit (f x * y) = (counit (x * f y) : ℂ)] := +by + tfae_have 1 ↔ 2 := by rw [← LinearEquiv.eq_symm_apply, eq_comm] + tfae_have 1 ↔ 3 := by rw [symmMap_apply, LinearMap.adjoint_eq_iff] + have := List.TFAE.out (symmMap_eq_conj_modAut_tfae f) 1 2 + simp only [gns, neg_zero, starAlgebra.modAut_zero, AlgEquiv.one_toLinearMap, + LinearMap.one_comp, LinearMap.comp_one] at this + tfae_finish + +theorem commute_real_real {R A : Type _} [Semiring R] [StarRing R] [AddCommMonoid A] [Module R A] + [StarAddMonoid A] [StarModule R A] (f g : A →ₗ[R] A) : + Commute (f.real : A →ₗ[R] A) (g.real : A →ₗ[R] A) ↔ Commute f g := by + simp_rw [Commute, SemiconjBy, Module.End.mul_eq_comp, ← LinearMap.real_comp, ← + LinearMap.real_inj_eq] + +theorem linearMap_commute_modAut_pos_neg (r : ℝ) (x : B →ₗ[ℂ] B) : + Commute x (hb.modAut r).toLinearMap ↔ + Commute x (hb.modAut (-r)).toLinearMap := + by + simp_rw [Commute, SemiconjBy, Module.End.mul_eq_comp] + rw [AlgEquiv.linearMap_comp_eq_iff, ← starAlgebra.modAut_symm] + nth_rw 1 [← AlgEquiv.comp_linearMap_eq_iff] + rw [eq_comm] + simp_rw [LinearMap.comp_assoc] + +theorem symmMap_apply_eq_symmMap_symm_apply_iff + (f : A →ₗ[ℂ] B) : + symmMap ℂ _ _ f = (symmMap ℂ _ _).symm f ↔ + f ∘ₗ (ha.modAut (2*hA.k + 1)).toLinearMap = (hb.modAut (2 * hB.k + 1)).toLinearMap ∘ₗ f := + by + rw [symmMap_apply, symmMap_symm_apply, LinearMap.adjoint_real_eq] + simp_rw [@eq_comm _ (LinearMap.adjoint _), AlgEquiv.comp_linearMap_eq_iff, + neg_sub_left, starAlgebra.modAut_symm] + nth_rw 1 [← QuantumSet.modAut_isSelfAdjoint] + nth_rw 2 [← QuantumSet.modAut_isSelfAdjoint] + simp_rw [LinearMap.star_eq_adjoint, ← LinearMap.adjoint_comp, + Function.Injective.eq_iff (LinearEquiv.injective _)] + nth_rw 1 [LinearMap.real_inj_eq] + simp only [LinearMap.real_comp, LinearMap.real_real, QuantumSet.modAut_real] + rw [eq_comm] + ring_nf + +theorem Psi.real_apply (r₁ r₂ : ℝ) (f : A →ₗ[ℂ] B) : + hA.Psi r₁ r₂ f.real = + ((hb.modAut (2 * r₁)).toLinearMap ⊗ₘ + ((ha.modAut (1 - 2 * (r₂ - hA.k))).op.toLinearMap)) + (star (hA.Psi r₁ r₂ f)) := +by + suffices + ∀ (a : B) (b : A), + hA.Psi r₁ r₂ (LinearMap.real |a⟩⟨b|) = + ((hb.modAut (2 * r₁)).toLinearMap ⊗ₘ + (ha.modAut (1 - 2 * (r₂ - hA.k))).op.toLinearMap) + (star (hA.Psi r₁ r₂ |a⟩⟨b|)) + by + obtain ⟨α, β, rfl⟩ := f.exists_sum_rankOne + letI ttt : StarAddMonoid (B ⊗[ℂ] Aᵐᵒᵖ) := by infer_instance + simp only [_root_.map_sum, LinearMap.real_sum, map_sum, star_sum, this] + intro a b + simp_rw [rankOne_real, hA.Psi_apply, hA.Psi_toFun_apply, + star_tmul, map_tmul, AlgEquiv.toLinearMap_apply, AlgEquiv.op_apply_apply, ← + MulOpposite.op_star, MulOpposite.unop_op, star_star, starAlgebra.modAut_star, + QuantumSet.modAut_apply_modAut, star_star, neg_sub, + sub_neg_eq_add] + ring_nf + +theorem Psi.adjoint_apply (r₁ r₂ : ℝ) (f : A →ₗ[ℂ] B) : + hB.Psi r₁ r₂ (LinearMap.adjoint f) = + ((ha.modAut (r₁ - r₂)).toLinearMap ⊗ₘ + ((hb.modAut (r₁ - r₂)).op.toLinearMap)) + (tenSwap ℂ (star (hA.Psi r₁ r₂ f))) := + by + suffices + ∀ (a : B) (b : A), + hB.Psi r₁ r₂ (LinearMap.adjoint ↑|a⟩⟨b|) = + ((ha.modAut (r₁ - r₂)).toLinearMap ⊗ₘ + (hb.modAut (r₁ - r₂)).op.toLinearMap ) + (tenSwap ℂ (star (hA.Psi r₁ r₂ |a⟩⟨b|))) + by + obtain ⟨α, β, rfl⟩ := f.exists_sum_rankOne + simp only [map_sum, star_sum, this] + intro a b + simp_rw [ContinuousLinearMap.linearMap_adjoint, rankOne_adjoint, + QuantumSet.Psi_apply, QuantumSet.Psi_toFun_apply, star_tmul, + ← MulOpposite.op_star, tenSwap_apply', star_star, map_tmul, + AlgEquiv.toLinearMap_apply, AlgEquiv.op_apply_apply, MulOpposite.unop_op, + starAlgebra.modAut_star, QuantumSet.modAut_apply_modAut, + sub_eq_add_neg, add_assoc, add_neg_cancel_comm_assoc, neg_add_cancel, add_zero] + +theorem Psi.symmMap_apply (r₁ r₂ : ℝ) (f : A →ₗ[ℂ] B) : + hB.Psi r₁ r₂ (symmMap _ _ _ f) = + ((ha.modAut (r₁ + r₂ - 1 - (2 * hA.k))).toLinearMap ⊗ₘ + (hb.modAut (-r₁ - r₂)).op.toLinearMap) + (tenSwap ℂ (hA.Psi r₁ r₂ f)) := + by + simp_rw [← LinearEquiv.coe_coe, ← LinearMap.comp_apply] + revert f + simp_rw [← LinearMap.ext_iff] + apply LinearMap.ext_of_rank_one' + intro a b + simp_rw [LinearMap.comp_apply, LinearEquiv.coe_coe, symmMap_rankOne_apply, + QuantumSet.Psi_apply, QuantumSet.Psi_toFun_apply, + tenSwap_apply', map_tmul, AlgEquiv.toLinearMap_apply, AlgEquiv.op_apply_apply, + MulOpposite.unop_op, starAlgebra.modAut_star, + QuantumSet.modAut_apply_modAut, star_star, sub_eq_add_neg, + neg_add_cancel_comm, add_assoc] + ring_nf + +theorem Psi.symmMap_symm_apply (r₁ r₂ : ℝ) (f : A →ₗ[ℂ] B) : + hB.Psi r₁ r₂ ((symmMap _ _ _).symm f) = + ((ha.modAut (r₁ + r₂)).toLinearMap ⊗ₘ + (hb.modAut (1 - r₁ - r₂ + (2 * hB.k))).op.toLinearMap) + (tenSwap ℂ (hA.Psi r₁ r₂ f)) := +by + simp_rw [← LinearEquiv.coe_coe, ← LinearMap.comp_apply] + revert f + simp_rw [← LinearMap.ext_iff] + apply LinearMap.ext_of_rank_one' + intro a b + simp_rw [LinearMap.comp_apply, LinearEquiv.coe_coe, symmMap_symm_rankOne_apply, + QuantumSet.Psi_apply, QuantumSet.Psi_toFun_apply, + tenSwap_apply', map_tmul, AlgEquiv.toLinearMap_apply, AlgEquiv.op_apply_apply, + MulOpposite.unop_op, starAlgebra.modAut_star, + QuantumSet.modAut_apply_modAut, star_star, sub_eq_add_neg, add_assoc] + ring_nf + +theorem symmMap_apply_adjoint (x : A →ₗ[ℂ] B) : + LinearMap.adjoint (symmMap ℂ A _ x) + = ((symmMap ℂ _ _).symm) (LinearMap.adjoint x) := + by + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne x + simp_rw [map_sum, ContinuousLinearMap.linearMap_adjoint, rankOne_adjoint, + symmMap_symm_apply, symmMap_apply, ContinuousLinearMap.linearMap_adjoint, + rankOne_adjoint, LinearMap.adjoint_adjoint] + +theorem symmMap_comp {C : Type*} [starAlgebra C] [QuantumSet C] + (x : A →ₗ[ℂ] B) (y : C →ₗ[ℂ] A) : + symmMap ℂ _ _ (x ∘ₗ y) = (symmMap ℂ _ _ y) ∘ₗ (symmMap ℂ _ _ x) := +by + simp_rw [symmMap_apply, LinearMap.real_comp, LinearMap.adjoint_comp] diff --git a/LeanPool/Monlib4/LinearAlgebra/QuantumSet/TensorProduct.lean b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/TensorProduct.lean new file mode 100644 index 0000000000..448a3a1cdc --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/QuantumSet/TensorProduct.lean @@ -0,0 +1,232 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Basic +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.OrthonormalBasis + +/-! +# Tensor Products of Quantum Sets + +This file restores the upstream tensor-product quantum-set instance and the +fourfold tensor-shuffle lemmas used by later quantum-graph files. +-/ + +variable {A : Type*} [ha : starAlgebra A] + {B : Type*} [hb : starAlgebra B] + +open scoped TensorProduct + +noncomputable instance tensorStarAlgebra + : + starAlgebra (A ⊗[ℂ] B) where + star_mul x y := x.induction_on (by simp only [zero_mul, star_zero, mul_zero]) + (y.induction_on + (by simp only [mul_zero, star_zero, TensorProduct.star_tmul, zero_mul, + implies_true]) + (fun _ _ _ _ => by simp only [Algebra.TensorProduct.tmul_mul_tmul, + TensorProduct.star_tmul, star_mul]) + (fun _ _ h1 h2 _ _ => by simp only [mul_add, star_add, h1, h2, add_mul])) + (fun _ _ h1 h2 => by simp only [star_add, add_mul, mul_add, h1, h2]) + star_add := star_add + modAut r := AlgEquiv.TensorProduct.map (ha.modAut r) (hb.modAut r) + modAut_trans r s := by + simp_rw [AlgEquiv.ext_iff, ← AlgEquiv.toLinearMap_apply, ← LinearMap.ext_iff] + apply TensorProduct.ext' + intro _ _ + simp only [AlgEquiv.trans_toLinearMap, LinearMap.coe_comp, Function.comp_apply, + AlgEquiv.toLinearMap_apply, AlgEquiv.TensorProduct.map_tmul, + QuantumSet.modAut_apply_modAut, add_comm] + modAut_star _ x := x.induction_on (by simp only [map_zero, star_zero]) + (fun _ _ => by + simp only [AlgEquiv.TensorProduct.map_tmul, TensorProduct.star_tmul, + starAlgebra.modAut_star]) + (fun _ _ h1 h2 => by simp only [map_add, star_add, h1, h2]) + +lemma modAut_tensor (r : ℝ) : + tensorStarAlgebra.modAut r = AlgEquiv.TensorProduct.map (ha.modAut r) (hb.modAut r) := + rfl + +lemma modAut_tensor_tmul (r : ℝ) (x : A) + (y : B) : + tensorStarAlgebra.modAut r (x ⊗ₜ[ℂ] y) = (ha.modAut r x) ⊗ₜ[ℂ] (hb.modAut r y) := + rfl + +noncomputable instance + [InnerProductAlgebra A] [InnerProductAlgebra B] + : + InnerProductAlgebra (A ⊗[ℂ] B) where + norm_smul_le := norm_smul_le + norm_sq_eq_inner _ := norm_sq_eq_re_inner (𝕜 := ℂ) _ + conj_symm x y := inner_conj_symm (𝕜 := ℂ) x y + add_left := inner_add_left + smul_left r x y := inner_smul_left (𝕜 := ℂ) r x y + +noncomputable instance QuantumSet.tensorProduct + [hA : QuantumSet A] [hB : QuantumSet B] [h : Fact (hA.k = hB.k)] : + QuantumSet (A ⊗[ℂ] B) where + modAut_isSymmetric r _ _ := by + simp_rw [← AlgEquiv.toLinearMap_apply, modAut_tensor, AlgEquiv.TensorProduct.map_toLinearMap] + nth_rw 1 [← @modAut_isSelfAdjoint A] + nth_rw 1 [← @modAut_isSelfAdjoint B] + simp_rw [LinearMap.star_eq_adjoint, ← TensorProduct.map_adjoint] + exact LinearMap.adjoint_inner_left _ _ _ + k := hA.k + inner_star_left a b c := a.induction_on + (by simp only [zero_mul, inner_zero_left, star_zero, map_zero, inner_zero_right]) + (b.induction_on + (by simp only [mul_zero, inner_zero_left, TensorProduct.star_tmul, implies_true]) + (c.induction_on + (by simp only [Algebra.TensorProduct.tmul_mul_tmul, inner_zero_right, + TensorProduct.star_tmul, mul_zero, implies_true]) + (fun _ _ _ _ _ _ => by + simp only [TensorProduct.star_tmul, modAut_tensor, + Algebra.TensorProduct.tmul_mul_tmul, QuantumSet.inner_star_left, + TensorProduct.inner_tmul, AlgEquiv.TensorProduct.map_tmul] + rw [h.out]) + (fun _ _ h1 h2 _ _ _ _ => by + simp only [inner_add_right, h1, h2, mul_add])) + (fun _ _ h1 h2 _ _ => by + simp only [mul_add, inner_add_left, h1, h2])) + (fun _ _ h1 h2 => by + simp only [add_mul, inner_add_left, inner_add_right, h1, h2, star_add, + map_add]) + inner_conj_left a b c := a.induction_on + (by simp only [zero_mul, inner_zero_left]) + (b.induction_on + (by simp only [mul_zero, inner_zero_left, star_zero, map_zero, inner_zero_right, + implies_true]) + (c.induction_on + (by simp only [Algebra.TensorProduct.tmul_mul_tmul, inner_zero_right, + TensorProduct.star_tmul, zero_mul, implies_true]) + (fun _ _ _ _ _ _ => by + simp_rw [TensorProduct.star_tmul, modAut_tensor_tmul, + Algebra.TensorProduct.tmul_mul_tmul, TensorProduct.inner_tmul, + QuantumSet.inner_conj_left] + rw [h.out]) + (fun _ _ h1 h2 _ _ _ _ => by + simp only [inner_add_right, add_mul, h1, h2])) + (fun _ _ h1 h2 _ _ => by + simp only [mul_add, inner_add_left, inner_add_right, star_add, map_add, h1, h2])) + (fun _ _ h1 h2 => by + simp only [add_mul, inner_add_left, h1, h2]) + n := _ + n_isFintype := _ + onb := hA.onb.tensorProduct hB.onb + n_isDecidableEq := by infer_instance + +theorem QuantumSet.tensorProduct.k_eq₁ [hA : QuantumSet A] [hB : QuantumSet B] + [Fact (hA.k = hB.k)] : + (QuantumSet.tensorProduct : QuantumSet (A ⊗[ℂ] B)).k = hA.k := + rfl + +theorem QuantumSet.tensorProduct.k_eq₂ [hA : QuantumSet A] [hB : QuantumSet B] + [h : Fact (hA.k = hB.k)] : + (QuantumSet.tensorProduct : QuantumSet (A ⊗[ℂ] B)).k = hB.k := by + rw [← h.out] + rfl + +theorem comul_real [hA : QuantumSet A] : + (Coalgebra.comul : A →ₗ[ℂ] A ⊗[ℂ] A).real = + (TensorProduct.comm ℂ A A).toLinearMap ∘ₗ Coalgebra.comul := by + letI := Fact.mk (rfl : hA.k = hA.k) + letI : starAlgebra (A ⊗[ℂ] A) := by infer_instance + letI : QuantumSet (A ⊗[ℂ] A) := QuantumSet.tensorProduct + rw [Coalgebra.comul_eq_mul_adjoint, LinearMap.adjoint_real_eq (f := LinearMap.mul' ℂ A), + LinearMap.mul'_real, LinearMap.adjoint_comp, TensorProduct.comm_adjoint, + LinearMap.comp_assoc, ← LinearMap.comp_assoc, modAut_tensor, + AlgEquiv.TensorProduct.map_toLinearMap, + ← TensorProduct.comm_symm_map, ← Coalgebra.comul_eq_mul_adjoint] + simp_rw [LinearMap.comp_assoc, ← LinearMap.comp_assoc _ _ (TensorProduct.map _ _), + (QuantumSet.modAut_isCoalgHom _).2, LinearMap.comp_assoc, ← AlgEquiv.trans_toLinearMap, + starAlgebra.modAut_trans, neg_sub_left, add_comm, + QuantumSet.tensorProduct.k_eq₁, neg_add_cancel, starAlgebra.modAut_zero] + rfl + +/-- Swap the two middle factors in a fourfold tensor product. -/ +noncomputable def swap_middle_tensor + (R : Type*) [CommSemiring R] (A B C D : Type*) + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] : + (A ⊗[R] B) ⊗[R] (C ⊗[R] D) ≃ₗ[R] (A ⊗[R] C) ⊗[R] (B ⊗[R] D) := + ((TensorProduct.assoc R (A ⊗[R] B) C D).symm.trans + (LinearEquiv.rTensor D + (((TensorProduct.assoc R A B C).trans + ((LinearEquiv.lTensor A (TensorProduct.comm R B C)))).trans + (TensorProduct.assoc R A C B).symm))).trans + (TensorProduct.assoc R (A ⊗[R] C) _ _) + +@[simp] +lemma swap_middle_tensor_tmul_apply + {R : Type*} [CommSemiring R] {A B C D : Type*} + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] + (x : A) (y : B) (z : C) (w : D) : + swap_middle_tensor R A B C D ((x ⊗ₜ[R] y) ⊗ₜ[R] (z ⊗ₜ[R] w)) = + (x ⊗ₜ z) ⊗ₜ (y ⊗ₜ w) := + rfl + +@[simp] +lemma swap_middle_tensor_symm + {R : Type*} [CommSemiring R] {A B C D : Type*} + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] : + (swap_middle_tensor R A B C D).symm = swap_middle_tensor R A C B D := + rfl + +lemma swap_middle_tensor_comp_map + {R : Type*} [CommSemiring R] {A B C D E F G H : Type*} + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] + [AddCommMonoid E] [AddCommMonoid F] [AddCommMonoid G] [AddCommMonoid H] + [Module R E] [Module R F] [Module R G] [Module R H] + (f : A →ₗ[R] B) (g : C →ₗ[R] D) + (h : E →ₗ[R] F) (k : G →ₗ[R] H) : + (swap_middle_tensor R B D F H).toLinearMap ∘ₗ + (TensorProduct.map (TensorProduct.map f g) (TensorProduct.map h k)) = + (TensorProduct.map (TensorProduct.map f h) (TensorProduct.map g k)) ∘ₗ + (swap_middle_tensor R A C E G).toLinearMap := by + apply TensorProduct.ext_fourfold' + simp + +lemma LinearMap.mul'_tensorProduct {R A B : Type*} + [CommSemiring R] [NonUnitalNonAssocSemiring A] + [NonUnitalNonAssocSemiring B] [Module R A] [Module R B] + [SMulCommClass R A A] [SMulCommClass R B B] [IsScalarTower R A A] + [IsScalarTower R B B] : + LinearMap.mul' R (A ⊗[R] B) = + (TensorProduct.map (LinearMap.mul' R A) (LinearMap.mul' R B)) ∘ₗ + (swap_middle_tensor R A B A B).toLinearMap := by + apply TensorProduct.ext_fourfold' + simp + +lemma swap_middle_tensor_map_conj {R A B C D E F G H : Type*} [CommSemiring R] + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] + [Module R A] [Module R B] [Module R C] [Module R D] + [AddCommMonoid E] [AddCommMonoid F] [AddCommMonoid G] [AddCommMonoid H] + [Module R E] [Module R F] [Module R G] [Module R H] + (f : A →ₗ[R] B) (g : C →ₗ[R] D) + (h : E →ₗ[R] F) (k : G →ₗ[R] H) : + (swap_middle_tensor R B D F H).toLinearMap ∘ₗ + (TensorProduct.map (TensorProduct.map f g) (TensorProduct.map h k)) ∘ₗ + (swap_middle_tensor R A C E G).symm.toLinearMap = + TensorProduct.map (TensorProduct.map f h) (TensorProduct.map g k) := by + apply TensorProduct.ext_fourfold' + simp + +lemma swap_middle_tensor_adjoint + {𝕜 E F G H : Type*} [RCLike 𝕜] + [NormedAddCommGroup E] [NormedAddCommGroup F] + [NormedAddCommGroup G] [NormedAddCommGroup H] + [InnerProductSpace 𝕜 E] [InnerProductSpace 𝕜 F] + [InnerProductSpace 𝕜 G] [InnerProductSpace 𝕜 H] + [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] + [FiniteDimensional 𝕜 G] [FiniteDimensional 𝕜 H] : + LinearMap.adjoint (swap_middle_tensor 𝕜 E F G H).toLinearMap = + (swap_middle_tensor 𝕜 E F G H).symm.toLinearMap := by + apply TensorProduct.ext_fourfold' + intros x y z w + rw [TensorProduct.inner_ext_fourfold_iff'] + simp [LinearMap.adjoint_inner_left, mul_mul_mul_comm] diff --git a/LeanPool/Monlib4/LinearAlgebra/TensorProduct.lean b/LeanPool/Monlib4/LinearAlgebra/TensorProduct.lean new file mode 100644 index 0000000000..8292d9d10b --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/TensorProduct.lean @@ -0,0 +1,17 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.BasicLemmas +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.FiniteDimensional +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.Lemmas +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.OrthonormalBasis +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.Submodule + +/-! +# TensorProduct + +Import-only index for the `TensorProduct` directory of the monlib4 import. +-/ diff --git a/LeanPool/Monlib4/LinearAlgebra/TensorProduct/BasicLemmas.lean b/LeanPool/Monlib4/LinearAlgebra/TensorProduct/BasicLemmas.lean new file mode 100644 index 0000000000..84dd204f46 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/TensorProduct/BasicLemmas.lean @@ -0,0 +1,245 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import Mathlib.Algebra.Algebra.Bilinear +import Mathlib.LinearAlgebra.Basis.VectorSpace +import Mathlib.LinearAlgebra.TensorProduct.Basis +import Mathlib.RingTheory.TensorProduct.Maps + +/-! +# Some lemmas about `tensor_product` +-/ + +open scoped TensorProduct BigOperators + +namespace TensorProduct + +variable {R M N P Q : Type _} [CommSemiring R] [AddCommMonoid M] [AddCommMonoid N] + [AddCommMonoid P] [AddCommMonoid Q] [Module R M] [Module R N] [Module R P] + [Module R Q] + +/-- Linear maps out of a tensor product are equal iff they agree on pure tensors. -/ +protected theorem ext_iff' {g h : M ⊗[R] N →ₗ[R] P} : + g = h ↔ ∀ x y, g (x ⊗ₜ[R] y) = h (x ⊗ₜ[R] y) := + ⟨fun hxy x y => by rw [hxy], fun hxy => TensorProduct.ext' hxy⟩ + +theorem ext'_iff {g h : (M ⊗[R] N) ⊗[R] Q →ₗ[R] P} : + (∀ x : (M ⊗[R] N) ⊗[R] Q, g x = h x) ↔ + ∀ (x : M) (y : N) (z : Q), + g ((x ⊗ₜ[R] y) ⊗ₜ[R] z) = h ((x ⊗ₜ[R] y) ⊗ₜ[R] z) := by + refine ⟨fun hxy x y z => by rw [hxy], ?_⟩ + rw [← LinearMap.ext_iff] + exact TensorProduct.ext_threefold + +@[simp] +theorem map_apply (f : M →ₗ[R] P) (t : N →ₗ[R] Q) (x : M) (y : N) : + TensorProduct.map f t (x ⊗ₜ[R] y) = f x ⊗ₜ[R] t y := + rfl + +@[simp] +theorem comm_commutes {g : M ⊗[R] N →ₗ[R] P} {h : M ⊗[R] N →ₗ[R] Q} : + (TensorProduct.comm R P Q).toLinearMap ∘ₗ TensorProduct.map g h = + TensorProduct.map h g ∘ₗ + (TensorProduct.comm R (M ⊗[R] N) (M ⊗[R] N)).toLinearMap := by + rw [TensorProduct.ext_iff'] + intro x y + simp_rw [LinearMap.comp_apply, LinearEquiv.coe_coe, TensorProduct.comm_tmul, + TensorProduct.map_apply, TensorProduct.comm_tmul] + +theorem comm_commutes' {g : M →ₗ[R] M} {h : M →ₗ[R] R} : + (TensorProduct.comm R M R).toLinearMap ∘ₗ TensorProduct.map g h = + TensorProduct.map h g ∘ₗ (TensorProduct.comm R M M).toLinearMap := by + simp_rw [TensorProduct.ext_iff', LinearMap.comp_apply, LinearEquiv.coe_coe, + TensorProduct.comm_tmul, TensorProduct.map_apply, TensorProduct.comm_tmul, + forall₂_true_iff] + +theorem assoc_comp_map {R : Type _} [CommSemiring R] {M N M₂ N₂ P Q : Type _} + [AddCommMonoid M] [AddCommMonoid N] [AddCommMonoid M₂] [AddCommMonoid N₂] + [AddCommMonoid P] [AddCommMonoid Q] [Module R M] [Module R N] [Module R M₂] + [Module R N₂] [Module R P] [Module R Q] (f : M →ₗ[R] P) (t : N →ₗ[R] Q) + (s : M₂ →ₗ[R] N₂) : + (TensorProduct.assoc R P Q N₂).toLinearMap ∘ₗ TensorProduct.map (TensorProduct.map f t) s = + TensorProduct.map f (TensorProduct.map t s) ∘ₗ + (TensorProduct.assoc R M N M₂).toLinearMap := by + apply TensorProduct.ext_threefold + intro x y z + simp_rw [LinearMap.comp_apply, LinearEquiv.coe_coe, TensorProduct.map_apply, + TensorProduct.assoc_tmul, TensorProduct.map_apply] + +theorem assoc_symm_comp_map {R : Type _} [CommSemiring R] {M N M₂ N₂ P Q : Type _} + [AddCommMonoid M] [AddCommMonoid N] [AddCommMonoid M₂] [AddCommMonoid N₂] + [AddCommMonoid P] [AddCommMonoid Q] [Module R M] [Module R N] [Module R M₂] + [Module R N₂] [Module R P] [Module R Q] (f : M →ₗ[R] P) (t : N →ₗ[R] Q) + (s : M₂ →ₗ[R] N₂) : + (TensorProduct.assoc R P Q N₂).symm.toLinearMap ∘ₗ + TensorProduct.map f (TensorProduct.map t s) = + TensorProduct.map (TensorProduct.map f t) s ∘ₗ + (TensorProduct.assoc R M N M₂).symm.toLinearMap := by + apply TensorProduct.ext_threefold' + intro x y z + simp_rw [LinearMap.comp_apply, LinearEquiv.coe_coe, TensorProduct.map_apply, + TensorProduct.assoc_symm_tmul, TensorProduct.map_apply] + +theorem comm_map {R : Type _} [CommSemiring R] {M N P Q : Type _} [AddCommMonoid M] + [AddCommMonoid N] [AddCommMonoid P] [AddCommMonoid Q] [Module R M] [Module R N] + [Module R P] [Module R Q] (f : M →ₗ[R] P) (t : N →ₗ[R] Q) : + (TensorProduct.comm R P Q).toLinearMap ∘ₗ TensorProduct.map f t = + TensorProduct.map t f ∘ₗ (TensorProduct.comm R M N).toLinearMap := by + rw [TensorProduct.ext_iff'] + intro x y + simp_rw [LinearMap.comp_apply, LinearEquiv.coe_coe, TensorProduct.map_apply, + TensorProduct.comm_tmul, TensorProduct.map_apply] + +theorem comm_symm_map {R : Type _} [CommSemiring R] {M N P Q : Type _} + [AddCommMonoid M] [AddCommMonoid N] [AddCommMonoid P] [AddCommMonoid Q] + [Module R M] [Module R N] [Module R P] [Module R Q] (f : M →ₗ[R] P) + (t : N →ₗ[R] Q) : + (TensorProduct.comm R P Q).symm.toLinearMap ∘ₗ TensorProduct.map t f = + TensorProduct.map f t ∘ₗ (TensorProduct.comm R M N).symm.toLinearMap := by + rw [TensorProduct.ext_iff'] + intro x y + simp_rw [LinearMap.comp_apply, LinearEquiv.coe_coe, TensorProduct.map_apply, + TensorProduct.comm_symm_tmul, TensorProduct.map_apply] + +protected theorem map_sum {R : Type _} [CommSemiring R] {M₁ M₂ N₁ N₂ : Type _} + [AddCommMonoid M₁] [AddCommMonoid M₂] [AddCommMonoid N₁] [AddCommMonoid N₂] + [Module R M₁] [Module R M₂] [Module R N₁] [Module R N₂] (x : M₁ →ₗ[R] M₂) + {α : Type _} (s : Finset α) (n : α → N₁ →ₗ[R] N₂) : + map x (∑ a ∈ s, n a) = ∑ a ∈ s, map x (n a) := by + simp_rw [TensorProduct.ext_iff', LinearMap.sum_apply, map_apply, LinearMap.coe_sum, + Finset.sum_apply, tmul_sum, forall₂_true_iff] + +theorem sum_map {R : Type _} [CommSemiring R] {M₁ M₂ N₁ N₂ : Type _} + [AddCommMonoid M₁] [AddCommMonoid M₂] [AddCommMonoid N₁] [AddCommMonoid N₂] + [Module R M₁] [Module R M₂] [Module R N₁] [Module R N₂] {α : Type _} + (s : Finset α) (n : α → N₁ →ₗ[R] N₂) (x : M₁ →ₗ[R] M₂) : + map (∑ a ∈ s, n a) x = ∑ a ∈ s, map (n a) x := by + simp_rw [TensorProduct.ext_iff', LinearMap.sum_apply, map_apply, LinearMap.coe_sum, + Finset.sum_apply, sum_tmul, forall₂_true_iff] + +protected theorem map_smul {R : Type _} [CommSemiring R] {M₁ M₂ N₁ N₂ : Type _} + [AddCommMonoid M₁] [AddCommMonoid M₂] [AddCommMonoid N₁] [AddCommMonoid N₂] + [Module R M₁] [Module R M₂] [Module R N₁] [Module R N₂] (x : M₁ →ₗ[R] M₂) + (y : N₁ →ₗ[R] N₂) (a : R) : + map x (a • y) = a • map x y := by + simp_rw [TensorProduct.ext_iff', LinearMap.smul_apply, map_apply, LinearMap.smul_apply, + tmul_smul, forall₂_true_iff] + +theorem smul_map {R : Type _} [CommSemiring R] {M₁ M₂ N₁ N₂ : Type _} + [AddCommMonoid M₁] [AddCommMonoid M₂] [AddCommMonoid N₁] [AddCommMonoid N₂] + [Module R M₁] [Module R M₂] [Module R N₁] [Module R N₂] (x : M₁ →ₗ[R] M₂) + (y : N₁ →ₗ[R] N₂) (a : R) : + map (a • x) y = a • map x y := by + simp_rw [TensorProduct.ext_iff', LinearMap.smul_apply, map_apply, LinearMap.smul_apply, + smul_tmul', forall₂_true_iff] + +theorem add_map {R : Type _} [CommSemiring R] {M₁ M₂ N₁ N₂ : Type _} + [AddCommMonoid M₁] [AddCommMonoid M₂] [AddCommMonoid N₁] [AddCommMonoid N₂] + [Module R M₁] [Module R M₂] [Module R N₁] [Module R N₂] (x y : M₁ →ₗ[R] M₂) + (z : N₁ →ₗ[R] N₂) : + TensorProduct.map (x + y) z = TensorProduct.map x z + TensorProduct.map y z := by + apply ext' + intro u v + simp only [TensorProduct.map_apply, LinearMap.add_apply, add_tmul] + +protected theorem map_zero {R : Type _} [CommSemiring R] {M₁ N₁ M₂ N₂ : Type _} + [AddCommMonoid M₁] [AddCommMonoid N₁] [AddCommMonoid M₂] [AddCommMonoid N₂] + [Module R M₁] [Module R N₁] [Module R M₂] [Module R N₂] (x : M₁ →ₗ[R] N₁) : + TensorProduct.map x (0 : M₂ →ₗ[R] N₂) = 0 := by + apply TensorProduct.ext' + intros + simp_rw [TensorProduct.map_tmul, LinearMap.zero_apply, TensorProduct.tmul_zero] + +protected theorem zero_map {R : Type _} [CommSemiring R] {M₁ N₁ M₂ N₂ : Type _} + [AddCommMonoid M₁] [AddCommMonoid N₁] [AddCommMonoid M₂] [AddCommMonoid N₂] + [Module R M₁] [Module R N₁] [Module R M₂] [Module R N₂] (x : M₁ →ₗ[R] N₁) : + TensorProduct.map (0 : M₂ →ₗ[R] N₂) x = 0 := by + apply TensorProduct.ext' + intros + simp_rw [TensorProduct.map_tmul, LinearMap.zero_apply, TensorProduct.zero_tmul] + +theorem tmul_eq_zero {R : Type _} [Field R] {M N : Type _} [AddCommGroup M] + [AddCommGroup N] [Module R M] [Module R N] {x : M} {y : N} : + x ⊗ₜ[R] y = 0 ↔ x = 0 ∨ y = 0 := by + let b₁ := Module.Basis.ofVectorSpace R M + let b₂ := Module.Basis.ofVectorSpace R N + constructor + · intro h + apply_fun (b₁.tensorProduct b₂).repr at h + simp only [Module.Basis.tensorProduct_repr_tmul_apply, DFunLike.ext_iff, Prod.forall, + map_zero, Finsupp.zero_apply, smul_eq_zero] at h + simp only [Module.Basis.ext_elem_iff b₁, Module.Basis.ext_elem_iff b₂, map_zero, + Finsupp.zero_apply, ← forall_or_left, ← forall_or_right] + exact fun _ _ => or_comm.mp (h _ _) + · rintro (rfl | rfl) + · exact TensorProduct.zero_tmul _ _ + · exact TensorProduct.tmul_zero _ _ + +theorem zero_tmul_zero {R : Type _} [CommSemiring R] {M N : Type _} [AddCommGroup M] + [AddCommGroup N] [Module R M] [Module R N] : (0 : M ⊗[R] N) = 0 ⊗ₜ 0 := by + rw [TensorProduct.zero_tmul] + +theorem map_mul'_commute_iff {R M N : Type _} [CommSemiring R] + [NonUnitalNonAssocSemiring M] [NonUnitalNonAssocSemiring N] [Module R M] + [Module R N] [SMulCommClass R M M] [SMulCommClass R N N] [IsScalarTower R M M] + [IsScalarTower R N N] {f : M →ₗ[R] N} : + (LinearMap.mul' R N).comp (TensorProduct.map f f) = f.comp (LinearMap.mul' R M) ↔ + ∀ x y, f (x * y) = f x * f y := by + simp only [TensorProduct.ext_iff', LinearMap.comp_apply, TensorProduct.map_tmul, + LinearMap.mul'_apply, eq_comm] + +end TensorProduct + +theorem Algebra.TensorProduct.map_toLinearMap {R M N P Q : Type _} [CommSemiring R] + [Semiring M] [Semiring N] [Semiring P] [Semiring Q] [Algebra R M] [Algebra R N] + [Algebra R P] [Algebra R Q] (f : M →ₐ[R] N) (g : P →ₐ[R] Q) : + AlgHom.toLinearMap (Algebra.TensorProduct.map f g) = + _root_.TensorProduct.map (AlgHom.toLinearMap f) (AlgHom.toLinearMap g) := + rfl + +theorem AlgHom.commute_map_mul' {R M N : Type _} [CommSemiring R] [Semiring M] + [Semiring N] [Algebra R M] [Algebra R N] (f : M →ₐ[R] N) : + (LinearMap.mul' R N).comp (Algebra.TensorProduct.map f f).toLinearMap = + f.toLinearMap.comp (LinearMap.mul' R M) := by + rw [TensorProduct.ext_iff'] + intro x y + simp only [LinearMap.comp_apply, AlgHom.toLinearMap_apply, LinearMap.mul'_apply, + Algebra.TensorProduct.map_tmul, _root_.map_mul] + +theorem AlgHom.commute_map_mul'_apply {R M N : Type _} [CommSemiring R] [Semiring M] + [Semiring N] [Algebra R M] [Algebra R N] (f : M →ₐ[R] N) (x : M ⊗[R] M) : + (LinearMap.mul' R N) ((Algebra.TensorProduct.map f f) x) = + f ((LinearMap.mul' R M) x) := by + simp only [← LinearMap.comp_apply, ← AlgHom.toLinearMap_apply] + revert x + rw [← LinearMap.ext_iff] + exact AlgHom.commute_map_mul' _ + +open TensorProduct + +theorem TensorProduct.map_add {R : Type _} [CommSemiring R] {M₁ M₂ N₁ N₂ : Type _} + [AddCommMonoid M₁] [AddCommMonoid M₂] [AddCommMonoid N₁] [AddCommMonoid N₂] + [Module R M₁] [Module R M₂] [Module R N₁] [Module R N₂] (x y : M₁ →ₗ[R] M₂) + (z : N₁ →ₗ[R] N₂) : + TensorProduct.map z (x + y) = map z x + map z y := by + rw [TensorProduct.ext_iff'] + intros + simp only [TensorProduct.map_tmul, tmul_add, LinearMap.add_apply] + +theorem TensorProduct.of_basis_eq_span {𝕜 : Type _} {E : Type _} {F : Type _} + [CommSemiring 𝕜] [AddCommGroup E] [Module 𝕜 E] [AddCommGroup F] [Module 𝕜 F] + (x : TensorProduct 𝕜 E F) {ι₁ ι₂ : Type _} [Fintype ι₁] [Fintype ι₂] + (b₁ : Module.Basis ι₁ 𝕜 E) (b₂ : Module.Basis ι₂ 𝕜 F) : + x = ∑ i : ι₁, ∑ j : ι₂, (b₁.tensorProduct b₂).repr x (i, j) • b₁ i ⊗ₜ[𝕜] b₂ j := + x.induction_on + (by simp only [map_zero, Finsupp.zero_apply, zero_smul, Finset.sum_const_zero]) + (fun α₁ α₂ => by + simp_rw [Module.Basis.tensorProduct_repr_tmul_apply, smul_eq_mul, mul_comm, + ← TensorProduct.smul_tmul_smul, ← TensorProduct.tmul_sum, ← TensorProduct.sum_tmul, + Module.Basis.sum_repr]) + (fun a b ha hb => by + simp_rw [_root_.map_add, Finsupp.add_apply, add_smul, Finset.sum_add_distrib] + rw [← ha, ← hb]) diff --git a/LeanPool/Monlib4/LinearAlgebra/TensorProduct/FiniteDimensional.lean b/LeanPool/Monlib4/LinearAlgebra/TensorProduct/FiniteDimensional.lean new file mode 100644 index 0000000000..bab2dbed83 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/TensorProduct/FiniteDimensional.lean @@ -0,0 +1,250 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.LinearAlgebra.TensorProduct.Basis +import Mathlib.LinearAlgebra.FiniteDimensional.Basic +import Mathlib.Analysis.RCLike.Basic +import Mathlib.Algebra.Star.TensorProduct +import Mathlib.RingTheory.TensorProduct.Finite +import LeanPool.Monlib4.LinearAlgebra.IsReal +import LeanPool.Monlib4.LinearAlgebra.Ips.OpUnop +import LeanPool.Monlib4.LinearAlgebra.Ips.MulOp +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.BasicLemmas +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.Lemmas + +/-! + +# Tensor products of finite-dimensional star modules + +This file defines the star operation on a tensor product of finite-dimensional +star modules and proves compatibility lemmas for tensor-product maps. + +-/ + + +open scoped TensorProduct BigOperators + +section + +variable {𝕜 E F G : Type _} + [Field 𝕜] [StarRing 𝕜] + [AddCommGroup E] [AddCommGroup F] [AddCommGroup G] + [StarAddMonoid E] [StarAddMonoid F] [StarAddMonoid G] + [Module 𝕜 E] [Module 𝕜 F] [Module 𝕜 G] + [StarModule 𝕜 G] + [Module.Finite 𝕜 E] [Module.Finite 𝕜 F] + [Module.Finite 𝕜 G] + +omit [StarModule 𝕜 G] [Module.Finite 𝕜 E] [Module.Finite 𝕜 F] + [Module.Finite 𝕜 G] in +/-- Compatibility name for the tensor-product star instance now provided by Mathlib. -/ +noncomputable abbrev TensorProduct.Star [StarModule 𝕜 E] [StarModule 𝕜 F] : + Star (E ⊗[𝕜] F) := + inferInstance + +omit [StarModule 𝕜 G] [Module.Finite 𝕜 E] [Module.Finite 𝕜 F] + [Module.Finite 𝕜 G] in +/-- Compatibility name for the tensor-product involutive-star instance. -/ +noncomputable abbrev TensorProduct.InvolutiveStar [StarModule 𝕜 E] [StarModule 𝕜 F] : + InvolutiveStar (E ⊗[𝕜] F) := + inferInstance + +omit [StarModule 𝕜 G] [Module.Finite 𝕜 E] [Module.Finite 𝕜 F] + [Module.Finite 𝕜 G] in +/-- Compatibility name for the tensor-product star-additive instance. -/ +noncomputable abbrev TensorProduct.starAddMonoid [StarModule 𝕜 E] [StarModule 𝕜 F] : + StarAddMonoid (E ⊗[𝕜] F) := + inferInstance + +omit [StarModule 𝕜 G] [Module.Finite 𝕜 E] [Module.Finite 𝕜 F] + [Module.Finite 𝕜 G] in +/-- Compatibility name for the tensor-product star-module instance. -/ +theorem TensorProduct.starModule [StarModule 𝕜 E] [StarModule 𝕜 F] : + StarModule 𝕜 (E ⊗[𝕜] F) := + inferInstance + +omit [Module.Finite 𝕜 E] [Module.Finite 𝕜 F] in +/-- Tensor-product star is additive. -/ +theorem TensorProduct.star_add + [StarModule 𝕜 E] [StarModule 𝕜 F] (x y : E ⊗[𝕜] F) : + star (x + y) = star x + star y := + StarAddMonoid.star_add x y + +omit [Module.Finite 𝕜 E] [Module.Finite 𝕜 F] in +/-- Tensor-product star is involutive. -/ +theorem TensorProduct.star_is_involutive [StarModule 𝕜 E] [StarModule 𝕜 F] : + Function.Involutive (star : E ⊗[𝕜] F → E ⊗[𝕜] F) := + fun a => star_star a + +theorem TensorProduct.map_real {A B E F : Type _} [AddCommGroup A] [AddCommGroup B] [AddCommGroup E] + [AddCommGroup F] [StarAddMonoid A] [StarAddMonoid B] [StarAddMonoid E] [StarAddMonoid F] + [Module 𝕜 A] [Module 𝕜 B] [Module 𝕜 E] [Module 𝕜 F] [StarModule 𝕜 A] [StarModule 𝕜 B] + [StarModule 𝕜 E] [StarModule 𝕜 F] [Module.Finite 𝕜 A] [Module.Finite 𝕜 B] + [Module.Finite 𝕜 E] [Module.Finite 𝕜 F] (f : E →ₗ[𝕜] F) (g : A →ₗ[𝕜] B) : + (TensorProduct.map f g).real = TensorProduct.map f.real g.real := + by + apply TensorProduct.ext' + intro x y + simp only [LinearMap.real_apply, TensorProduct.star_tmul, TensorProduct.map_tmul] + + +variable (A : Type _) [Ring A] [Module 𝕜 A] [StarRing A] [StarModule 𝕜 A] [SMulCommClass 𝕜 A A] + [IsScalarTower 𝕜 A A] [Module.Finite 𝕜 A] + +omit [Module.Finite 𝕜 A] in +theorem LinearMap.mul'_real : + (LinearMap.mul' 𝕜 A).real = LinearMap.mul' 𝕜 A ∘ₗ (TensorProduct.comm 𝕜 A A).toLinearMap := + by + apply TensorProduct.ext' + intro a b + simp only [LinearMap.real_apply, TensorProduct.star_tmul, + LinearEquiv.coe_coe, LinearMap.comp_apply, TensorProduct.comm_tmul, LinearMap.mul'_apply, + star_mul, star_star] + +variable [StarModule 𝕜 E] [StarModule 𝕜 F] + +omit [Module.Finite 𝕜 E] [Module.Finite 𝕜 F] [Module.Finite 𝕜 G] in +theorem TensorProduct.assoc_real : + (TensorProduct.assoc 𝕜 E F G : (E ⊗[𝕜] F) ⊗[𝕜] G →ₗ[𝕜] E ⊗[𝕜] (F ⊗[𝕜] G)).real = + TensorProduct.assoc 𝕜 E F G := + by + apply TensorProduct.ext_threefold + intro a b c + simp only [LinearMap.real_apply, TensorProduct.star_tmul, LinearEquiv.coe_coe, + TensorProduct.assoc_tmul, star_star] + +omit [Module.Finite 𝕜 E] [Module.Finite 𝕜 F] in +theorem TensorProduct.comm_real : + (TensorProduct.comm 𝕜 E F : E ⊗[𝕜] F →ₗ[𝕜] F ⊗[𝕜] E).real = TensorProduct.comm 𝕜 E F := + by + apply TensorProduct.ext' + intro a b + simp only [LinearMap.real_apply, TensorProduct.star_tmul, LinearEquiv.coe_coe, + TensorProduct.comm_tmul, star_star] + +omit [Module.Finite 𝕜 E] in +theorem TensorProduct.lid_real : + (TensorProduct.lid 𝕜 E : 𝕜 ⊗[𝕜] E →ₗ[𝕜] E).real = TensorProduct.lid 𝕜 E := + by + apply TensorProduct.ext' + intro a b + simp only [LinearMap.real_apply, TensorProduct.star_tmul, LinearEquiv.coe_coe, + TensorProduct.lid_tmul, star_star, star_smul] + +omit [Module.Finite 𝕜 E] in +theorem TensorProduct.rid_real : + (TensorProduct.rid 𝕜 E : E ⊗[𝕜] 𝕜 →ₗ[𝕜] E).real = TensorProduct.rid 𝕜 E := + by + apply TensorProduct.ext' + intro a b + simp only [LinearMap.real_apply, TensorProduct.star_tmul, LinearEquiv.coe_coe, + TensorProduct.rid_tmul, star_star, star_smul] + +omit [Module.Finite 𝕜 E] in +theorem tensor_op_star_apply (x : E) (y : Eᵐᵒᵖ) : + star (x ⊗ₜ[𝕜] y) = star x ⊗ₜ[𝕜] (op 𝕜) (star (unop 𝕜 y)) := + by + simp only [TensorProduct.star_tmul] + rfl + +omit [Module.Finite 𝕜 E] in +theorem tenSwap_star (x : E ⊗[𝕜] Eᵐᵒᵖ) : star (tenSwap 𝕜 x) = tenSwap 𝕜 (star x) := +x.induction_on + (by simp only [star_zero, map_zero]) + (fun _ _ => by + simp only [tenSwap_apply, tensor_op_star_apply, unop_apply, op_apply, MulOpposite.unop_op]) + (fun z w hz hw => by simp only [map_add, StarAddMonoid.star_add, hz, hw]) + +end + +/-- Build a star algebra equivalence from a tensor-product linear equivalence. -/ +noncomputable def starAlgEquivOfLinearEquivTensorProduct + {R A B C : Type*} [RCLike R] [Ring A] + [StarAddMonoid A] + [Algebra R A] [StarModule R A] + [Ring B] [StarAddMonoid B] [Algebra R B] [StarModule R B] + [Semiring C] [Algebra R C] [StarAddMonoid C] + (f : TensorProduct R A B ≃ₗ[R] C) + (h_mul : ∀ (a₁ a₂ : A) (b₁ b₂ : B), + f ((a₁ * a₂) ⊗ₜ[R] (b₁ * b₂)) = f (a₁ ⊗ₜ[R] b₁) * f (a₂ ⊗ₜ[R] b₂)) + (h_one : f (1 ⊗ₜ[R] 1) = 1) + (h_star : ∀ (x : A) (y : B), f (star (x ⊗ₜ[R] y)) = star (f (x ⊗ₜ[R] y))) : + TensorProduct R A B ≃⋆ₐ[R] C := +StarAlgEquiv.ofAlgEquiv + (Algebra.TensorProduct.algEquivOfLinearEquivTensorProduct f h_mul h_one) + (fun x => x.induction_on (by simp only [star_zero, map_zero]) + h_star + (fun _ _ h1 h2 => by simp only [star_add, map_add, h1, h2])) + +/-- Tensor a pair of star algebra equivalences. -/ +noncomputable def StarAlgEquiv.TensorProduct.map {R A B C D : Type*} [RCLike R] + [Ring A] [Ring B] [Ring C] [Ring D] + [Algebra R A] [Algebra R B] [Algebra R C] [Algebra R D] + [StarAddMonoid A] [StarAddMonoid B] [StarAddMonoid C] [StarAddMonoid D] + [StarModule R A] [StarModule R B] [StarModule R C] [StarModule R D] + (f : A ≃⋆ₐ[R] B) (g : C ≃⋆ₐ[R] D) : + TensorProduct R A C ≃⋆ₐ[R] TensorProduct R B D := +StarAlgEquiv.ofAlgEquiv + (AlgEquiv.TensorProduct.map f.toAlgEquiv g.toAlgEquiv) + (fun x => x.induction_on + (by simp only [star_zero, map_zero]) + (fun _ _ => by simp only [TensorProduct.star_tmul, AlgEquiv.TensorProduct.map_tmul, + coe_toAlgEquiv, map_star]) + (fun _ _ h1 h2 => by simp only [star_add, map_add, h1, h2])) + +theorem StarAlgEquiv.TensorProduct.map_tmul {R A B C D : Type*} [RCLike R] + [Ring A] [Ring B] [Ring C] [Ring D] + [Algebra R A] [Algebra R B] [Algebra R C] [Algebra R D] + [StarAddMonoid A] [StarAddMonoid B] [StarAddMonoid C] [StarAddMonoid D] + [StarModule R A] [StarModule R B] [StarModule R C] [StarModule R D] + (f : A ≃⋆ₐ[R] B) (g : C ≃⋆ₐ[R] D) (x : A) (y : C) : + (StarAlgEquiv.TensorProduct.map f g) (x ⊗ₜ[R] y) = f x ⊗ₜ g y := +rfl +theorem StarAlgEquiv.TensorProduct.map_symm_tmul {R A B C D : Type*} [RCLike R] + [Ring A] [Ring B] [Ring C] [Ring D] + [Algebra R A] [Algebra R B] [Algebra R C] [Algebra R D] + [StarAddMonoid A] [StarAddMonoid B] [StarAddMonoid C] [StarAddMonoid D] + [StarModule R A] [StarModule R B] [StarModule R C] [StarModule R D] + (f : A ≃⋆ₐ[R] B) (g : C ≃⋆ₐ[R] D) (x : B) (y : D) : + (StarAlgEquiv.TensorProduct.map f g).symm (x ⊗ₜ[R] y) = f.symm x ⊗ₜ g.symm y := +rfl + + +/-- Tensor a star algebra equivalence on the left by a fixed algebra. -/ +noncomputable def StarAlgEquiv.lTensor {R A B : Type*} (C : Type*) [RCLike R] + [Ring A] + [Ring B] [Ring C] [Algebra R A] [Algebra R B] [Algebra R C] + [StarAddMonoid A] [StarAddMonoid B] [StarAddMonoid C] + [StarModule R A] [StarModule R B] [StarModule R C] + (f : A ≃⋆ₐ[R] B) : + (C ⊗[R] A) ≃⋆ₐ[R] (C ⊗[R] B) := +StarAlgEquiv.ofAlgEquiv + (AlgEquiv.lTensor C f.toAlgEquiv) + (fun x => x.induction_on + (by simp only [star_zero, map_zero]) + (fun _ _ => by + simp only [AlgEquiv.lTensor_tmul, TensorProduct.star_tmul, coe_toAlgEquiv, map_star]) + (fun _ _ h1 h2 => by simp only [star_add, map_add, h1, h2])) + +lemma StarAlgEquiv.lTensor_tmul {R A B C : Type*} + [RCLike R] + [Ring A] + [Ring B] [Ring C] [Algebra R A] [Algebra R B] [Algebra R C] + [StarAddMonoid A] [StarAddMonoid B] [StarAddMonoid C] + [StarModule R A] [StarModule R B] [StarModule R C] + (f : A ≃⋆ₐ[R] B) (x : C) (y : A) : + (StarAlgEquiv.lTensor C f) (x ⊗ₜ[R] y) = x ⊗ₜ f (y) := +by + simpa [StarAlgEquiv.lTensor] using AlgEquiv.lTensor_tmul (C := C) f.toAlgEquiv x y +lemma StarAlgEquiv.lTensor_symm_tmul {R A B C : Type*} [RCLike R] + [Ring A] + [Ring B] [Ring C] [Algebra R A] [Algebra R B] [Algebra R C] + [StarAddMonoid A] [StarAddMonoid B] [StarAddMonoid C] + [StarModule R A] [StarModule R B] [StarModule R C] + (f : A ≃⋆ₐ[R] B) (x : C) (y : B) : + (StarAlgEquiv.lTensor C f).symm (x ⊗ₜ[R] y) = x ⊗ₜ f.symm (y) := +by + simpa [StarAlgEquiv.lTensor, StarAlgEquiv.toAlgEquiv_symm] using + AlgEquiv.lTensor_symm_tmul (C := C) f.toAlgEquiv x y diff --git a/LeanPool/Monlib4/LinearAlgebra/TensorProduct/Lemmas.lean b/LeanPool/Monlib4/LinearAlgebra/TensorProduct/Lemmas.lean new file mode 100644 index 0000000000..05268439dd --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/TensorProduct/Lemmas.lean @@ -0,0 +1,171 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import Mathlib.LinearAlgebra.TensorProduct.Map +import Mathlib.RingTheory.TensorProduct.Maps +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.BasicLemmas +import LeanPool.Monlib4.Preq.StarAlgEquiv + +/-! +# Tensor-product map lemmas + +This file contains compatibility lemmas and equivalences for tensor-product +maps used by the Monlib4 port. +-/ + +open scoped TensorProduct + +theorem Algebra.TensorProduct.map_apply_map_apply {R : Type _} [CommSemiring R] + {A B C D E F : Type _} [Semiring A] [Semiring B] [Semiring C] [Semiring D] [Semiring E] + [Semiring F] [Algebra R A] [Algebra R B] [Algebra R C] [Algebra R D] [Algebra R E] [Algebra R F] + (f : A →ₐ[R] B) (g : C →ₐ[R] D) (z : B →ₐ[R] E) (w : D →ₐ[R] F) (x : A ⊗[R] C) : + (Algebra.TensorProduct.map z w) (Algebra.TensorProduct.map f g x) = + Algebra.TensorProduct.map (z.comp f) (w.comp g) x := +x.induction_on + (map_zero _) + (fun a b => by simp only [Algebra.TensorProduct.map_tmul]; rfl) + (fun a b ha hb => by simp only [map_add, ha, hb]) + +theorem TensorProduct.map_apply_map_apply {R : Type _} [CommSemiring R] {A B C D E F : Type _} + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] [AddCommMonoid E] + [AddCommMonoid F] [Module R A] [Module R B] [Module R C] [Module R D] [Module R E] [Module R F] + (f : A →ₗ[R] B) (g : C →ₗ[R] D) (z : B →ₗ[R] E) (w : D →ₗ[R] F) (x : A ⊗[R] C) : + (TensorProduct.map z w) (TensorProduct.map f g x) = TensorProduct.map (z.comp f) (w.comp g) x := + by + revert x + simp_rw [← LinearMap.comp_apply, ← LinearMap.ext_iff] + apply TensorProduct.ext' + intro x y + simp only [LinearMap.comp_apply, TensorProduct.map_tmul] + +/-- Tensor two algebra equivalences. -/ +noncomputable def AlgEquiv.TensorProduct.map {R : Type _} [CommSemiring R] {A B C D : Type _} + [Semiring A] [Semiring B] [Semiring C] [Semiring D] [Algebra R A] [Algebra R B] + [Algebra R C] [Algebra R D] + (f : A ≃ₐ[R] B) (g : C ≃ₐ[R] D) : A ⊗[R] C ≃ₐ[R] B ⊗[R] D + where + toFun x := Algebra.TensorProduct.map f.toAlgHom g.toAlgHom x + invFun x := Algebra.TensorProduct.map f.symm.toAlgHom g.symm.toAlgHom x + left_inv x := by + simp_rw [Algebra.TensorProduct.map_apply_map_apply, AlgEquiv.toAlgHom_eq_coe, + AlgEquiv.symm_comp, Algebra.TensorProduct.map_id, AlgHom.id_apply] + right_inv x := by + simp_rw [Algebra.TensorProduct.map_apply_map_apply, AlgEquiv.toAlgHom_eq_coe, + AlgEquiv.comp_symm, Algebra.TensorProduct.map_id, AlgHom.id_apply] + map_add' x y := by simp_rw [map_add] + map_mul' x y := by simp_rw [_root_.map_mul] + commutes' r := by simp_rw [Algebra.algebraMap_eq_smul_one, _root_.map_smul, _root_.map_one] + +@[simp] +lemma AlgEquiv.TensorProduct.map_tmul {R : Type _} [CommSemiring R] {A B C D : Type _} [Semiring A] + [Semiring B] [Semiring C] [Semiring D] [Algebra R A] [Algebra R B] [Algebra R C] [Algebra R D] + (f : A ≃ₐ[R] B) (g : C ≃ₐ[R] D) (x : A) (y : C) : + AlgEquiv.TensorProduct.map f g (x ⊗ₜ[R] y) = f x ⊗ₜ[R] g y := +rfl + +/-- Tensor two linear equivalences. -/ +@[simps!] +noncomputable def LinearEquiv.TensorProduct.map {R : Type _} [CommSemiring R] {A B C D : Type _} + [AddCommMonoid A] [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] [Module R A] + [Module R B] [Module R C] [Module R D] (f : A ≃ₗ[R] B) (g : C ≃ₗ[R] D) : + A ⊗[R] C ≃ₗ[R] B ⊗[R] D + where + toFun x := _root_.TensorProduct.map f.toLinearMap g.toLinearMap x + invFun x := _root_.TensorProduct.map f.symm.toLinearMap g.symm.toLinearMap x + left_inv x := by + induction x using _root_.TensorProduct.induction_on with + | zero => simp + | tmul a c => simp [_root_.TensorProduct.map_tmul] + | add x y hx hy => simp [map_add, hx, hy] + right_inv x := by + induction x using _root_.TensorProduct.induction_on with + | zero => simp + | tmul a c => simp [_root_.TensorProduct.map_tmul] + | add x y hx hy => simp [map_add, hx, hy] + map_add' x y := (_root_.TensorProduct.map f.toLinearMap g.toLinearMap).map_add x y + map_smul' r x := (_root_.TensorProduct.map f.toLinearMap g.toLinearMap).map_smul r x + + +local notation + f " ⊗ₘ " g => _root_.TensorProduct.map f g + +@[simp] +lemma AlgEquiv.TensorProduct.map_toLinearMap + {R : Type _} [CommSemiring R] {A B C D : Type _} [Semiring A] + [Semiring B] [Semiring C] [Semiring D] [Algebra R A] [Algebra R B] [Algebra R C] [Algebra R D] + (f : A ≃ₐ[R] B) (g : C ≃ₐ[R] D) : + (AlgEquiv.TensorProduct.map f g).toLinearMap = f.toLinearMap ⊗ₘ g.toLinearMap := +rfl +lemma AlgEquiv.TensorProduct.map_map_toLinearMap + {R : Type _} [CommSemiring R] {A B C D E F : Type _} [Semiring A] + [Semiring B] [Semiring C] [Semiring D] [Semiring E] [Semiring F] + [Algebra R A] [Algebra R B] [Algebra R C] [Algebra R D] [Algebra R E] [Algebra R F] + (h : B ≃ₐ[R] E) (i : D ≃ₐ[R] F) (f : A ≃ₐ[R] B) (g : C ≃ₐ[R] D) (x : A ⊗[R] C) : + (AlgEquiv.TensorProduct.map h i) ((AlgEquiv.TensorProduct.map f g) x) + = (AlgEquiv.TensorProduct.map (f.trans h) (g.trans i)) x := +by + simp only [TensorProduct.map, toAlgHom_eq_coe, coe_mk, Algebra.TensorProduct.map_apply_map_apply, + Equiv.coe_fn_mk] + rfl + +lemma AlgEquiv.TensorProduct.map_symm + {R : Type _} [CommSemiring R] {B D E F : Type _} + [Semiring B] [Semiring D] [Semiring E] [Semiring F] + [Algebra R B] [Algebra R D] [Algebra R E] [Algebra R F] + (h : B ≃ₐ[R] E) (i : D ≃ₐ[R] F) : + (AlgEquiv.TensorProduct.map h i).symm + = (AlgEquiv.TensorProduct.map h.symm i.symm) := +rfl + +lemma AlgEquiv.op_trans {R A B C : Type*} [CommSemiring R] [Semiring A] + [Semiring B] [Semiring C] [Algebra R A] [Algebra R B] [Algebra R C] + (f : A ≃ₐ[R] B) (g : B ≃ₐ[R] C) : + (AlgEquiv.op f).trans (AlgEquiv.op g) = AlgEquiv.op (f.trans g) := +rfl +@[simp] +lemma AlgEquiv.op_one {R A : Type*} [CommSemiring R] [Semiring A] + [Algebra R A] : + AlgEquiv.op (1 : A ≃ₐ[R] A) = 1 := +rfl + +@[simp] +lemma AlgEquiv.TensorProduct.map_one {R A B : Type*} [CommSemiring R] [Semiring A] + [Semiring B] [Algebra R A] [Algebra R B] : + AlgEquiv.TensorProduct.map (1 : A ≃ₐ[R] A) (1 : B ≃ₐ[R] B) = 1 := +by + rw [AlgEquiv.ext_iff] + simp_rw [← AlgEquiv.toLinearMap_apply, ← LinearMap.ext_iff] + simp only [map_toLinearMap, one_toLinearMap, _root_.TensorProduct.map_one] + +lemma LinearEquiv.TensorProduct.map_tmul + {R A B C D : Type*} [CommSemiring R] [AddCommMonoid A] + [AddCommMonoid B] [AddCommMonoid C] [AddCommMonoid D] [Module R A] + [Module R B] [Module R C] [Module R D] (f : A ≃ₗ[R] B) (g : C ≃ₗ[R] D) (x : A) (y : C) : + LinearEquiv.TensorProduct.map f g (x ⊗ₜ y) = f x ⊗ₜ g y := +by simp [LinearEquiv.TensorProduct.map, _root_.TensorProduct.map_tmul] + +/-- Tensor an algebra equivalence on the left by a fixed algebra. -/ +noncomputable def AlgEquiv.lTensor {R A B : Type*} (C : Type*) [CommSemiring R] [Semiring A] + [Semiring B] [Semiring C] [Algebra R A] [Algebra R B] [Algebra R C] + (f : A ≃ₐ[R] B) : + (C ⊗[R] A) ≃ₐ[R] (C ⊗[R] B) := +Algebra.TensorProduct.algEquivOfLinearEquivTensorProduct + (LinearEquiv.lTensor C f.toLinearEquiv) + (by + simp only [toLinearEquiv_apply, LinearEquiv.lTensor_tmul, Algebra.TensorProduct.tmul_mul_tmul, + _root_.map_mul, implies_true]) + (by simp only [toLinearEquiv_apply, map_one, LinearEquiv.lTensor_tmul]; rfl) + +lemma AlgEquiv.lTensor_tmul {R A B C : Type*} [CommSemiring R] [Semiring A] + [Semiring B] [Semiring C] [Algebra R A] [Algebra R B] [Algebra R C] + (f : A ≃ₐ[R] B) (x : C) (y : A) : + (AlgEquiv.lTensor C f) (x ⊗ₜ[R] y) = x ⊗ₜ f (y) := +rfl +lemma AlgEquiv.lTensor_symm_tmul {R A B C : Type*} [CommSemiring R] [Semiring A] + [Semiring B] [Semiring C] [Algebra R A] [Algebra R B] [Algebra R C] + (f : A ≃ₐ[R] B) (x : C) (y : B) : + (AlgEquiv.lTensor C f).symm (x ⊗ₜ[R] y) = x ⊗ₜ f.symm (y) := +rfl diff --git a/LeanPool/Monlib4/LinearAlgebra/TensorProduct/OrthonormalBasis.lean b/LeanPool/Monlib4/LinearAlgebra/TensorProduct/OrthonormalBasis.lean new file mode 100644 index 0000000000..8424d45eea --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/TensorProduct/OrthonormalBasis.lean @@ -0,0 +1,30 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.FiniteDimensional +import LeanPool.Monlib4.LinearAlgebra.Ips.TensorHilbert + +/-! +# Orthonormal Bases of Tensor Products + +Compatibility module for the upstream Monlib4 file. The old declarations in this file, +including `OrthonormalBasis.tensorProduct` and its simp lemmas, are already available +from current Mathlib through the imports above. +-/ + +open scoped TensorProduct + +namespace Basis + +theorem tensorProduct_repr_tmul_apply' + {R S M N ι κ : Type*} [CommSemiring R] [Semiring S] [Algebra R S] + [AddCommMonoid M] [Module R M] [Module S M] [IsScalarTower R S M] + [AddCommMonoid N] [Module R N] (b : Module.Basis ι S M) + (c : Module.Basis κ R N) (m : M) (n : N) (i : ι × κ) : + ((b.tensorProduct c).repr (m ⊗ₜ[R] n)) i = (c.repr n) i.2 • (b.repr m) i.1 := + Module.Basis.tensorProduct_repr_tmul_apply b c m n i.1 i.2 + +end Basis diff --git a/LeanPool/Monlib4/LinearAlgebra/TensorProduct/Submodule.lean b/LeanPool/Monlib4/LinearAlgebra/TensorProduct/Submodule.lean new file mode 100644 index 0000000000..bce24b69f5 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/TensorProduct/Submodule.lean @@ -0,0 +1,427 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.Ips.MinimalProj +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.OrthonormalBasis +import Mathlib.LinearAlgebra.TensorProduct.Finiteness +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.SchurMul +import Mathlib.LinearAlgebra.TensorProduct.RightExactness +import LeanPool.Monlib4.LinearAlgebra.PiDirectSum +import LeanPool.Monlib4.LinearAlgebra.Matrix.Reshape + +open scoped TensorProduct + +/-- The submodule of a tensor product generated by tensors from two submodules. -/ +noncomputable def Submodule.tensorProduct {R : Type*} {E F : Type*} [CommSemiring R] + [AddCommMonoid E] [AddCommMonoid F] [Module R E] [Module R F] + (V : Submodule R E) (W : Submodule R F) : + Submodule R (E ⊗[R] F) := +LinearMap.range (TensorProduct.mapIncl V W : V ⊗[R] W →ₗ[R] E ⊗[R] F) + +theorem Submodule.tensorProduct_mem {R : Type*} {E F : Type*} [CommSemiring R] + [AddCommMonoid E] [AddCommMonoid F] [Module R E] [Module R F] + {V : Submodule R E} {W : Submodule R F} (x : V ⊗[R] W) : + (TensorProduct.mapIncl V W) x ∈ V.tensorProduct W := +⟨_, rfl⟩ + +/-- Choose a preimage of an element of `V.tensorProduct W` in `V ⊗ W`. -/ +noncomputable def Submodule.mem_tensorProduct {R : Type*} {E F : Type*} [CommSemiring R] + [AddCommMonoid E] [AddCommMonoid F] [Module R E] [Module R F] + {V : Submodule R E} {W : Submodule R F} (vw : V.tensorProduct W) : + V ⊗[R] W := +vw.property.choose +theorem Submodule.mem_tensorProduct_eq {R : Type*} {E F : Type*} [CommSemiring R] + [AddCommMonoid E] [AddCommMonoid F] [Module R E] [Module R F] + {V : Submodule R E} {W : Submodule R F} (vw : V.tensorProduct W) : + (TensorProduct.mapIncl V W) (mem_tensorProduct vw) = vw := +Set.apply_rangeSplitting (fun x ↦ (TensorProduct.mapIncl V W) x) vw + +theorem TensorProduct.mapIncl_isInjective {R : Type*} {E F : Type*} [RCLike R] + [NormedAddCommGroup E] [NormedAddCommGroup F] [InnerProductSpace R E] [InnerProductSpace R F] + [FiniteDimensional R E] [FiniteDimensional R F] + {V : Submodule R E} {W : Submodule R F} : + Function.Injective (TensorProduct.mapIncl V W : V ⊗[R] W → E ⊗[R] F) := +by + rw [injective_iff_map_eq_zero] + intro a ha + obtain ⟨x, rfl⟩ := TensorProduct.exists_finset a + simp only [TensorProduct.mapIncl, map_tmul, map_sum, Submodule.coe_subtype] at ha ⊢ + rw [TensorProduct.inner_ext_iff'] at ha ⊢ + intro v w + specialize ha (↑v) (↑w) + simp_rw [inner_zero_left, sum_inner, TensorProduct.inner_tmul, + Submodule.coe_inner] at ha ⊢ + exact ha + +theorem Submodule.mapIncl_mem_tensorProduct {R : Type*} {E F : Type*} [RCLike R] + [NormedAddCommGroup E] [NormedAddCommGroup F] [InnerProductSpace R E] [InnerProductSpace R F] + [FiniteDimensional R E] [FiniteDimensional R F] + {V : Submodule R E} {W : Submodule R F} (v : V ⊗[R] W) : + Submodule.mem_tensorProduct (⟨_, Submodule.tensorProduct_mem v⟩ : V.tensorProduct W) = v := +by + apply_fun (TensorProduct.mapIncl V W) using TensorProduct.mapIncl_isInjective + rw [Submodule.mem_tensorProduct_eq] + +variable {𝕜 E F : Type*} [RCLike 𝕜] [NormedAddCommGroup E] + [NormedAddCommGroup F] [InnerProductSpace 𝕜 E] [InnerProductSpace 𝕜 F] +variable [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] + +theorem norm_tmul {𝕜 B C : Type*} [RCLike 𝕜] [NormedAddCommGroup B] + [NormedAddCommGroup C] [InnerProductSpace 𝕜 B] [InnerProductSpace 𝕜 C] [FiniteDimensional 𝕜 B] + [FiniteDimensional 𝕜 C] (x : B) (y : C) : ‖x ⊗ₜ[𝕜] y‖ = ‖x‖ * ‖y‖ := by + symm + calc + ‖x‖ * ‖y‖ = Real.sqrt (RCLike.re (inner 𝕜 x x)) * Real.sqrt (RCLike.re (inner 𝕜 y y)) := by + simp_rw [@norm_eq_sqrt_re_inner 𝕜] + _ = Real.sqrt (RCLike.re (inner 𝕜 x x) * RCLike.re (inner 𝕜 y y)) := by + rw [Real.sqrt_mul inner_self_nonneg] + _ = Real.sqrt (RCLike.re ((inner 𝕜 x x) * (inner 𝕜 y y))) := + by + congr 1 + simp only [RCLike.mul_re, @inner_self_im 𝕜, MulZeroClass.zero_mul, sub_zero] + _ = Real.sqrt (RCLike.re (inner 𝕜 (x ⊗ₜ[𝕜] y) (x ⊗ₜ[𝕜] y))) := by + rw [TensorProduct.inner_tmul] + _ = ‖x ⊗ₜ[𝕜] y‖ := by rw [@norm_eq_sqrt_re_inner 𝕜] + +open scoped InnerProductSpace +omit [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] in +lemma TensorProduct.mapIncl_norm_map (V : Submodule 𝕜 E) (W : Submodule 𝕜 F) (x : V ⊗[𝕜] W) : + ‖TensorProduct.mapIncl V W x‖ = ‖x‖ := +by + obtain ⟨S, rfl⟩ := TensorProduct.exists_finset x + simp only [TensorProduct.mapIncl, map_sum, TensorProduct.map_tmul, Submodule.coe_subtype] + simp_rw [@norm_eq_sqrt_re_inner 𝕜] + congr 2 + simp only [sum_inner, inner_sum, TensorProduct.inner_tmul, ← Submodule.coe_inner] + +/-- The natural linear isometry between `V ⊗ W` and its image in `E ⊗ F`. -/ +noncomputable def Submodule.tensorProduct_linearIsometryEquiv + (V : Submodule 𝕜 E) (W : Submodule 𝕜 F) : + (V ⊗[𝕜] W) ≃ₗᵢ[𝕜] (V.tensorProduct W) where + toFun x := ⟨(TensorProduct.mapIncl V W) x, ⟨_, rfl⟩⟩ + invFun x := Submodule.mem_tensorProduct x + left_inv x := by simp only [Submodule.mapIncl_mem_tensorProduct] + right_inv x := by + refine SetCoe.ext ?_ + exact Submodule.mem_tensorProduct_eq x + map_add' _ _ := by + simp only [TensorProduct.mapIncl, map_add]; rfl + map_smul' _ _ := by + simp only [TensorProduct.mapIncl, LinearMapClass.map_smul, RingHom.id_apply, SetLike.mk_smul_mk] + norm_map' x := TensorProduct.mapIncl_norm_map _ _ _ + +/-- The tensor product orthonormal basis, transported to `V.tensorProduct W`. -/ +noncomputable def Submodule.tensorProduct_orthonormalBasis {V : Submodule 𝕜 E} {W : Submodule 𝕜 F} + {ι₁ ι₂ : Type*} [Fintype ι₁] [Fintype ι₂] + (v : OrthonormalBasis ι₁ 𝕜 V) (w : OrthonormalBasis ι₂ 𝕜 W) : + OrthonormalBasis (ι₁ × ι₂) 𝕜 (V.tensorProduct W) := +OrthonormalBasis.map (v.tensorProduct w) (Submodule.tensorProduct_linearIsometryEquiv V W) + +theorem Submodule.tensorProduct_orthonormalBasis_apply {V : Submodule 𝕜 E} {W : Submodule 𝕜 F} + {ι₁ ι₂ : Type*} [Fintype ι₁] [Fintype ι₂] + (v : OrthonormalBasis ι₁ 𝕜 V) (w : OrthonormalBasis ι₂ 𝕜 W) (i : ι₁ × ι₂) : + Submodule.tensorProduct_orthonormalBasis v w i = + (v i.1).val ⊗ₜ[𝕜] (w i.2).val := +by + simp only [Submodule.tensorProduct_orthonormalBasis, OrthonormalBasis.map_apply] + simp only [OrthonormalBasis.tensorProduct_apply'] + rfl + +theorem Submodule.tensorProduct_finrank {V : Submodule 𝕜 E} {W : Submodule 𝕜 F} : + Module.finrank 𝕜 (V.tensorProduct W) = Module.finrank 𝕜 V * Module.finrank 𝕜 W := +by + simp only [← Module.finrank_tensorProduct] + refine Eq.symm (LinearEquiv.finrank_eq ?f) + exact (Submodule.tensorProduct_linearIsometryEquiv V W).toLinearEquiv + +omit [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] in +theorem rankOne_tmul {x₁ y₁ : E} {x₂ y₂ : F} : + (rankOne 𝕜 (x₁ ⊗ₜ[𝕜] x₂) (y₁ ⊗ₜ[𝕜] y₂)).toLinearMap = + TensorProduct.map (rankOne 𝕜 x₁ y₁).toLinearMap (rankOne 𝕜 x₂ y₂).toLinearMap := +by + ext a b + simp [TensorProduct.inner_tmul, TensorProduct.smul_tmul', smul_smul, mul_comm] + +theorem orthogonalProjection_map_orthogonalProjection (V : Submodule 𝕜 E) (W : Submodule 𝕜 F) : + TensorProduct.map + (orthogonalProjection' V).toLinearMap (orthogonalProjection' W).toLinearMap = + orthogonalProjection' (V.tensorProduct W) := +by + let v := stdOrthonormalBasis 𝕜 V + let w := stdOrthonormalBasis 𝕜 W + rw [OrthonormalBasis.orthogonalProjection'_eq_sum_rankOne + (Submodule.tensorProduct_orthonormalBasis v w), + OrthonormalBasis.orthogonalProjection'_eq_sum_rankOne v, + OrthonormalBasis.orthogonalProjection'_eq_sum_rankOne w] + simp_rw [ContinuousLinearMap.coe_sum, TensorProduct.sum_map, TensorProduct.map_sum, + ← rankOne_tmul, Submodule.tensorProduct_orthonormalBasis_apply] + rw [← Finset.sum_product'] + simp only [Finset.univ_product_univ] + +theorem TensorProduct.submodule_exists_le_tensorProduct {R M N : Type*} + [Field R] [AddCommGroup M] [AddCommGroup N] [Module R M] [Module R N] + (U : Submodule R (M ⊗[R] N)) (hU : Module.Finite R ↥U) : + ∃ (M' : Submodule R M) (N' : Submodule R N) + (_ : Module.Finite R ↥M') (_ : Module.Finite R ↥N'), + U ≤ M'.tensorProduct N' := +by + let e := Module.Basis.ofVectorSpace R U + let e'' : Set U.carrier := (Set.range e) + let e''' : Set U := e'' + let e' : Set (M ⊗[R] N) := e'' + let he' : e'.Finite := Set.toFinite e' + obtain ⟨M', N', hM', hN', hS⟩ := + TensorProduct.exists_finite_submodule_of_setFinite e' he' + have : Submodule.span R e''' = ⊤ := e.span_eq + have : Submodule.span R e' = U := by + simp only [e'] + calc Submodule.span R (Subtype.val '' e'') + = Submodule.map (U.subtype) (Submodule.span R e''') := ?_ + _ = Submodule.map (U.subtype) (⊤ : Submodule R ↥U) := by rw [this] + _ = U := by simp only [Submodule.map_top, Submodule.range_subtype] + rw [← Submodule.span_image] + rfl + have := + calc U = Submodule.span R e' := this.symm + _ ≤ Submodule.span R (LinearMap.range (TensorProduct.mapIncl M' N')) := + by + exact Submodule.span_mono hS + use M', N', hM', hN' + simp_all only [TensorProduct.mapIncl, + Submodule.span_coe_eq_restrictScalars, Submodule.restrictScalars_self] + exact this + +theorem orthogonalProjection'_ortho_eq {𝕜 E : Type*} [RCLike 𝕜] + [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] (K : Submodule 𝕜 E) + [K.HasOrthogonalProjection] : + orthogonalProjection' Kᗮ = ContinuousLinearMap.id 𝕜 _ - orthogonalProjection' K := +by + calc + orthogonalProjection' Kᗮ = Kᗮ.starProjection := rfl + _ = ContinuousLinearMap.id 𝕜 E - K.starProjection := by + rw [Submodule.id_eq_sum_starProjection_self_orthogonalComplement (K := K)] + abel + _ = ContinuousLinearMap.id 𝕜 E - orthogonalProjection' K := rfl + +theorem TensorProduct.submodule_exists_le_tensorProduct_ofFiniteDimensional + {R M N : Type*} + [Field R] [AddCommGroup M] [AddCommGroup N] [Module R M] [Module R N] + [Module.Finite R M] [Module.Finite R N] + (U : Submodule R (M ⊗[R] N)) : + ∃ (M' : Submodule R M) (N' : Submodule R N), + U ≤ M'.tensorProduct N' := +by + obtain ⟨V, W, _, _, hVW⟩ := TensorProduct.submodule_exists_le_tensorProduct U + (FiniteDimensional.finiteDimensional_submodule U) + refine ⟨V, W, hVW⟩ + +theorem orthogonalProjection_of_tensorProduct {E F : Type*} + [NormedAddCommGroup E] [NormedAddCommGroup F] [InnerProductSpace ℂ E] + [InnerProductSpace ℂ F] [FiniteDimensional ℂ E] [FiniteDimensional ℂ F] + {A : E ⊗[ℂ] F →ₗ[ℂ] E ⊗[ℂ] F} + (hA : ∃ (U : Submodule ℂ E) (V : Submodule ℂ F), + (orthogonalProjection' (U.tensorProduct V)).toLinearMap = A) : + ∃ (U : Submodule ℂ (E ⊗[ℂ] F)), (orthogonalProjection' U).toLinearMap = A := +by + obtain ⟨U, V, hUV⟩ := hA + exact ⟨U.tensorProduct V, hUV⟩ + +local notation x" ⊗ₘ "y => TensorProduct.map x y + +open Matrix + +/-- Identify functions on `n × Unit` with functions on `n`. -/ +def piProdUnitEquivPi {R n : Type*} [Semiring R] : (n × Unit → R) ≃ₗ[R] n → R + where + toFun x i := x (i, PUnit.unit) + invFun x i := x i.1 + left_inv x := by + ext; simp + right_inv x := by ext1; rfl + map_add' x y := by simp only [Pi.add_apply]; rfl + map_smul' r x := by simp only [RingHom.id_apply]; rfl + +/-- `matrix.replicateCol` written as a linear equivalence -/ +def Matrix.ofReplicateCol {R n : Type*} [Semiring R] : Matrix n Unit R ≃ₗ[R] n → R := + (reshape : Matrix n Unit R ≃ₗ[R] n × Unit → R).trans piProdUnitEquivPi + +/-- Remove a trailing `Unit` factor from the column index of a matrix. -/ +def matrixProdUnitRight {R n m : Type*} [Semiring R] : Matrix n (m × Unit) R ≃ₗ[R] Matrix n m R + where + toFun x i j := x i (j, PUnit.unit) + invFun x i j := x i j.1 + left_inv x := by + ext; simp + right_inv x := by ext1; rfl + map_add' x y := by rfl + map_smul' r x := by simp only [RingHom.id_apply]; rfl + +open Kronecker +/-- `vec_mulVec x y` written as a kronecker product -/ +theorem replicateCol_hMul_replicateCol_conjTranspose_is_kronecker_of_vectors + {R m n : Type*} [Semiring R] + (x : m → R) (y : n → R) : + vecMulVec x y = + reshape.symm + (Matrix.ofReplicateCol + (matrixProdUnitRight (replicateCol Unit x ⊗ₖ replicateCol Unit y))) := +by + ext + simp_rw [reshape_symm_apply, Matrix.ofReplicateCol, matrixProdUnitRight, piProdUnitEquivPi, + LinearEquiv.trans_apply, LinearEquiv.coe_mk] + simp only [LinearMap.coe_mk, AddHom.coe_mk, kroneckerMap_apply, replicateCol_apply] + rw [reshape_apply, vecMulVec_apply] + +section + +variable {ι₁ ι₂ : Type*} [DecidableEq ι₁] [DecidableEq ι₂] [Fintype ι₁] [Fintype ι₂] + {M₁ : ι₁ → Type*} {M₂ : ι₂ → Type*} + [(i₁ : ι₁) → NormedAddCommGroup (M₁ i₁)] [(i₂ : ι₂) → NormedAddCommGroup (M₂ i₂)] + [(i₁ : ι₁) → InnerProductSpace 𝕜 (M₁ i₁)] [(i₂ : ι₂) → InnerProductSpace 𝕜 (M₂ i₂)] + +/-- Tensor products commute with finite `PiLp 2` products as a linear equivalence. -/ +@[simps!] +noncomputable def PiLp_tensorEquiv : + (PiLp 2 M₁ ⊗[𝕜] PiLp 2 M₂) ≃ₗ[𝕜] + PiLp 2 (fun (i : ι₁ × ι₂) => (M₁ i.1) ⊗[𝕜] (M₂ i.2)) := +((TensorProduct.congr + (WithLp.linearEquiv 2 𝕜 (∀ i, M₁ i)) + (WithLp.linearEquiv 2 𝕜 (∀ i, M₂ i))).trans directSumTensor).trans + (WithLp.linearEquiv 2 𝕜 (∀ i : ι₁ × ι₂, M₁ i.1 ⊗[𝕜] M₂ i.2)).symm + +theorem PiLp_tensorEquiv_tmul (x : PiLp 2 M₁) (y : PiLp 2 M₂) (i : ι₁ × ι₂) : + PiLp_tensorEquiv (x ⊗ₜ y) i = x i.1 ⊗ₜ[𝕜] y i.2 := +by + simp [PiLp_tensorEquiv, TensorProduct.congr_tmul, directSumTensor_apply, + directSumTensorToFun_apply] + +variable [(i : ι₁) → FiniteDimensional 𝕜 (M₁ i)] + [(i : ι₂) → FiniteDimensional 𝕜 (M₂ i)] + +omit [(i : ι₁) → FiniteDimensional 𝕜 (M₁ i)] + [(i : ι₂) → FiniteDimensional 𝕜 (M₂ i)] in +@[simp] +theorem PiLp_tensorEquiv_norm_map + (x : (PiLp 2 M₁ ⊗[𝕜] PiLp 2 M₂)) : + ‖(PiLp_tensorEquiv x : PiLp 2 (fun i : ι₁ × ι₂ => M₁ i.1 ⊗[𝕜] M₂ i.2))‖ = ‖x‖ := +by + simp_rw [norm_eq_sqrt_re_inner (𝕜 := 𝕜)] + obtain ⟨S, rfl⟩ := TensorProduct.exists_finset x + simp_rw [map_sum, sum_inner, inner_sum] + simp_rw [TensorProduct.inner_tmul, PiLp.inner_apply, PiLp_tensorEquiv_tmul, Finset.sum_mul, + Finset.mul_sum, Fintype.sum_prod_type] + simp only [TensorProduct.inner_tmul] + +/-- `PiLp_tensorEquiv` as a linear isometry equivalence. -/ +@[simps!] +noncomputable abbrev PiLp_tensorLinearIsometryEquiv : + (PiLp 2 M₁ ⊗[𝕜] PiLp 2 M₂) ≃ₗᵢ[𝕜] + PiLp 2 (fun (i : ι₁ × ι₂) => (M₁ i.1) ⊗[𝕜] (M₂ i.2)) where + toLinearEquiv := PiLp_tensorEquiv + norm_map' := PiLp_tensorEquiv_norm_map + +omit [(i : ι₁) → FiniteDimensional 𝕜 (M₁ i)] + [(i : ι₂) → FiniteDimensional 𝕜 (M₂ i)] in +theorem PiLp_tensorLinearIsometryEquiv_tmul + (x : PiLp 2 M₁) (y : PiLp 2 M₂) (i : ι₁ × ι₂) : + PiLp_tensorLinearIsometryEquiv (x ⊗ₜ y) i = x i.1 ⊗ₜ[𝕜] y i.2 := +PiLp_tensorEquiv_tmul x y i + +end + +/-- Tensor product equivalence for finite Euclidean spaces. -/ +noncomputable abbrev euclideanSpaceTensor {R : Type*} [RCLike R] {ι₁ ι₂ : Type*} + [Fintype ι₁] [Fintype ι₂] + [DecidableEq ι₁] [DecidableEq ι₂] : + (EuclideanSpace R ι₁ ⊗[R] EuclideanSpace R ι₂) ≃ₗᵢ[R] + EuclideanSpace (R ⊗[R] R) (ι₁ × ι₂) := +PiLp_tensorLinearIsometryEquiv + +lemma euclideanSpaceTensor_apply {R : Type*} [RCLike R] {ι₁ ι₂ : Type*} + [Fintype ι₁] [Fintype ι₂] + [DecidableEq ι₁] [DecidableEq ι₂] (x : EuclideanSpace R ι₁) (y : EuclideanSpace R ι₂) + (i : ι₁ × ι₂) : + euclideanSpaceTensor (R := R) (x ⊗ₜ y) i = x i.1 ⊗ₜ y i.2 := +PiLp_tensorLinearIsometryEquiv_tmul x y i + +/-- The left unit tensor equivalence as a linear isometry equivalence. -/ +@[simps!] +noncomputable def TensorProduct.lid_linearIsometryEquiv + (𝕜 E : Type*) [RCLike 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] + [FiniteDimensional 𝕜 E] : + (𝕜 ⊗[𝕜] E) ≃ₗᵢ[𝕜] E where + toLinearEquiv := TensorProduct.lid _ _ + norm_map' x := by + rw [norm_eq_sqrt_re_inner (𝕜 := 𝕜)] + simp only [← LinearEquiv.coe_toLinearMap, ← LinearMap.adjoint_inner_left, + TensorProduct.lid_adjoint] + simp only [LinearEquiv.coe_coe, LinearEquiv.symm_apply_apply, ← norm_eq_sqrt_re_inner] + +/-- Tensor product equivalence for finite Euclidean spaces, using `R ⊗[R] R ≃ R`. -/ +noncomputable abbrev euclideanSpaceTensor' {R : Type*} [RCLike R] {ι₁ ι₂ : Type*} + [Fintype ι₁] [Fintype ι₂] + [DecidableEq ι₁] [DecidableEq ι₂] : + (EuclideanSpace R ι₁ ⊗[R] EuclideanSpace R ι₂) ≃ₗᵢ[R] + EuclideanSpace R (ι₁ × ι₂) := +(euclideanSpaceTensor (R := R)).trans + (LinearIsometryEquiv.piLpCongrRight 2 (fun _ => TensorProduct.lid_linearIsometryEquiv R _)) +lemma euclideanSpaceTensor'_apply {R : Type*} [RCLike R] {ι₁ ι₂ : Type*} + [Fintype ι₁] [Fintype ι₂] + [DecidableEq ι₁] [DecidableEq ι₂] (x : EuclideanSpace R ι₁) (y : EuclideanSpace R ι₂) + (i : ι₁ × ι₂) : + euclideanSpaceTensor' (R := R) (x ⊗ₜ y) i = x i.1 * y i.2 := +by + rw [LinearIsometryEquiv.trans_apply] + change TensorProduct.lid_linearIsometryEquiv R R + ((euclideanSpaceTensor (R := R) (x ⊗ₜ[R] y)) i) = + x i.1 * y i.2 + rw [euclideanSpaceTensor_apply] + change (TensorProduct.lid R R) (x i.1 ⊗ₜ[R] y i.2) = x i.1 * y i.2 + rw [TensorProduct.lid_tmul] + rfl + +open scoped FiniteDimensional +theorem LinearIsometryEquiv.linearMap_adjoint {f : E ≃ₗᵢ[𝕜] F} : + LinearMap.adjoint f.toLinearMap = f.symm.toLinearMap := +by + letI := FiniteDimensional.complete 𝕜 E + letI := FiniteDimensional.complete 𝕜 F + calc + LinearMap.adjoint f.toLinearMap = + ContinuousLinearMap.adjoint + (LinearIsometry.toContinuousLinearMap f.toLinearIsometry) := rfl + _ = LinearIsometry.toContinuousLinearMap f.symm.toLinearIsometry := by + simp only [ContinuousLinearMap.coe_inj] + exact LinearIsometryEquiv.adjoint_eq_symm _ + _ = f.symm.toLinearMap := rfl + +theorem TensorProduct.ring_tmul {R : Type*} [CommRing R] (x : R ⊗[R] R) : + ∃ (a b : R), x = a ⊗ₜ[R] b := +by + refine ⟨1, TensorProduct.lid R R x, ?_⟩ + rw [← TensorProduct.lid_symm_apply] + exact (TensorProduct.lid R R).symm_apply_apply x |>.symm + +theorem submodule_neq_tensorProduct_of {R : Type*} [RCLike R] + {E F : Type*} [NormedAddCommGroup E] [NormedAddCommGroup F] + [InnerProductSpace R E] [InnerProductSpace R F] + [FiniteDimensional R E] [FiniteDimensional R F] + (U : Submodule R (E ⊗[R] F)) + {p : ℕ} (hp : Nat.Prime p) + (hU : Module.finrank R U = p) : + ¬ ∃ (V : Submodule R E) (W : Submodule R F) + (_ : 1 < Module.finrank R V) + (_ : 1 < Module.finrank R W), + U = V.tensorProduct W := +by + push Not + intro V W hVW₁ hVW₂ hVW + have : Module.finrank R (V.tensorProduct W) = + Module.finrank R V * Module.finrank R W := Submodule.tensorProduct_finrank + rw [← hVW, hU] at this + exact + (Nat.not_prime_of_mul_eq this.symm (Ne.symm (Nat.ne_of_lt hVW₁)) (Ne.symm (Nat.ne_of_lt hVW₂))) + hp diff --git a/LeanPool/Monlib4/LinearAlgebra/ToMatrixOfEquiv.lean b/LeanPool/Monlib4/LinearAlgebra/ToMatrixOfEquiv.lean new file mode 100644 index 0000000000..fcf99c2216 --- /dev/null +++ b/LeanPool/Monlib4/LinearAlgebra/ToMatrixOfEquiv.lean @@ -0,0 +1,326 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import Mathlib.Algebra.Algebra.Equiv +import Mathlib.Analysis.Complex.Basic +import Mathlib.Analysis.InnerProductSpace.Adjoint +import Mathlib.Analysis.InnerProductSpace.PiL2 +import Mathlib.Analysis.RCLike.Basic +import LeanPool.Monlib4.LinearAlgebra.InnerAut +import LeanPool.Monlib4.LinearAlgebra.Matrix.Reshape +import LeanPool.Monlib4.Preq.StarAlgEquiv + +/-! +# Linear equivalence conjugation compatibility + +Mathlib's `LinearEquiv.conjAlgEquiv` is the current version of the upstream +`LinearEquiv.innerConj` construction used by the Monlib4 `IncludeBlock` slice. +-/ + +open scoped BigOperators +open Matrix Module.End InnerProductSpace + +variable {𝕜 : Type _} [RCLike 𝕜] + +/-- Star-algebra equivalence from endomorphisms of a finite-dimensional inner-product +space to matrices in an orthonormal basis. -/ +noncomputable def OrthonormalBasis.toMatrix {n E : Type _} [Fintype n] [DecidableEq n] + [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] + (b : OrthonormalBasis n 𝕜 E) : + (E →ₗ[𝕜] E) ≃⋆ₐ[𝕜] Matrix n n 𝕜 where + toFun x k p := inner 𝕜 (b k) (x (b p)) + invFun x := ∑ i, ∑ j, + x i j • (InnerProductSpace.rankOne 𝕜 (b i) (b j)).toLinearMap + map_add' x y := by + simp only [LinearMap.add_apply, inner_add_right] + rfl + map_smul' r x := by + simp only [LinearMap.smul_apply, inner_smul_right] + rfl + map_mul' x y := by + ext + simp only [Module.End.mul_apply, Matrix.mul_apply, ← LinearMap.adjoint_inner_left x, + OrthonormalBasis.sum_inner_mul_inner] + map_star' x := by + ext + simp only [star_eq_conjTranspose, conjTranspose_apply, LinearMap.star_eq_adjoint, + LinearMap.adjoint_inner_right, RCLike.star_def, inner_conj_symm] + right_inv x := by + ext + simp only [LinearMap.sum_apply, LinearMap.smul_apply, ContinuousLinearMap.coe_coe, + InnerProductSpace.rankOne_apply, inner_sum, smul_smul, inner_smul_right] + simp only [orthonormal_iff_ite.mp b.orthonormal, mul_boole, Finset.sum_ite_irrel, + Finset.sum_const_zero, Finset.sum_ite_eq, Finset.sum_ite_eq', Finset.mem_univ, if_true] + left_inv x := by + ext + simp only [LinearMap.sum_apply, LinearMap.smul_apply, ContinuousLinearMap.coe_coe, + InnerProductSpace.rankOne_apply, ← LinearMap.adjoint_inner_left x, smul_smul, + ← Finset.sum_smul, OrthonormalBasis.sum_inner_mul_inner] + simp_rw [LinearMap.adjoint_inner_left, ← OrthonormalBasis.repr_apply_apply, + OrthonormalBasis.sum_repr] + +theorem OrthonormalBasis.toMatrix_apply {n E : Type _} [Fintype n] [DecidableEq n] + [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] + (b : OrthonormalBasis n 𝕜 E) (x : E →ₗ[𝕜] E) (i j : n) : + b.toMatrix x i j = inner 𝕜 (b i) (x (b j)) := + rfl + +theorem OrthonormalBasis.toMatrix_symm_apply {n E : Type _} [Fintype n] [DecidableEq n] + [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] + (b : OrthonormalBasis n 𝕜 E) (x : Matrix n n 𝕜) : + b.toMatrix.symm x = + ∑ i, ∑ j, x i j • (InnerProductSpace.rankOne 𝕜 (b i) (b j)).toLinearMap := + rfl + +theorem OrthonormalBasis.toMatrix_symm_apply' {n E : Type _} [Fintype n] [DecidableEq n] + [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] + (b : OrthonormalBasis n 𝕜 E) (x : Matrix n n 𝕜) : + b.toMatrix.symm x = + ∑ i, ∑ j, x i j • (InnerProductSpace.rankOne 𝕜 (b i) (b j)).toLinearMap := + OrthonormalBasis.toMatrix_symm_apply b x + +theorem orthonormalBasis_toMatrix_eq_basis_toMatrix {n E : Type _} [Fintype n] + [DecidableEq n] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] + [FiniteDimensional 𝕜 E] (b : OrthonormalBasis n 𝕜 E) : + LinearMap.toMatrixAlgEquiv b.toBasis = b.toMatrix.toAlgEquiv := by + ext + simp_rw [StarAlgEquiv.coe_toAlgEquiv, OrthonormalBasis.toMatrix_apply, + LinearMap.toMatrixAlgEquiv_apply, OrthonormalBasis.coe_toBasis_repr_apply, + OrthonormalBasis.repr_apply_apply, OrthonormalBasis.coe_toBasis] + +alias EuclideanSpace.orthonormalBasis := EuclideanSpace.basisFun + +theorem EuclideanSpace.orthonormalBasis.repr_eq_one {n : Type _} [Fintype n] : + (EuclideanSpace.orthonormalBasis n 𝕜 : + OrthonormalBasis n 𝕜 (EuclideanSpace 𝕜 n)).repr = 1 := + rfl + +theorem LinearIsometryEquiv.toLinearEquiv_one {R E : Type _} [Semiring R] + [SeminormedAddCommGroup E] [Module R E] : + (1 : E ≃ₗᵢ[R] E).toLinearEquiv = 1 := + rfl + +theorem LinearEquiv.one_symm {R E : Type _} [Semiring R] [AddCommMonoid E] + [Module R E] : + (1 : E ≃ₗ[R] E).symm = 1 := + rfl + +theorem LinearEquiv.toLinearMap_one {R E : Type _} [Semiring R] + [AddCommMonoid E] [Module R E] : + (1 : E ≃ₗ[R] E).toLinearMap = 1 := + rfl + +theorem LinearEquiv.refl_conj {R E : Type _} [CommSemiring R] [AddCommMonoid E] + [Module R E] : + (LinearEquiv.refl R E).conj = 1 := by + ext + simp only [LinearEquiv.conj_apply_apply, LinearEquiv.refl_apply, LinearEquiv.refl_symm] + rfl + +theorem LinearEquiv.conj_hMul {R E F : Type _} [CommSemiring R] [AddCommMonoid E] + [AddCommMonoid F] [Module R E] [Module R F] (f : E ≃ₗ[R] F) + (x y : Module.End R E) : + f.conj (x * y) = f.conj x * f.conj y := by + simp only [mul_eq_comp, LinearEquiv.conj_comp] + +theorem LinearEquiv.conj_apply_one {R E F : Type _} [CommSemiring R] + [AddCommMonoid E] [AddCommMonoid F] [Module R E] [Module R F] + (f : E ≃ₗ[R] F) : f.conj 1 = 1 := + LinearEquiv.conj_id _ + +theorem LinearEquiv.conj_one {R E : Type _} [CommSemiring R] [AddCommMonoid E] + [Module R E] : + (1 : E ≃ₗ[R] E).conj = 1 := by + ext + simp only [LinearEquiv.conj_apply, LinearMap.comp_apply, LinearEquiv.coe_coe] + rfl + +theorem LinearEquiv.one_apply {R E : Type _} [CommSemiring R] [AddCommMonoid E] + [Module R E] (x : E) : + (1 : E ≃ₗ[R] E) x = x := + rfl + +theorem OrthonormalBasis.std_toMatrix {n : Type _} [Fintype n] [DecidableEq n] : + (((EuclideanSpace.orthonormalBasis n 𝕜).toMatrix).symm).toLinearEquiv + = Matrix.toEuclideanLin := + by + change ((EuclideanSpace.orthonormalBasis n 𝕜).toMatrix.toAlgEquiv.symm).toLinearEquiv + = Matrix.toEuclideanLin + rw [← orthonormalBasis_toMatrix_eq_basis_toMatrix] + rw [Matrix.toEuclideanLin_eq_toLin_orthonormal] + rfl + +namespace LinearEquiv + +/-- Conjugate endomorphism algebras along a linear equivalence. -/ +def innerConj {R E F : Type*} [CommSemiring R] [AddCommMonoid E] [AddCommMonoid F] + [Module R E] [Module R F] (e : E ≃ₗ[R] F) : + Module.End R E ≃ₐ[R] Module.End R F := + e.conjAlgEquiv R + +theorem innerConj_apply {R E F : Type*} [CommSemiring R] [AddCommMonoid E] + [AddCommMonoid F] [Module R E] [Module R F] (e : E ≃ₗ[R] F) + (f : Module.End R E) : + e.innerConj f = e.toLinearMap ∘ₗ f ∘ₗ e.symm.toLinearMap := + rfl + +end LinearEquiv + +variable {R I J : Type _} [Fintype I] [Fintype J] [CommSemiring R] + [DecidableEq I] [DecidableEq J] + +open scoped BigOperators +open Matrix Module.End + +theorem Matrix.stdBasis_repr_eq_reshape {R I J : Type _} [Fintype I] [Finite J] + [CommSemiring R] : + (Matrix.stdBasis R I J).equivFun = Matrix.reshape := + by + classical + ext x ij + rw [Module.Basis.equivFun_apply] + exact (Matrix.stdBasis R I J).repr_apply_eq Matrix.reshape + (by intro x y; ext ij; simp [Matrix.reshape_apply]) + (by intro c x; ext ij; simp [Matrix.reshape_apply]) + (by + intro i + ext j + simp only [Finsupp.single_apply] + calc Matrix.reshape (Matrix.stdBasis R I J i) j = + Matrix.reshape (Matrix.single i.1 i.2 (1 : R)) j := by + rw [Matrix.stdBasis_eq_single] + _ = Matrix.single i.1 i.2 (1 : R) j.1 j.2 := rfl + _ = if i = j then 1 else 0 := by + simp_rw [Matrix.single, Matrix.of_apply, ← Prod.eq_iff_fst_eq_snd_eq]) + x ij + +namespace LinearMap + +open scoped Matrix BigOperators + +theorem toMatrix_stdBasis_stdBasis {K L : Type _} [Fintype K] [Finite L] + (x : Matrix I J R →ₗ[R] Matrix K L R) : + toMatrix (Matrix.stdBasis R I J) (Matrix.stdBasis R K L) x = + LinearMap.toMatrix' (Matrix.reshape.toLinearMap ∘ₗ + x ∘ₗ Matrix.reshape.symm.toLinearMap) := + rfl + +theorem toLin_stdBasis_stdBasis {K L : Type _} [Fintype K] [Finite L] + (x : Matrix (K × L) (I × J) R) : + (toLin (Matrix.stdBasis R I J) (Matrix.stdBasis R K L)) x = + (Matrix.reshape : Matrix K L R ≃ₗ[R] _).symm.toLinearMap ∘ₗ + toLin' x ∘ₗ (Matrix.reshape : Matrix I J R ≃ₗ[R] _).toLinearMap := + rfl + +/-- Identify endomorphisms of a matrix space with matrices on the reshaped index type. -/ +def toMatrixOfAlgEquiv : (Matrix I J R →ₗ[R] Matrix I J R) ≃ₐ[R] + Matrix (I × J) (I × J) R := + (Matrix.reshape : Matrix I J R ≃ₗ[R] _).innerConj.trans toMatrixAlgEquiv' + +theorem toMatrixOfAlgEquiv_apply (x : Matrix I J R →ₗ[R] Matrix I J R) : + toMatrixOfAlgEquiv x = + toMatrixAlgEquiv' ((Matrix.reshape : Matrix I J R ≃ₗ[R] _).toLinearMap ∘ₗ + x ∘ₗ (Matrix.reshape : Matrix I J R ≃ₗ[R] _).symm.toLinearMap) := + rfl + +theorem toMatrixOfAlgEquiv_symm_apply (x : Matrix (I × J) (I × J) R) : + toMatrixOfAlgEquiv.symm x = + (Matrix.reshape : Matrix I J R ≃ₗ[R] _).symm.toLinearMap ∘ₗ + toMatrixAlgEquiv'.symm x ∘ₗ (Matrix.reshape : Matrix I J R ≃ₗ[R] _).toLinearMap := + rfl + +theorem toMatrixOfAlgEquiv_apply' (x : Matrix I J R →ₗ[R] Matrix I J R) + (ij kl : I × J) : + toMatrixOfAlgEquiv x ij kl = x (Matrix.single kl.1 kl.2 (1 : R)) ij.1 ij.2 := by + simp_rw [toMatrixOfAlgEquiv_apply, toMatrixAlgEquiv'_apply, LinearMap.comp_apply, + LinearEquiv.coe_coe, Matrix.reshape_apply] + have hsingle : + (Matrix.reshape : Matrix I J R ≃ₗ[R] I × J → R).symm (Pi.single kl 1) = + Matrix.single kl.1 kl.2 (1 : R) := by + ext i j + rw [Matrix.reshape_symm_apply, Matrix.single_apply] + simp [Pi.single_apply, Prod.ext_iff, eq_comm] + rw [hsingle] + +end LinearMap + +namespace Matrix + +/-- The inverse algebra equivalence turning a matrix on `I × J` into an endomorphism +of `Matrix I J R`. -/ +def toLinOfAlgEquiv : Matrix (I × J) (I × J) R ≃ₐ[R] + Matrix I J R →ₗ[R] Matrix I J R := + LinearMap.toMatrixOfAlgEquiv.symm + +theorem toLinOfAlgEquiv_apply (x : Matrix (I × J) (I × J) R) + (y : Matrix I J R) : + toLinOfAlgEquiv x y = + (reshape : Matrix I J R ≃ₗ[R] I × J → R).symm (toLinAlgEquiv' x (reshape y)) := + rfl + +/-- Rank-one endomorphism on the standard basis of a matrix space. -/ +def rankOneStdBasis {I J : Type _} [DecidableEq I] [DecidableEq J] + (ij kl : I × J) (r : R) : Matrix I J R →ₗ[R] Matrix I J R where + toFun x := single ij.1 ij.2 (r • r • x kl.1 kl.2) + map_add' x y := by + simp_rw [Matrix.add_apply, smul_add, single_add] + map_smul' r x := by + simp_rw [RingHom.id_apply, Matrix.smul_apply, smul_single, smul_smul, mul_rotate'] + +theorem rankOneStdBasis_apply {I J : Type _} [DecidableEq I] [DecidableEq J] + (ij kl : I × J) (r : R) (x : Matrix I J R) : + rankOneStdBasis ij kl r x = single ij.1 ij.2 (r • r • x kl.1 kl.2) := + rfl + +open scoped BigOperators + +theorem toLinOfAlgEquiv_eq (x : Matrix (I × J) (I × J) R) : + toLinOfAlgEquiv x = + ∑ ij : I × J, ∑ kl : I × J, x ij kl • rankOneStdBasis ij kl (1 : R) := by + simp_rw [LinearMap.ext_iff, ← ext_iff, toLinOfAlgEquiv_apply, reshape_symm_apply, + LinearMap.sum_apply, Matrix.sum_apply, toLinAlgEquiv'_apply, mulVec, dotProduct, + reshape_apply, LinearMap.smul_apply, Matrix.smul_apply, rankOneStdBasis_apply, single, + of_apply, smul_ite, ← Prod.mk_inj, Prod.mk.eta, one_smul, smul_zero, smul_eq_mul, + Finset.sum_ite_irrel, Finset.sum_const_zero, Finset.sum_ite_eq', Finset.mem_univ, if_true, + forall₃_true_iff] + +theorem toLinOfAlgEquiv_toMatrixOfAlgEquiv (x : Matrix (I × J) (I × J) R) : + LinearMap.toMatrixOfAlgEquiv (toLinOfAlgEquiv x) = x := by + rw [toLinOfAlgEquiv, AlgEquiv.apply_symm_apply] + +end Matrix + +open Matrix + +theorem LinearMap.toMatrixOfAlgEquiv_toLinOfAlgEquiv + (x : Matrix I J R →ₗ[R] Matrix I J R) : + toLinOfAlgEquiv (toMatrixOfAlgEquiv x) = x := by + rw [toLinOfAlgEquiv, AlgEquiv.symm_apply_apply] + +open scoped Kronecker Matrix + +variable {n 𝕜 : Type _} [Fintype n] [DecidableEq n] [RCLike 𝕜] + +theorem innerAut_toMatrix (U : unitaryGroup n 𝕜) : + LinearMap.toMatrixOfAlgEquiv (innerAut U) = U ⊗ₖ Uᴴᵀ := by + ext + simp_rw [LinearMap.toMatrixOfAlgEquiv_apply', innerAut_apply', Matrix.mul_apply, + Matrix.single, Matrix.of_apply, mul_ite, mul_one, MulZeroClass.mul_zero, + Finset.sum_mul, ite_mul, MulZeroClass.zero_mul, ite_and, + ← unitaryGroup.star_coe_eq_coe_star, star_apply, kroneckerMap_apply, conj_apply] + simp only [Finset.sum_ite_eq, Finset.mem_univ, if_true] + +theorem innerAut_coord (U : unitaryGroup n 𝕜) (ij kl : n × n) : + (LinearMap.toMatrixOfAlgEquiv (innerAut U)) ij kl = + U ij.1 kl.1 * star (U ij.2 kl.2) := by + rw [innerAut_toMatrix] + rfl + +theorem innerAut_inv_coord (U : unitaryGroup n ℂ) (ij kl : n × n) : + LinearMap.toMatrixOfAlgEquiv (innerAut U⁻¹) ij kl = + U kl.2 ij.2 * star (U kl.1 ij.1) := by + simp_rw [innerAut_toMatrix, UnitaryGroup.inv_apply, star_eq_conjTranspose, + kroneckerMap_apply, conj_apply, conjTranspose_apply, star_star, mul_comm] diff --git a/LeanPool/Monlib4/Monlib.lean b/LeanPool/Monlib4/Monlib.lean new file mode 100644 index 0000000000..a99e7f01e0 --- /dev/null +++ b/LeanPool/Monlib4/Monlib.lean @@ -0,0 +1,17 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra +import LeanPool.Monlib4.Other +import LeanPool.Monlib4.Preq +import LeanPool.Monlib4.QuantumGraph +import LeanPool.Monlib4.RepTheory + +/-! +# Monlib4 import root + +Compatibility root corresponding to upstream `Monlib.lean`. +-/ diff --git a/LeanPool/Monlib4/Other.lean b/LeanPool/Monlib4/Other.lean new file mode 100644 index 0000000000..fba49c9b9f --- /dev/null +++ b/LeanPool/Monlib4/Other.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.Other.Sonia + +/-! +# Other + +Import-only index for miscellaneous self-contained monlib4 files. +-/ diff --git a/LeanPool/Monlib4/Other/Sonia.lean b/LeanPool/Monlib4/Other/Sonia.lean new file mode 100644 index 0000000000..999958c9e7 --- /dev/null +++ b/LeanPool/Monlib4/Other/Sonia.lean @@ -0,0 +1,115 @@ +/- +Copyright (c) 2024 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Algebra.BigOperators.Fin +import Mathlib.Tactic +import Init.Data.Nat.Lemmas + +/-! + +# Useless and interesting fact(s) on naturals and integers + +*Sonia* recently asked me: + "Is there a way to prove that a number is divisible by 9, by looking at the sum of its digits?" +So here is the generalised version of the question. + +## Main results + +In both of the following results, `b` is a natural number greater than `1`. + +* `nat_repr_mod_eq_sum_repr_mod`: this says that the remainder of dividing a number + in base `b + 1` by `b` is equal to the remainder of dividing the sum of its digits by `b` +* `nat_dvd_repr_iff_nat_dvd_sum_repr`: this says that a number in base `b + 1` is divisible by `b` + if and only if the sum of its digits is divisible by `b` + +-/ + + +open scoped BigOperators + +/-- `(∑ i, x i) % a = (∑ i, (x i % a)) % a` -/ +theorem Int.sum_mod {n : ℕ} (x : Fin n → ℤ) (a : ℤ) : (∑ i, x i) % a = (∑ i, x i % a) % a := + by + induction n generalizing a with + | zero => rfl + | succ d hd => + let x' : Fin d → ℤ := fun i => x i.succ + have hx' : ∀ i, x' i = x i.succ := fun i => rfl + simp_rw [Fin.sum_univ_succ] + rw [Int.add_emod] + simp_rw [← hx', Int.emod_add_cancel_left] + rw [hd] + simp_rw [Int.emod_emod] + +-- `n.succ % n = 1` if `1 < n` +theorem Fin.succ_mod_self {n : ℕ} (hn : 1 < n) : n.succ % n = 1 := + by + rw [Nat.succ_eq_add_one, Nat.add_mod, Nat.mod_self, zero_add, Nat.mod_mod] + exact Nat.mod_eq_of_lt hn + +/-- `a.succ ^ n % a = 1` when `1 < a` -/ +theorem Fin.succ_pow_mod_self {n a : ℕ} (ha : 1 < a) : a.succ ^ n % a = 1 := + by + induction n generalizing a ha with + | zero => + rw [pow_zero] + exact Nat.mod_eq_of_lt ha + | succ d hd => + rw [Nat.pow_mod] + simp_rw [Nat.pow_mod (Nat.succ _)] at hd + specialize hd ha + rw [Fin.succ_mod_self ha, one_pow] at hd ⊢ + exact hd + +-- `(a * b.succ ^ n) % b = a % b` +theorem Int.hMul_nat_succ_pow_mod_nat (a : ℤ) {b n : ℕ} (hb : 1 < b) : + a * ((b : ℕ).succ ^ n : ℕ) % (b : ℕ) = a % b := by + rw [Int.mul_emod, Int.ofNat_mod_ofNat, Fin.succ_pow_mod_self hb, Int.ofNat_one, mul_one, + Int.emod_emod] + +/-- `(∑ i, (x i * a.succ ^ i)) % a = (∑ i, x i) % a` +-/ +theorem nat_repr_mod_eq_sum_repr_mod {a n : ℕ} (x : Fin n → ℤ) (ha : 1 < a) : + (∑ i, x i * (a.succ : ℕ) ^ (i : ℕ)) % a = (∑ i, x i) % a := + by + induction n with + | zero => rfl + | succ d hd => + simp_rw [Fin.sum_univ_succ, Fin.val_zero, pow_zero, mul_one, Fin.val_succ, + Int.emod_add_cancel_left] + let x' : Fin d → ℤ := fun i => x i.succ + have hx' : ∀ i, x' i = x i.succ := fun i => rfl + simp_rw [← Nat.succ_eq_add_one, ← hx'] + simp only [hx'] + rw [Int.sum_mod] + simp_rw [← hx'] + rw [← Int.emod_emod, Int.emod_emod] + have : ∀ (c : ℤ) (d : ℕ), c * (a.succ : ℕ) ^ d % a = c % a := fun c d => + calc + c * (a.succ : ℕ) ^ d % a = c * ((a.succ : ℕ) ^ d : ℕ) % (a : ℕ) := by + simp_rw [Int.natCast_pow] + _ = c % a := Int.hMul_nat_succ_pow_mod_nat _ ha + simp_rw [this, ← Int.sum_mod] + +/-- `a ∣ (∑ i, (x i * a.succ ^ i)) ↔ a ∣ (∑ i, x i)` + in other words, a number in base `a.succ` is divisible by `a`, if and only if + the sum of its digits is divisible by `a` +-/ +theorem nat_dvd_repr_iff_nat_dvd_sum_repr {a n : ℕ} (x : Fin n → ℤ) (ha : 1 < a) : + (a : ℤ) ∣ ∑ i, x i * (a.succ : ℕ) ^ (i : ℕ) ↔ (a : ℤ) ∣ ∑ i, x i := by + simp_rw [Int.dvd_iff_emod_eq_zero, nat_repr_mod_eq_sum_repr_mod _ ha] + +/-- most natural example: + `9 ∣ ∑ i, (x i * 10 ^ i) ↔ 9 ∣ ∑ i, x i` + in other words, a number (in base `10`) is divisible by `9`, if and only if + the sum of its digits is divisible by `9` +-/ +example {n : ℕ} (x : Fin n → ℤ) : 9 ∣ ∑ i, x i * 10 ^ (i : ℕ) ↔ 9 ∣ ∑ i, x i := + nat_dvd_repr_iff_nat_dvd_sum_repr x (Nat.one_lt_succ_succ _) + +/-- so when the base is `8`, then a number in base `8` is divisible by `7`, + if and only if the sum of its digits is divisible by `7` -/ +example {n : ℕ} (x : Fin n → ℤ) : 7 ∣ ∑ i, x i * 8 ^ (i : ℕ) ↔ 7 ∣ ∑ i, x i := + nat_dvd_repr_iff_nat_dvd_sum_repr _ (Nat.one_lt_succ_succ _) diff --git a/LeanPool/Monlib4/Preq.lean b/LeanPool/Monlib4/Preq.lean new file mode 100644 index 0000000000..86997f99cf --- /dev/null +++ b/LeanPool/Monlib4/Preq.lean @@ -0,0 +1,20 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.Preq.Complex +import LeanPool.Monlib4.Preq.Dite +import LeanPool.Monlib4.Preq.Equiv +import LeanPool.Monlib4.Preq.Finset +import LeanPool.Monlib4.Preq.Ites +import LeanPool.Monlib4.Preq.RCLikeLe +import LeanPool.Monlib4.Preq.Set +import LeanPool.Monlib4.Preq.StarAlgEquiv + +/-! +# Preq + +Import-only index for the `Preq` directory of the monlib4 import. +-/ diff --git a/LeanPool/Monlib4/Preq/Complex.lean b/LeanPool/Monlib4/Preq/Complex.lean new file mode 100644 index 0000000000..68f00dee7b --- /dev/null +++ b/LeanPool/Monlib4/Preq/Complex.lean @@ -0,0 +1,196 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Data.Complex.Basic +import Mathlib.Analysis.Complex.Norm +import Mathlib.Algebra.BigOperators.Fin +import Mathlib.Data.Complex.BigOperators + +/-! + +# Some stuff about complex numbers + +This file contains some basic lemmas about complex numbers. + +-/ + + +open scoped ComplexConjugate BigOperators + +open Complex + +/-- +The norm of `∑ i, α i ^ 2` is the sum of `‖α i‖ ^ 2` if and only if +the real and imaginary parts of the `α i` are pairwise proportional. +-/ +theorem norm_of_sum_sq_eq_sum_norm_sq_iff {n : Type _} [Fintype n] (α : n → ℂ) : + ‖(∑ i : n, α i ^ 2)‖ = ∑ i : n, ‖(α i)‖ ^ 2 ↔ + ∀ i j : n, (α i).re * (α j).im = (α j).re * (α i).im := + by + have complex.abs_sq : ∀ x : ℂ, ‖x‖ ^ 2 = Complex.normSq x := + by + intros + simp_rw [norm_def, Real.sq_sqrt (normSq_nonneg _)] + simp_rw [complex.abs_sq, norm_def] + rw [Real.sqrt_eq_iff_eq_sq (normSq_nonneg _), eq_comm, pow_two, Finset.sum_mul_sum] + · simp_rw [← normSq_mul, normSq_apply, re_sum, im_sum, Finset.sum_mul_sum, ← + Finset.sum_add_distrib, pow_two, mul_re, mul_im, sub_mul, mul_sub, mul_add, add_mul] + rw [← sub_eq_zero] + have aux_for_ex : + ∀ x : n × n, + (α x.fst).re * (α x.snd).re * ((α x.fst).re * (α x.snd).re) - + (α x.fst).re * (α x.snd).re * ((α x.fst).im * (α x.snd).im) - + ((α x.fst).im * (α x.snd).im * ((α x.fst).re * (α x.snd).re) - + (α x.fst).im * (α x.snd).im * ((α x.fst).im * (α x.snd).im)) + + ((α x.fst).re * (α x.snd).im * ((α x.fst).re * (α x.snd).im) + + (α x.fst).im * (α x.snd).re * ((α x.fst).re * (α x.snd).im) + + ((α x.fst).re * (α x.snd).im * ((α x.fst).im * (α x.snd).re) + + (α x.fst).im * (α x.snd).re * ((α x.fst).im * (α x.snd).re))) - + ((α x.fst).re * (α x.fst).re * ((α x.snd).re * (α x.snd).re) - + (α x.fst).re * (α x.fst).re * ((α x.snd).im * (α x.snd).im) - + ((α x.fst).im * (α x.fst).im * ((α x.snd).re * (α x.snd).re) - + (α x.fst).im * (α x.fst).im * ((α x.snd).im * (α x.snd).im)) + + ((α x.fst).re * (α x.fst).im * ((α x.snd).re * (α x.snd).im) + + (α x.fst).im * (α x.fst).re * ((α x.snd).re * (α x.snd).im) + + ((α x.fst).re * (α x.fst).im * ((α x.snd).im * (α x.snd).re) + + (α x.fst).im * (α x.fst).re * ((α x.snd).im * (α x.snd).re)))) = + 2 * + (((α x.snd).im * (α x.fst).re) ^ 2 - + 2 * ((α x.snd).im * (α x.fst).re) * ((α x.fst).im * (α x.snd).re) + + ((α x.fst).im * (α x.snd).re) ^ 2) := + by + intros + simp_rw [← pow_two, sub_sub, mul_comm, ← two_mul] + ring_nf + simp_rw [← Finset.sum_sub_distrib, ← Finset.sum_product', Finset.univ_product_univ, + aux_for_ex, ← sub_sq, ← Finset.mul_sum, mul_eq_zero, two_ne_zero, false_or] + rw [Finset.sum_eq_zero_iff_of_nonneg] + · simp_rw [Finset.mem_univ, true_imp_iff, Prod.forall, sq_eq_zero_iff, sub_eq_zero, + mul_comm] + · simp_rw [Finset.mem_univ, true_imp_iff, sq_nonneg, forall_true_iff] + · apply Finset.sum_nonneg + intros + exact normSq_nonneg _ + +theorem norm_of_sq_add_sq_eq_norm_sq_add_norm_sq_iff (α₁ α₂ : ℂ) : + norm (α₁ ^ 2 + α₂ ^ 2) = norm α₁ ^ 2 + norm α₂ ^ 2 ↔ + α₁.re * α₂.im = α₂.re * α₁.im := + by + let α := ![α₁, α₂] + have h₀ : α 0 = α₁ := rfl + have h₁ : α 1 = α₂ := rfl + have hy : + norm (∑ i : Fin 2, α i ^ 2) = norm (α 0 ^ 2 + α 1 ^ 2) ∧ + ∑ i : Fin 2, norm (α i) ^ 2 = norm (α 0) ^ 2 + norm (α 1) ^ 2 := + by + simp [Fin.sum_univ_two] + simp_rw [← h₀, ← h₁, ← hy.1, ← hy.2, norm_of_sum_sq_eq_sum_norm_sq_iff, + Fin.forall_fin_two, h₀, h₁, true_and, and_true, eq_comm, and_self_iff] + +theorem norm_of_sq_add_sq_norm_sq_add_norm_sq_iff' (α₁ α₂ : ℂ) : + norm (α₁ ^ 2 + α₂ ^ 2) = norm α₁ ^ 2 + norm α₂ ^ 2 ↔ α₁ * conj α₂ = conj α₁ * α₂ := + by + rw [norm_of_sq_add_sq_eq_norm_sq_add_norm_sq_iff, ← re_add_im α₁, ← re_add_im α₂] + simp_rw [add_re, add_im, map_add, conj_ofReal, mul_I_im, mul_I_re, starRingEnd_apply, star_mul', + ← starRingEnd_apply, conj_I, conj_ofReal, mul_add, add_mul] + simp only [ofReal_re, ofReal_im, MulZeroClass.mul_zero, neg_zero, add_zero, + MulZeroClass.zero_mul, zero_add, mul_neg, neg_mul, mul_comm _ I, mul_mul_mul_comm, I_mul_I, + neg_neg, one_mul] + simp_rw [add_assoc, add_right_inj, ← add_assoc, add_left_inj, mul_comm _ (I * _), + add_comm (- ((I * _) * _)) _, ← sub_eq_add_neg, mul_assoc, ← mul_sub, mul_right_inj' I_ne_zero, + ← ofReal_mul, ← ofReal_sub] + norm_cast + simp_rw [sub_eq_sub_iff_add_eq_add, ← two_mul, mul_eq_mul_left_iff, OfNat.ofNat_ne_zero, + or_false, mul_comm _ (Complex.re _), eq_comm] + +/-- +The norm identity for a finite sum of squares is equivalent to saying that +`α i * conj (α j) = conj (α i) * α j` for every pair `i`, `j`. +-/ +theorem norm_of_sum_sq_eq_sum_norm_sq_iff' {n : Type _} [Fintype n] (α : n → ℂ) : + norm (∑ i : n, α i ^ 2) = ∑ i : n, norm (α i) ^ 2 ↔ + ∀ i j : n, α i * conj (α j) = conj (α i) * α j := + by + have := norm_of_sq_add_sq_norm_sq_add_norm_sq_iff' + simp_rw [norm_of_sq_add_sq_eq_norm_sq_add_norm_sq_iff] at this + simp_rw [norm_of_sum_sq_eq_sum_norm_sq_iff, this] + +theorem norm_of_sq_add_sq_norm_sq_add_norm_sq_iff'' (α₁ α₂ : ℂ) : + norm (α₁ ^ 2 + α₂ ^ 2) = norm α₁ ^ 2 + norm α₂ ^ 2 ↔ + ∃ (γ : ℂ) (β₁ β₂ : ℝ), α₁ = γ * β₁ ∧ α₂ = γ * β₂ := + by + rw [norm_of_sq_add_sq_eq_norm_sq_add_norm_sq_iff] + constructor + · intro h + rw [← re_add_im α₂, ← re_add_im α₁] + by_cases h1 : α₂.im = 0 + · by_cases h2 : α₂.re = 0 + · rw [h1, h2, ofReal_zero, zero_add, MulZeroClass.zero_mul] + use α₁ + use 1 + use 0 + simp_rw [re_add_im, ofReal_zero, MulZeroClass.mul_zero, ofReal_one, mul_one, + true_and] + have : α₂.re = 0 ∨ α₁.im = 0 := by rw [← mul_eq_zero, ← h, h1, MulZeroClass.mul_zero] + rcases this with (this | this) + · contradiction + · use 1 + use α₁.re + use α₂.re + simp_rw [h1, this, ofReal_zero, MulZeroClass.zero_mul, add_zero, one_mul, and_self_iff] + by_cases h2 : α₂.re = 0 + · have : α₁.re = 0 ∨ α₂.im = 0 := by rw [← mul_eq_zero, h, h2, MulZeroClass.zero_mul] + rcases this with (this | this) + · use I + use α₁.im + use α₂.im + simp_rw [h2, this, ofReal_zero, zero_add, mul_comm, and_self_iff] + · contradiction + use 1 / α₂.im + I * (1 / α₂.re) + use α₁.re * α₂.im + use α₂.im * α₂.re + push Not at h1 h2 + simp_rw [add_mul, one_div, ← ofReal_inv, ← ofReal_mul, mul_comm, mul_assoc, + mul_inv_cancel₀ h1, mul_one, h, ofReal_mul, mul_rotate _ _ (I * _), mul_assoc, + ← ofReal_mul, inv_mul_cancel₀ h2, ofReal_one, mul_one, mul_comm I _, and_self] + · rintro ⟨γ, β₁, β₂, ⟨rfl, rfl⟩⟩ + simp_rw [mul_comm γ _, re_ofReal_mul, im_ofReal_mul, mul_mul_mul_comm, mul_comm] + +/-- +The norm identity for a finite sum of squares is equivalent to all `α i` +lying on a common complex line through the origin with real coefficients. +-/ +theorem norm_of_sum_sq_eq_sum_norm_sq_iff'' {n : Type _} [Fintype n] (α : n → ℂ) : + norm (∑ i : n, α i ^ 2) = ∑ i : n, norm (α i) ^ 2 ↔ + ∃ γ : ℂ, ∀ i : n, ∃ β : ℝ, α i = γ * β := + by + have := norm_of_sq_add_sq_norm_sq_add_norm_sq_iff'' + simp_rw [norm_of_sq_add_sq_eq_norm_sq_add_norm_sq_iff] at this + simp_rw [norm_of_sum_sq_eq_sum_norm_sq_iff, this] + constructor + · intro h + by_cases H : α = 0 + · use 0 + intros + use 0 + simp_rw [H, Pi.zero_apply, MulZeroClass.zero_mul] + · have : ∃ i : n, α i ≠ 0 := by simp_rw [ne_eq, ← not_forall, ← funext_iff]; exact H + have := this + rcases this with ⟨i, hi⟩ + rcases this with ⟨j, hj⟩ + obtain ⟨γ, β₁, β₂, ⟨hβ₁, _⟩⟩ := h i j + use γ + intro k + obtain ⟨γ₂, β₃, β₄, ⟨hβ₃, hβ₄⟩⟩ := h i k + by_cases h' : β₃ = 0 + · simp_rw [h', ofReal_zero, MulZeroClass.mul_zero] at hβ₃ + contradiction + · use β₁ * (β₄ / β₃) + simp_rw [ofReal_mul, ← mul_assoc, ← hβ₁, hβ₃, mul_assoc, ← ofReal_mul, + mul_div_cancel₀ _ h', hβ₄] + · rintro ⟨γ, hγ⟩ i j + obtain ⟨β₁, hβ₁⟩ := hγ i + obtain ⟨β₂, hβ₂⟩ := hγ j + exact ⟨γ, β₁, β₂, ⟨hβ₁, hβ₂⟩⟩ diff --git a/LeanPool/Monlib4/Preq/Dite.lean b/LeanPool/Monlib4/Preq/Dite.lean new file mode 100644 index 0000000000..bd78ad38f6 --- /dev/null +++ b/LeanPool/Monlib4/Preq/Dite.lean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Logic.Basic +import Mathlib.Algebra.Group.Defs +import Mathlib.Algebra.Star.Basic +import Mathlib.LinearAlgebra.TensorProduct.Basic + +/-! + # Some stuff on dites +-/ + +theorem ite_eq_ite_iff {α : Type _} (a b c : α) : + (∀ {p : Prop} [hp : Decidable p], @ite α p hp a c + = @ite α p hp b c) ↔ a = b := + by + constructor + · intro h + exact h (p := True) + · intro h + simp [h] + +theorem ite_eq_ite_iff_of_pi {n α : Type _} [DecidableEq n] (a b c : n → α) : + (∀ i j : n, ite (i = j) (a i) (c i) = ite (i = j) (b i) (c i)) ↔ a = b := + by + constructor + · intro h + funext i + specialize h i i + simpa using h + · intro h + rw [h] + intro i j + rfl + + +-- theorem dite_add_dite {α : Type _} [Add α] (P : Prop) [Decidable P] +-- (a b : P → α) (c d : ¬P → α) : +-- ((dite P (fun x => a x) fun x => c x) + dite P (fun x => b x) fun x => d x) = +-- dite P (fun x => a x + b x) fun x => c x + d x := +-- by +-- rw [eq_comm] +-- simp only [dite_eq_iff'] +-- constructor +-- · intro h +-- simp only [h, dif_pos] +-- · intro h +-- simp only [h, dif_neg, not_false_iff] + +theorem hMul_dite {α : Type _} [Mul α] (P : Prop) [Decidable P] (a : α) (b : P → α) (c : ¬P → α) : + (a * dite P (fun x => b x) fun x => c x) = dite P (fun x => a * b x) fun x => a * c x := + by + rw [eq_comm] + simp only [dite_eq_iff'] + constructor + · intro h + simp only [h, dif_pos] + · intro h + simp only [h, dif_neg, not_false_iff] + +theorem dite_hMul {α : Type _} [Mul α] (P : Prop) [Decidable P] (a : α) (b : P → α) (c : ¬P → α) : + (dite P (fun x => b x) fun x => c x) * a = dite P (fun x => b x * a) fun x => c x * a := + by + rw [eq_comm] + simp only [dite_eq_iff'] + constructor + · intro h + simp only [h, dif_pos] + · intro h + simp only [h, dif_neg, not_false_iff] + +theorem dite_boole_add {α : Type _} [AddZeroClass α] (P : Prop) [Decidable P] (a b : P → α) : + (dite P (fun x => a x + b x) fun _ => 0) = + (dite P (fun x => a x) fun _ => 0) + dite P (fun x => b x) fun _ => 0 := + by rw [dite_add_dite, add_zero] + +theorem dite_boole_smul {α β : Type _} [Zero α] [SMulZeroClass β α] (P : Prop) [Decidable P] + (a : P → α) (r : β) : + (dite P (fun x => r • a x) fun _ => 0) = r • dite P (fun x => a x) fun _ => 0 := by + rw [smul_dite, smul_zero] + +theorem star_dite (P : Prop) [Decidable P] {α : Type _} [InvolutiveStar α] (a : P → α) + (b : ¬P → α) : + star (dite P (fun i => a i) fun i => b i) = dite P (fun i => star (a i)) fun i => star (b i) := + by + rw [eq_comm, dite_eq_iff'] + constructor + · intro h + simp only [h, dif_pos] + · intro h + simp only [h, dif_neg, not_false_iff] + +theorem dite_tmul {R N₁ N₂ : Type _} [CommSemiring R] [AddCommGroup N₁] [AddCommGroup N₂] + [Module R N₁] [Module R N₂] (P : Prop) [Decidable P] (x₁ : P → N₁) (x₂ : N₂) : + (dite P (fun h => x₁ h) fun _ => 0) ⊗ₜ[R] x₂ = dite P (fun h => x₁ h ⊗ₜ[R] x₂) fun _ => 0 := by + split_ifs <;> simp + +theorem tmul_dite {R N₁ N₂ : Type _} [CommSemiring R] [AddCommGroup N₁] [AddCommGroup N₂] + [Module R N₁] [Module R N₂] (P : Prop) [Decidable P] (x₁ : N₁) (x₂ : P → N₂) : + (x₁ ⊗ₜ[R] dite P (fun h => x₂ h) fun _ => 0) = dite P (fun h => x₁ ⊗ₜ[R] x₂ h) fun _ => 0 := by + split_ifs <;> simp + +theorem LinearMap.apply_dite {R H₁ H₂ : Type _} [Semiring R] [AddCommMonoid H₁] [AddCommMonoid H₂] + [Module R H₁] [Module R H₂] (f : H₁ →ₗ[R] H₂) (P : Prop) [Decidable P] (a : P → H₁) + (b : ¬P → H₁) : + f (dite P (fun h => a h) fun h => b h) = dite P (fun h => f (a h)) fun h => f (b h) := by + split_ifs <;> simp + +lemma dite_apply' {i β : Type*} {α : i → Type*} (P : Prop) [Decidable P] + {j : i} (f : P → (β → α j)) [Zero (α j)] (a : β) : + (if h : P then (f h) else 0) a = if h : P then f h a else 0 := +by aesop diff --git a/LeanPool/Monlib4/Preq/Equiv.lean b/LeanPool/Monlib4/Preq/Equiv.lean new file mode 100644 index 0000000000..a4b94fbe46 --- /dev/null +++ b/LeanPool/Monlib4/Preq/Equiv.lean @@ -0,0 +1,19 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.LinearAlgebra.Matrix.Basic +import Mathlib.Data.Matrix.PEquiv +import Mathlib.LinearAlgebra.UnitaryGroup + +theorem Equiv.Perm.ToPequiv.toMatrix_mem_unitaryGroup {n : Type _} [DecidableEq n] + [Fintype n] {𝕜 : Type _} [CommRing 𝕜] [StarRing 𝕜] (σ : Equiv.Perm n) : + (Equiv.toPEquiv σ).toMatrix ∈ Matrix.unitaryGroup n 𝕜 := + by + rw [Matrix.mem_unitaryGroup_iff] + ext i j + by_cases h : i = j <;> + simp [Matrix.mul_apply, PEquiv.toMatrix_apply, Equiv.toPEquiv_apply, Matrix.one_apply, + Function.Injective.eq_iff (Equiv.injective σ), eq_comm, h] diff --git a/LeanPool/Monlib4/Preq/Finset.lean b/LeanPool/Monlib4/Preq/Finset.lean new file mode 100644 index 0000000000..55410f8118 --- /dev/null +++ b/LeanPool/Monlib4/Preq/Finset.lean @@ -0,0 +1,108 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Algebra.Group.Defs +import Mathlib.Data.Finset.Basic +import Mathlib.Algebra.BigOperators.Group.Finset.Sigma +import Mathlib.Data.Fintype.Prod + +/-! + +# finset + +In this file we provide some elementary results for summations + +-/ + + +namespace Finset + +open scoped BigOperators + +theorem sum_rotate {α β γ ζ : Type _} [AddCommMonoid β] {s : Finset α} {t : Finset γ} {u : Finset ζ} + {f : α → γ → ζ → β} : + ∑ x ∈ s, ∑ y ∈ t, ∑ z ∈ u, f x y z = + ∑ z ∈ u, ∑ x ∈ s, ∑ y ∈ t, f x y z := + by + nth_rw 2 [Finset.sum_comm] + congr + ext x + rw [Finset.sum_comm] + +theorem sum_3_comm {α β γ ζ : Type _} [AddCommMonoid β] {s : Finset α} {t : Finset γ} {u : Finset ζ} + {f : α → γ → ζ → β} : + ∑ x ∈ s, ∑ y ∈ t, ∑ z ∈ u, f x y z = + ∑ z ∈ u, ∑ y ∈ t, ∑ x ∈ s, f x y z := + by + rw [Finset.sum_rotate] + congr + ext + rw [Finset.sum_comm] + +theorem sum_4_rotate {α β γ ζ ε : Type _} [AddCommMonoid β] {s : Finset α} {t : Finset γ} + {u : Finset ζ} {v : Finset ε} {f : α → γ → ζ → ε → β} : + ∑ x ∈ s, ∑ y ∈ t, ∑ z ∈ u, ∑ w ∈ v, f x y z w = + ∑ w ∈ v, ∑ x ∈ s, ∑ y ∈ t, ∑ z ∈ u, f x y z w := + by + nth_rw 2 [Finset.sum_comm] + congr + ext x + rw [Finset.sum_rotate] + +theorem sum_sum_comm_sum {α β γ ζ ε : Type _} [AddCommMonoid β] {s : Finset α} {t : Finset γ} + {u : Finset ζ} {v : Finset ε} {f : α → γ → ζ → ε → β} : + ∑ x ∈ s, ∑ y ∈ t, ∑ z ∈ u, ∑ w ∈ v, f x y z w = + ∑ x ∈ s, ∑ y ∈ t, ∑ w ∈ v, ∑ z ∈ u, f x y z w := + by + congr + ext x + congr + ext y + nth_rw 2 [Finset.sum_comm] + +theorem sum_sum_sum {β α γ ζ : Type _} [AddCommMonoid β] {s : Finset γ} {t : Finset α} + {g : Finset ζ} {f : γ → α → ζ → β} : + ∑ x ∈ s, ∑ y ∈ t, ∑ z ∈ g, f x y z = + ∑ z ∈ g, ∑ x ∈ s, ∑ y ∈ t, f x y z := + by + symm + rw [Finset.sum_comm] + congr + ext + rw [Finset.sum_comm] + +theorem sum_4_swap_2 {β α γ ζ ε : Type _} [AddCommMonoid β] {s : Finset γ} {t : Finset α} + {u : Finset ζ} {v : Finset ε} {f : γ → α → ζ → ε → β} : + ∑ x ∈ s, ∑ y ∈ t, ∑ z ∈ u, ∑ w ∈ v, f x y z w = + ∑ z ∈ u, ∑ w ∈ v, ∑ x ∈ s, ∑ y ∈ t, f x y z w := + by + rw [Finset.sum_rotate] + congr + ext + rw [sum_rotate] + +theorem sum_5_rotate {α β γ ζ ε κ : Type _} [AddCommMonoid β] {s : Finset α} {t : Finset γ} + {u : Finset ζ} {v : Finset ε} {k : Finset κ} {f : α → γ → ζ → ε → κ → β} : + ∑ x ∈ s, ∑ y ∈ t, ∑ z ∈ u, ∑ w ∈ v, ∑ vz ∈ k, f x y z w vz = + ∑ vz ∈ k, ∑ x ∈ s, ∑ y ∈ t, ∑ z ∈ u, ∑ w ∈ v, f x y z w vz := + by + nth_rw 2 [Finset.sum_comm] + congr + ext x + rw [Finset.sum_4_rotate] + +end Finset + +theorem Forall.rotate {α β γ : Sort _} {p : α → β → γ → Prop} : + (∀ (x : α) (y : β) (z : γ), p x y z) ↔ ∀ (z : γ) (x : α) (y : β), p x y z := + ⟨fun h _ _ _ => h _ _ _, fun h _ _ _ => h _ _ _⟩ + +theorem forall_forall_comm {α β γ ζ : Sort _} {p : α → β → γ → ζ → Prop} : + (∀ (x : α) (y : β) (z : γ) (w : ζ), p x y z w) ↔ ∀ (x : α) (z : γ) (y : β) (w : ζ), p x y z w := + ⟨fun h _ _ _ _ => h _ _ _ _, fun h _ _ _ _ => h _ _ _ _⟩ + +theorem Finset.sum_product_univ {β α γ : Type _} [AddCommMonoid β] [Fintype α] [Fintype γ] + {f : γ × α → β} : ∑ x : γ × α, f x = ∑ x : γ, ∑ y : α, f (x, y) := + Finset.sum_product _ _ _ diff --git a/LeanPool/Monlib4/Preq/Ites.lean b/LeanPool/Monlib4/Preq/Ites.lean new file mode 100644 index 0000000000..2d23949bd8 --- /dev/null +++ b/LeanPool/Monlib4/Preq/Ites.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Algebra.Star.Basic +import Mathlib.Algebra.Module.LinearMap.Basic +import Mathlib.LinearAlgebra.TensorProduct.Basic +import Mathlib.LinearAlgebra.TensorProduct.Map + +/-! + # Some stuff on ites + + Some lemmas about `ite` and `coe` for `star` and `tensor_product`. +-/ + + +@[simp] +theorem star_ite {α : Type _} [InvolutiveStar α] (P : Prop) [Decidable P] (a b : α) : + star (ite P a b) = ite P (star a) (star b) := + by + by_cases h : a = b + · simp_rw [h, ite_self] + · have : ¬star a = star b := by + apply star_injective.ne_iff.mp + rw [star_star a, star_star b] + exact h + by_cases h' : P + · simp_rw [(Ne.ite_eq_left_iff h).mpr h', (Ne.ite_eq_left_iff this).mpr h'] + · simp_rw [(Ne.ite_eq_right_iff h).mpr h', (Ne.ite_eq_right_iff this).mpr h'] + +theorem coe_ite {α β : Type _} [CoeTC α β] (P : Prop) [Decidable P] (a b : α) : + (↑(ite P a b) : β) = ite P (a : β) (b : β) := +by split_ifs <;> rfl + +theorem ite_apply_lm {R A B : Type _} [Semiring R] [AddCommMonoid A] [AddCommMonoid B] [Module R A] + [Module R B] (f g : A →ₗ[R] B) (x : A) (P : Prop) [Decidable P] : + (if P then f else g : A →ₗ[R] B) x = if P then f x else g x := + by + by_cases h : P + · simp only [h, if_true] + · simp only [h, if_false] + +local notation f " ⊗ₘ " g => TensorProduct.map f g + +open scoped TensorProduct + +theorem TensorProduct.ite_map {R M₁ M₂ M₃ M₄ : Type _} [CommSemiring R] [AddCommMonoid M₁] + [AddCommMonoid M₂] [AddCommMonoid M₃] [AddCommMonoid M₄] [Module R M₁] [Module R M₂] + [Module R M₃] [Module R M₄] (f₁ f₂ : M₁ →ₗ[R] M₂) (g : M₃ →ₗ[R] M₄) (P : Prop) [Decidable P] : + (ite P f₁ f₂ ⊗ₘ g) = (ite P (f₁ ⊗ₘ g) (f₂ ⊗ₘ g) : M₁ ⊗[R] M₃ →ₗ[R] M₂ ⊗[R] M₄) := by + split_ifs <;> simp diff --git a/LeanPool/Monlib4/Preq/RCLikeLe.lean b/LeanPool/Monlib4/Preq/RCLikeLe.lean new file mode 100644 index 0000000000..0b80acf324 --- /dev/null +++ b/LeanPool/Monlib4/Preq/RCLikeLe.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Analysis.RCLike.Basic + +/-! + # Extra lemmas on RCLike + + This file contains extra lemmas on `RCLike`. +-/ + +namespace RCLike + +variable {𝕜 : Type _} [RCLike 𝕜] + +open scoped ComplexOrder + +alias le_def := le_iff_re_im +alias lt_def := lt_iff_re_im +alias nonneg_def := nonneg_iff +alias pos_def := pos_iff +alias nonpos_def := nonpos_iff +alias neg_def := neg_iff + +theorem nonneg_def' {x : 𝕜} : 0 ≤ x ↔ (re x : 𝕜) = x ∧ 0 ≤ re x := + by + rw [nonneg_def, ← conj_eq_iff_re, conj_eq_iff_im, and_comm] + +theorem real_le_real {x y : ℝ} : (x : 𝕜) ≤ (y : 𝕜) ↔ x ≤ y := by + rw [le_def]; simp_rw [ofReal_re, ofReal_im, and_true] + +theorem real_lt_real {x y : ℝ} : (x : 𝕜) < (y : 𝕜) ↔ x < y := by simp [@lt_def 𝕜] + +theorem zero_le_real {x : ℝ} : 0 ≤ (x : 𝕜) ↔ 0 ≤ x := by + simp_rw [@nonneg_def 𝕜, ofReal_im, and_true, ofReal_re] + +theorem zero_lt_real {x : ℝ} : 0 < (x : 𝕜) ↔ 0 < x := by + simp_rw [@pos_def 𝕜, ofReal_im, and_true, ofReal_re] + +theorem not_le_iff {z w : 𝕜} : ¬z ≤ w ↔ re w < re z ∨ im z ≠ im w := by + rw [le_def, not_and_or, not_le] + +theorem not_lt_iff {z w : 𝕜} : ¬z < w ↔ re w ≤ re z ∨ im z ≠ im w := by + rw [lt_def, not_and_or, not_lt] + +theorem not_le_zero_iff {z : 𝕜} : ¬z ≤ 0 ↔ 0 < re z ∨ im z ≠ 0 := by + simp only [not_le_iff, map_zero] + +theorem not_lt_zero_iff {z : 𝕜} : ¬z < 0 ↔ 0 ≤ re z ∨ im z ≠ 0 := by + simp only [not_lt_iff, map_zero] + +theorem eq_re_ofReal_le {r : ℝ} {z : 𝕜} (hz : (r : 𝕜) ≤ z) : z = re z := by + rw [RCLike.ext_iff] + refine ⟨by simp only [ofReal_re], ?_⟩ + simp only [← (RCLike.le_def.1 hz).2, RCLike.ofReal_im] + +end RCLike diff --git a/LeanPool/Monlib4/Preq/Set.lean b/LeanPool/Monlib4/Preq/Set.lean new file mode 100644 index 0000000000..f81f2353d6 --- /dev/null +++ b/LeanPool/Monlib4/Preq/Set.lean @@ -0,0 +1,14 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.GroupTheory.Subsemigroup.Center +import Mathlib.Algebra.Group.Prod + +/-! +# Set center lemmas + +`Set.center_prod` and `Set.center_pi` are now in Mathlib; this file only re-exports +the relevant imports for downstream files. +-/ diff --git a/LeanPool/Monlib4/Preq/StarAlgEquiv.lean b/LeanPool/Monlib4/Preq/StarAlgEquiv.lean new file mode 100644 index 0000000000..02cfa09b96 --- /dev/null +++ b/LeanPool/Monlib4/Preq/StarAlgEquiv.lean @@ -0,0 +1,268 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Algebra.Star.StarAlgHom +import Mathlib.Algebra.Algebra.Equiv +import Mathlib.LinearAlgebra.Span.Basic +import Mathlib.Algebra.Star.Pi + +/-! + # Some stuff on star algebra equivalences + + This file contains some obvious definitions and lemmas on star algebra equivalences. +-/ + + +theorem AlgEquiv.comp_inj {R A B C : Type _} [CommSemiring R] [Semiring A] [Semiring B] [Semiring C] + [Algebra R A] [Algebra R B] [Algebra R C] (f : B ≃ₐ[R] C) (S T : A →ₗ[R] B) : + f.toLinearMap ∘ₗ S = f.toLinearMap ∘ₗ T ↔ S = T := by + simp only [LinearMap.ext_iff, LinearMap.comp_apply, AlgEquiv.toLinearMap_apply, + f.injective.eq_iff] + +theorem AlgEquiv.inj_comp {R A B C : Type _} [CommSemiring R] [Semiring A] [Semiring B] [Semiring C] + [Algebra R A] [Algebra R B] [Algebra R C] (f : C ≃ₐ[R] A) (S T : A →ₗ[R] B) : + S ∘ₗ f.toLinearMap = T ∘ₗ f.toLinearMap ↔ S = T := + by + refine ⟨fun h => ?_, fun h => by rw [h]⟩ + simp_rw [LinearMap.ext_iff, LinearMap.comp_apply, AlgEquiv.toLinearMap_apply] at h ⊢ + intro x + specialize h (f.symm x) + rw [AlgEquiv.apply_symm_apply] at h + exact h + +/-- The linear map underlying a star algebra equivalence. -/ +@[simps] +def StarAlgEquiv.toLinearMap {R A B : Type*} [Semiring R] [AddCommMonoid A] + [AddCommMonoid B] + [Mul A] [Mul B] [Module R A] [Module R B] [Star A] [Star B] + (f : A ≃⋆ₐ[R] B) : A →ₗ[R] B where + toFun x := f x + map_add' _ _ := by simp only [map_add] + map_smul' _ _ := by simp only [map_smul, RingHom.id_apply] + +theorem StarAlgEquiv.injective {R A B : Type _} [Add A] [Add B] [Mul A] [Mul B] + [SMul R A] [SMul R B] [Star A] [Star B] + (f : A ≃⋆ₐ[R] B) : Function.Injective f := +EquivLike.injective f + +theorem StarAlgEquiv.comp_inj {R A B C : Type*} [Semiring R] [AddCommMonoid A] + [AddCommMonoid B] + [AddCommMonoid C] [Mul B] [Mul C] [Module R A] [Module R B] [Module R C] + [Star B] [Star C] + (f : B ≃⋆ₐ[R] C) (S T : A →ₗ[R] B) : + f.toLinearMap ∘ₗ S = f.toLinearMap ∘ₗ T ↔ S = T := by + simp only [LinearMap.ext_iff, LinearMap.comp_apply, StarAlgEquiv.toLinearMap_apply, + f.injective.eq_iff] + +theorem StarAlgEquiv.inj_comp {R A B C : Type*} [Semiring R] [AddCommMonoid A] + [AddCommMonoid B] + [AddCommMonoid C] [Mul A] [Mul C] [Module R A] [Module R B] [Module R C] + [Star A] [Star C] (f : C ≃⋆ₐ[R] A) (S T : A →ₗ[R] B) : + S ∘ₗ f.toLinearMap = T ∘ₗ f.toLinearMap ↔ S = T := + by + refine ⟨fun h => ?_, fun h => by rw [h]⟩ + simp_rw [LinearMap.ext_iff, LinearMap.comp_apply, StarAlgEquiv.toLinearMap_apply] at h ⊢ + intro x + specialize h (f.symm x) + rw [StarAlgEquiv.apply_symm_apply] at h + exact h + +/-- The linear equivalence underlying a star algebra equivalence. -/ +@[simps] +def StarAlgEquiv.toLinearEquiv {R A B : Type*} [Semiring R] [AddCommMonoid A] + [AddCommMonoid B] + [Mul A] [Mul B] [Module R A] [Module R B] [Star A] [Star B] + (f : A ≃⋆ₐ[R] B) : A ≃ₗ[R] B where + toFun x := f x + invFun x := f.symm x + left_inv x := by simp only [symm_apply_apply] + right_inv x := by simp only [apply_symm_apply] + map_add' _ _ := by simp only [map_add] + map_smul' _ _ := by simp only [map_smul, RingHom.id_apply] + +theorem StarAlgEquiv.symm_apply_eq {R A B : Type _} + [Add A] [Add B] [Mul A] [Mul B] [SMul R A] [SMul R B] [Star A] [Star B] + (f : A ≃⋆ₐ[R] B) (x : A) (y : B) : + f.symm y = x ↔ y = f x := + EquivLike.inv_apply_eq (e := f) + +@[simp] +theorem StarAlgEquiv.ofAlgEquiv_coe {R A B : Type _} + [CommSemiring R] [Semiring A] [Semiring B] + [Algebra R A] [Algebra R B] [Star A] [Star B] + (f : A ≃ₐ[R] B) (hf : ∀ x : A, f (star x) = star (f x)) : + ⇑(StarAlgEquiv.ofAlgEquiv f hf) = f := + rfl + +@[simp] +theorem StarAlgEquiv.ofAlgEquiv_symm_coe {R A B : Type _} + [CommSemiring R] [Semiring A] [Semiring B] + [Algebra R A] [Algebra R B] [Star A] [Star B] + (f : A ≃ₐ[R] B) (hf : ∀ x : A, f (star x) = star (f x)) : + ⇑(StarAlgEquiv.ofAlgEquiv f hf).symm = f.symm := + rfl + +theorem StarAlgEquiv.comp_eq_iff {R E₁ E₂ E₃ : Type _} [CommSemiring R] + [AddCommMonoid E₁] [AddCommMonoid E₂] [AddCommMonoid E₃] + [Module R E₁] [Module R E₂] [Module R E₃] [Star E₁] [Star E₂] [Mul E₁] [Mul E₂] + (f : E₁ ≃⋆ₐ[R] E₂) (x : E₂ →ₗ[R] E₃) (y : E₁ →ₗ[R] E₃) : + x ∘ₗ f.toLinearMap = y ↔ x = y ∘ₗ f.symm.toLinearMap := + by + constructor + · intro h + ext1 + rw [← h] + simp only [LinearMap.comp_apply, StarAlgEquiv.toLinearMap_apply, + StarAlgEquiv.apply_symm_apply] + · rintro rfl + ext1 + simp only [LinearMap.comp_apply, StarAlgEquiv.toLinearMap_apply, StarAlgEquiv.symm_apply_apply] + +theorem AlgEquiv.map_eq_zero_iff {R E₁ E₂ : Type _} [CommSemiring R] [Semiring E₁] [Semiring E₂] + [Algebra R E₁] [Algebra R E₂] (f : E₁ ≃ₐ[R] E₂) (x : E₁) : f x = 0 ↔ x = 0 := + RingEquiv.map_eq_zero_iff f.toRingEquiv + +theorem StarAlgEquiv.map_eq_zero_iff {R A B : Type _} + [NonUnitalNonAssocSemiring A] [NonUnitalNonAssocSemiring B] + [SMul R A] [SMul R B] [Star A] [Star B] + (f : A ≃⋆ₐ[R] B) (x : A) : + f x = 0 ↔ x = 0 := + RingEquiv.map_eq_zero_iff f.toRingEquiv + +theorem IsIdempotentElem.mulEquiv {H₁ H₂ : Type _} [Mul H₁] [Mul H₂] + -- (f : H₁ ≃* H₂) + {F : Type*} [EquivLike F H₁ H₂] [MulEquivClass F H₁ H₂] {f : F} {x : H₁} : + IsIdempotentElem (f x) ↔ IsIdempotentElem x := by + simp_rw [IsIdempotentElem, ← _root_.map_mul] + exact EmbeddingLike.apply_eq_iff_eq f + +theorem IsIdempotentElem.algEquiv {R H₁ H₂ : Type _} [CommSemiring R] [Semiring H₁] [Semiring H₂] + [Algebra R H₁] [Algebra R H₂] (f : H₁ ≃ₐ[R] H₂) {x : H₁} : + IsIdempotentElem (f x) ↔ IsIdempotentElem x := +IsIdempotentElem.mulEquiv + +theorem IsIdempotentElem.starAlgEquiv {R A B : Type _} + [Add A] [Add B] [Mul A] [Mul B] [SMul R A] [SMul R B] [Star A] [Star B] + (f : A ≃⋆ₐ[R] B) {x : A} : + IsIdempotentElem (f x) ↔ IsIdempotentElem x := +IsIdempotentElem.mulEquiv + +lemma _root_.isIdempotentElem_pi_iff + {ι : Type*} {A : ι → Type*} [Π i, Mul (A i)] {a : Π i, A i} : + IsIdempotentElem a ↔ ∀ i, IsIdempotentElem (a i) := +by + simp only [IsIdempotentElem, Pi.mul_def, funext_iff] + +theorem AlgEquiv.eq_apply_iff_symm_eq {R A B : Type _} [CommSemiring R] [Semiring A] [Semiring B] + [Algebra R A] [Algebra R B] (f : A ≃ₐ[R] B) {a : B} {b : A} : a = f b ↔ f.symm a = b := + by + have : ∀ e : A ≃ B, a = e b ↔ e.symm a = b := + by + intro e + rw [← Equiv.apply_eq_iff_eq e, Equiv.apply_symm_apply] + exact this f + +theorem StarAlgEquiv.eq_apply_iff_symm_eq {R A B : Type _} + [Add A] [Add B] [Mul A] [Mul B] [SMul R A] [SMul R B] [Star A] [Star B] + (f : A ≃⋆ₐ[R] B) {a : B} {b : A} : + a = f b ↔ f.symm a = b := +by + rw [eq_comm] + nth_rw 2 [eq_comm] + exact Equiv.apply_eq_iff_eq_symm_apply f.toRingEquiv.toEquiv + +lemma AlgEquiv.apply_eq_iff_eq {R A B : Type*} [CommSemiring R] [Semiring A] [Algebra R A] + [Semiring B] [Algebra R B] + (f : A ≃ₐ[R] B) {x y : A} : + f x = f y ↔ x = y := +Equiv.apply_eq_iff_eq f.toEquiv + +lemma MulEquiv.image_center {F A B : Type*} [Semigroup A] [Semigroup B] + [EquivLike F A B] [MulEquivClass F A B] + (f : F) : + f '' (Set.center A) = Set.center B := +by + let f' : A ≃* B := f + ext x + symm + calc x ∈ Set.center B ↔ ∀ y, y * x = x * y := Semigroup.mem_center_iff + _ ↔ ∀ y, f'.symm y * f'.symm x = f'.symm x * f'.symm y := by + simp only [MulEquiv.apply_eq_iff_eq, ← map_mul] + _ ↔ ∀ y, y * f'.symm x = f'.symm x * y := by + refine ⟨fun h y => ?_, fun h y => h _⟩ + specialize h (f' y) + simp_all only [MulEquiv.symm_apply_apply] + _ ↔ f'.symm x ∈ Set.center A := Semigroup.mem_center_iff.symm + _ ↔ x ∈ f '' Set.center A := Set.mem_image_equiv.symm + +instance + {F R A B : Type*} [Monoid R] [NonUnitalNonAssocSemiring A] [NonUnitalNonAssocSemiring B] + [DistribMulAction R A] [DistribMulAction R B] + [EquivLike F A B] [NonUnitalAlgHomClass F R A B] : + MulEquivClass F A B where + map_mul := MulHomClass.map_mul + +lemma NonUnitalAlgEquiv.image_span_center {F R A B : Type*} [Semiring R] + [NonUnitalSemiring A] [NonUnitalSemiring B] [Module R A] [Module R B] + [EquivLike F A B] [NonUnitalAlgHomClass F R A B] (f : F) : + f '' (Submodule.span R (Set.center A)) = Submodule.span R (Set.center B) := +by + change (LinearMapClass.linearMap f : A → B) '' + (Submodule.span R (Set.center A) : Set A) = + (Submodule.span R (Set.center B) : Set B) + rw [← Submodule.map_coe (LinearMapClass.linearMap f) (Submodule.span R (Set.center A)), + Submodule.map_span] + rw [show (LinearMapClass.linearMap f : A → B) '' Set.center A = Set.center B by + change f '' Set.center A = Set.center B + exact MulEquiv.image_center f] + +lemma NonUnitalAlgEquiv.map_span_center {F R A B : Type*} [Semiring R] + [NonUnitalSemiring A] [NonUnitalSemiring B] [Module R A] [Module R B] + [EquivLike F A B] [NonUnitalAlgHomClass F R A B] (f : F) : + Submodule.map (LinearMapClass.linearMap f) (Submodule.span R (Set.center A)) = + Submodule.span R (Set.center B) := +by + rw [Submodule.map_span] + rw [show (LinearMapClass.linearMap f : A → B) '' Set.center A = Set.center B by + change f '' Set.center A = Set.center B + exact MulEquiv.image_center f] + +/-- Assemble pointwise star algebra equivalences into a star algebra equivalence of dependent +functions. -/ +@[simps apply] +def StarAlgEquiv.piCongrRight {R ι : Type*} {A₁ A₂ : ι → Type*} + [(i : ι) → Add (A₁ i)] [(i : ι) → Add (A₂ i)] + [(i : ι) → Mul (A₁ i)] [(i : ι) → Mul (A₂ i)] + [(i : ι) → Star (A₁ i)] [(i : ι) → Star (A₂ i)] + [(i : ι) → SMul R (A₁ i)] [(i : ι) → SMul R (A₂ i)] + (e : (i : ι) → A₁ i ≃⋆ₐ[R] A₂ i) : + ((i : ι) → A₁ i) ≃⋆ₐ[R] (i : ι) → A₂ i where + toFun x j := e j (x j) + invFun x j := (e j).symm (x j) + map_add' _ _ := by simp only [Pi.add_apply, map_add]; rfl + map_mul' _ _ := by simp only [Pi.mul_apply, map_mul]; rfl + map_star' _ := by simp only [Pi.star_apply, map_star]; rfl + map_smul' _ _ := by simp only [Pi.smul_apply, map_smul]; rfl + left_inv _ := by simp only [symm_apply_apply] + right_inv _ := by simp only [apply_symm_apply] + +theorem AlgEquiv.coe_comp + {R A₁ A₂ A₃ : Type*} [CommSemiring R] [Semiring A₁] [Semiring A₂] + [Semiring A₃] [Algebra R A₁] [Algebra R A₂] [Algebra R A₃] + (e : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) : + e₂.toLinearMap.comp e.toLinearMap = (e.trans e₂).toLinearMap := +rfl + +variable {R A B : Type*} [CommSemiring R] [Semiring A] [Semiring B] [Algebra R A] [Algebra R B] + +theorem AlgEquiv.refl_toLinearMap : + (AlgEquiv.refl (R := R) (A₁ := A)).toLinearMap = LinearMap.id := +rfl +theorem AlgEquiv.symm_comp_toLinearMap (e : A ≃ₐ[R] B) : + e.symm.toLinearMap ∘ₗ e.toLinearMap = LinearMap.id := +by simp only [coe_comp, self_trans_symm]; rfl +theorem AlgEquiv.comp_symm_toLinearMap (e : A ≃ₐ[R] B) : + e.toLinearMap ∘ₗ e.symm.toLinearMap = LinearMap.id := +by simp only [coe_comp, symm_trans_self]; rfl diff --git a/LeanPool/Monlib4/QuantumGraph.lean b/LeanPool/Monlib4/QuantumGraph.lean new file mode 100644 index 0000000000..17a99c08d6 --- /dev/null +++ b/LeanPool/Monlib4/QuantumGraph.lean @@ -0,0 +1,18 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.QuantumGraph.Basic +import LeanPool.Monlib4.QuantumGraph.Degree +import LeanPool.Monlib4.QuantumGraph.Example +import LeanPool.Monlib4.QuantumGraph.Grad +import LeanPool.Monlib4.QuantumGraph.Iso +import LeanPool.Monlib4.QuantumGraph.Matrix +import LeanPool.Monlib4.QuantumGraph.Nontracial +import LeanPool.Monlib4.QuantumGraph.OfClassicalGraph +import LeanPool.Monlib4.QuantumGraph.PiMat +import LeanPool.Monlib4.QuantumGraph.PiMatFinTwo +import LeanPool.Monlib4.QuantumGraph.QamA +import LeanPool.Monlib4.QuantumGraph.QamAExample +import LeanPool.Monlib4.QuantumGraph.ToProjections diff --git a/LeanPool/Monlib4/QuantumGraph/Basic.lean b/LeanPool/Monlib4/QuantumGraph/Basic.lean new file mode 100644 index 0000000000..9ba0d4eb14 --- /dev/null +++ b/LeanPool/Monlib4/QuantumGraph/Basic.lean @@ -0,0 +1,1196 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.SchurMul +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Symm +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.Lemmas +import LeanPool.Monlib4.LinearAlgebra.Ips.MinimalProj +import LeanPool.Monlib4.LinearAlgebra.PosMapIsReal +import LeanPool.Monlib4.LinearAlgebra.MyBimodule +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.Submodule +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.PhiMap +import LeanPool.Monlib4.LinearAlgebra.Ips.Functional +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.TensorProduct +import Mathlib.LinearAlgebra.TensorProduct.Opposite +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Subset +-- import LeanPool.Monlib4.LinearAlgebra.QuantumSet.TensorProduct + +local notation x " ⊗ₘ " y => TensorProduct.map x y + +instance FiniteDimensional.innerProductSpace.complete {E : Type*} [NormedAddCommGroup E] + [InnerProductSpace ℂ E] [FiniteDimensional ℂ E] : CompleteSpace E := + FiniteDimensional.complete ℂ E + +theorem symmMap_apply_schurMul {A B : Type*} [starAlgebra A] [starAlgebra B] + [hA : QuantumSet A] [QuantumSet B] (f g : A →ₗ[ℂ] B) : + symmMap ℂ _ _ (f •ₛ g) = (symmMap _ _ _ g) •ₛ (symmMap _ _ _ f) := +by + rw [symmMap_apply, schurMul_real, schurMul_adjoint] + rfl + +alias QuantumSet.modAut_star := starAlgebra.modAut_star +alias QuantumSet.modAut_zero := starAlgebra.modAut_zero + +theorem Psi_apply_linearMap_comp_linearMap_of_commute_modAut {A B C D : Type*} + [ha : starAlgebra A] [hb : starAlgebra B] + [hc : starAlgebra C] [hd : starAlgebra D] + [hA : QuantumSet A] [hB : QuantumSet B] + [hC : QuantumSet C] [hD : QuantumSet D] + {f : A →ₗ[ℂ] B} {g : D →ₗ[ℂ] C} + (t r : ℝ) + (hf : (hb.modAut t).toLinearMap.comp f = f.comp (ha.modAut t).toLinearMap) + (hg : (hc.modAut r).toLinearMap.comp g = g.comp (hd.modAut r).toLinearMap) + (x : C →ₗ[ℂ] A) : + QuantumSet.Psi t r (f ∘ₗ x ∘ₗ g) + = (f ⊗ₘ ((symmMap ℂ _ _).symm g).op) (QuantumSet.Psi t r x) := +by + apply_fun LinearMap.adjoint at hg + simp_rw [LinearMap.adjoint_comp, ← LinearMap.star_eq_adjoint, + isSelfAdjoint_iff.mp (QuantumSet.modAut_isSelfAdjoint _)] at hg + have : ∀ a b, QuantumSet.Psi t r (f ∘ₗ (rankOne ℂ a b).toLinearMap ∘ₗ g) + = (f ⊗ₘ ((symmMap ℂ _ _).symm g).op) (QuantumSet.Psi t r (rankOne ℂ a b).toLinearMap) := + fun _ _ => by + simp_rw [LinearMap.ext_iff, LinearMap.comp_apply, AlgEquiv.toLinearMap_apply] at hf hg + simp only [symmMap_symm_apply, + QuantumSet.Psi_apply, LinearMap.rankOne_comp, LinearMap.comp_rankOne, + QuantumSet.Psi_toFun_apply, TensorProduct.map_tmul, + QuantumSet.modAut_star, LinearMap.real_apply, + LinearMap.op_apply, + MulOpposite.unop_op, neg_neg, star_star, ← hf, ← hg, QuantumSet.modAut_star] + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne x + simp only [LinearMap.comp_sum, LinearMap.sum_comp, map_sum, this] + +theorem symmMap_symm_comp {A B C : Type*} [starAlgebra A] + [starAlgebra B] [hA : QuantumSet A] [hB : QuantumSet B] + [starAlgebra C] [QuantumSet C] + (x : A →ₗ[ℂ] B) (y : C →ₗ[ℂ] A) : + (symmMap ℂ _ _).symm (x ∘ₗ y) = (symmMap ℂ _ _).symm y ∘ₗ (symmMap ℂ _ _).symm x := +by + simp only [symmMap_symm_apply, LinearMap.adjoint_comp, LinearMap.real_comp] + +theorem linearMap_map_Psi_of_commute_modAut {A B C D : Type*} + [ha : starAlgebra A] [hb : starAlgebra B] + [hc : starAlgebra C] [hd : starAlgebra D] + [hA : QuantumSet A] [hB : QuantumSet B] + [hC : QuantumSet C] [hD : QuantumSet D] + {f : A →ₗ[ℂ] B} {g : Cᵐᵒᵖ →ₗ[ℂ] Dᵐᵒᵖ} + (t r : ℝ) + (hf : (hb.modAut t).toLinearMap.comp f = f.comp (ha.modAut t).toLinearMap) + (hg : (hd.modAut r).toLinearMap.comp g.unop = g.unop.comp (hc.modAut r).toLinearMap) + (x : C →ₗ[ℂ] A) : + (f ⊗ₘ g) (QuantumSet.Psi t r x) = QuantumSet.Psi t r (f ∘ₗ x ∘ₗ ((symmMap ℂ _ _) g.unop)) := +by + rw [Psi_apply_linearMap_comp_linearMap_of_commute_modAut, + LinearEquiv.symm_apply_apply, LinearMap.unop_op] + · exact hf + · apply_fun (symmMap ℂ _ _).symm using LinearEquiv.injective _ + simp_rw [symmMap_symm_comp, LinearEquiv.symm_apply_apply, + symmMap_symm_apply, ← LinearMap.star_eq_adjoint, + isSelfAdjoint_iff.mp (QuantumSet.modAut_isSelfAdjoint _), + QuantumSet.modAut_real, AlgEquiv.linearMap_comp_eq_iff, starAlgebra.modAut_symm, + neg_neg, LinearMap.comp_assoc, ← hg, ← starAlgebra.modAut_symm, + ← AlgEquiv.comp_linearMap_eq_iff] + +@[simp] +theorem LinearMap.op_real {K E F : Type*} + [AddCommMonoid E] [StarAddMonoid E] [AddCommMonoid F] [StarAddMonoid F] + [Semiring K] [Module K E] [Module K F] [InvolutiveStar K] [StarModule K E] [StarModule K F] + (φ : E →ₗ[K] F) : + φ.op.real = φ.real.op := +rfl + +lemma modAut_map_comp_Psi {A B : Type*} [ha : starAlgebra A] [hb : starAlgebra B] + [hA : QuantumSet A] [hB : QuantumSet B] (t₁ r₁ t₂ r₂ : ℝ) : + ((hb.modAut t₁).toLinearMap ⊗ₘ ((ha.modAut r₁).op.toLinearMap)) ∘ₗ (hA.Psi t₂ r₂).toLinearMap + = (hA.Psi (t₁ + t₂) (-r₁ + r₂)).toLinearMap := +by + apply LinearMap.ext_of_rank_one' + intro _ _ + simp_rw [LinearMap.comp_apply, LinearEquiv.coe_toLinearMap] + rw [linearMap_map_Psi_of_commute_modAut, AlgEquiv.op_toLinearMap, + LinearMap.op_unop, symmMap_apply, LinearMap.rankOne_comp', + LinearMap.comp_rankOne] + · simp_rw [AlgEquiv.toLinearMap_apply, QuantumSet.Psi_apply, QuantumSet.Psi_toFun_apply, + QuantumSet.modAut_real, AlgEquiv.toLinearMap_apply, QuantumSet.modAut_apply_modAut, add_comm] + · ext + simp only [LinearMap.comp_apply, AlgEquiv.toLinearMap_apply, + QuantumSet.modAut_apply_modAut, add_comm] + · ext + simp only [AlgEquiv.op_toLinearMap, LinearMap.op_unop, + LinearMap.comp_apply, AlgEquiv.toLinearMap_apply, + QuantumSet.modAut_apply_modAut, add_comm] +lemma lTensor_modAut_comp_Psi {A B : Type*} [ha : starAlgebra A] [hb : starAlgebra B] + [hA : QuantumSet A] [hB : QuantumSet B] (t₂ r₁ r₂ : ℝ) : + (LinearMap.lTensor B (ha.modAut r₁).op.toLinearMap) + ∘ₗ (hA.Psi t₂ r₂).toLinearMap + = (hA.Psi t₂ (-r₁ + r₂)).toLinearMap := +by + nth_rw 2 [← zero_add t₂] + rw [← modAut_map_comp_Psi, QuantumSet.modAut_zero] + rfl +lemma rTensor_modAut_comp_Psi {A B : Type*} [ha : starAlgebra A] [hb : starAlgebra B] + [hA : QuantumSet A] [hB : QuantumSet B] (t₁ t₂ r₂ : ℝ) : + (LinearMap.rTensor Aᵐᵒᵖ (hb.modAut t₁).toLinearMap) + ∘ₗ (hA.Psi t₂ r₂).toLinearMap + = (hA.Psi (t₁ + t₂) r₂).toLinearMap := +by + nth_rw 2 [← zero_add r₂] + rw [← neg_zero, ← modAut_map_comp_Psi, QuantumSet.modAut_zero] + rfl + +open scoped TensorProduct +variable {A B : Type*} [ha : starAlgebra A] [hb : starAlgebra B] + [hA : QuantumSet A] [hB : QuantumSet B] + +private noncomputable def rmulMapLmul_apply_Upsilon_apply_aux : + (A →ₗ[ℂ] B) →ₗ[ℂ] ((A ⊗[ℂ] B) →ₗ[ℂ] (A ⊗[ℂ] B)) where + toFun x := + { toFun := fun y => Upsilon (x •ₛ Upsilon.symm y) + map_add' := fun _ _ => by simp only [LinearEquiv.trans_symm, map_add, LinearEquiv.trans_apply, + LinearEquiv.TensorProduct.map_symm_apply, LinearEquiv.symm_symm, QuantumSet.Psi_symm_apply, + schurMul_apply_apply, QuantumSet.Psi_apply, LinearEquiv.TensorProduct.map_apply] + map_smul' := fun _ _ => by simp only [LinearEquiv.trans_symm, LinearMapClass.map_smul, + LinearEquiv.trans_apply, LinearEquiv.TensorProduct.map_symm_apply, LinearEquiv.symm_symm, + QuantumSet.Psi_symm_apply, schurMul_apply_apply, QuantumSet.Psi_apply, + LinearEquiv.TensorProduct.map_apply, RingHom.id_apply] } + map_add' _ _ := by + simp_rw [map_add, LinearMap.add_apply, map_add]; rfl + map_smul' _ _ := by + simp_rw [map_smul, LinearMap.smul_apply, map_smul]; rfl + +private lemma rmulMapLmul_apply_Upsilon_apply_aux_apply + (x : A →ₗ[ℂ] B) (y : A ⊗[ℂ] B) : + rmulMapLmul_apply_Upsilon_apply_aux x y = Upsilon (x •ₛ Upsilon.symm y) := +rfl + +theorem rmulMapLmul_apply_Upsilon_apply (x : A →ₗ[ℂ] B) (y : A ⊗[ℂ] B) : + (rmulMapLmul (Upsilon x)) y = Upsilon (x •ₛ Upsilon.symm y) := +by + rw [← rmulMapLmul_apply_Upsilon_apply_aux_apply, ← LinearEquiv.coe_toLinearMap, + ← LinearMap.comp_apply] + revert y x + simp_rw [← LinearMap.ext_iff] + apply LinearMap.ext_of_rank_one' + intro x y + rw [TensorProduct.ext_iff'] + intro a b + simp only [rmulMapLmul_apply_Upsilon_apply_aux_apply, LinearMap.comp_apply, + LinearEquiv.coe_toLinearMap, Upsilon_rankOne, Upsilon_symm_tmul, + schurMul.apply_rankOne, rmulMapLmul_apply, + TensorProduct.map_tmul, star_mul, map_mul, + starAlgebra.modAut_star, QuantumSet.modAut_apply_modAut, + add_neg_cancel, QuantumSet.modAut_zero, star_star] + rfl + + +theorem QuantumSet.comm_op_modAut_map_comul_one_eq_Psi (r : ℝ) (f : A →ₗ[ℂ] B) : + (TensorProduct.comm _ _ _) + ((TensorProduct.map ((op ℂ).toLinearMap ∘ₗ (modAut r).toLinearMap) f) (Coalgebra.comul 1)) = + Psi 0 (k A + 1 - r) f := +by + calc (TensorProduct.comm ℂ Aᵐᵒᵖ B) + ((TensorProduct.map + ((op ℂ).toLinearMap ∘ₗ (ha.modAut r).toLinearMap) f) (Coalgebra.comul 1 : A ⊗[ℂ] A)) + = (TensorProduct.comm ℂ Aᵐᵒᵖ B) + ((TensorProduct.map ((op ℂ).toLinearMap ∘ₗ (modAut r).toLinearMap) (unop ℂ).toLinearMap) + (tenSwap ℂ (Psi 0 (k A + 1) f))) := ?_ + _ = (TensorProduct.comm _ _ _) + ((TensorProduct.map (op ℂ).toLinearMap (unop ℂ).toLinearMap) + (tenSwap ℂ + ((LinearMap.lTensor _ (modAut r).op.toLinearMap) + (Psi 0 (k A + 1) f)))) := ?_ + _ = (TensorProduct.comm _ _ _) + ((TensorProduct.map (op ℂ).toLinearMap (unop ℂ).toLinearMap) + (tenSwap ℂ + (Psi 0 (k A + 1 - r) f))) := ?_ + _ = Psi 0 (k A + 1 - r) f := ?_ + · rw [← tenSwap_lTensor_comul_one_eq_Psi, tenSwap_apply_tenSwap] + simp_rw [LinearMap.lTensor, TensorProduct.map_apply_map_apply] + simp only [LinearMap.comp_id, ← LinearMap.comp_assoc, + unop_comp_op, LinearMap.one_comp] + · congr 1 + simp_rw [AlgEquiv.op_toLinearMap, tenSwap_apply_lTensor, + ← LinearMap.comp_apply, + ← LinearEquiv.coe_toLinearMap, ← LinearMap.comp_apply, + ← LinearMap.comp_assoc, LinearMap.map_comp_rTensor] + · simp_rw [← LinearEquiv.coe_toLinearMap, ← LinearMap.comp_apply, + lTensor_modAut_comp_Psi] + ring_nf + · suffices ∀ x, + (TensorProduct.comm ℂ Aᵐᵒᵖ B) (((op ℂ).toLinearMap ⊗ₘ (unop ℂ).toLinearMap) (tenSwap ℂ x)) + = x by + rw [this] + intro x + simp_rw [← LinearEquiv.coe_toLinearMap, ← LinearMap.comp_apply] + nth_rw 2 [← LinearMap.id_apply (R := ℂ) x] + revert x + rw [← LinearMap.ext_iff, TensorProduct.ext_iff'] + intro a b + simp only [LinearMap.coe_comp, LinearEquiv.coe_coe, Function.comp_apply, LinearMap.id_coe, + id_eq, tenSwap_apply, TensorProduct.map_tmul, + TensorProduct.comm_tmul] + rfl + +open scoped TensorProduct + +@[simp] +theorem AlgEquiv.symm_one {R A : Type*} [CommSemiring R] [Semiring A] [Algebra R A] : + (1 : A ≃ₐ[R] A).symm = 1 := +rfl +theorem LinearMap.lTensor_eq {R M N P : Type*} [CommSemiring R] + [AddCommMonoid M] [AddCommMonoid N] [AddCommMonoid P] [Module R M] + [Module R N] [Module R P] (f : N →ₗ[R] P) : + lTensor M f = TensorProduct.map LinearMap.id f := +rfl +theorem AlgEquiv.symm_op + {R A B : Type*} [CommSemiring R] [Semiring A] [Semiring B] [Algebra R A] [Algebra R B] + (f : A ≃ₐ[R] B) : + (AlgEquiv.op f).symm = AlgEquiv.op f.symm := +rfl + +alias QuantumSet.modAut_trans := starAlgebra.modAut_trans + +variable {A B : Type*} [ha : starAlgebra A] [hb : starAlgebra B] + [hA : QuantumSet A] [hB : QuantumSet B] +lemma isReal_iff_Psi (f : A →ₗ[ℂ] B) (t r : ℝ) : + LinearMap.IsReal f ↔ star (hA.Psi t r f) = hA.Psi (-t) ((2 * hA.k) + 1 - r) f := +by + simp_rw [LinearMap.isReal_iff, ← Function.Injective.eq_iff (hA.Psi t r).injective, + Psi.real_apply] + nth_rw 1 [← Function.Injective.eq_iff + (AlgEquiv.TensorProduct.map (hb.modAut (- (2 * t))) + (AlgEquiv.op (ha.modAut (2 * r - 1)))).injective] + simp_rw [← AlgEquiv.TensorProduct.map_toLinearMap, AlgEquiv.toLinearMap_apply, + AlgEquiv.TensorProduct.map_map_toLinearMap, AlgEquiv.op_trans, + QuantumSet.modAut_trans] + simp only [add_neg_cancel, QuantumSet.modAut_zero] + simp only [← LinearEquiv.coe_toLinearMap, ← AlgEquiv.toLinearMap_apply, + ← LinearMap.comp_apply, AlgEquiv.TensorProduct.map_toLinearMap, modAut_map_comp_Psi, + two_mul, neg_add, neg_sub, sub_add] + ring_nf + simp only [← AlgEquiv.TensorProduct.map_toLinearMap, + AlgEquiv.toLinearMap_apply] + rw [eq_comm, AlgEquiv.eq_apply_iff_symm_eq, AlgEquiv.TensorProduct.map_symm, + AlgEquiv.symm_one, ← AlgEquiv.toLinearMap_apply, + AlgEquiv.TensorProduct.map_toLinearMap, AlgEquiv.one_toLinearMap, + Module.End.one_eq_id, ← LinearMap.lTensor_eq, + AlgEquiv.symm_op, starAlgebra.modAut_symm] + simp_rw [← LinearMap.comp_apply, LinearEquiv.coe_toLinearMap] + rw [lTensor_modAut_comp_Psi, neg_neg, eq_comm, LinearEquiv.coe_toLinearMap] + ring_nf + + +lemma isReal_iff_Psi_isSelfAdjoint (f : A →ₗ[ℂ] B) : + LinearMap.IsReal f ↔ IsSelfAdjoint (hA.Psi 0 (hA.k + (1 / 2)) f) := +by + rw [_root_.IsSelfAdjoint, isReal_iff_Psi f 0 (hA.k + 1/2)] + ring_nf + +theorem real_Upsilon_toBimodule {f : A →ₗ[ℂ] B} (gns₁ : hA.k = 0) + (gns₂ : hB.k = 0) : + (Upsilon f.real).toIsBimoduleMap.1 + = LinearMap.adjoint + (Upsilon f).toIsBimoduleMap.1 := +by + have : ∀ (a : B) (b : A), + (Upsilon (rankOne ℂ a b).toLinearMap.real).toIsBimoduleMap.1 + = LinearMap.adjoint (Upsilon (rankOne ℂ a b).toLinearMap).toIsBimoduleMap.1 := + by + intro a b + simp_rw [Upsilon_rankOne, LinearEquiv.trans_apply, QuantumSet.Psi_apply, + rankOne_real, QuantumSet.Psi_toFun_apply, + LinearEquiv.TensorProduct.map_apply, + TensorProduct.toIsBimoduleMap_apply_coe, + rmulMapLmul_apply, TensorProduct.map_adjoint, + TensorProduct.comm_tmul, TensorProduct.map_tmul, + LinearEquiv.lTensor_tmul, rmulMapLmul_apply, + rmul_adjoint, QuantumSet.modAut_star, QuantumSet.modAut_apply_modAut, + lmul_adjoint,] + ring_nf + simp only [star_star, LinearEquiv.coe_coe, unop_apply, + MulOpposite.unop_op, starAlgebra.modAut_zero, AlgEquiv.one_apply, op_apply, + MulOpposite.op_star, MulOpposite.unop_star, gns₁, gns₂, neg_zero] + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne f + simp only [map_sum, LinearMap.real_sum, Submodule.coe_sum, this] + + +/-- A Schur projection is an idempotent real map for the Schur product. -/ +class schurProjection (f : A →ₗ[ℂ] B) : + Prop where + /-- Schur idempotence. -/ + isIdempotentElem : f •ₛ f = f + /-- Realness of the underlying linear map. -/ + isReal : LinearMap.IsReal f + +theorem Coalgebra.comul_mul_of_gns (gns : k A = 0) (a b : A) : + Coalgebra.comul (R := ℂ) (a * b) = ∑ i, (a * onb i) ⊗ₜ[ℂ] (star (onb i) * b) := +by + calc (Coalgebra.comul (R := ℂ) ∘ₗ LinearMap.mul' ℂ A) (a ⊗ₜ b) + = (PhiMap (LinearMap.id : A →ₗ[ℂ] A)).1 (a ⊗ₜ b) := + by + congr + simp_rw [PhiMap_apply, TensorProduct.toIsBimoduleMap_apply_coe, + rmulMapLmul_apply_Upsilon_eq, LinearMap.lTensor_id, + LinearMap.rTensor_id, LinearMap.id_comp] + exact (@FrobeniusAlgebra.lTensor_mul_comp_rTensor_comul_eq_comul_comp_mul _ _ _ _ + (QuantumSet.isFrobeniusAlgebra)).symm + _ = rmulMapLmul (Upsilon (1 : A →ₗ[ℂ] A)) (a ⊗ₜ b) := rfl + _ = LinearMap.adjoint (rmulMapLmul (Upsilon (1 : A →ₗ[ℂ] A))) (a ⊗ₜ b) := + by + congr 1 + nth_rw 1 [← LinearMap.real_one] + exact real_Upsilon_toBimodule gns gns + _ = ∑ i, + LinearMap.adjoint (TensorProduct.map (LinearMap.adjoint (rmul (onb i))) (lmul (onb i))) (a + ⊗ₜ b) := + by + rw [← LinearMap.sum_apply] + congr 1 + rw [← rankOne.sum_orthonormalBasis_eq_id_lm onb] + simp_rw [map_sum, Upsilon_rankOne, rmulMapLmul_apply, ← rmul_adjoint] + _ = ∑ i, TensorProduct.map (rmul (onb i)) (LinearMap.adjoint (lmul (onb i))) (a ⊗ₜ b) := + by + simp only [TensorProduct.map_adjoint, LinearMap.adjoint_adjoint] + _ = ∑ i, (a * onb i) ⊗ₜ[ℂ] (star (onb i) * b) := + by + simp_rw [lmul_adjoint, gns, neg_zero, QuantumSet.modAut_zero] + rfl + +open scoped InnerProductSpace +open Coalgebra in +theorem QuantumSet.counit_isReal {A : Type*} [starAlgebra A] [QuantumSet A] : + LinearMap.IsReal (counit (R := ℂ) (A := A)) := +by + intro x + calc counit (star x) = ⟪x, 1⟫_ℂ := + by simp only [QuantumSet.inner_eq_counit, map_one, mul_one] + _ = star ⟪1, x⟫_ℂ := (inner_conj_symm _ _).symm + _ = star (counit x) := by simp_rw [QuantumSet.inner_eq_counit'] + +theorem QuantumSet.innerOne_map_one_isReal_ofReal + {A B : Type*} [starAlgebra A] [starAlgebra B] [QuantumSet A] [QuantumSet B] + {f : A →ₗ[ℂ] B} (hf : LinearMap.IsReal f) : + ⟪1, f 1⟫_ℂ = Complex.re ⟪1, f 1⟫_ℂ := +by + rw [eq_comm, ← Complex.conj_eq_iff_re] + simp_rw [Coalgebra.inner_eq_counit'] + nth_rw 1 [← star_one] + rw [hf, QuantumSet.counit_isReal] + simp +/-- The star-algebra structure transported to the opposite algebra. -/ +@[reducible] +noncomputable def starAlgebra.mulOpposite {A : Type*} [starAlgebra A] : + starAlgebra Aᵐᵒᵖ where + modAut r := (modAut (-r)).op + modAut_trans _ _ := by simp [AlgEquiv.op_trans, add_comm] + modAut_star _ x := by simp [← MulOpposite.op_star] +attribute [local instance] starAlgebra.mulOpposite +/-- The inner-product algebra structure transported to the opposite algebra. -/ +@[reducible] +noncomputable def InnerProductAlgebra.mulOpposite {A : + Type*} [starAlgebra A] [InnerProductAlgebra A] : + InnerProductAlgebra (Aᵐᵒᵖ) where + norm_smul_le c x := by + change ‖MulOpposite.op (c • x.unop)‖ ≤ ‖c‖ * ‖x.unop‖ + simpa using InnerProductAlgebra.norm_smul_le c x.unop + norm_sq_eq_inner x := by + rw [MulOpposite.inner_eq] + change ‖x.unop‖ ^ 2 = RCLike.re ⟪x.unop, x.unop⟫_ℂ + exact InnerProductAlgebra.norm_sq_eq_inner x.unop + dist_eq x y := by + simpa only [MulOpposite.unop_neg, MulOpposite.unop_add] using + InnerProductAlgebra.dist_eq x.unop y.unop + conj_symm x y := by + simp only [MulOpposite.inner_eq] + exact InnerProductAlgebra.conj_symm x.unop y.unop + add_left x y z := by + simp only [MulOpposite.inner_eq, MulOpposite.unop_add] + exact InnerProductAlgebra.add_left x.unop y.unop z.unop + smul_left x y r := by + simp only [MulOpposite.inner_eq, MulOpposite.unop_smul] + exact InnerProductAlgebra.smul_left x.unop y.unop r +attribute [local instance] InnerProductAlgebra.mulOpposite +noncomputable instance QuantumSet.mulOpposite {A : Type*} [starAlgebra A] [QuantumSet A] + [kms : Fact (k A = -(1 / 2))] : + QuantumSet Aᵐᵒᵖ where + modAut_isSymmetric r x y := by + simp only [MulOpposite.inner_eq] + exact QuantumSet.modAut_isSymmetric (-r) x.unop y.unop + k := k A + inner_star_left _ _ _ := by + simp only [MulOpposite.inner_eq, modAut, MulOpposite.unop_mul, MulOpposite.unop_star, + AlgEquiv.op_apply_apply, MulOpposite.unop_op] + rw [inner_conj_left] + simp [kms.out] + norm_num + inner_conj_left _ _ _ := by + simp only [MulOpposite.inner_eq, modAut, MulOpposite.unop_mul, MulOpposite.unop_star, + AlgEquiv.op_apply_apply, MulOpposite.unop_op] + rw [inner_star_left] + simp [kms.out] + norm_num + n := n A + n_isFintype := n_isFintype + n_isDecidableEq := n_isDecidableEq + onb := onb.mulOpposite +attribute [local instance] QuantumSet.mulOpposite +noncomputable instance CoalgebraStruct.mulOpposite {A : + Type*} [Semiring A] [Algebra ℂ A] [CoalgebraStruct ℂ A] : + CoalgebraStruct ℂ Aᵐᵒᵖ where + comul := (Algebra.TensorProduct.opAlgEquiv ℂ ℂ A A).symm.toLinearMap ∘ₗ Coalgebra.comul.op + counit := (MulOpposite.opLinearEquiv ℂ).symm.toLinearMap ∘ₗ Coalgebra.counit.op +theorem Coalgebra.counit_mulOpposite_eq {A : + Type*} [Semiring A] [Algebra ℂ A] [CoalgebraStruct ℂ A] (a : Aᵐᵒᵖ) : + (Coalgebra.counit (R := ℂ) (A := Aᵐᵒᵖ)) a = Coalgebra.counit a.unop := +rfl + +theorem QuantumSet.counit_isFaithful {A : Type*} [starAlgebra A] [QuantumSet A] : + Module.Dual.IsFaithful (Coalgebra.counit (R := ℂ) (A := A)) := +by + intro x + simp only [← QuantumSet.inner_eq_counit'] + rw [← inner_conj_symm, QuantumSet.inner_star_left, star_star, mul_one, ← add_halves (- k A), + ← modAut_apply_modAut, ← modAut_isSymmetric, inner_conj_symm, inner_self_eq_zero, + map_eq_zero_iff _ (AlgEquiv.injective _)] + +/-- Opposite-algebra version of a module dual functional. -/ +def Module.Dual.op {R A : Type*} [CommSemiring R] [AddCommMonoid A] [Module R A] + (f : Module.Dual R A) : + Module.Dual R Aᵐᵒᵖ := +(unop R).toLinearMap ∘ₗ LinearMap.op f +theorem Module.Dual.op_apply {R A : Type*} [CommSemiring R] [AddCommMonoid A] [Module R A] + (f : Module.Dual R A) (x : Aᵐᵒᵖ) : + Module.Dual.op f x = f x.unop := +rfl + +theorem Coalgebra.counit_moduleDualOp_eq {A : Type*} [Semiring A] [Algebra ℂ A] + [CoalgebraStruct ℂ A] : + Module.Dual.op (Coalgebra.counit (R := ℂ) (A := A)) = counit (R := ℂ) (A := Aᵐᵒᵖ) := +rfl + +/-- Star-ring structure on the opposite of a star ring. -/ +@[reducible] +def MulOpposite.starRing {A : Type*} [NonUnitalNonAssocSemiring A] [hA : StarRing A] : + StarRing Aᵐᵒᵖ where + star_add _ _ := star_add _ _ + +attribute [local instance] MulOpposite.starRing + +theorem Module.Dual.op_isFaithful_iff {𝕜 A : Type*} [RCLike 𝕜] [NonUnitalSemiring A] + [StarRing A] [Module 𝕜 A] (φ : Module.Dual 𝕜 A) : + Module.Dual.IsFaithful φ ↔ Module.Dual.IsFaithful (Module.Dual.op φ) := +by + simp only [Module.Dual.IsFaithful, Module.Dual.op_apply, MulOpposite.unop_mul, + MulOpposite.unop_star] + refine ⟨fun h a => ?_, fun h a => ?_⟩ + · simpa [star_star, MulOpposite.unop_eq_zero_iff] using h (star a.unop) + · simpa [star_star, MulOpposite.op_eq_zero_iff] using h (star (MulOpposite.op a)) + +theorem QuantumSet.counit_op_isFaithful {A : Type*} [starAlgebra A] [QuantumSet A] : + Module.Dual.IsFaithful (Coalgebra.counit (R := ℂ) (A := Aᵐᵒᵖ)) := +(Module.Dual.op_isFaithful_iff _).mp QuantumSet.counit_isFaithful + +noncomputable instance QuantumSet.tensorOp_self {A : + Type*} [starAlgebra A] [QuantumSet A] [kms : Fact (k A = -(1 / 2))] : + QuantumSet (A ⊗[ℂ] Aᵐᵒᵖ) := +QuantumSet.tensorProduct (h := Fact.mk rfl) + +theorem MulOpposite.norm_eq {𝕜 H : Type*} [RCLike 𝕜] [NormedAddCommGroup H] + (x : Hᵐᵒᵖ) : ‖x‖ = ‖x.unop‖ := +rfl + +theorem Coalgebra.comul_mul (a b : A) : + Coalgebra.comul (R := ℂ) (a * b) + = ∑ i, (a * (modAut ((k A / 2)) (hA.onb i))) + ⊗ₜ[ℂ] (star (modAut ((k A / 2)) (hA.onb i)) * b) := +by + rw [QuantumSet.comul_of_subset 0] + letI := hA.instSubset 0 + simp only [LinearMap.comp_apply, AlgEquiv.toLinearMap_apply, map_mul] + rw [Coalgebra.comul_mul_of_gns rfl] + simp only [map_sum] + congr + ext i + rw [QuantumSet.toSubset_onb 0] + simp only [zero_div, neg_zero, add_zero] + rw [← QuantumSet.toSubset_algEquiv_isReal] + simp only [← map_mul, TensorProduct.map_tmul, AlgEquiv.toLinearMap_apply, + AlgEquiv.symm_apply_apply] + +open scoped ComplexOrder +theorem schurProjection.isPosMap [PartialOrder A] [PartialOrder B] + [StarOrderedRing B] + (h₁ : ∀ ⦃a : A⦄, 0 ≤ a ↔ ∃ (b : A), a = star b * b) + {f : A →ₗ[ℂ] B} + (hf : schurProjection f) : + LinearMap.IsPosMap f := +by + revert hf + rintro ⟨h1, h2⟩ x hx + obtain ⟨a, b, rfl⟩ := h₁.mp hx + rw [← h1, schurMul_apply_apply] + simp_rw [LinearMap.comp_apply] + rw [Coalgebra.comul_mul] + simp_rw [map_sum, TensorProduct.map_tmul, LinearMap.mul'_apply] + nth_rw 2 [← star_star a] + simp_rw [← star_mul, h2 _] + exact Finset.sum_nonneg (fun _ _ => mul_star_self_nonneg _) + +theorem schurIdempotent.isSchurProjection_iff_isPosMap + [PartialOrder A] [PartialOrder B] + [StarOrderedRing A] [StarOrderedRing B] + (h₁ : ∀ ⦃a : A⦄, 0 ≤ a ↔ ∃ (b : A), a = star b * b) + (hh : isEquivToPiMat A) {f : A →ₗ[ℂ] B} (hf : f •ₛ f = f) : + schurProjection f ↔ LinearMap.IsPosMap f := +⟨fun h => h.isPosMap h₁, + fun h => ⟨hf, isReal_of_isPosMap_of_starAlgEquiv_piMat hh h⟩⟩ + +/-- A quantum graph is a Schur-idempotent endomorphism of a quantum set. -/ +class QuantumGraph (A : Type*) [starAlgebra A] [hA : QuantumSet A] [CoalgebraStruct ℂ A] + (f : A →ₗ[ℂ] A) : Prop where + /-- Schur idempotence of the adjacency map. -/ + isIdempotentElem : f •ₛ f = f + +theorem quantumGraph_iff {A : Type*} [starAlgebra A] [QuantumSet A] [CoalgebraStruct ℂ A] + {f : A →ₗ[ℂ] A} : + QuantumGraph A f ↔ f •ₛ f = f := +⟨fun ⟨h⟩ => h, fun h => ⟨h⟩⟩ + +/-- Predicate asserting that a quantum graph is real. -/ +class QuantumGraph.IsReal {A : Type*} [starAlgebra A] [hA : QuantumSet A] [CoalgebraStruct ℂ A] + {f : A →ₗ[ℂ] A} (h : QuantumGraph A f) : Prop where + /-- Realness of the adjacency map. -/ + isReal : LinearMap.IsReal f + +/-- A real quantum graph bundles Schur idempotence and realness. -/ +class QuantumGraph.Real (A : Type*) [starAlgebra A] [hA : QuantumSet A] [CoalgebraStruct ℂ A] + (f : A →ₗ[ℂ] A) : Prop where + /-- Schur idempotence of the adjacency map. -/ + isIdempotentElem : f •ₛ f = f + /-- Realness of the adjacency map. -/ + isReal : LinearMap.IsReal f + +theorem QuantumGraph.real_iff {A : Type*} [starAlgebra A] [QuantumSet A] [CoalgebraStruct ℂ A] + {f : A →ₗ[ℂ] A} : + QuantumGraph.Real A f ↔ f •ₛ f = f ∧ LinearMap.IsReal f := +⟨fun h => ⟨h.1, h.2⟩, fun h => ⟨h.1, h.2⟩⟩ + +theorem quantumGraphReal_iff_schurProjection {f : A →ₗ[ℂ] A} : + QuantumGraph.Real A f ↔ schurProjection f := +⟨fun h => ⟨h.isIdempotentElem, h.isReal⟩, + fun h => ⟨h.isIdempotentElem, h.isReal⟩⟩ + +theorem QuantumGraph.Real.toQuantumGraph {f : A →ₗ[ℂ] A} (h : QuantumGraph.Real A f) : + QuantumGraph A f := +⟨h.isIdempotentElem⟩ + +theorem quantumGraphReal_iff_Psi_isIdempotentElem_and_isSelfAdjoint {f : A →ₗ[ℂ] A} : + QuantumGraph.Real A f ↔ + (IsIdempotentElem (hA.Psi 0 (hA.k + 1/2) f) ∧ + IsSelfAdjoint (hA.Psi 0 (hA.k + 1/2) f)) := +by + rw [← schurIdempotent_iff_Psi_isIdempotentElem, ← isReal_iff_Psi_isSelfAdjoint] + exact ⟨fun h => ⟨h.1, h.2⟩, fun h => ⟨h.1, h.2⟩⟩ + +theorem schurMul_Upsilon_toBimodule {f g : A →ₗ[ℂ] B} : + (Upsilon (f •ₛ g)).toIsBimoduleMap.1 + = (Upsilon f).toIsBimoduleMap.1 * (Upsilon g).toIsBimoduleMap.1 := +by + have : ∀ (a c : B) (b d : A), + (Upsilon ((rankOne ℂ a b).toLinearMap •ₛ (rankOne ℂ c d).toLinearMap)).toIsBimoduleMap.1 + = (Upsilon (rankOne ℂ a b).toLinearMap).toIsBimoduleMap.1 + * (Upsilon (rankOne ℂ c d).toLinearMap).toIsBimoduleMap.1 := + by + intro a c b d + simp_rw [schurMul.apply_rankOne, Upsilon_rankOne, TensorProduct.toIsBimoduleMap_apply_coe, + rmulMapLmul_apply, ← TensorProduct.map_mul, + rmul_eq_mul, Module.End.mul_eq_comp, ← LinearMap.mulRight_mul, + lmul_eq_mul, ← LinearMap.mulLeft_mul, ← map_mul, ← star_mul] + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne f + obtain ⟨γ, δ, rfl⟩ := LinearMap.exists_sum_rankOne g + simp only [map_sum, LinearMap.sum_apply, Finset.sum_mul, + Finset.mul_sum, Submodule.coe_sum, this] + +theorem quantumGraphReal_iff_Upsilon_toBimodule_orthogonalProjection + {f : A →ₗ[ℂ] A} (gns : hA.k = 0) : + QuantumGraph.Real A f ↔ + ContinuousLinearMap.IsOrthogonalProjection + (LinearMap.toContinuousLinearMap + (Upsilon f).toIsBimoduleMap.1) := +by + rw [LinearMap.isOrthogonalProjection_iff, + IsIdempotentElem, ← schurMul_Upsilon_toBimodule, + isSelfAdjoint_iff, LinearMap.star_eq_adjoint, + ← real_Upsilon_toBimodule gns gns] + simp_rw [Subtype.val_inj, (LinearEquiv.injective _).eq_iff, + ← LinearMap.isReal_iff] + exact ⟨fun h => ⟨h.1, h.2⟩, fun h => ⟨h.1, h.2⟩⟩ + +section + +theorem StarAlgEquiv.toAlgEquiv_toAlgHom_toLinearMap + {R A B : Type*} [CommSemiring R] [Semiring A] [Semiring B] [Algebra R A] [Algebra R B] + [Star A] [Star B] (f : A ≃⋆ₐ[R] B) : + f.toAlgEquiv.toAlgHom.toLinearMap = f.toLinearMap := +rfl + +attribute [local instance] Algebra.ofIsScalarTowerSmulCommClass + +/-- Real quantum graphs are preserved by isometric star-algebra equivalence conjugation. -/ +theorem QuantumGraph.Real_conj_starAlgEquiv + {A B : Type*} [starAlgebra A] [starAlgebra B] + [QuantumSet A] [QuantumSet B] + {x : A →ₗ[ℂ] A} (hx : QuantumGraph.Real A x) + {f : A ≃⋆ₐ[ℂ] B} (hf : Isometry f) : + QuantumGraph.Real _ (f.toLinearMap ∘ₗ x ∘ₗ (LinearMap.adjoint f.toLinearMap)) := +by + constructor + · rw [← StarAlgEquiv.toAlgEquiv_toAlgHom_toLinearMap, + QuantumSet.schurMul_algHom_comp_algHom_adjoint, hx.1] + · suffices LinearMap.adjoint f.toLinearMap = f.symm.toLinearMap from ?_ + · simp_rw [this] + change LinearMap.IsReal + (f.toAlgEquiv.toLinearMap ∘ₗ x ∘ₗ f.symm.toAlgEquiv.toLinearMap) + exact (LinearMap.real_starAlgEquiv_conj_iff x f).mpr hx.isReal + · exact QuantumSet.starAlgEquiv_isometry_iff_adjoint_eq_symm.mp hf + +theorem Submodule.eq_iff_orthogonalProjection_eq + {E : Type u_1} [NormedAddCommGroup E] [InnerProductSpace ℂ E] {U : Submodule ℂ E} + {V : Submodule ℂ E} [CompleteSpace E] [CompleteSpace ↥U] [CompleteSpace ↥V] : + U = V ↔ orthogonalProjection' U = orthogonalProjection' V := +by simp_rw [le_antisymm_iff, orthogonalProjection.is_le_iff_subset] + +open scoped FiniteDimensional in +theorem Submodule.adjoint_subtype {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℂ E] + [FiniteDimensional ℂ E] {U : Submodule ℂ E} : + LinearMap.adjoint U.subtype = (orthogonalProjection U).toLinearMap := +by + rw [← Submodule.adjoint_subtypeL] + rfl + +theorem Submodule.map_orthogonalProjection_self {E : + Type*} [NormedAddCommGroup E] [InnerProductSpace ℂ E] + [FiniteDimensional ℂ E] {U : Submodule ℂ E} : + Submodule.map (orthogonalProjection U).toLinearMap U = ⊤ := +by + ext x + simp only [mem_map, ContinuousLinearMap.coe_coe, mem_top, iff_true] + use x + simp only [SetLike.coe_mem, orthogonalProjection_mem_subspace_eq_self, and_self] + +theorem orthogonalProjection_submoduleMap {E E' : + Type*} [NormedAddCommGroup E] [InnerProductSpace ℂ E] + [NormedAddCommGroup E'] [InnerProductSpace ℂ E'] + {U : Submodule ℂ E} + [FiniteDimensional ℂ E] [FiniteDimensional ℂ E'] (f : E ≃ₗᵢ[ℂ] E') : + (orthogonalProjection' (Submodule.map (f.toLinearEquiv : E →ₗ[ℂ] E') U)).toLinearMap + = f.toLinearMap + ∘ₗ (orthogonalProjection' U).toLinearMap + ∘ₗ f.symm.toLinearMap := +by + ext x + exact Submodule.starProjection_map_apply f U x + +theorem orthogonalProjection_submoduleMap_isometry {E E' : + Type*} [NormedAddCommGroup E] [InnerProductSpace ℂ E] + [NormedAddCommGroup E'] [InnerProductSpace ℂ E'] + {U : Submodule ℂ E} + [FiniteDimensional ℂ E] [FiniteDimensional ℂ E'] + {f : E ≃ₗ[ℂ] E'} (hf : Isometry f) : + (orthogonalProjection' (Submodule.map f.toLinearMap U)).toLinearMap + = f.toLinearMap + ∘ₗ (orthogonalProjection' U).toLinearMap + ∘ₗ f.symm.toLinearMap := +by + let f' : E ≃ₗᵢ[ℂ] E' := ⟨f, (isometry_iff_norm _).mp hf⟩ + simpa using orthogonalProjection_submoduleMap f' + +instance + StarAlgEquivClass.instLinearMapClass + {R A B : Type*} [Semiring R] [AddCommMonoid A] [AddCommMonoid B] + [Mul A] [Mul B] [Module R A] [Module R B] [Star A] [Star B] + {F : Type*} [EquivLike F A B] [NonUnitalAlgEquivClass F R A B] + [StarHomClass F A B] : + LinearMapClass F R A B := +SemilinearMapClass.mk + +theorem orthogonalProjection_submoduleMap_isometry_starAlgEquiv + {E E' : Type*} [NormedAddCommGroup E] [InnerProductSpace ℂ E] + [NormedAddCommGroup E'] [InnerProductSpace ℂ E'] + {U : Submodule ℂ E} + [Mul E] [Mul E'] [Star E] [Star E'] + [FiniteDimensional ℂ E] [FiniteDimensional ℂ E'] + {f : E ≃⋆ₐ[ℂ] E'} (hf : Isometry f) : + (orthogonalProjection' (Submodule.map f.toLinearMap U)).toLinearMap + = f.toLinearMap + ∘ₗ (orthogonalProjection' U).toLinearMap + ∘ₗ f.symm.toLinearMap := +by + have hf' : Isometry f.toLinearEquiv := hf + calc (orthogonalProjection' (Submodule.map f.toLinearMap U)).toLinearMap + = (orthogonalProjection' (Submodule.map f.toLinearEquiv.toLinearMap U)).toLinearMap := rfl + _ = f.toLinearEquiv.toLinearMap + ∘ₗ (orthogonalProjection' U).toLinearMap + ∘ₗ f.toLinearEquiv.symm.toLinearMap := orthogonalProjection_submoduleMap_isometry hf' + +theorem orthogonalProjection_submoduleMap' {E E' : + Type*} [NormedAddCommGroup E] [InnerProductSpace ℂ E] + [NormedAddCommGroup E'] [InnerProductSpace ℂ E'] + {U : Submodule ℂ E} + [FiniteDimensional ℂ E] [FiniteDimensional ℂ E'] (f : E' ≃ₗᵢ[ℂ] E) : + (orthogonalProjection' (Submodule.map (f.symm.toLinearEquiv : E →ₗ[ℂ] E') U)).toLinearMap + = f.symm.toLinearMap + ∘ₗ (orthogonalProjection' U).toLinearMap + ∘ₗ f.toLinearMap := +orthogonalProjection_submoduleMap f.symm + +end +section + +/-- The submodule whose orthogonal projection corresponds to `Upsilon f`. -/ +noncomputable def QuantumGraph.Real.upsilonSubmodule + {f : A →ₗ[ℂ] A} (gns : hA.k = 0) + (hf : QuantumGraph.Real A f) : + Submodule ℂ (A ⊗[ℂ] A) := +Classical.choose + (orthogonal_projection_iff.mpr + (And.comm.mp + (ContinuousLinearMap.isOrthogonalProjection_iff'.mp + ((quantumGraphReal_iff_Upsilon_toBimodule_orthogonalProjection gns).mp hf)))) + +instance QuantumGraph.Real.upsilonSubmodule.hasOrthogonalProjection {f : A →ₗ[ℂ] A} + (gns : hA.k = 0) (hf : QuantumGraph.Real A f) : + (upsilonSubmodule gns hf).HasOrthogonalProjection := by + letI : CompleteSpace (upsilonSubmodule gns hf) := + FiniteDimensional.complete ℂ (upsilonSubmodule gns hf) + infer_instance + +theorem QuantumGraph.Real.upsilonOrthogonalProjection {f : A →ₗ[ℂ] A} + (gns : hA.k = 0) + (hf : QuantumGraph.Real A f) : + orthogonalProjection' (upsilonSubmodule gns hf) + = LinearMap.toContinuousLinearMap + ((TensorProduct.toIsBimoduleMap (Upsilon f)).1) := +by + unfold upsilonSubmodule + exact Classical.choose_spec + (orthogonal_projection_iff.mpr + (And.comm.mp + (ContinuousLinearMap.isOrthogonalProjection_iff'.mp + ((quantumGraphReal_iff_Upsilon_toBimodule_orthogonalProjection gns).mp hf)))) + +theorem QuantumGraph.Real.upsilonOrthogonalProjection' {f : A →ₗ[ℂ] A} + (gns : hA.k = 0) + (hf : QuantumGraph.Real A f) : + (orthogonalProjection' (upsilonSubmodule gns hf)).toLinearMap + = rmulMapLmul ((orthogonalProjection' (upsilonSubmodule gns hf)).toLinearMap 1) := +by + symm + rw [← LinearMap.isBimoduleMap_iff', ← LinearMap.mem_isBimoduleMaps_iff] + rw [upsilonOrthogonalProjection gns hf, LinearMap.coe_toContinuousLinearMap] + exact Submodule.coe_mem (TensorProduct.toIsBimoduleMap (Upsilon f)) + +/-- A canonical orthonormal basis of `upsilonSubmodule`. -/ +noncomputable def QuantumGraph.Real.upsilonOrthonormalBasis {f : A →ₗ[ℂ] A} + (gns : hA.k = 0) (hf : QuantumGraph.Real A f) : + OrthonormalBasis (Fin (Module.finrank ℂ (upsilonSubmodule gns hf))) ℂ (upsilonSubmodule gns hf) := +stdOrthonormalBasis ℂ (upsilonSubmodule gns hf) + +theorem OrthonormalBasis.tensorProduct_toBasis {𝕜 E F : Type*} + [RCLike 𝕜] [NormedAddCommGroup E] [NormedAddCommGroup F] + [InnerProductSpace 𝕜 E] [InnerProductSpace 𝕜 F] + [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] + {ι₁ ι₂ : Type*} [Fintype ι₁] [Fintype ι₂] + (b₁ : OrthonormalBasis ι₁ 𝕜 E) (b₂ : OrthonormalBasis ι₂ 𝕜 F) : + (b₁.tensorProduct b₂).toBasis = b₁.toBasis.tensorProduct b₂.toBasis := +by aesop + +theorem TensorProduct.of_orthonormalBasis_eq_span + {𝕜 E F : Type*} [RCLike 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] + [NormedAddCommGroup F] [InnerProductSpace 𝕜 F] (x : TensorProduct 𝕜 E F) + {ι₁ ι₂ : Type*} [Fintype ι₁] [Fintype ι₂] (b₁ : OrthonormalBasis ι₁ 𝕜 E) + (b₂ : OrthonormalBasis ι₂ 𝕜 F) : + letI := Module.Basis.finiteDimensional_of_finite b₁.toBasis + letI := Module.Basis.finiteDimensional_of_finite b₂.toBasis + x = ∑ i : ι₁, ∑ j : ι₂, ((b₁.tensorProduct b₂).repr x) (i, j) • b₁ i ⊗ₜ[𝕜] b₂ j := +by + nth_rw 1 [TensorProduct.of_basis_eq_span x b₁.toBasis b₂.toBasis] + rfl + +/-- Coordinates of a tensor as a product-indexed family of scalar-weighted basis pairs. -/ +noncomputable def TensorProduct.of_orthonormalBasis_prod + {𝕜 E F : Type*} [RCLike 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] + [NormedAddCommGroup F] [InnerProductSpace 𝕜 F] (x : TensorProduct 𝕜 E F) + {ι₁ ι₂ : Type*} [Fintype ι₁] [Fintype ι₂] (b₁ : OrthonormalBasis ι₁ 𝕜 E) + (b₂ : OrthonormalBasis ι₂ 𝕜 F) : + letI := Module.Basis.finiteDimensional_of_finite b₁.toBasis + letI := Module.Basis.finiteDimensional_of_finite b₂.toBasis + (ι₁ × ι₂) → (E × F) := +letI := Module.Basis.finiteDimensional_of_finite b₁.toBasis +letI := Module.Basis.finiteDimensional_of_finite b₂.toBasis +fun (i,j) => ((((b₁.tensorProduct b₂).repr x) (i,j)) • b₁ i, b₂ j) + +@[simp] +theorem TensorProduct.of_othonormalBasis_prod_eq + {𝕜 E F : Type*} [RCLike 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] + [NormedAddCommGroup F] [InnerProductSpace 𝕜 F] (x : E ⊗[𝕜] F) + {ι₁ ι₂ : Type*} [Fintype ι₁] [Fintype ι₂] + (b₁ : OrthonormalBasis ι₁ 𝕜 E) (b₂ : OrthonormalBasis ι₂ 𝕜 F) : + ∑ i : ι₁ × ι₂, + (x.of_orthonormalBasis_prod b₁ b₂ i).1 ⊗ₜ[𝕜] (x.of_orthonormalBasis_prod b₁ b₂ i).2 + = x := +by + nth_rw 3 [TensorProduct.of_orthonormalBasis_eq_span x b₁ b₂] + simp_rw [smul_tmul', Finset.sum_product_univ] + rfl +@[simp] +theorem TensorProduct.of_othonormalBasis_prod_eq' + {𝕜 E F : Type*} [RCLike 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] + [NormedAddCommGroup F] [InnerProductSpace 𝕜 F] (x : E ⊗[𝕜] F) + {ι₁ ι₂ : Type*} [Fintype ι₁] [Fintype ι₂] + (b₁ : OrthonormalBasis ι₁ 𝕜 E) (b₂ : OrthonormalBasis ι₂ 𝕜 F) : + ∑ i : ι₁ × ι₂, + (x.of_orthonormalBasis_prod b₁ b₂ i).1 ⊗ₜ[𝕜] b₂ i.2 + = x := +by + nth_rw 2 [TensorProduct.of_orthonormalBasis_eq_span x b₁ b₂] + simp_rw [smul_tmul', Finset.sum_product_univ] + rfl + +open scoped InnerProductSpace +theorem + QuantumGraph.Real.upsilon_eq {f : A →ₗ[ℂ] A} + (hf : QuantumGraph.Real A f) (gns : hA.k = 0) : + let u := QuantumGraph.Real.upsilonOrthonormalBasis gns hf + let b := hA.onb + let a := fun (x : A ⊗[ℂ] A) => + fun i : (n A) × (n A) => (x.of_orthonormalBasis_prod b b i).1 + f = ∑ i, ∑ j, ⟪(u i : A ⊗[ℂ] A), 1⟫_ℂ + • rankOne ℂ (b j.2) (modAut (-1) (star (a (u i : A ⊗[ℂ] A) j))) := +by + intro u b a + symm + have := Upsilon_symm_tmul (A := A) (B:=A) + simp only [gns, neg_zero, zero_sub] at this + simp_rw [ContinuousLinearMap.coe_sum, ContinuousLinearMap.coe_smul, + ← this, ← map_smul] + simp_rw [← map_sum, ← Finset.smul_sum, a, TensorProduct.of_othonormalBasis_prod_eq', + ← rankOne_apply (𝕜 := ℂ) (1 : A ⊗[ℂ] A), + ← ContinuousLinearMap.sum_apply, + ← OrthonormalBasis.orthogonalProjection'_eq_sum_rankOne] + rw [upsilonOrthogonalProjection] + simp_rw [TensorProduct.toIsBimoduleMap_apply_coe, + LinearMap.coe_toContinuousLinearMap', + rmulMapLmul_apply_one, LinearEquiv.symm_apply_apply] + +theorem + QuantumGraph.Real.upsilon_eq' {f : A →ₗ[ℂ] A} + (hf : QuantumGraph.Real A f) (gns : hA.k = 0) : + let u := QuantumGraph.Real.upsilonOrthonormalBasis gns hf + let b := hA.onb + let a := fun (x : A ⊗[ℂ] A) => + fun i : (n A) × (n A) => (x.of_orthonormalBasis_prod b b i).1 + f = ∑ i, ∑ j, ⟪1, (u i : A ⊗[ℂ] A)⟫_ℂ + • rankOne ℂ (star (b j.2)) (a (u i : A ⊗[ℂ] A) j) := +by + intro u b a + nth_rw 1 [← (LinearMap.isReal_iff _).mp hf.isReal] + nth_rw 1 [QuantumGraph.Real.upsilon_eq hf gns] + simp only [ContinuousLinearMap.coe_sum, ContinuousLinearMap.coe_smul, + LinearMap.real_sum, LinearMap.real_smul, rankOne_real, gns, mul_zero, neg_zero, + zero_sub, QuantumSet.modAut_star, QuantumSet.modAut_apply_modAut, + add_neg_cancel, QuantumSet.modAut_zero, star_star, AlgEquiv.one_apply, + TensorProduct.inner_conj_symm] + rfl + +/-- Linear map sending a tensor to its first-coordinate orthonormal-basis expansion data. -/ +noncomputable def TensorProduct.of_orthonormalBasis_prod₁_lm + {𝕜 E F : Type*} [RCLike 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] + [NormedAddCommGroup F] [InnerProductSpace 𝕜 F] + {ι₁ ι₂ : Type*} [Fintype ι₁] [Fintype ι₂] (b₁ : OrthonormalBasis ι₁ 𝕜 E) + (b₂ : OrthonormalBasis ι₂ 𝕜 F) : + (E ⊗[𝕜] F) →ₗ[𝕜] ((ι₁ × ι₂) → E) := +by + letI := Module.Basis.finiteDimensional_of_finite b₁.toBasis + letI := Module.Basis.finiteDimensional_of_finite b₂.toBasis + exact + { toFun := fun x i => (x.of_orthonormalBasis_prod b₁ b₂ i).1 + map_add' := fun _ _ => by simp [of_orthonormalBasis_prod, add_smul]; rfl + map_smul' := fun _ _ => by ext; simp [of_orthonormalBasis_prod, smul_smul] } + +lemma TensorProduct.of_orthonormalBasis_prod₁_lm_eq + {𝕜 E F : Type*} [RCLike 𝕜] [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] + [NormedAddCommGroup F] [InnerProductSpace 𝕜 F] + {ι₁ ι₂ : Type*} [Fintype ι₁] [Fintype ι₂] (b₁ : OrthonormalBasis ι₁ 𝕜 E) + (b₂ : OrthonormalBasis ι₂ 𝕜 F) (x : E ⊗[𝕜] F) (i : ι₁ × ι₂) : + (TensorProduct.of_orthonormalBasis_prod₁_lm b₁ b₂) x i + = (TensorProduct.of_orthonormalBasis_prod x b₁ b₂ i).1 := +rfl + +theorem + QuantumGraph.Real.upsilon_eq'' {f : A →ₗ[ℂ] A} + (hf : QuantumGraph.Real A f) (gns : hA.k = 0) : + let P := orthogonalProjection' (upsilonSubmodule gns hf); + let a := fun x i => (TensorProduct.of_orthonormalBasis_prod x onb onb i).1 + f = ∑ j : n A × n A, rankOne ℂ (star (onb j.2)) (a (P 1 : A ⊗[ℂ] A) j) := +by + intro P a + nth_rw 1 [QuantumGraph.Real.upsilon_eq' hf gns] + let u := QuantumGraph.Real.upsilonOrthonormalBasis gns hf + simp_rw [P, u.orthogonalProjection'_eq_sum_rankOne] + simp only [ContinuousLinearMap.sum_apply, a, ← TensorProduct.of_orthonormalBasis_prod₁_lm_eq, + map_sum, rankOne_apply, map_smul, + Finset.sum_apply, Pi.smul_apply, map_smulₛₗ, inner_conj_symm] + rw [Finset.sum_comm] + +theorem QuantumSet.starAlgEquiv_commutes_with_modAut_of_isometry'' + {A B : Type*} [hb : starAlgebra B] [ha : starAlgebra A] + [hA : QuantumSet A] [hB : QuantumSet B] {f : A ≃⋆ₐ[ℂ] B} + (hf : Isometry f) : + f.toLinearMap ∘ₗ (modAut (-(2 * k A + 1))).toLinearMap + = (modAut (-(2 * k B + 1))).toLinearMap ∘ₗ f.toLinearMap := +by + rw [← starAlgebra.modAut_symm, AlgEquiv.linearMap_comp_eq_iff, AlgEquiv.symm_symm, + LinearMap.comp_assoc, starAlgEquiv_commutes_with_modAut_of_isometry' hf, + ← LinearMap.comp_assoc, ← starAlgebra.modAut_symm] + simp only [AlgEquiv.coe_comp, AlgEquiv.self_trans_symm] + rfl + +theorem LinearMap.tensorProduct_map_isometry_of {𝕜 A B C D : Type*} [RCLike 𝕜] + [NormedAddCommGroup A] [NormedAddCommGroup B] [NormedAddCommGroup C] [NormedAddCommGroup D] + [InnerProductSpace 𝕜 A] [InnerProductSpace 𝕜 B] [InnerProductSpace 𝕜 C] [InnerProductSpace 𝕜 D] + [FiniteDimensional 𝕜 A] [FiniteDimensional 𝕜 B] [FiniteDimensional 𝕜 C] [FiniteDimensional 𝕜 D] + {f : A →ₗ[𝕜] B} (hf : Isometry f) {g : C →ₗ[𝕜] D} (hg : Isometry g) : + Isometry (f ⊗ₘ g) := +by + rw [isometry_iff_inner] at hf hg + rw [isometry_iff_norm] + intro x + simp_rw [norm_eq_sqrt_re_inner (𝕜 := 𝕜)] + obtain ⟨S, rfl⟩ := TensorProduct.exists_finset x + simp only [map_sum, sum_inner, inner_sum, TensorProduct.map_tmul] + simp only [TensorProduct.inner_tmul, hf, hg, RCLike.mul_re, + Finset.sum_sub_distrib] + +theorem StarAlgEquiv.tensorProduct_map_isometry_of + {A B C D : Type*} [starAlgebra A] [starAlgebra B] [starAlgebra C] [starAlgebra D] + [QuantumSet A] [QuantumSet B] [QuantumSet C] [QuantumSet D] + {f : A ≃⋆ₐ[ℂ] B} (hf : Isometry f) {g : C ≃⋆ₐ[ℂ] D} + (hg : Isometry g) : + Isometry (StarAlgEquiv.TensorProduct.map f g) := +LinearMap.tensorProduct_map_isometry_of hf hg + +/-- Tensor product of two linear isometry equivalences. -/ +@[simps!] +noncomputable def LinearIsometryEquiv.TensorProduct.map {𝕜 A B C D : Type*} [RCLike 𝕜] + [NormedAddCommGroup A] [NormedAddCommGroup B] [NormedAddCommGroup C] [NormedAddCommGroup D] + [InnerProductSpace 𝕜 A] [InnerProductSpace 𝕜 B] [InnerProductSpace 𝕜 C] [InnerProductSpace 𝕜 D] + [FiniteDimensional 𝕜 A] [FiniteDimensional 𝕜 B] [FiniteDimensional 𝕜 C] [FiniteDimensional 𝕜 D] + (f : A ≃ₗᵢ[𝕜] B) (g : C ≃ₗᵢ[𝕜] D) : + A ⊗[𝕜] C ≃ₗᵢ[𝕜] B ⊗[𝕜] D where + toLinearEquiv := LinearEquiv.TensorProduct.map f.toLinearEquiv g.toLinearEquiv + norm_map' := by + rw [← isometry_iff_norm] + exact LinearMap.tensorProduct_map_isometry_of f.isometry g.isometry + +theorem LinearIsometryEquiv.TensorProduct.map_tmul + {𝕜 A B C D : Type*} [RCLike 𝕜] + [NormedAddCommGroup A] [NormedAddCommGroup B] [NormedAddCommGroup C] [NormedAddCommGroup D] + [InnerProductSpace 𝕜 A] [InnerProductSpace 𝕜 B] [InnerProductSpace 𝕜 C] [InnerProductSpace 𝕜 D] + [FiniteDimensional 𝕜 A] [FiniteDimensional 𝕜 B] [FiniteDimensional 𝕜 C] [FiniteDimensional 𝕜 D] + (f : A ≃ₗᵢ[𝕜] B) (g : C ≃ₗᵢ[𝕜] D) (x : A) (y : C) : + (LinearIsometryEquiv.TensorProduct.map f g) (x ⊗ₜ y) = f x ⊗ₜ g y := +rfl + +theorem oneHom_isometry_inner_one_right + {𝕜 A B : Type*} [RCLike 𝕜] + [NormedAddCommGroup A] [NormedAddCommGroup B] + [InnerProductSpace 𝕜 A] [InnerProductSpace 𝕜 B] + [One A] [One B] + {F : Type*} [FunLike F A B] [LinearMapClass F 𝕜 A B] + [OneHomClass F A B] {f : F} + (hf : Isometry f) (x : A) : + ⟪f x, 1⟫_𝕜 = ⟪x, 1⟫_𝕜 := +by + rw [← map_one f] + exact (isometry_iff_inner _).mp hf _ _ + +theorem + QuantumGraph.Real.upsilon_starAlgEquiv_conj_eq + {f : A →ₗ[ℂ] A} (gns : hA.k = 0) (gns₂ : hB.k = 0) + (hf : QuantumGraph.Real A f) + {φ : A ≃⋆ₐ[ℂ] B} (hφ : Isometry φ) : + let u := QuantumGraph.Real.upsilonOrthonormalBasis gns hf + let b := hA.onb + let a := fun (x : A ⊗[ℂ] A) => + fun i : (n A) × (n A) => (x.of_orthonormalBasis_prod b b i).1 + φ.toLinearMap ∘ₗ f ∘ₗ LinearMap.adjoint φ.toLinearMap + = ∑ i, ∑ j, ∑ p, + (⟪φ (a (u i : A ⊗[ℂ] A) p), 1⟫_ℂ + * ⟪φ (b p.2), 1⟫_ℂ) + • rankOne ℂ (φ (b j.2)) (modAut (-1) (star (φ (a (u i : A ⊗[ℂ] A) j)))) := +by + intro u b a + nth_rw 1 [hf.upsilon_eq gns] + simp only [ContinuousLinearMap.coe_sum, + ContinuousLinearMap.coe_smul, + LinearMap.comp_sum, LinearMap.sum_comp, + LinearMap.smul_comp, LinearMap.comp_smul, + LinearMap.comp_rankOne, LinearMap.rankOne_comp'] + simp only [StarAlgEquiv.toLinearMap_apply] + have := QuantumSet.starAlgEquiv_commutes_with_modAut_of_isometry'' hφ + simp only [gns, gns₂, mul_zero, zero_add, LinearMap.ext_iff, + LinearMap.comp_apply, AlgEquiv.toLinearMap_apply, + StarAlgEquiv.toLinearMap_apply] at this + simp_rw [this, map_star, oneHom_isometry_inner_one_right hφ, + ← TensorProduct.inner_tmul, ← Finset.sum_smul, + ← sum_inner, ← Algebra.TensorProduct.one_def, a, TensorProduct.of_othonormalBasis_prod_eq'] + rfl + +theorem LinearMapClass.apply_rankOne_apply + {E₁ E₂ E₃ 𝕜 : Type*} [RCLike 𝕜] + [NormedAddCommGroup E₁] [NormedAddCommGroup E₂] [NormedAddCommGroup E₃] + [InnerProductSpace 𝕜 E₁] [InnerProductSpace 𝕜 E₂] [InnerProductSpace 𝕜 E₃] + {F : Type*} + [FunLike F E₁ E₃] [LinearMapClass F 𝕜 E₁ E₃] + (x : E₁) (y z : E₂) (u : F) : + u ((rankOne 𝕜 x y) z) = rankOne 𝕜 (u x) y z := +by simp only [rankOne_apply, map_smul] + +theorem Upsilon_apply_comp {C D : Type*} [starAlgebra C] [QuantumSet C] + [starAlgebra D] [QuantumSet D] + {f : A →ₗ[ℂ] B} + {g : D →ₗ[ℂ] C} (x : C →ₗ[ℂ] A) + (hcd : k C = k D) + (h : (modAut (k C + 1)).toLinearMap ∘ₗ g = g ∘ₗ (modAut (k D + 1)).toLinearMap) : + Upsilon (f ∘ₗ x ∘ₗ g) = ((symmMap ℂ _ _).symm g ⊗ₘ f) (Upsilon x) := +by + rw [Upsilon] + simp only [LinearEquiv.trans_apply] + rw [Psi_apply_linearMap_comp_linearMap_of_commute_modAut, + ← TensorProduct.map_comm] + · simp only [← LinearEquiv.coe_toLinearMap] + rw [← LinearMap.comp_apply, ← LinearMap.comp_apply] + symm + rw [← LinearMap.comp_apply, ← LinearMap.comp_apply] + congr + rw [TensorProduct.ext_iff'] + intro _ _ + simp only [LinearEquiv.coe_coe, LinearEquiv.coe_lTensor, LinearMap.map_comp_lTensor, + LinearMap.coe_comp, Function.comp_apply, LinearEquiv.TensorProduct.map_apply, + TensorProduct.map_tmul, unop_apply, op_apply, MulOpposite.coe_opLinearEquiv_symm, + MulOpposite.unop_op, symmMap_symm_apply, LinearMap.op_apply, LinearMap.real_apply, + MulOpposite.op_star, MulOpposite.unop_star, LinearMap.lTensor_tmul] + · simp only [starAlgebra.modAut_zero, AlgEquiv.one_toLinearMap]; rfl + · rw [hcd] at h; exact h + +theorem TensorProduct.toIsBimoduleMap_comp + {R H₁ H₂ H₃ H₄ : Type*} [CommSemiring R] + [Semiring H₁] [Semiring H₂] [Semiring H₃] [Semiring H₄] [Algebra R H₁] [Algebra R H₂] + [Algebra R H₃] [Algebra R H₄] + {f : H₁ ≃ₐ[R] H₃} {g : H₂ ≃ₐ[R] H₄} {x : H₁ ⊗[R] H₂} : + (TensorProduct.toIsBimoduleMap + ((AlgEquiv.TensorProduct.map f g) x)).1 + = + (AlgEquiv.TensorProduct.map f g).toLinearMap + ∘ₗ (TensorProduct.toIsBimoduleMap x).1 + ∘ₗ (AlgEquiv.TensorProduct.map f.symm g.symm).toLinearMap := +by + induction x using TensorProduct.induction_on with + | zero => + simp only [map_zero, ZeroMemClass.coe_zero, AlgEquiv.TensorProduct.map_toLinearMap, + LinearMap.zero_comp, LinearMap.comp_zero] + | tmul _ _ => + rw [TensorProduct.toIsBimoduleMap_apply_coe, AlgEquiv.TensorProduct.map_tmul, rmulMapLmul_apply] + rw [TensorProduct.ext_iff'] + intro _ _ + rw [map_tmul, lmul_eq_mul, rmul_eq_mul, ← LinearMap.mulLeft_conj_of_mulEquivClass_apply, + ← LinearMap.mulRight_conj_of_mulEquivClass_apply] + simp only [LinearMap.comp_apply, AlgEquiv.toLinearMap_apply, AlgEquiv.TensorProduct.map_tmul, + toIsBimoduleMap_apply_coe, rmulMapLmul_apply, map_tmul] + rfl + | add _ _ h1 h2 => + simp only [_root_.map_add, LinearMap.IsBimoduleMaps.coe_add, h1, h2, + LinearMap.add_comp, LinearMap.comp_add] + +open scoped FiniteDimensional in +theorem QuantumGraph.Real.upsilon_starAlgEquiv_conj_submodule + {f : A →ₗ[ℂ] A} (gns : hA.k = 0) (gns₂ : hB.k = 0) + (hf : QuantumGraph.Real A f) + {φ : A ≃⋆ₐ[ℂ] B} (hφ : Isometry φ) : + upsilonSubmodule gns₂ (QuantumGraph.Real_conj_starAlgEquiv hf hφ) = + Submodule.map + (StarAlgEquiv.TensorProduct.map φ φ).toLinearMap (upsilonSubmodule gns hf) := +by + rw [Submodule.eq_iff_orthogonalProjection_eq, + ← ContinuousLinearMap.coe_inj, + orthogonalProjection_submoduleMap_isometry_starAlgEquiv + (StarAlgEquiv.tensorProduct_map_isometry_of hφ hφ)] + rw [upsilonOrthogonalProjection, upsilonOrthogonalProjection] + simp only [LinearMap.coe_toContinuousLinearMap] + rw [Upsilon_apply_comp] + · rw [symmMap_symm_apply, LinearMap.adjoint_adjoint, + (LinearMap.isReal_iff _).mp (StarAlgEquiv.isReal _)] + calc (TensorProduct.toIsBimoduleMap ((φ.toLinearMap ⊗ₘ φ.toLinearMap) (Upsilon f))).1 + = (TensorProduct.toIsBimoduleMap ((AlgEquiv.TensorProduct.map φ.toAlgEquiv + φ.toAlgEquiv) (Upsilon f))).1 := rfl + _ = (AlgEquiv.TensorProduct.map φ.toAlgEquiv φ.toAlgEquiv).toLinearMap + ∘ₗ (TensorProduct.toIsBimoduleMap (Upsilon f)).1 + ∘ₗ (AlgEquiv.TensorProduct.map φ.toAlgEquiv.symm φ.toAlgEquiv.symm).toLinearMap := + TensorProduct.toIsBimoduleMap_comp + · simp only [gns, gns₂] + · have := QuantumSet.starAlgEquiv_commutes_with_modAut_of_isometry' hφ + simp only [gns, gns₂, zero_add, mul_zero] at this ⊢ + apply_fun LinearMap.adjoint using LinearEquiv.injective _ + simp only [LinearMap.adjoint_comp, LinearMap.adjoint_adjoint, QuantumSet.modAut_adjoint] + exact this + +theorem PhiMap.apply_real (gns : k B = 0) (A : B →ₗ[ℂ] B) : + (PhiMap (LinearMap.real A)).1 + = LinearMap.adjoint (PhiMap A).1 := +real_Upsilon_toBimodule gns gns + +theorem PhiMap_rankOne (x y : B) : + (PhiMap (rankOne ℂ x y)).1 = + TensorProduct.map (LinearMap.adjoint (rmul y)) (lmul x) := +by + rw [PhiMap_apply, Upsilon_rankOne, TensorProduct.toIsBimoduleMap_apply_coe, + rmulMapLmul_apply, ← rmul_adjoint] + +theorem LinearMap.real_zero : + LinearMap.real (0 : B →ₗ[ℂ] B) = 0 := +by ext; simp only [real_apply, zero_apply, star_zero] + +theorem lTensor_counit_PhiMap_rTensor_algebraLinearMap (x : B →ₗ[ℂ] B) : + (modAut (-k B)).toLinearMap + ∘ₗ (TensorProduct.rid ℂ _).toLinearMap + ∘ₗ (LinearMap.lTensor _ Coalgebra.counit) + ∘ₗ (PhiMap x).1 + ∘ₗ (LinearMap.rTensor _ (Algebra.linearMap ℂ _)) + ∘ₗ (TensorProduct.lid ℂ _).symm.toLinearMap + ∘ₗ (modAut (k B)).toLinearMap + = symmMap ℂ B B x := +by + rw [PhiMap_apply, TensorProduct.toIsBimoduleMap_apply_coe, + rmulMapLmul_apply_Upsilon_eq, symmMap_eq] + simp only [LinearMap.comp_assoc, LinearMap.rTensor_comp, LinearMap.lTensor_comp] + +/-- Linear functional computing the weighted number of edges of a quantum graph. -/ +noncomputable def QuantumGraph.NumOfEdges {A : Type*} [starAlgebra A] [QuantumSet A] : + (A →ₗ[ℂ] A) →ₗ[ℂ] ℂ where + toFun f := ⟪1, f 1⟫_ℂ + map_add' _ _ := by simp only [LinearMap.add_apply, inner_add_right] + map_smul' _ _ := by simp only [LinearMap.smul_apply, inner_smul_right]; rfl + +end + +-- class QuantumGraphHom {A B : Type*} [NormedAddCommGroupOfRing A] +-- [NormedAddCommGroupOfRing B] [hA : QuantumSet A] [hB : QuantumSet B] +-- {x : A →ₗ[ℂ] A} (hx : QuantumGraph A x) +-- {y : B →ₗ[ℂ] B} (hy : QuantumGraph B y) +-- extends A →⋆ₐ[ℂ] B where +-- isGraphHom : +-- y •ₛ (toStarAlgHom.toLinearMap ∘ₗ x ∘ₗ (LinearMap.adjoint toStarAlgHom.toLinearMap)) +-- = toStarAlgHom.toLinearMap ∘ₗ x ∘ₗ (LinearMap.adjoint toStarAlgHom.toLinearMap) diff --git a/LeanPool/Monlib4/QuantumGraph/Degree.lean b/LeanPool/Monlib4/QuantumGraph/Degree.lean new file mode 100644 index 0000000000..80c9869e26 --- /dev/null +++ b/LeanPool/Monlib4/QuantumGraph/Degree.lean @@ -0,0 +1,507 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.PhiMap +import LeanPool.Monlib4.QuantumGraph.Basic +import Mathlib.LinearAlgebra.TensorProduct.Opposite +import LeanPool.Monlib4.QuantumGraph.Example + +open scoped InnerProductSpace ComplexOrder + +theorem schurProjection.innerOne_map_one_nonneg + {A B : Type*} [starAlgebra A] [starAlgebra B] [QuantumSet A] + [QuantumSet B] + [PartialOrder A] [PartialOrder B] [StarOrderedRing A] [StarOrderedRing B] + (h₁ : ∀ ⦃a : A⦄, 0 ≤ a ↔ ∃ (b : A), a = star b * b) + (h₂ : ∀ ⦃a : B⦄, 0 ≤ a ↔ ∃ (b : B), a = star b * b) + {f : A →ₗ[ℂ] B} + (h : schurProjection f) : + 0 ≤ ⟪1, f 1⟫_ℂ := +by + have iPM := schurProjection.isPosMap h₁ h + obtain ⟨x, hx⟩ := h₂.mp (@iPM 1 zero_le_one) + rw [hx, ← inner_conj_symm, QuantumSet.inner_star_left, star_star, mul_one, + inner_conj_symm, ← add_halves (-k B), ← QuantumSet.modAut_apply_modAut, + ← AlgEquiv.toLinearMap_apply, ← LinearMap.adjoint_inner_right, + QuantumSet.modAut_adjoint, AlgEquiv.toLinearMap_apply] + exact inner_self_nonneg' + +theorem QuantumGraph.toSubset_iff {A : Type*} [starAlgebra A] [h : QuantumSet A] {f : + A →ₗ[ℂ] A} (r : ℝ) : + letI := QuantumSet.instSubset (A := A) h r + QuantumGraph (QuantumSet.subset r A) + (LinearMap.toSubsetQuantumSet f r r) ↔ QuantumGraph A f := +by + simp only [quantumGraph_iff, schurMul_toSubsetQuantumSet, LinearMap.toSubsetQuantumSet_inj] + +theorem QuantumGraph.real_toSubset_iff {A : Type*} [starAlgebra A] [h : QuantumSet A] {f : + A →ₗ[ℂ] A} (r : ℝ) : + letI := QuantumSet.instSubset (A := A) h r + QuantumGraph.Real (QuantumSet.subset r A) + (LinearMap.toSubsetQuantumSet f r r) ↔ QuantumGraph.Real A f := +by + simp only [real_iff, LinearMap.toSubsetQuantumSet_isReal_iff, + schurMul_toSubsetQuantumSet, LinearMap.toSubsetQuantumSet_inj] + +theorem QuantumGraph.Real.innerOne_map_one_nonneg + {A : Type*} [starAlgebra A] [hA : QuantumSet A] + [PartialOrder A] [StarOrderedRing A] + (h₁ : ∀ ⦃a : A⦄, 0 ≤ a ↔ ∃ (b : A), a = star b * b) {f : A →ₗ[ℂ] A} + (h : QuantumGraph.Real A f) : + 0 ≤ ⟪1, f 1⟫_ℂ := +schurProjection.innerOne_map_one_nonneg h₁ h₁ (quantumGraphReal_iff_schurProjection.mp h) + +open scoped TensorProduct + +attribute [local instance] starAlgebra.mulOpposite +attribute [local instance] InnerProductAlgebra.mulOpposite +attribute [local instance] QuantumSet.mulOpposite +attribute [local instance] MulOpposite.starRing + +theorem QuantumGraph.Real.innerOne_map_one_eq_zero_iff_of_kms + {A : Type*} [starAlgebra A] [QuantumSet A] {f : A →ₗ[ℂ] A} + (h : QuantumGraph.Real A f) [kms : Fact (k A = -(1 / 2))] : + ⟪1, f 1⟫_ℂ = 0 ↔ f = 0 := +by + rw [oneInner_map_one_eq_oneInner_Psi_map _ 0 (k A + (1/2)), + ← (quantumGraphReal_iff_Psi_isIdempotentElem_and_isSelfAdjoint.mp h).1] + nth_rw 1 [← (quantumGraphReal_iff_Psi_isIdempotentElem_and_isSelfAdjoint.mp h).2] + simp_rw [Coalgebra.inner_eq_counit'] + rw [QuantumSet.counit_isFaithful, map_eq_zero_iff _ (LinearEquiv.injective _)] + +theorem QuantumGraph.Real.innerOne_map_one_eq_zero_iff + {A : Type*} [starAlgebra A] [QuantumSet A] {f : A →ₗ[ℂ] A} (h : QuantumGraph.Real A f) : + ⟪1, f 1⟫_ℂ = 0 ↔ f = 0 := +by + letI := QuantumSet.instSubset (A := A) (by infer_instance) (-(1 / 2)) + have kms : Fact (k (QuantumSet.subset (-(1/2)) A) = -(1/2)) := Fact.mk rfl + let f' := LinearMap.toSubsetQuantumSet f (-(1/2)) (-(1/2)) + rw [QuantumSet.innerOne_map_one_toSubset_eq (- (1/2)) (- (1/2)), + QuantumGraph.Real.innerOne_map_one_eq_zero_iff_of_kms + ((QuantumGraph.real_toSubset_iff (-(1/2))).mpr h) (kms := kms)] + rfl + +theorem QuantumGraph.real_iff_complement'_real + {A : Type*} [starAlgebra A] [QuantumSet A] {f : A →ₗ[ℂ] A} : + QuantumGraph.Real A f ↔ QuantumGraph.Real A (Qam.complement' f) := +by + simp only [real_iff, ← Qam.Nontracial.Complement'.qam, ← Qam.Nontracial.Complement'.qam.isReal] + +theorem QuantumGraph.Real.innerOne_map_one_eq_norm_pow_four_iff_of_kms + {A : Type*} [starAlgebra A] [QuantumSet A] {f : A →ₗ[ℂ] A} + (h : QuantumGraph.Real A f) [kms : Fact (k A = -(1 / 2))] : + ⟪1, f 1⟫_ℂ = ‖(1 : A)‖ ^ 4 ↔ f = rankOne ℂ (1 : A) (1 : A) := +by + have : ‖(1 : A)‖ ^ 4 = ⟪(1 : A ⊗[ℂ] Aᵐᵒᵖ), 1⟫_ℂ := + by + rw [Algebra.TensorProduct.one_def, TensorProduct.inner_tmul] + simp only [inner_self_eq_norm_sq_to_K, MulOpposite.norm_eq, MulOpposite.unop_one] + ring_nf + rfl + rw [oneInner_map_one_eq_oneInner_Psi_map _ 0 (k A + (1/2))] + rw [this] + nth_rw 3 [← QuantumSet.Psi_apply_one_one 0 (k A + ( 1 / 2))] + rw [eq_comm, ← sub_eq_zero, ← inner_sub_right (𝕜 := ℂ) (E := A ⊗[ℂ] Aᵐᵒᵖ), ← map_sub, + ← Qam.completeGraph_eq, ← Qam.complement'_eq] + have := QuantumGraph.real_iff_complement'_real.mp h + rw [← (quantumGraphReal_iff_Psi_isIdempotentElem_and_isSelfAdjoint.mp this).1] + nth_rw 1 [← (quantumGraphReal_iff_Psi_isIdempotentElem_and_isSelfAdjoint.mp this).2] + simp_rw [Coalgebra.inner_eq_counit'] + rw [QuantumSet.counit_isFaithful, map_eq_zero_iff _ (LinearEquiv.injective _), + Qam.complement'_eq, sub_eq_zero, eq_comm] + +theorem QuantumGraph.Real.innerOne_map_one_eq_norm_pow_four_iff + {A : Type*} [starAlgebra A] [QuantumSet A] {f : A →ₗ[ℂ] A} (h : QuantumGraph.Real A f) : + ⟪1, f 1⟫_ℂ = ‖(1 : A)‖ ^ 4 ↔ f = rankOne ℂ (1 : A) (1 : A) := +by + letI := QuantumSet.instSubset (A := A) (by infer_instance) (-(1 / 2)) + have kms : Fact (k (QuantumSet.subset (-(1/2)) A) = -(1/2)) := Fact.mk rfl + let f' := LinearMap.toSubsetQuantumSet f (-(1/2)) (-(1/2)) + rw [QuantumSet.innerOne_map_one_toSubset_eq (- (1/2)) (- (1/2)), QuantumSet.normOne_toSubset] + rw [QuantumGraph.Real.innerOne_map_one_eq_norm_pow_four_iff_of_kms + ((QuantumGraph.real_toSubset_iff (-(1/2))).mpr h) (kms := kms)] + rw [LinearMap.toSubsetQuantumSet_eq_iff, rankOne_ofSubsetQuantumSet] + simp_rw [← QuantumSet.toSubset_algEquiv_symm_eq_toSubset_equiv, map_one] + +/-- Out-degree operator of a quantum graph. -/ +@[simps] +noncomputable def QuantumGraph.outDegree {A : Type*} [starAlgebra A] [QuantumSet A] : + (A →ₗ[ℂ] A) →ₗ[ℂ] (A →ₗ[ℂ] A) where + toFun f := LinearMap.mul' ℂ _ ∘ₗ (LinearMap.rTensor _ f) + ∘ₗ (LinearMap.rTensor _ (Algebra.linearMap ℂ _)) + ∘ₗ (TensorProduct.lid ℂ _).symm.toLinearMap + map_add' _ _ := by simp only [LinearMap.rTensor_add, LinearMap.add_comp, LinearMap.comp_add] + map_smul' _ _ := by simp only [LinearMap.rTensor_smul, LinearMap.smul_comp, + LinearMap.comp_smul]; rfl + +theorem QuantumGraph.outDegree_eq {A : Type*} [starAlgebra A] [QuantumSet A] {f : A →ₗ[ℂ] A} : + QuantumGraph.outDegree f = lmul (f 1) := +by + ext a + simp only [outDegree_apply, LinearMap.comp_apply, LinearEquiv.coe_coe, + TensorProduct.lid_symm_apply, LinearMap.rTensor_tmul, Algebra.linearMap_apply, + Algebra.algebraMap_eq_smul_one, one_smul, + lmul_apply, LinearMap.mul'_apply] + +/-- In-degree operator of a quantum graph. -/ +@[simps] +noncomputable def QuantumGraph.inDegree {A : Type*} [starAlgebra A] [QuantumSet A] : + (A →ₗ[ℂ] A) →ₗ⋆[ℂ] (A →ₗ[ℂ] A) where + toFun f := LinearMap.mul' ℂ _ ∘ₗ (LinearMap.lTensor _ (LinearMap.adjoint f)) + ∘ₗ (LinearMap.lTensor _ (Algebra.linearMap ℂ _)) + ∘ₗ (TensorProduct.rid ℂ _).symm.toLinearMap + map_add' _ _ := by simp only [map_add, LinearMap.lTensor_add, LinearMap.add_comp, + LinearMap.comp_add] + map_smul' _ _ := by simp only [LinearMap.lTensor_smul, LinearMap.smul_comp, + LinearMap.comp_smul, LinearMap.adjoint_smul] + +theorem QuantumGraph.inDegree_eq {A : Type*} [starAlgebra A] [QuantumSet A] {f : A →ₗ[ℂ] A} : + QuantumGraph.inDegree f = rmul (LinearMap.adjoint f 1) := +by + ext a + simp only [inDegree_apply, LinearMap.comp_apply, LinearEquiv.coe_coe, + TensorProduct.rid_symm_apply, LinearMap.lTensor_tmul, Algebra.linearMap_apply, + Algebra.algebraMap_eq_smul_one, one_smul, + rmul_apply, LinearMap.mul'_apply] + +lemma QuantumGraph.outDegree_real_eq {A : Type*} [starAlgebra A] [QuantumSet A] {x : A →ₗ[ℂ] A} : + LinearMap.real (QuantumGraph.outDegree x) = QuantumGraph.inDegree (symmMap ℂ _ _ x) := +by + rw [outDegree_eq, lmul_eq_mul, LinearMap.mulLeft_real, + ← star_one, ← LinearMap.real_apply, inDegree_eq, symmMap_apply, + LinearMap.adjoint_adjoint] + rfl + +lemma QuantumGraph.inDegree_real_eq {A : Type*} [starAlgebra A] [QuantumSet A] {x : A →ₗ[ℂ] A} : + LinearMap.real (QuantumGraph.inDegree x) = QuantumGraph.outDegree ((symmMap ℂ _ _).symm x) := +by + rw [LinearMap.real_inj_eq, LinearMap.real_real, + outDegree_real_eq, LinearEquiv.apply_symm_apply] + +theorem QuantumGraph.outDegree_eq' {A : Type*} [starAlgebra A] [QuantumSet A] {f : A →ₗ[ℂ] A} : + QuantumGraph.outDegree f = + (TensorProduct.lid ℂ _).toLinearMap + ∘ₗ (LinearMap.rTensor _ Coalgebra.counit) + ∘ₗ (PhiMap f).1 + ∘ₗ (LinearMap.rTensor _ (Algebra.linearMap ℂ _)) + ∘ₗ (TensorProduct.lid ℂ _).symm.toLinearMap := +by + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne f + simp only [map_sum, LinearMap.IsBimoduleMap.sum_coe, LinearMap.sum_comp, LinearMap.comp_sum] + congr + ext + simp only [PhiMap_rankOne, LinearMap.comp_apply, + LinearEquiv.coe_coe, TensorProduct.lid_symm_apply, + LinearMap.rTensor_tmul, TensorProduct.map_tmul, + TensorProduct.lid_tmul, outDegree_eq, lmul_apply, + ContinuousLinearMap.coe_coe, rankOne_apply, Algebra.linearMap_apply, + Algebra.algebraMap_eq_smul_one, one_smul, ← Coalgebra.inner_eq_counit', + LinearMap.adjoint_inner_right, rmul_apply, one_mul, smul_mul_assoc] + +theorem QuantumGraph.inDegree_eq' {A : Type*} [starAlgebra A] [QuantumSet A] + (gns : k A = 0) {f : A →ₗ[ℂ] A} : + QuantumGraph.inDegree f = + (TensorProduct.rid ℂ _).toLinearMap + ∘ₗ (LinearMap.lTensor _ Coalgebra.counit) + ∘ₗ (PhiMap (LinearMap.real f)).1 + ∘ₗ (LinearMap.lTensor _ (Algebra.linearMap ℂ _)) + ∘ₗ (TensorProduct.rid ℂ _).symm.toLinearMap := +by + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne f + simp only [map_sum, LinearMap.IsBimoduleMap.sum_coe, LinearMap.sum_comp, LinearMap.comp_sum, + LinearMap.real_sum] + congr + ext + simp only [rankOne_real, PhiMap_rankOne, LinearMap.comp_apply, + LinearEquiv.coe_coe, TensorProduct.rid_symm_apply, + LinearMap.lTensor_tmul, TensorProduct.map_tmul, + TensorProduct.rid_tmul, inDegree_eq, lmul_apply, + ContinuousLinearMap.coe_coe, rankOne_apply, Algebra.linearMap_apply, + Algebra.algebraMap_eq_smul_one, one_smul, ← Coalgebra.inner_eq_counit', rmul_apply, + rmul_adjoint, starAlgebra.modAut_star, starAlgebra.modAut_apply_modAut, star_star, + ContinuousLinearMap.linearMap_adjoint, rankOne_adjoint, mul_one] + ring_nf + simp only [gns, starAlgebra.modAut_zero, mul_smul_comm, + QuantumSet.inner_eq_counit, star_one, one_mul, AlgEquiv.one_apply, mul_one] + +theorem QuantumGraph.outDegree_apply_schurMul + {A : Type*} [starAlgebra A] [QuantumSet A] (gns : k A = 0) (f₁ f₂ : A →ₗ[ℂ] A) : + QuantumGraph.outDegree (f₁ •ₛ f₂) + = (f₁ ∘ₗ symmMap ℂ _ _ f₂) •ₛ 1 := +by + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne f₁ + obtain ⟨γ, δ, rfl⟩ := LinearMap.exists_sum_rankOne f₂ + simp only [map_sum, LinearMap.sum_apply, LinearMap.sum_comp, LinearMap.comp_sum, + schurMul.apply_rankOne, QuantumGraph.outDegree_eq, + ContinuousLinearMap.coe_coe, rankOne_apply, map_smul, + symmMap_rankOne_apply, LinearMap.rankOne_comp, + schurMul_one_right_rankOne, lmul_adjoint] + simp only [lmul_eq_alg_lmul, map_mul, ContinuousLinearMap.linearMap_adjoint, + rankOne_adjoint, ContinuousLinearMap.coe_coe, rankOne_apply, + star_smul, star_star, Complex.star_def, inner_conj_symm, map_smul] + simp only [QuantumSet.inner_conj_left, one_mul, gns] + ring_nf + simp only [starAlgebra.modAut_zero, AlgEquiv.one_apply] + simp only [Module.End.mul_eq_comp, LinearMap.comp_smul] + +theorem QuantumGraph.inDegree_apply_schurMul + {A : Type*} [starAlgebra A] [QuantumSet A] (gns : k A = 0) (f₁ f₂ : A →ₗ[ℂ] A) : + QuantumGraph.inDegree (f₁ •ₛ f₂) + = 1 •ₛ (LinearMap.adjoint f₂ ∘ₗ LinearMap.real f₁) := +by + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne f₁ + obtain ⟨γ, δ, rfl⟩ := LinearMap.exists_sum_rankOne f₂ + simp only [map_sum, LinearMap.sum_apply, LinearMap.sum_comp, LinearMap.comp_sum, + LinearMap.real_sum, + schurMul.apply_rankOne, QuantumGraph.inDegree_eq, + ContinuousLinearMap.coe_coe, rankOne_apply, map_smul, + LinearMap.rankOne_comp, schurMul_one_left_rankOne, rmul_adjoint, + rankOne_real, ContinuousLinearMap.linearMap_adjoint, + rankOne_adjoint, ContinuousLinearMap.coe_coe, + LinearMap.adjoint_smul, + starAlgebra.modAut_star, starAlgebra.modAut_apply_modAut, + star_star, inner_conj_symm] + simp_rw [QuantumSet.inner_star_left, mul_one] + simp only [gns] + ring_nf + simp only [starAlgebra.modAut_zero, AlgEquiv.one_apply] + simp only [rmul_eq_mul, LinearMap.mulRight_mul] + rw [Finset.sum_comm] + simp only [LinearMap.comp_smul] + +/-- A quantum graph is regular of degree `d` when both `f` and its adjoint send `1` to `d • 1`. -/ +def QuantumGraph.IsRegular + {A : Type*} [starAlgebra A] [QuantumSet A] {f : A →ₗ[ℂ] A} + (h : QuantumGraph A f) (d : ℂ) : Prop := +let _ := h +f 1 = d • 1 ∧ LinearMap.adjoint f 1 = d • 1 + +lemma QuantumGraph.degree_is_real_of_real + {A : Type*} [starAlgebra A] [QuantumSet A] [Nontrivial A] {f : A →ₗ[ℂ] A} + (h : QuantumGraph.Real A f) (d : ℂ) + (h2 : (h.toQuantumGraph).IsRegular d) : + d = Complex.re d := +by + have := calc d • (1 : A) = f 1 := h2.1.symm + _ = f.real 1 := by rw [LinearMap.real_of_isReal h.isReal] + _ = star (f 1) := by rw [LinearMap.real_apply, star_one] + _ = star d • (1 : A) := by rw [h2.1, star_smul, star_one] + rw [← sub_eq_zero, ← sub_smul, smul_eq_zero] at this + simp_rw [one_ne_zero, or_false, sub_eq_zero] at this + exact (Complex.conj_eq_iff_re.mp this.symm).symm + +open scoped TensorProduct +lemma PhiMap_apply_one_one + {A B : Type*} [starAlgebra B] [starAlgebra A] [QuantumSet A] [QuantumSet B] : + (PhiMap (rankOne ℂ (1 : B) (1 : A))).1 = (1 : A ⊗[ℂ] B →ₗ[ℂ] _) := +by + simp_rw [PhiMap_apply, Upsilon_apply_one_one] + exact rmulMapLmul_one + +open scoped InnerProductSpace + +lemma ContinuousLinearMap.isPositive_iff_complex' {E' : + Type*} [NormedAddCommGroup E'] [InnerProductSpace ℂ E'] + [CompleteSpace E'] (T : E' →L[ℂ] E') : + T.IsPositive ↔ ∀ (x : E'), 0 ≤ ⟪T x, x⟫_ℂ := +by simp [isPositive_iff_complex, RCLike.nonneg_def' (𝕜 := ℂ)] +lemma ContinuousLinearMap.isPositive_iff_complex'' {E' : + Type*} [NormedAddCommGroup E'] [InnerProductSpace ℂ E'] + [CompleteSpace E'] (T : E' →L[ℂ] E') : + T.IsPositive ↔ ∀ (x : E'), 0 ≤ ⟪x, T x⟫_ℂ := +by + simp_rw [isPositive_iff_complex', ← inner_conj_symm (T _), + Complex.nonneg_iff, Complex.conj_re, Complex.conj_im, zero_eq_neg, eq_comm] + +lemma ContinuousLinearMap.le_iff_complex_inner_le {E : Type*} [NormedAddCommGroup E] + [InnerProductSpace ℂ E] [CompleteSpace E] {p q : E →L[ℂ] E} : + p ≤ q ↔ ∀ (x : E), ⟪x, p x⟫_ℂ ≤ ⟪x, q x⟫_ℂ := +by + rw [ContinuousLinearMap.le_def, isPositive_iff_complex''] + simp only [sub_apply, inner_sub_right, sub_nonneg] + +theorem isOrthogonalProjection_iff_exists {E : Type*} [NormedAddCommGroup E] + [InnerProductSpace ℂ E] [FiniteDimensional ℂ E] {p : E →L[ℂ] E} : + p.IsOrthogonalProjection ↔ (∃ U, orthogonalProjection' U = p) := +by + rw [ContinuousLinearMap.isOrthogonalProjection_iff', and_comm, ← orthogonal_projection_iff] + +theorem orthogonalProjection'_le_one {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℂ E] + [CompleteSpace E] [CompleteSpace (⊤ : Submodule ℂ E)] + (U : Submodule ℂ E) [CompleteSpace U] : + orthogonalProjection' U ≤ 1 := +by + rw [← orthogonalProjection_of_top, orthogonalProjection.is_le_iff_subset] + exact fun _ _ ↦ trivial + +theorem isOrthogonalProjection_le_one {E : Type*} [NormedAddCommGroup E] + [InnerProductSpace ℂ E] [FiniteDimensional ℂ E] {p : E →L[ℂ] E} (hp : p.IsOrthogonalProjection) : + p ≤ 1 := +by + obtain ⟨U, rfl⟩ := isOrthogonalProjection_iff_exists.mp hp + exact orthogonalProjection'_le_one U + +lemma QuantumGraph.Real.gns_le_one + {A : Type*} [starAlgebra A] [QuantumSet A] {f : A →ₗ[ℂ] A} + (hf : QuantumGraph.Real A f) (gns : k A = 0) : + LinearMap.toContinuousLinearMap (PhiMap f).1 ≤ 1 := +isOrthogonalProjection_le_one + ((quantumGraphReal_iff_Upsilon_toBimodule_orthogonalProjection gns).mp hf) + +theorem QuantumGraph.Real.innerOne_map_one_le_norm_one_pow_four_of_gns + {A : Type*} [starAlgebra A] [QuantumSet A] [Nontrivial A] + [PartialOrder A] [StarOrderedRing A] + (gns : k A = 0) + (h₁ : ∀ ⦃a : A⦄, 0 ≤ a ↔ ∃ (b : A), a = star b * b) + {f : A →ₗ[ℂ] A} + (h : QuantumGraph.Real A f) : + ⟪1, f 1⟫_ℂ ≤ ‖(1 : A)‖ ^ 4 := +by + have sP : schurProjection f := ⟨h.isIdempotentElem, h.isReal⟩ + have iPM := schurProjection.isPosMap h₁ sP + calc ⟪1, f 1⟫_ℂ = Complex.re ⟪1, f 1⟫_ℂ := + QuantumSet.innerOne_map_one_isReal_ofReal h.isReal + _ = Complex.re ⟪1, (PhiMap f).1 1⟫_ℂ := by rw [← oneInner_map_one_eq_oneInner_PhiMap_map_one] + _ = (RCLike.re ⟪1, LinearMap.toContinuousLinearMap (PhiMap f).1 1⟫_ℂ) := rfl + _ ≤ RCLike.re ⟪(1 : A ⊗[ℂ] A), (1 : (A ⊗[ℂ] A) →L[ℂ] (A ⊗[ℂ] A)) 1⟫_ℂ := + by + rw [Complex.real_le_real] + exact + ((RCLike.le_def.mp ((ContinuousLinearMap.le_iff_complex_inner_le + (p := LinearMap.toContinuousLinearMap (PhiMap f).1) + (q := 1)).mp + (QuantumGraph.Real.gns_le_one h gns) 1)).1) + _ = (‖(1 : A)‖ ^ 2) ^ 2 := + by + rw [ContinuousLinearMap.one_apply, inner_self_eq_norm_sq (𝕜 := ℂ) (E := A ⊗[ℂ] A), + Algebra.TensorProduct.one_def, norm_tmul, ← pow_two] + simp + _ = ‖(1 : A)‖ ^ 4 := by simp only [← pow_mul] + +lemma QuantumGraph.zero_le_degree_le_norm_one_sq_of_gns + {A : Type*} [starAlgebra A] [QuantumSet A] [Nontrivial A] + [PartialOrder A] [StarOrderedRing A] + (h₁ : ∀ ⦃a : A⦄, 0 ≤ a ↔ ∃ (b : A), a = star b * b) (gns : k A = 0) + {f : A →ₗ[ℂ] A} (h : QuantumGraph.Real A f) (d : ℂ) (h2 : (h.toQuantumGraph).IsRegular d) : + 0 ≤ d ∧ d ≤ ‖(1 : A)‖ ^ 2 := +by + have sP : schurProjection f := ⟨h.isIdempotentElem, h.isReal⟩ + have iPM := schurProjection.isPosMap h₁ sP + have hd : d = ⟪1, f 1⟫_ℂ / ⟪1, (1 : A)⟫_ℂ := + by + rw [h2.1, inner_smul_right, mul_div_assoc, div_self, mul_one] + norm_num + rw [hd] + refine ⟨mul_nonneg (QuantumGraph.Real.innerOne_map_one_nonneg h₁ h) ?_, ?_⟩ + · simp only [inner_self_eq_norm_sq_to_K] + simp only [Complex.coe_algebraMap, ← Complex.ofReal_pow, ← Complex.ofReal_inv, + Complex.zero_le_real, inv_nonneg, pow_two_nonneg] + rw [← ge_iff_le, ← Complex.ofReal_pow] + calc ((‖(1 : A)‖ ^ 2 : ℝ) : ℂ) = ((‖(1 : A)‖ ^ 2) ^ 2 / ‖(1 : A)‖ ^ 2 : ℝ) := + by + rw [pow_two, pow_two, mul_div_assoc, div_self, mul_one] + norm_num + _ = ((‖(1 : A)‖ ^ 4 / ‖(1 : A)‖ ^ 2 : ℝ) : ℂ) := by simp [← pow_mul] + _ ≥ (⟪1, f 1⟫_ℂ / (‖(1 : A)‖ ^ 2 : ℝ) : ℂ) := + by + rw [QuantumSet.innerOne_map_one_isReal_ofReal h.isReal] + rw [← Complex.ofReal_div, ge_iff_le, Complex.real_le_real] + apply div_le_div_of_nonneg_right ?_ (sq_nonneg _) + · simpa only [← Complex.real_le_real, + ← QuantumSet.innerOne_map_one_isReal_ofReal h.isReal, Complex.ofReal_pow] using + Real.innerOne_map_one_le_norm_one_pow_four_of_gns gns h₁ h + simp [inner_self_eq_norm_sq_to_K] + +theorem StarOrderedRing.nonneg_iff_toQuantumSetSubset + {A : Type*} [NonUnitalSemiring A] [StarRing A] + [PartialOrder A] [StarOrderedRing A] (r : ℝ) : + (∀ ⦃a : A⦄, 0 ≤ a ↔ ∃ (b : A), a = star b * b) ↔ + ∀ ⦃a : QuantumSet.subset r A⦄, 0 ≤ a ↔ ∃ (b : QuantumSet.subset r A), a = star b * b := +Iff.rfl + +theorem Coalgebra.comul_comp_mul_quantumSetSubset + {A : Type*} [starAlgebra A] [QuantumSet A] (r : ℝ) : + letI subsetA : QuantumSet (QuantumSet.subset r A) := + QuantumSet.instSubset (A := A) (by infer_instance) r + letI frobSubsetA : FrobeniusAlgebra ℂ (QuantumSet.subset r A) := + QuantumSet.isFrobeniusAlgebra + letI coalgebraSubsetA : Coalgebra ℂ (QuantumSet.subset r A) := + FrobeniusAlgebra.toCoalgebra + Coalgebra.comul ∘ₗ LinearMap.mul' ℂ (QuantumSet.subset r A) + = (TensorProduct.map (QuantumSet.toSubset_algEquiv r).toLinearMap + (QuantumSet.toSubset_algEquiv r).toLinearMap) + ∘ₗ (Coalgebra.comul (R := ℂ) (A := A) + ∘ₗ (LinearMap.mul' ℂ A)) + ∘ₗ (TensorProduct.map (QuantumSet.toSubset_algEquiv r).symm.toLinearMap + (QuantumSet.toSubset_algEquiv r).symm.toLinearMap) := +by + letI subsetA : QuantumSet (QuantumSet.subset r A) := + QuantumSet.instSubset (A := A) (by infer_instance) r + letI frobSubsetA : FrobeniusAlgebra ℂ (QuantumSet.subset r A) := + QuantumSet.isFrobeniusAlgebra + letI coalgebraSubsetA : Coalgebra ℂ (QuantumSet.subset r A) := + FrobeniusAlgebra.toCoalgebra + letI : Fact (k A = k A) := Fact.mk rfl + letI tensorA : QuantumSet (A ⊗[ℂ] A) := + QuantumSet.tensorProduct (A := A) (B := A) (h := Fact.mk rfl) + letI subsetTensorA : QuantumSet (QuantumSet.subset r (A ⊗[ℂ] A)) := + QuantumSet.instSubset (A := A ⊗[ℂ] A) (by infer_instance) r + calc + Coalgebra.comul ∘ₗ LinearMap.mul' ℂ (QuantumSet.subset r A) + = Coalgebra.comul ∘ₗ + ((QuantumSet.toSubset_algEquiv r).toLinearMap ∘ₗ + LinearMap.mul' ℂ A ∘ₗ + TensorProduct.map (QuantumSet.toSubset_algEquiv r).symm.toLinearMap + (QuantumSet.toSubset_algEquiv r).symm.toLinearMap) := + congrArg (fun f => Coalgebra.comul ∘ₗ f) + (LinearMap.mul'_quantumSet_subset_eq (A := A) r) + _ = (TensorProduct.map (QuantumSet.toSubset_algEquiv r).toLinearMap + (QuantumSet.toSubset_algEquiv r).toLinearMap) + ∘ₗ (Coalgebra.comul (R := ℂ) (A := A) + ∘ₗ LinearMap.mul' ℂ A) + ∘ₗ (TensorProduct.map (QuantumSet.toSubset_algEquiv r).symm.toLinearMap + (QuantumSet.toSubset_algEquiv r).symm.toLinearMap) := by + rw [QuantumSet.comul_subset_eq r] + simp only [← LinearMap.comp_assoc] + rw [LinearMap.comp_assoc (QuantumSet.toSubset_algEquiv r).toLinearMap + (QuantumSet.toSubset_algEquiv r).symm.toLinearMap + ((TensorProduct.map (QuantumSet.toSubset_algEquiv r).toLinearMap + (QuantumSet.toSubset_algEquiv r).toLinearMap) ∘ₗ + Coalgebra.comul (R := ℂ) (A := A))] + rw [AlgEquiv.symm_comp_toLinearMap] + simp only [LinearMap.comp_id, LinearMap.comp_assoc] + + +theorem QuantumGraph.toSubset_isRegular_iff + {A : Type*} [starAlgebra A] [QuantumSet A] + {f : A →ₗ[ℂ] A} (r : ℝ) (h : QuantumGraph A f) (d : ℂ) : + let h' := (QuantumGraph.toSubset_iff r).mpr h; + letI := QuantumSet.instSubset (A := A) (by infer_instance) r; + h.IsRegular d ↔ h'.IsRegular d := +by + intro h' + simp only [QuantumGraph.IsRegular, LinearMap.toSubsetQuantumSet_apply] + rw [LinearMap.toSubsetQuantumSet_adjoint_apply] + simp only [LinearMap.comp_apply, ← QuantumSet.toSubset_algEquiv_symm_eq_toSubset_equiv, + ← QuantumSet.toSubset_algEquiv_eq_toSubset_equiv, map_one, AlgEquiv.toLinearMap_apply] + nth_rw 3 [eq_comm] + nth_rw 4 [eq_comm] + simp_rw [← AlgEquiv.symm_apply_eq, map_smul, map_one] + nth_rw 1 [eq_comm] + nth_rw 2 [eq_comm] + +lemma QuantumGraph.zero_le_degree_le_norm_one_sq + {A : Type*} [starAlgebra A] [QuantumSet A] [Nontrivial A] + [PartialOrder A] [StarOrderedRing A] + (h₁ : ∀ ⦃a : A⦄, 0 ≤ a ↔ ∃ (b : A), a = star b * b) + {f : A →ₗ[ℂ] A} (h : QuantumGraph.Real A f) (d : ℂ) (h2 : (h.toQuantumGraph).IsRegular d) : + 0 ≤ d ∧ d ≤ ‖(1 : A)‖ ^ 2 := +by + letI := QuantumSet.instSubset (A := A) (by infer_instance) 0 + rw [QuantumSet.normOne_toSubset 0] + exact QuantumGraph.zero_le_degree_le_norm_one_sq_of_gns + ((StarOrderedRing.nonneg_iff_toQuantumSetSubset 0).mp h₁) rfl + ((QuantumGraph.real_toSubset_iff 0).mpr h) _ + ((QuantumGraph.toSubset_isRegular_iff 0 h.toQuantumGraph d).mp h2) diff --git a/LeanPool/Monlib4/QuantumGraph/Example.lean b/LeanPool/Monlib4/QuantumGraph/Example.lean new file mode 100644 index 0000000000..beb467d299 --- /dev/null +++ b/LeanPool/Monlib4/QuantumGraph/Example.lean @@ -0,0 +1,397 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.QuantumGraph.Basic +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Pi +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.TensorProduct +import LeanPool.Monlib4.LinearAlgebra.Ips.MatIps +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Instances +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.DeltaForm + +/-! + # Basic examples on quantum adjacency matrices + + This file contains elementary examples of quantum adjacency matrices, + such as the complete graph and the trivial graph. +-/ + + +-- import quantum_graph.basic +-- import quantum_graph.basic +open TensorProduct Matrix + +open scoped TensorProduct BigOperators Kronecker Matrix Functional + +variable {p : Type _} [Fintype p] [DecidableEq p] {n : p → Type _} [∀ i, Fintype (n i)] + [∀ i, DecidableEq (n i)] + {p₂ : Type*} [Fintype p₂] [DecidableEq p₂] {n₂ : p₂ → Type*} [∀ i, Fintype (n₂ i)] + [∀ i, DecidableEq (n₂ i)] + +local notation "ℍ" => PiMat ℂ p n +local notation "ℍ₂" => PiMat ℂ p₂ n₂ + +-- local notation `⊗K` := matrix (n × n) (n × n) ℂ +local notation "l(" x ")" => x →ₗ[ℂ] x + +variable {φ : Π i : p, Module.Dual ℂ (Matrix (n i) (n i) ℂ)} {ψ : Π i, + Module.Dual ℂ (Matrix (n₂ i) (n₂ i) ℂ)} + +local notation "|" x "⟩⟨" y "|" => @rankOne ℂ _ _ _ _ _ _ _ x y + +local notation "m" => LinearMap.mul' ℂ ℍ + +local notation "η" => Algebra.linearMap ℂ ℍ + +local notation x " ⊗ₘ " y => TensorProduct.map x y + +local notation "υ" => + LinearEquiv.toLinearMap (TensorProduct.assoc ℂ ℍ ℍ ℍ) + +local notation "υ⁻¹" => + LinearEquiv.toLinearMap (LinearEquiv.symm (TensorProduct.assoc ℂ ℍ ℍ ℍ)) + +local notation "ϰ" => + LinearEquiv.toLinearMap ((TensorProduct.comm ℂ ℍ ℂ)) + +local notation "ϰ⁻¹" => + LinearEquiv.toLinearMap (LinearEquiv.symm (TensorProduct.comm ℂ ℍ ℂ)) + +local notation "τ" => + LinearEquiv.toLinearMap (TensorProduct.lid ℂ ℍ) + +local notation "τ⁻¹" => + LinearEquiv.toLinearMap (LinearEquiv.symm (TensorProduct.lid ℂ ℍ)) + +local notation "id" => (1 : ℍ →ₗ[ℂ] ℍ) + +/-- The complete quantum adjacency map between two Hilbert spaces with chosen units. -/ +noncomputable def Qam.completeGraph (E₁ E₂ : Type _) [One E₁] [One E₂] [NormedAddCommGroup E₁] + [NormedAddCommGroup E₂] [InnerProductSpace ℂ E₁] [InnerProductSpace ℂ E₂] : + E₂ →ₗ[ℂ] E₁ := + |(1 : E₁)⟩⟨(1 : E₂)| + +theorem Qam.completeGraph_eq {E₁ E₂ : Type _} [One E₁] [One E₂] [NormedAddCommGroup E₁] + [NormedAddCommGroup E₂] [InnerProductSpace ℂ E₁] [InnerProductSpace ℂ E₂] : + Qam.completeGraph E₁ E₂ = |(1 : E₁)⟩⟨(1 : E₂)| := + rfl + +variable {A B : Type*} [ha : starAlgebra A] [hb : starAlgebra B] + [hA : QuantumSet A] [hB : QuantumSet B] + +theorem Qam.completeGraph_eq' : + Qam.completeGraph A B = + Algebra.linearMap ℂ A ∘ₗ Coalgebra.counit := +by + rw [Coalgebra.counit_eq_bra_one] + ext + simp [Algebra.algebraMap_eq_smul_one] + rfl + +open scoped schurMul +theorem Qam.Nontracial.CompleteGraph.qam : + ((Qam.completeGraph A B) •ₛ (Qam.completeGraph A B)) = Qam.completeGraph A B := +schurMul_one_one_left _ + +open scoped FiniteDimensional + +lemma Qam.Nontracial.CompleteGraph.adjoint_eq {E₁ E₂ : Type _} [NormedAddCommGroupOfRing E₁] + [NormedAddCommGroupOfRing E₂] [InnerProductSpace ℂ E₁] [InnerProductSpace ℂ E₂] + [FiniteDimensional ℂ E₁] [FiniteDimensional ℂ E₂] + [IsScalarTower ℂ E₁ E₁] [IsScalarTower ℂ E₂ E₂] + [SMulCommClass ℂ E₁ E₁] [SMulCommClass ℂ E₂ E₂] : + LinearMap.adjoint (Qam.completeGraph E₁ E₂) = Qam.completeGraph E₂ E₁ := +by rw [completeGraph_eq, ContinuousLinearMap.linearMap_adjoint, rankOne_adjoint]; rfl + +theorem Qam.Nontracial.CompleteGraph.isSelfAdjoint {E : Type _} [One E] [NormedAddCommGroup E] + [InnerProductSpace ℂ E] [FiniteDimensional ℂ E] : + _root_.IsSelfAdjoint (Qam.completeGraph E E) := by + simp_rw [_root_.IsSelfAdjoint, Qam.completeGraph, LinearMap.star_eq_adjoint, + ContinuousLinearMap.linearMap_adjoint, rankOne_adjoint] + +theorem Qam.Nontracial.CompleteGraph.isReal : + LinearMap.IsReal (Qam.completeGraph A B) := by + simp_rw [Qam.completeGraph, LinearMap.isReal_iff, rankOne_real, star_one, + _root_.map_one] + +theorem Qam.Nontracial.CompleteGraph.symm_eq : + symmMap ℂ _ _ (Qam.completeGraph A B) = Qam.completeGraph B A := +by simp_rw [Qam.completeGraph, symmMap_rankOne_apply, star_one, _root_.map_one] +theorem Qam.Nontracial.CompleteGraph.is_symm : + symmMap ℂ _ _ (Qam.completeGraph A A) = Qam.completeGraph A A := +Qam.Nontracial.CompleteGraph.symm_eq + +theorem Qam.Nontracial.CompleteGraph.is_reflexive : + (Qam.completeGraph A A) •ₛ 1 = 1 := +by + obtain ⟨α, β, hαβ⟩ := (1 : l(A)).exists_sum_rankOne + nth_rw 1 [hαβ] + simp_rw [map_sum, Qam.completeGraph, schurMul.apply_rankOne, one_mul, ← hαβ] + +/-- The trivial quantum graph on a quantum set with delta form. -/ +noncomputable def Qam.trivialGraph (A : Type*) [starAlgebra A] [CoalgebraStruct ℂ A] [QuantumSet A] + [QuantumSetDeltaForm A] : + l(A) := +⅟ (LinearMap.mul' ℂ A ∘ₗ Coalgebra.comul) + +variable {A : Type*} [ha : starAlgebra A] [hA : QuantumSet A] + +open scoped ComplexOrder + +section TrivialGraph + +variable [hAc : CoalgebraStruct ℂ A] + +theorem Qam.trivialGraph_eq [hA2 : QuantumSetDeltaForm A] : + Qam.trivialGraph A = hA2.delta⁻¹ • (1 : l(A)) := + by + simp_rw [Qam.trivialGraph] + apply invOf_eq_right_inv + rw [hA2.mul_comp_comul_eq, smul_mul_smul_comm, one_mul, mul_inv_cancel₀, + one_smul] + · exact ne_of_gt hA2.delta_pos + +theorem Qam.Nontracial.TrivialGraph.qam [hA2 : QuantumSetDeltaForm A] : + (Qam.trivialGraph A) •ₛ (Qam.trivialGraph A) = Qam.trivialGraph A := + by + rw [Qam.trivialGraph_eq] + simp_rw [_root_.map_smul, LinearMap.smul_apply, smul_smul, schurMul] + simp only [LinearMap.coe_mk, AddHom.coe_mk] + simp_rw [TensorProduct.map_one, Module.End.one_eq_id, LinearMap.id_comp, + hA2.mul_comp_comul_eq, smul_smul, mul_assoc] + rw [inv_mul_cancel₀ _, mul_one, Module.End.one_eq_id] + · exact ne_of_gt hA2.delta_pos + +theorem Qam.Nontracial.TrivialGraph.qam.is_self_adjoint [hA2 : QuantumSetDeltaForm A] : + LinearMap.adjoint (Qam.trivialGraph A) = Qam.trivialGraph A := + by + simp_rw [Qam.trivialGraph_eq, LinearMap.adjoint_smul, LinearMap.adjoint_one, starRingEnd_apply, + star_inv₀, ← starRingEnd_apply] + congr 2 + have := hA2.delta_pos + rw [RCLike.pos_def, ← RCLike.conj_eq_iff_im] at this + exact this.2 + +theorem Qam.Nontracial.trivialGraph [hA2 : QuantumSetDeltaForm A] : + (Qam.trivialGraph A) •ₛ 1 = 1 := + by + rw [Qam.trivialGraph_eq, _root_.map_smul, LinearMap.smul_apply] + simp only [schurMul, LinearMap.coe_mk, AddHom.coe_mk] + simp_rw [TensorProduct.map_one, Module.End.one_eq_id, + LinearMap.id_comp, hA2.mul_comp_comul_eq, smul_smul, + inv_mul_cancel₀ (ne_of_gt hA2.delta_pos), one_smul, Module.End.one_eq_id] + +theorem Qam.refl_idempotent_one_one_of_delta [hA2 : QuantumSetDeltaForm A] : + (1 : _) •ₛ (1 : l(A)) = hA2.delta • (1 : l(A)) := by + simp_rw [schurMul_apply_apply, TensorProduct.map_one, LinearMap.one_comp, hA2.mul_comp_comul_eq] + +theorem Qam.Lm.Nontracial.is_unreflexive_iff_reflexive_add_one [hA2 : QuantumSetDeltaForm A] + (x : l(A)) : + x •ₛ 1 = 0 ↔ (hA2.delta⁻¹ • (x + 1)) •ₛ 1 = 1 := + by + simp_rw [_root_.map_smul, LinearMap.smul_apply, _root_.map_add, LinearMap.add_apply, + Qam.refl_idempotent_one_one_of_delta, smul_add, smul_smul, + inv_mul_cancel₀ (ne_of_gt hA2.delta_pos), one_smul, add_eq_right] + rw [smul_eq_zero_iff_right (inv_ne_zero (ne_of_gt hA2.delta_pos))] + +end TrivialGraph + +theorem Qam.refl_idempotent_completeGraph_left + (x : A →ₗ[ℂ] B) : (Qam.completeGraph B A) •ₛ x = x := +schurMul_one_one_left _ + +theorem Qam.refl_idempotent_completeGraph_right (x : A →ₗ[ℂ] B) : + x •ₛ (Qam.completeGraph B A) = x := +schurMul_one_one_right _ + +/-- The complement of a quantum adjacency map, relative to the complete graph. -/ +noncomputable def Qam.complement' {E₁ E₂ : Type _} [One E₁] [One E₂] + [NormedAddCommGroup E₁] [NormedAddCommGroup E₂] + [InnerProductSpace ℂ E₁] [InnerProductSpace ℂ E₂] + (x : E₂ →ₗ[ℂ] E₁) : E₂ →ₗ[ℂ] E₁ := +Qam.completeGraph E₁ E₂ - x + +theorem Qam.Nontracial.Complement'.qam + (x : A →ₗ[ℂ] B) : + x •ₛ x = x ↔ + (Qam.complement' x) •ₛ (Qam.complement' x) = Qam.complement' x := + by + simp only [Qam.complement', _root_.map_sub, LinearMap.sub_apply, + Qam.refl_idempotent_completeGraph_left, Qam.refl_idempotent_completeGraph_right] + simp only [sub_eq_self] + simp only [sub_eq_zero, @eq_comm _ x] + +theorem Qam.Nontracial.Complement'.qam.isReal + (x : A →ₗ[ℂ] B) : LinearMap.IsReal x ↔ LinearMap.IsReal (Qam.complement' x) := + by + simp only [Qam.complement', LinearMap.isReal_iff, LinearMap.real_sub, + (LinearMap.isReal_iff _).mp (Qam.Nontracial.CompleteGraph.isReal)] + simp only [sub_right_inj] + +theorem Qam.complement'_complement' {E₁ E₂ : Type _} [NormedAddCommGroupOfRing E₁] + [NormedAddCommGroupOfRing E₂] + [InnerProductSpace ℂ E₁] [InnerProductSpace ℂ E₂] [FiniteDimensional ℂ E₁] + [FiniteDimensional ℂ E₂] [IsScalarTower ℂ E₁ E₁] [IsScalarTower ℂ E₂ E₂] [SMulCommClass ℂ E₁ E₁] + [SMulCommClass ℂ E₂ E₂] + (x : E₁ →ₗ[ℂ] E₂) : Qam.complement' (Qam.complement' x) = x := + sub_sub_cancel _ _ + +theorem Qam.Nontracial.Complement'.ir_reflexive + (x : l(A)) (α : Prop) [Decidable α] : + x •ₛ (1 : l(A)) = ite α (1 : l(A)) (0 : l(A)) ↔ + (Qam.complement' x) •ₛ (1 : l(A)) = ite α (0 : l(A)) (1 : l(A)) := +by + simp_rw [Qam.complement', _root_.map_sub, LinearMap.sub_apply, + Qam.refl_idempotent_completeGraph_left] + by_cases h : α <;> simp_rw [h] + · simp_rw [if_true, sub_eq_zero, eq_comm] + · simp_rw [if_false, sub_eq_self] + +/-- A quantum adjacency map that is idempotent and reflexive. -/ +class QamReflexive (x : l(A)) : Prop where +/-- Idempotence under Schur multiplication. -/ +toQam : x •ₛ x = x +/-- Reflexivity condition. -/ +toRefl : x •ₛ 1 = 1 + +lemma QamReflexive_iff (x : l(A)) : + QamReflexive x ↔ x •ₛ x = x ∧ x •ₛ 1 = 1 := +⟨fun h => ⟨h.toQam, h.toRefl⟩, fun h => ⟨h.1, h.2⟩⟩ + +/-- A quantum adjacency map that is idempotent and irreflexive. -/ +class QamIrreflexive (x : l(A)) : Prop where +/-- Idempotence under Schur multiplication. -/ +toQam : x •ₛ x = x +/-- Irreflexivity condition. -/ +toIrrefl : x •ₛ 1 = 0 + +lemma QamIrreflexive_iff (x : l(A)) : + QamIrreflexive x ↔ x •ₛ x = x ∧ x •ₛ 1 = 0 := +⟨fun h => ⟨h.toQam, h.toIrrefl⟩, fun h => ⟨h.1, h.2⟩⟩ + +theorem Qam.complement'_is_irreflexive_iff + (x : l(A)) : QamIrreflexive (Qam.complement' x) ↔ QamReflexive x := + by + have := Qam.Nontracial.Complement'.ir_reflexive x True + simp_rw [if_true] at this + rw [QamReflexive_iff, QamIrreflexive_iff, ← Qam.Nontracial.Complement'.qam] + simp_rw [this] + +theorem Qam.complement'_is_reflexive_iff + (x : l(A)) : QamReflexive (Qam.complement' x) ↔ QamIrreflexive x := + by + have := Qam.Nontracial.Complement'.ir_reflexive x False + simp_rw [if_false] at this + rw [QamReflexive_iff, QamIrreflexive_iff, ← Qam.Nontracial.Complement'.qam, this] + +/-- Complement relative to the trivial graph. -/ +noncomputable def Qam.complement'' [QuantumSetDeltaForm A] + (x : l(A)) : + l(A) := + x - Qam.trivialGraph A + +theorem Qam.complement''_is_irreflexive_iff [hA2 : QuantumSetDeltaForm A] {x : l(A)} + (hx : LinearMap.IsReal x) : QamIrreflexive (Qam.complement'' x) ↔ QamReflexive x := + by + rw [QamReflexive_iff, QamIrreflexive_iff] + have t1 := @Qam.Nontracial.TrivialGraph.qam A _ _ _ + have t2 := @Qam.Nontracial.trivialGraph A _ _ _ + have t3 : (Qam.complement'' x) •ₛ 1 = 0 ↔ x •ₛ 1 = 1 := by + simp_rw [Qam.complement'', map_sub, LinearMap.sub_apply, t2, sub_eq_zero] + rw [t3] + simp_rw [Qam.complement'', map_sub, LinearMap.sub_apply, t1, sub_sub] + constructor <;> rintro ⟨h1, h2⟩ + all_goals + exact ⟨by + simp only [Qam.trivialGraph_eq, _root_.map_smul, LinearMap.smul_apply, h2, + (schurMul_reflexive_of_isReal hx).mp h2, sub_self, add_zero, sub_left_inj] at h1 ⊢ + exact h1, h2⟩ + +/-- Complement operation producing the irreflexive complement. -/ +noncomputable def Qam.irreflexiveComplement [QuantumSetDeltaForm A] (x : l(A)) : + l(A) := +Qam.completeGraph A A - Qam.trivialGraph A - x + +/-- Complement operation producing the reflexive complement. -/ +noncomputable def Qam.reflexiveComplement [QuantumSetDeltaForm A] (x : l(A)) : + l(A) := +Qam.completeGraph A A + Qam.trivialGraph A - x + +theorem Qam.Nontracial.trivialGraph.isReal [hA2 : QuantumSetDeltaForm A] : + LinearMap.IsReal (Qam.trivialGraph A) := + by + rw [LinearMap.isReal_iff, Qam.trivialGraph_eq, LinearMap.real_smul, LinearMap.real_one, + starRingEnd_apply, star_inv₀] + congr + have := hA2.delta_pos + rw [RCLike.pos_def, ← RCLike.conj_eq_iff_im] at this + exact this.2 + +theorem Qam.irreflexiveComplement.isReal [hA2 : QuantumSetDeltaForm A] + {x : l(A)} (hx : LinearMap.IsReal x) : LinearMap.IsReal (Qam.irreflexiveComplement x) := by + rw [LinearMap.isReal_iff, Qam.irreflexiveComplement, LinearMap.real_sub, LinearMap.real_sub, + (LinearMap.isReal_iff (Qam.completeGraph A A)).mp Qam.Nontracial.CompleteGraph.isReal, + (LinearMap.isReal_iff (Qam.trivialGraph A)).mp + Qam.Nontracial.trivialGraph.isReal, + (LinearMap.isReal_iff x).mp hx] + +theorem Qam.reflexiveComplement.isReal [hA2 : QuantumSetDeltaForm A] {x : l(A)} + (hx : LinearMap.IsReal x) : LinearMap.IsReal (Qam.reflexiveComplement x) := by + rw [LinearMap.isReal_iff, Qam.reflexiveComplement, LinearMap.real_sub, LinearMap.real_add, + (LinearMap.isReal_iff (Qam.completeGraph A A)).mp Qam.Nontracial.CompleteGraph.isReal, + (LinearMap.isReal_iff (Qam.trivialGraph A)).mp + Qam.Nontracial.trivialGraph.isReal, + (LinearMap.isReal_iff x).mp hx] + +theorem Qam.irreflexiveComplement_irreflexiveComplement [QuantumSetDeltaForm A] + {x : l(A)} : Qam.irreflexiveComplement (Qam.irreflexiveComplement x) = x := + sub_sub_cancel _ _ + +theorem Qam.reflexiveComplement_reflexiveComplement [QuantumSetDeltaForm A] {x : l(A)} : + Qam.reflexiveComplement (Qam.reflexiveComplement x) = x := + sub_sub_cancel _ _ + +theorem Qam.trivialGraph_reflexiveComplement_eq_completeGraph [QuantumSetDeltaForm A] : + Qam.reflexiveComplement (Qam.trivialGraph A) = Qam.completeGraph A A := +by simp_rw [reflexiveComplement, add_sub_cancel_right] + +theorem Qam.completeGraph_reflexiveComplement_eq_trivialGraph [QuantumSetDeltaForm A] : + Qam.reflexiveComplement (Qam.completeGraph A A) = Qam.trivialGraph A := + add_sub_cancel_left _ _ + +theorem Qam.complement'_eq {E₁ E₂ : Type _} [NormedAddCommGroupOfRing E₁] + [NormedAddCommGroupOfRing E₂] + [InnerProductSpace ℂ E₁] [InnerProductSpace ℂ E₂] [FiniteDimensional ℂ E₁] + [FiniteDimensional ℂ E₂] [IsScalarTower ℂ E₁ E₁] [IsScalarTower ℂ E₂ E₂] [SMulCommClass ℂ E₁ E₁] + [SMulCommClass ℂ E₂ E₂] (a : E₂ →ₗ[ℂ] E₁) : + Qam.complement' a = Qam.completeGraph E₁ E₂ - a := + rfl + +theorem Qam.irreflexiveComplement_is_irreflexive_qam_iff_irreflexive_qam + [hA2 : QuantumSetDeltaForm A] {x : l(A)} (hx : LinearMap.IsReal x) : + QamIrreflexive (Qam.irreflexiveComplement x) ↔ QamIrreflexive x := + by + rw [Qam.irreflexiveComplement, sub_sub, ← Qam.complement'_eq, + Qam.complement'_is_irreflexive_iff, ← Qam.complement''_is_irreflexive_iff, + Qam.complement'', add_sub_cancel_left] + · rw [LinearMap.isReal_iff, LinearMap.real_add, x.isReal_iff.mp hx, + (Qam.trivialGraph A).isReal_iff.mp Qam.Nontracial.trivialGraph.isReal] + +theorem Qam.reflexive_complment_is_reflexive_qam_iff_reflexive_qam + [hA2 : QuantumSetDeltaForm A] {x : l(A)} (hx : LinearMap.IsReal x) : + QamReflexive (Qam.reflexiveComplement x) ↔ QamReflexive x := + by + rw [Qam.reflexiveComplement, ← sub_sub_eq_add_sub, ← Qam.complement'_eq, + Qam.complement'_is_reflexive_iff] + exact Qam.complement''_is_irreflexive_iff hx + + +theorem QuantumSet.Psi_apply_completeGraph {A : Type*} {B : Type*} [starAlgebra A] + [starAlgebra B] [QuantumSet A] [QuantumSet B] (t r : ℝ) : + QuantumSet.Psi t r (Qam.completeGraph A B) = 1 := +QuantumSet.Psi_apply_one_one _ _ +theorem QuantumSet.Psi_symm_one {A B : Type*} [starAlgebra A] + [starAlgebra B] [QuantumSet A] [QuantumSet B] (t r : ℝ) : + (QuantumSet.Psi t r).symm 1 = Qam.completeGraph A B := +QuantumSet.Psi_symm_apply_one _ _ diff --git a/LeanPool/Monlib4/QuantumGraph/Grad.lean b/LeanPool/Monlib4/QuantumGraph/Grad.lean new file mode 100644 index 0000000000..73cc1077f7 --- /dev/null +++ b/LeanPool/Monlib4/QuantumGraph/Grad.lean @@ -0,0 +1,166 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.QuantumGraph.Basic +import LeanPool.Monlib4.QuantumGraph.Degree + +variable {B : Type*} [starAlgebra B] [QuantumSet B] + +open scoped TensorProduct + +local notation "lT" => LinearMap.lTensor +local notation "rT" => LinearMap.rTensor +local notation "η" => Algebra.linearMap ℂ +local notation "τ" => TensorProduct.lid ℂ +local notation "τ'" => TensorProduct.rid ℂ + +/-- Gradient map associated to a quantum graph adjacency operator. -/ +noncomputable def QuantumGraph.Grad : + (B →ₗ[ℂ] B) →+ (B →ₗ[ℂ] B ⊗[ℂ] B) where + toFun f := (rT _ (LinearMap.adjoint f) - lT _ f) ∘ₗ Coalgebra.comul + map_add' _ _ := by simp_rw [LinearMap.lTensor_add, map_add, LinearMap.rTensor_add, + add_sub_add_comm, LinearMap.add_comp] + map_zero' := by simp only [map_zero, LinearMap.rTensor_zero, LinearMap.lTensor_zero, sub_self, + LinearMap.zero_comp] + +lemma QuantumGraph.Grad_apply (A : B →ₗ[ℂ] B) : + QuantumGraph.Grad A = (rT _ (LinearMap.adjoint A) - lT _ A) ∘ₗ Coalgebra.comul := +rfl + +private noncomputable def grad_phiMap : + (B →ₗ[ℂ] B) →+ (B →ₗ[ℂ] B ⊗[ℂ] B) where + toFun A := ((PhiMap (LinearMap.real A)).1 ∘ₗ (rT _ (η _)) ∘ₗ (τ _).symm.toLinearMap) + - (PhiMap A).1 ∘ₗ (lT _ (η _)) ∘ₗ (τ' _).symm.toLinearMap + map_add' _ _ := by simp only [LinearMap.real_add, map_add, + LinearMap.IsBimoduleMaps.coe_add, add_sub_add_comm, LinearMap.add_comp] + map_zero' := by simp only [map_zero, LinearMap.real_zero, LinearMap.IsBimoduleMaps.coe_zero, + sub_self, LinearMap.zero_comp] +private lemma grad_phiMap_apply (A : B →ₗ[ℂ] B) : + grad_phiMap A = ((PhiMap (LinearMap.real A)).1 ∘ₗ (rT _ (η _)) ∘ₗ (τ _).symm.toLinearMap) + - (PhiMap A).1 ∘ₗ (lT _ (η _)) ∘ₗ (τ' _).symm.toLinearMap := +rfl + +theorem QuantumGraph.Grad_eq (gns : k B = 0) (A : B →ₗ[ℂ] B) : + QuantumGraph.Grad A + = ((PhiMap (LinearMap.real A)).1 ∘ₗ (rT _ (η _)) ∘ₗ (τ _).symm.toLinearMap) + - (PhiMap A).1 ∘ₗ (lT _ (η _)) ∘ₗ (τ' _).symm.toLinearMap := +by + rw [← grad_phiMap_apply] + revert A + rw [← AddMonoidHom.ext_iff] + apply AddMonoidHom.ext_of_rank_one' + intro x y + ext a + obtain ⟨S, hS⟩ := TensorProduct.exists_finset (R := ℂ) (Coalgebra.comul a) + apply (TensorProduct.inner_ext_iff' _ _).mpr + intro c d + simp only [grad_phiMap_apply, QuantumGraph.Grad_apply] + rw [LinearMap.comp_apply, ← LinearMap.adjoint_inner_right, + map_sub, LinearMap.rTensor_adjoint, LinearMap.lTensor_adjoint, + LinearMap.adjoint_adjoint, LinearMap.sub_apply, + LinearMap.rTensor_tmul, LinearMap.lTensor_tmul, + ← LinearMap.adjoint_inner_right, Coalgebra.comul_eq_mul_adjoint, + LinearMap.adjoint_adjoint, map_sub] + simp_rw [LinearMap.mul'_apply] + simp only [LinearMap.comp_apply, + LinearEquiv.coe_coe, TensorProduct.lid_symm_apply, + TensorProduct.rid_symm_apply, + LinearMap.rTensor_tmul, Algebra.linearMap_apply, Algebra.algebraMap_eq_smul_one, + one_smul, LinearMap.sub_apply, + PhiMap.apply_real gns, PhiMap_rankOne, TensorProduct.map_adjoint, + LinearMap.adjoint_adjoint, LinearMap.lTensor_tmul, TensorProduct.map_tmul, + inner_sub_left, TensorProduct.inner_tmul, rmul_apply, one_mul, mul_one, + inner_sub_right, LinearMap.adjoint_inner_left, lmul_apply] + simp only [ContinuousLinearMap.linearMap_adjoint, rankOne_adjoint, + ContinuousLinearMap.coe_coe, rankOne_apply, smul_mul_assoc, inner_smul_right, + mul_smul_comm, mul_comm] + +theorem QuantumGraph.Grad_apply' (gns : k B = 0) (A : B →ₗ[ℂ] B) (x : B) : + QuantumGraph.Grad A x = (PhiMap (LinearMap.real A)).1 (1 ⊗ₜ x) - (PhiMap A).1 (x ⊗ₜ 1) := +by + simp_rw [Grad_eq gns, LinearMap.sub_apply, LinearMap.comp_apply, + LinearEquiv.coe_coe, + TensorProduct.lid_symm_apply, TensorProduct.rid_symm_apply, + LinearMap.lTensor_tmul, LinearMap.rTensor_tmul, + Algebra.linearMap_apply, Algebra.algebraMap_eq_smul_one, one_smul] + +theorem QuantumGraph.Real.range_grad_le_range_phiMap + (gns : k B = 0) {A : B →ₗ[ℂ] B} (hA : QuantumGraph.Real _ A) : + LinearMap.range (QuantumGraph.Grad A) ≤ LinearMap.range (PhiMap A).1 := +by + have : IsIdempotentElem (PhiMap A).1 := + by + rw [IsIdempotentElem, PhiMap_apply, ← schurMul_Upsilon_toBimodule, hA.1] + apply (IsIdempotentElem.comp_idempotent_iff this (p := QuantumGraph.Grad A)).mp + rw [QuantumGraph.Grad_eq gns, LinearMap.comp_sub] + simp_rw [← LinearMap.comp_assoc, LinearMap.real_of_isReal hA.2, + ← Module.End.mul_eq_comp, this.eq] + +theorem Upsilon_symm_grad_apply_apply (gns : k B = 0) (A : B →ₗ[ℂ] B) (x : B) : + Upsilon.symm (QuantumGraph.Grad A x) + = rmul x ∘ₗ LinearMap.real A - A ∘ₗ rmul x := +by + suffices ∀ a b : B, Upsilon.symm (QuantumGraph.Grad (rankOne ℂ a b) x) + = rmul x ∘ₗ LinearMap.real (rankOne ℂ a b) - rankOne ℂ a b ∘ₗ rmul x by + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne A + simp only [map_sum, LinearMap.sum_apply, this, LinearMap.real_sum, + LinearMap.comp_sum, LinearMap.sum_comp, Finset.sum_sub_distrib] + intro a b + rw [QuantumGraph.Grad_eq gns, PhiMap.apply_real gns, PhiMap_rankOne, + TensorProduct.map_adjoint, LinearMap.adjoint_adjoint] + simp only [LinearMap.sub_apply, LinearMap.comp_apply, LinearEquiv.coe_coe, + TensorProduct.lid_symm_apply, TensorProduct.rid_symm_apply, LinearMap.lTensor_tmul, + LinearMap.rTensor_tmul, Algebra.linearMap_apply, Algebra.algebraMap_eq_smul_one, one_smul, + TensorProduct.map_tmul, map_sub, Upsilon_symm_tmul, + lmul_adjoint, rmul_adjoint, lmul_apply, rmul_apply, mul_one, one_mul, + rankOne_real, LinearMap.comp_rankOne, LinearMap.rankOne_comp, + gns, neg_zero, mul_zero, zero_sub, starAlgebra.modAut_zero, + star_mul, map_mul, starAlgebra.modAut_star, starAlgebra.modAut_apply_modAut, + star_star, add_neg_cancel] + rfl + +theorem QuantumGraph.grad_adjoint_comp_grad (gns : k B = 0) (A : B →ₗ[ℂ] B) : + LinearMap.adjoint (Grad A) ∘ₗ Grad A + = outDegree (A •ₛ LinearMap.real A) + - A •ₛ A + - LinearMap.adjoint (A •ₛ A) + + inDegree (LinearMap.real A •ₛ A) := +by + rw [Grad_apply, LinearMap.adjoint_comp, Coalgebra.comul_eq_mul_adjoint, + map_sub, LinearMap.rTensor_adjoint, LinearMap.lTensor_adjoint] + simp_rw [LinearMap.adjoint_adjoint, ← Coalgebra.comul_eq_mul_adjoint] + rw [LinearMap.comp_assoc] + nth_rw 2 [← LinearMap.comp_assoc] + simp only [← Module.End.mul_eq_comp, sub_mul, mul_sub, + ← LinearMap.rTensor_mul, ← LinearMap.lTensor_mul] + simp only [Module.End.mul_eq_comp, + LinearMap.lTensor_comp_rTensor, LinearMap.rTensor_comp_lTensor] + simp only [LinearMap.sub_comp, LinearMap.comp_sub, LinearMap.rTensor, LinearMap.lTensor, + ← schurMul_apply_apply, outDegree_apply_schurMul gns, inDegree_apply_schurMul gns, + LinearMap.real_real, + symmMap_apply, schurMul_adjoint] + rw [sub_sub_sub_comm, sub_add] + rfl + +open scoped Bimodule +theorem Bimodule.lsmul_sub {R H₁ H₂ : Type*} [CommSemiring R] [Ring H₁] + [Ring H₂] [Algebra R H₁] [Algebra R H₂] (x : H₁) (a b : H₁ ⊗[R] H₂) : + x •ₗ (a - b) = x •ₗ a - x •ₗ b := +map_sub _ _ _ +theorem Bimodule.sub_rsmul {R H₁ H₂ : Type*} [CommSemiring R] [Ring H₁] + [Ring H₂] [Algebra R H₁] [Algebra R H₂] (x : H₂) (a b : H₁ ⊗[R] H₂) : + (a - b) •ᵣ x = a •ᵣ x - b •ᵣ x := +map_sub _ _ _ + +theorem QuantumGraph.apply_mul_of_isReal + (gns : k B = 0) {A : B →ₗ[ℂ] B} (hA : LinearMap.IsReal A) (x y : B) : + Grad A (x * y) = Grad A x •ᵣ y + x •ₗ Grad A y := +by + simp only [Grad_apply' gns, Bimodule.lsmul_sub, + PhiMap_apply, TensorProduct.toIsBimoduleMap_apply_coe, rmulMapLmul_apply_apply, + Bimodule.one_lsmul, Bimodule.rsmul_one, Bimodule.sub_rsmul, + Bimodule.rsmul_rsmul, Bimodule.lsmul_lsmul, + Bimodule.lsmul_rsmul_assoc, LinearMap.real_of_isReal hA, + sub_add_sub_cancel] diff --git a/LeanPool/Monlib4/QuantumGraph/Iso.lean b/LeanPool/Monlib4/QuantumGraph/Iso.lean new file mode 100644 index 0000000000..644392e2d5 --- /dev/null +++ b/LeanPool/Monlib4/QuantumGraph/Iso.lean @@ -0,0 +1,438 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.QuantumGraph.Basic +import LeanPool.Monlib4.QuantumGraph.Example + +/-! + # Isomorphisms between quantum graphs + + This file defines isomorphisms between quantum graphs. +-/ + + +open TensorProduct Matrix + +open scoped TensorProduct BigOperators Kronecker Functional + +variable {p n : Type _} [Fintype n] [Fintype p] [DecidableEq n] [DecidableEq p] + +local notation "⊗K" => Matrix (n × n) (n × n) ℂ + +local notation "l(" x ")" => x →ₗ[ℂ] x + +variable {φ : Module.Dual ℂ (Matrix n n ℂ)} {ψ : Module.Dual ℂ (Matrix p p ℂ)} + +local notation "|" x "⟩⟨" y "|" => @rankOne ℂ _ _ _ _ _ _ _ x y + +local notation "m" => LinearMap.mul' ℂ (Matrix n n ℂ) + +local notation "η" => Algebra.linearMap ℂ (Matrix n n ℂ) + +local notation x " ⊗ₘ " y => TensorProduct.map x y + +local notation "υ" => + (TensorProduct.assoc ℂ (Matrix n n ℂ) (Matrix n n ℂ) (Matrix n n ℂ) : + (Matrix n n ℂ ⊗[ℂ] Matrix n n ℂ) ⊗[ℂ] Matrix n n ℂ →ₗ[ℂ] + Matrix n n ℂ ⊗[ℂ] Matrix n n ℂ ⊗[ℂ] Matrix n n ℂ) + +local notation "υ⁻¹" => + (LinearEquiv.symm (TensorProduct.assoc ℂ (Matrix n n ℂ) (Matrix n n ℂ) (Matrix n n ℂ)) : + Matrix n n ℂ ⊗[ℂ] Matrix n n ℂ ⊗[ℂ] Matrix n n ℂ →ₗ[ℂ] + (Matrix n n ℂ ⊗[ℂ] Matrix n n ℂ) ⊗[ℂ] Matrix n n ℂ) + +local notation "ϰ" => + ((TensorProduct.comm ℂ (Matrix n n ℂ) ℂ) : + Matrix n n ℂ ⊗[ℂ] ℂ →ₗ[ℂ] ℂ ⊗[ℂ] Matrix n n ℂ) + +local notation "ϰ⁻¹" => + (LinearEquiv.symm (TensorProduct.comm ℂ (Matrix n n ℂ) ℂ) : + ℂ ⊗[ℂ] Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ ⊗[ℂ] ℂ) + +local notation "τ" => + (TensorProduct.lid ℂ (Matrix n n ℂ) : + ℂ ⊗[ℂ] Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ) + +local notation "τ⁻¹" => + (LinearEquiv.symm (TensorProduct.lid ℂ (Matrix n n ℂ)) : Matrix n n ℂ →ₗ[ℂ] ℂ ⊗[ℂ] Matrix n n ℂ) + +local notation "id" => (1 : Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ) + +private theorem commutes_with_mul''_adjoint [hφ : φ.IsFaithfulPosMap] [Nontrivial n] + {f : (Matrix n n ℂ) ≃⋆ₐ[ℂ] (Matrix n n ℂ)} (hf : f φ.matrix = φ.matrix) : + withMatrixQuantum[φ] + ( + TensorProduct.map f.toLinearMap f.toLinearMap + ∘ₗ Coalgebra.comul = + Coalgebra.comul ∘ₗ f.toLinearMap) := + by + exact withMatrixQuantum[φ] (by + change + TensorProduct.map f.toLinearMap f.toLinearMap + ∘ₗ LinearMap.adjoint (LinearMap.mul' ℂ (Matrix n n ℂ)) = + LinearMap.adjoint (LinearMap.mul' ℂ (Matrix n n ℂ)) ∘ₗ f.toLinearMap + rw [LinearMap.commutes_with_mul_adjoint_iff f.toLinearMap] + -- rw [LinearMap.comp_assoc] + have := + (List.TFAE.out + (@Module.Dual.IsFaithfulPosMap.starAlgEquiv_is_isometry_tFAE n _ _ φ _ _ f) + 0 1).mp + hf + simp_rw [this, StarAlgEquiv.toLinearMap_apply, _root_.map_mul, implies_true]) + +open scoped Matrix + +theorem innerAut_adjoint_eq_iff [hφ : φ.IsFaithfulPosMap] [Nontrivial n] + (U : unitaryGroup n ℂ) : + withMatrixQuantum[φ] + (LinearMap.adjoint (innerAut U) = innerAut (star U) ↔ Commute φ.matrix U) := + by + exact withMatrixQuantum[φ] (by + have hf : ∀ U : unitaryGroup n ℂ, innerAut U = (innerAutStarAlg U).toLinearMap := + fun _ => rfl + have hh : ∀ U : unitaryGroup n ℂ, (innerAutStarAlg U).symm = innerAutStarAlg (star U) := + by + intro V + ext1 + simp_rw [innerAutStarAlg_symm_apply, innerAutStarAlg_apply, Unitary.star_eq_inv, + UnitaryGroup.inv_apply, star_star] + have hf' : innerAut (star U) = (innerAutStarAlg U).symm.toLinearMap := by + rw [hh, hf] + have := List.TFAE.out + (@Module.Dual.IsFaithfulPosMap.starAlgEquiv_is_isometry_tFAE n _ _ φ hφ _ + (innerAutStarAlg U)) + 1 0 + rw [hf, hf', this, + innerAutStarAlg_apply, unitaryGroup.injective_hMul U, Matrix.mul_assoc, ← + unitaryGroup.star_coe_eq_coe_star, UnitaryGroup.star_mul_self, Matrix.mul_one] + exact ⟨fun h => h.symm, fun h => h.symm⟩) + +theorem Qam.mul'_adjoint_commutes_with_innerAut_lm [hφ : φ.IsFaithfulPosMap] [Nontrivial n] + {x : Matrix.unitaryGroup n ℂ} (hx : Commute φ.matrix x) : + withMatrixQuantum[φ] + ( + TensorProduct.map (innerAut x) (innerAut x) ∘ₗ Coalgebra.comul = + Coalgebra.comul ∘ₗ innerAut x) := +by + exact withMatrixQuantum[φ] (commutes_with_mul''_adjoint (f := innerAutStarAlg x) (by + rw [innerAutStarAlg_apply, ← hx, mul_assoc, ← unitaryGroup.star_coe_eq_coe_star, + unitaryGroup.star_coe_eq_coe_star, Unitary.coe_mul_star_self, mul_one])) + +theorem Qam.unit_commutes_with_innerAut_lm (U : Matrix.unitaryGroup n ℂ) : + innerAut U ∘ₗ η = η := by + rw [commutes_with_unit_iff, innerAut_apply_one] + +theorem Qam.mul'_commutes_with_innerAut_lm (x : Matrix.unitaryGroup n ℂ) : + m ∘ₗ ((innerAut x) ⊗ₘ (innerAut x)) = innerAut x ∘ₗ m := +by simp_rw [commutes_with_mul'_iff, innerAut.map_mul, forall₂_true_iff] + +theorem Qam.unit_adjoint_commutes_with_innerAut_lm [hφ : φ.IsFaithfulPosMap] [Nontrivial n] + {U : Matrix.unitaryGroup n ℂ} (hU : Commute φ.matrix U) : + withMatrixQuantum[φ] + ( + Coalgebra.counit ∘ₗ innerAut U = Coalgebra.counit) := + by + exact withMatrixQuantum[φ] (by + rw [← innerAut_adjoint_eq_iff] at hU + apply_fun LinearMap.adjoint using LinearMap.adjoint.injective + rw [LinearMap.adjoint_comp, Coalgebra.counit_eq_unit_adjoint, LinearMap.adjoint_adjoint, + hU] + ext1 + simp [LinearMap.comp_apply, Algebra.linearMap_apply]) + +local notation "f_{" x "}" => innerAut x + +theorem innerAutIsReal (U : unitaryGroup n ℂ) : LinearMap.IsReal (innerAut U) := fun _ => + (innerAut.map_star _ _).symm + +-- def StarAlgEquiv.IsIsometry [hφ : φ.IsFaithfulPosMap] (f : (Matrix n n ℂ) ≃⋆ₐ[ℂ] (Matrix n n ℂ)) +-- : Prop := + -- ∀ x, ‖f x‖ = ‖x‖ +@[reducible] +alias StarAlgEquiv.IsIsometry := Isometry + +open scoped InnerProductSpace + +theorem InnerAut.toMatrix [hφ : φ.IsFaithfulPosMap] (U : unitaryGroup n ℂ) : + withMatrixQuantum[φ] + ( + hφ.toMatrix (innerAut U) = U ⊗ₖ (modAut (-(1 / 2)) U)ᴴᵀ) := + by + exact withMatrixQuantum[φ] (by + ext + simp only [Module.Dual.IsFaithfulPosMap.toMatrix, LinearMap.toMatrixAlgEquiv_apply, + modAut, + Module.Dual.IsFaithfulPosMap.inner_coord', Module.Dual.IsFaithfulPosMap.basis_repr_apply, + Module.Dual.IsFaithfulPosMap.inner_coord'] + simp only [mul_apply, single, mul_ite, ite_mul, + MulZeroClass.mul_zero, MulZeroClass.zero_mul, one_mul, Finset.sum_ite_irrel, + Finset.sum_ite_eq, Finset.sum_const_zero, Finset.mem_univ, + if_true, ite_and, kroneckerMap, of_apply, conj_apply, sig_apply, star_sum, + star_mul', neg_neg, Finset.mul_sum, Finset.sum_mul, mul_assoc, innerAut_apply', + Module.Dual.IsFaithfulPosMap.basis_apply] + simp_rw [← star_apply, star_eq_conjTranspose] + repeat' apply Finset.sum_congr rfl; intros + simp_rw [← star_eq_conjTranspose, ← unitaryGroup.star_coe_eq_coe_star] + congr 1 + simp_rw [star_apply, ← conjTranspose_apply, + (PosDef.rpow.isPosDef _ _).isHermitian.eq] + nth_rw 1 [mul_rotate', ← mul_assoc] + rw [mul_comm _ (PosDef.rpow _ (1 / 2) _ _), mul_assoc]) + +theorem unitary_commutes_with_hφ_matrix_iff_isIsometry (hφ : φ.IsFaithfulPosMap) [Nontrivial n] + (U : unitaryGroup n ℂ) : + letI : φ.IsFaithfulPosMap := hφ + withMatrixQuantum[φ] + ( + Commute φ.matrix U ↔ StarAlgEquiv.IsIsometry (innerAutStarAlg U)) := by + letI : φ.IsFaithfulPosMap := hφ + exact withMatrixQuantum[φ] (by + rw [← innerAut_adjoint_eq_iff, ← innerAutStarAlg_equiv_toLinearMap, ← + innerAut_inv_eq_star, ← innerAutStarAlg_equiv_symm_toLinearMap] + have := List.TFAE.out + (@Module.Dual.IsFaithfulPosMap.starAlgEquiv_is_isometry_tFAE n _ _ φ _ _ + (innerAutStarAlg U)) + 1 4 + change LinearMap.adjoint (innerAutStarAlg U).toLinearMap = + (innerAutStarAlg U).symm.toLinearMap ↔ + StarAlgEquiv.IsIsometry (innerAutStarAlg U) + rw [this, StarAlgEquiv.IsIsometry, iff_comm] + exact isometry_iff_norm _) + +theorem Qam.symm_apply_starAlgEquiv_conj [hφ : φ.IsFaithfulPosMap] [Nontrivial n] + {f : (Matrix n n ℂ) ≃⋆ₐ[ℂ] (Matrix n n ℂ)} + (hf : StarAlgEquiv.IsIsometry f) (A : l((Matrix n n ℂ))) : + withMatrixQuantum[φ] + ( + symmMap ℂ (Matrix n n ℂ) _ (f.toLinearMap ∘ₗ A ∘ₗ f.symm.toLinearMap) = + f.toLinearMap ∘ₗ (symmMap ℂ (Matrix n n ℂ) _ A) ∘ₗ f.symm.toLinearMap) := + by + exact withMatrixQuantum[φ] (by + have := List.TFAE.out + (@Module.Dual.IsFaithfulPosMap.starAlgEquiv_is_isometry_tFAE n _ _ φ _ _ f) 4 1 + rw [StarAlgEquiv.IsIsometry, isometry_iff_norm, this] at hf + change LinearMap.adjoint f.toAlgEquiv.toLinearMap = f.symm.toAlgEquiv.toLinearMap at hf + change LinearMap.adjoint + (LinearMap.real (f.toAlgEquiv.toLinearMap ∘ₗ A ∘ₗ f.symm.toAlgEquiv.toLinearMap)) = + f.toAlgEquiv.toLinearMap ∘ₗ LinearMap.adjoint (LinearMap.real A) ∘ₗ + f.symm.toAlgEquiv.toLinearMap + rw [LinearMap.real_starAlgEquiv_conj, LinearMap.adjoint_comp, hf] + nth_rw 1 [← hf] + rw [LinearMap.adjoint_comp, LinearMap.adjoint_adjoint, LinearMap.comp_assoc]) + +theorem InnerAut.symmetric_eq [hφ : φ.IsFaithfulPosMap] [Nontrivial n] (A : l((Matrix n n ℂ))) + {U : Matrix.unitaryGroup n ℂ} (hU : Commute φ.matrix U) : + withMatrixQuantum[φ] + ( + symmMap ℂ (Matrix n n ℂ) _ (f_{U} ∘ₗ A ∘ₗ f_{star U}) = + f_{U} ∘ₗ symmMap ℂ (Matrix n n ℂ) _ A ∘ₗ f_{star U}) := + by + exact withMatrixQuantum[φ] (by + rw [← innerAut_inv_eq_star, ← innerAutStarAlg_equiv_symm_toLinearMap, ← + innerAutStarAlg_equiv_toLinearMap] + exact Qam.symm_apply_starAlgEquiv_conj + ((unitary_commutes_with_hφ_matrix_iff_isIsometry hφ U).mp hU) _) + +open scoped Classical in +omit [DecidableEq n] in +theorem StarAlgEquiv.commutes_with_mul' (f : (Matrix n n ℂ) ≃⋆ₐ[ℂ] (Matrix n n ℂ)) : + letI : DecidableEq n := Classical.decEq n + (LinearMap.mul' ℂ (Matrix n n ℂ) ∘ₗ f.toLinearMap ⊗ₘ f.toLinearMap) = + f.toLinearMap ∘ₗ LinearMap.mul' ℂ (Matrix n n ℂ) := + by + classical + rw [commutes_with_mul'_iff] + intro x y + simp only [StarAlgEquiv.toLinearMap_apply, _root_.map_mul] + +theorem StarAlgEquiv.IsIsometry.commutes_with_mul'_adjoint + [hφ : φ.IsFaithfulPosMap] [Nontrivial n] {f : (Matrix n n ℂ) ≃⋆ₐ[ℂ] (Matrix n n ℂ)} + (hf : StarAlgEquiv.IsIsometry f) : + withMatrixQuantum[φ] + ( + (f.toLinearMap ⊗ₘ f.toLinearMap) ∘ₗ LinearMap.adjoint (LinearMap.mul' ℂ (Matrix n n ℂ)) = + LinearMap.adjoint (LinearMap.mul' ℂ (Matrix n n ℂ)) ∘ₗ f.toLinearMap) := + by + exact withMatrixQuantum[φ] (by + have := List.TFAE.out + (@Module.Dual.IsFaithfulPosMap.starAlgEquiv_is_isometry_tFAE n _ _ φ _ _ f) 4 1 + rw [StarAlgEquiv.IsIsometry, isometry_iff_norm, this] at hf + rw [← LinearMap.adjoint_adjoint (f.toLinearMap ⊗ₘ f.toLinearMap), ← + LinearMap.adjoint_comp, TensorProduct.map_adjoint, hf, + StarAlgEquiv.commutes_with_mul' f.symm, LinearMap.adjoint_comp, ← hf, + LinearMap.adjoint_adjoint]) + +theorem Qam.reflIdempotent_starAlgEquiv_conj [hφ : φ.IsFaithfulPosMap] [Nontrivial n] + {f : (Matrix n n ℂ) ≃⋆ₐ[ℂ] (Matrix n n ℂ)} + (hf : StarAlgEquiv.IsIsometry f) (A B : l((Matrix n n ℂ))) : + withMatrixQuantum[φ] + ( + (f.toLinearMap ∘ₗ A ∘ₗ f.symm.toLinearMap) •ₛ (f.toLinearMap ∘ₗ B ∘ₗ f.symm.toLinearMap) = + f.toLinearMap ∘ₗ (A •ₛ B) ∘ₗ f.symm.toLinearMap) := + by + exact withMatrixQuantum[φ] (by + simp only [schurMul_apply_apply, TensorProduct.map_comp, ← + LinearMap.comp_assoc, StarAlgEquiv.commutes_with_mul' f] + have hsymm : StarAlgEquiv.IsIsometry f.symm := + by + simp_rw [StarAlgEquiv.IsIsometry, isometry_iff_norm] at hf ⊢ + have := List.TFAE.out + (@Module.Dual.IsFaithfulPosMap.starAlgEquiv_is_isometry_tFAE n _ _ φ _ _ f.symm) + 4 1 + rw [this] + have this' := List.TFAE.out + (@Module.Dual.IsFaithfulPosMap.starAlgEquiv_is_isometry_tFAE n _ _ φ _ _ f) + 4 1 + rw [this'] at hf + rw [StarAlgEquiv.symm_symm, ← hf, LinearMap.adjoint_adjoint] + change + (((f.toLinearMap ∘ₗ LinearMap.mul' ℂ (Matrix n n ℂ)) ∘ₗ A ⊗ₘ B) ∘ₗ + f.symm.toLinearMap ⊗ₘ f.symm.toLinearMap) ∘ₗ + LinearMap.adjoint (LinearMap.mul' ℂ (Matrix n n ℂ)) = + (((f.toLinearMap ∘ₗ LinearMap.mul' ℂ (Matrix n n ℂ)) ∘ₗ A ⊗ₘ B) ∘ₗ + LinearMap.adjoint (LinearMap.mul' ℂ (Matrix n n ℂ))) ∘ₗ + f.symm.toLinearMap + simp only [LinearMap.comp_assoc, + StarAlgEquiv.IsIsometry.commutes_with_mul'_adjoint hsymm]) + + +theorem InnerAut.reflIdempotent [hφ : φ.IsFaithfulPosMap] + [Nontrivial n] {U : unitaryGroup n ℂ} (hU : Commute φ.matrix U) + (A B : l((Matrix n n ℂ))) : + withMatrixQuantum[φ] + ( + (f_{U} ∘ₗ A ∘ₗ f_{star U}) •ₛ (f_{U} ∘ₗ B ∘ₗ f_{star U}) = + f_{U} ∘ₗ (A •ₛ B) ∘ₗ f_{star U}) := + by + exact withMatrixQuantum[φ] (by + rw [← innerAut_inv_eq_star, ← innerAutStarAlg_equiv_symm_toLinearMap, ← + innerAutStarAlg_equiv_toLinearMap] + rw [unitary_commutes_with_hφ_matrix_iff_isIsometry hφ U] at hU + exact Qam.reflIdempotent_starAlgEquiv_conj hU _ _) + +/-- Isomorphism relation between two matrix quantum adjacency maps. -/ +def Qam.Iso (A B : l((Matrix n n ℂ))) : Prop := + ∃ f : (Matrix n n ℂ) ≃⋆ₐ[ℂ] (Matrix n n ℂ), + A ∘ₗ f.toLinearMap = f.toLinearMap ∘ₗ B ∧ f φ.matrix = φ.matrix + +-- structure QamIso [hφ : φ.IsFaithfulPosMap] {A B : l((Matrix n n ℂ))} (hA : Qam φ A) (hB : Qam φ +-- B) extends +-- StarAlgEquiv ℂ (Matrix n n ℂ) (Matrix n n ℂ) where +-- IsHom := +-- A ∘ₗ toStarAlgEquiv.toLinearMap = toStarAlgEquiv.toLinearMap ∘ₗ B +-- is_iso := toFun φ.matrix = φ.matrix + +-- -- TODO: +-- def qam.lm.reflexive.iso {A B : l((Matrix n n ℂ))} (hA : qam_lm_is_reflexive A) +-- (hB : qam_lm_is_reflexive B) : +-- Prop := +-- ∃ f : (Matrix n n ℂ) ≃⋆ₐ[ℂ] (Matrix n n ℂ), A ∘ f = f ∘ B +-- def qam.lm.unreflexive.iso {A B : l((Matrix n n ℂ))} (hA : qam_lm_is_unreflexive A) +-- (hB : qam_lm_is_unreflexive B) : Prop := +-- ∃ f : (Matrix n n ℂ) ≃⋆ₐ[ℂ] (Matrix n n ℂ), A ∘ f = f ∘ B +theorem Qam.iso_iff [hφ : φ.IsFaithfulPosMap] {A B : l((Matrix n n ℂ))} [Nontrivial n] : + @Qam.Iso n _ _ φ A B ↔ + ∃ U : unitaryGroup n ℂ, A ∘ₗ innerAut U = innerAut U ∘ₗ B ∧ Commute φ.matrix U := + by + exact withMatrixQuantum[φ] (by + simp_rw [← innerAut_adjoint_eq_iff] + have hf : ∀ U : unitaryGroup n ℂ, f_{U} = (innerAutStarAlg U).toLinearMap := + fun _ => rfl + have hh : ∀ U : unitaryGroup n ℂ, (innerAutStarAlg U).symm = innerAutStarAlg (star U) := + by + intro V + ext1 + simp_rw [innerAutStarAlg_symm_apply, innerAutStarAlg_apply, Unitary.star_eq_inv, + UnitaryGroup.inv_apply, star_star] + have := fun U => + List.TFAE.out + (@Module.Dual.IsFaithfulPosMap.starAlgEquiv_is_isometry_tFAE n _ _ φ _ _ + (innerAutStarAlg U)) + 1 0 + simp_rw [hf, ← hh, this] + constructor + · rintro ⟨f, hf⟩ + obtain ⟨U, rfl⟩ := StarAlgEquiv.of_matrix_is_inner f + exact ⟨U, hf⟩ + · rintro ⟨U, hU⟩ + exact ⟨innerAutStarAlg U, hU⟩) + +theorem Qam.iso_preserves_spectrum (A B : l((Matrix n n ℂ))) (h : @Qam.Iso n _ _ φ A B) : + spectrum ℂ A = spectrum ℂ B := by + obtain ⟨f, ⟨hf, _⟩⟩ := h + let f' := f.toLinearMap + let f'' := f.symm.toLinearMap + have hh' : f'' ∘ₗ f' = LinearMap.id := + by + rw [LinearMap.ext_iff] + intro x + simp_rw [LinearMap.comp_apply, f', f'', StarAlgEquiv.toLinearMap_apply, + StarAlgEquiv.symm_apply_apply, LinearMap.id_apply] + have : B = f'' ∘ₗ A ∘ₗ f' := by rw [hf, ← LinearMap.comp_assoc, hh', LinearMap.id_comp] + have hh'' : f' ∘ₗ f'' = LinearMap.id := by + rw [LinearMap.ext_iff] + intro x + simp_rw [LinearMap.comp_apply, f', f'', StarAlgEquiv.toLinearMap_apply, + StarAlgEquiv.apply_symm_apply, LinearMap.id_apply] + rw [this, spectrum.comm f'' (A ∘ₗ f'), LinearMap.comp_assoc, + hh'', LinearMap.comp_id] + +-- MOVE: +theorem innerAut_lm_rankOne [hφ : φ.IsFaithfulPosMap] [Nontrivial n] + {U : Matrix.unitaryGroup n ℂ} (hU : Commute φ.matrix U) (x y : (Matrix n n ℂ)) : + withMatrixQuantum[φ] + ( + f_{U} ∘ₗ (|x⟩⟨y| : l((Matrix n n ℂ))) ∘ₗ f_{star U} = + |f_{U} x⟩⟨f_{U} y|) := + by + exact withMatrixQuantum[φ] (by + rw [← innerAut_adjoint_eq_iff] at hU + simp_rw [LinearMap.ext_iff, LinearMap.comp_apply, ContinuousLinearMap.coe_coe, + rankOne_apply, _root_.map_smul, ← hU, LinearMap.adjoint_inner_right, + forall_true_iff]) + +local notation "e_{" x "," y "}" => Matrix.stdBasisMatrix x y (1 : ℂ) + +--MOVE: +theorem innerAut_lm_basis_apply (U : Matrix.unitaryGroup n ℂ) (i j k l : n) : + (f_{U} e_{i,j}) k l = (U ⊗ₖ star U) (k, j) (i, l) := + by + simp_rw [Matrix.innerAut_apply, Matrix.mul_apply, Matrix.UnitaryGroup.inv_apply, + Matrix.stdBasisMatrix, Matrix.single, of_apply, mul_boole, Finset.sum_mul, ite_mul, + MulZeroClass.zero_mul, ite_and, + Matrix.kroneckerMap, Matrix.of_apply] + simp only [Finset.sum_ite_eq, Finset.mem_univ, if_true] + +lemma Module.Dual.IsFaithfulPosMap.basis_eq_onb_toBasis + [hφ : φ.IsFaithfulPosMap] : + withMatrixQuantum[φ] + (hφ.basis = (hφ.orthonormalBasis).toBasis) := +by + exact withMatrixQuantum[φ] (by + ext + simp only [OrthonormalBasis.coe_toBasis, Module.Dual.IsFaithfulPosMap.orthonormalBasis_apply, + Module.Dual.IsFaithfulPosMap.basis_apply]) + +theorem Qam.rankOne_toMatrix_of_star_algEquiv_coord [hφ : φ.IsFaithfulPosMap] + (x y : Matrix n n ℂ) (i j k l : n) : + withMatrixQuantum[φ] + ( + hφ.toMatrix |x⟩⟨y| (i, j) (k, l) = + ((x * hφ.matrixIsPosDef.rpow (1 / 2)) ⊗ₖ (y * hφ.matrixIsPosDef.rpow (1 / 2))ᴴᵀ) + (i, k) (j, l)) := +by + exact withMatrixQuantum[φ] (by + simp only [Module.Dual.IsFaithfulPosMap.toMatrix, + LinearMap.toMatrixAlgEquiv, + AlgEquiv.ofLinearEquiv_apply, + Module.Dual.IsFaithfulPosMap.basis_eq_onb_toBasis, + rankOne_toMatrix_of_onb] + simp_rw [conjTranspose_replicateCol, Matrix.mul_apply, Matrix.replicateCol_apply, + Matrix.replicateRow_apply, Pi.star_apply, kronecker_apply, conj_apply] + simp only [Finset.sum_const, nsmul_eq_mul] + simp only [OrthonormalBasis.repr_apply_apply, + Module.Dual.IsFaithfulPosMap.inner_coord] + simp only [Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Finset.card_singleton, + Nat.cast_one, one_div, RCLike.star_def, one_mul]) diff --git a/LeanPool/Monlib4/QuantumGraph/Matrix.lean b/LeanPool/Monlib4/QuantumGraph/Matrix.lean new file mode 100644 index 0000000000..944d5dfc8c --- /dev/null +++ b/LeanPool/Monlib4/QuantumGraph/Matrix.lean @@ -0,0 +1,1015 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.QuantumGraph.PiMatFinTwo + +open scoped Functional MatrixOrder ComplexOrder TensorProduct Matrix + +open scoped Kronecker + +variable {n : Type*} [Fintype n] [DecidableEq n] + {φ : Module.Dual ℂ (Matrix n n ℂ)} [hφ : φ.IsFaithfulPosMap] + +/-- Elaborate a matrix quantum-graph statement with its finite-dimensional coalgebra. -/ +syntax "withMatrixCoalgebraQuantum[" term "] " term : term +macro_rules + | `(withMatrixCoalgebraQuantum[$φ] $p) => + `(withMatrixQuantum[$φ] + letI : Coalgebra ℂ (Matrix n n ℂ) := Coalgebra.ofFiniteDimensionalHilbertAlgebra + $p) + +/-- Introduce the matrix quantum-set and finite-dimensional coalgebra instances in a proof. -/ +syntax "withMatrixCoalgebraQuantumCtx" "[" term "]" : tactic +macro_rules + | `(tactic| withMatrixCoalgebraQuantumCtx[$φ]) => + `(tactic| + withMatrixQuantumCtx[$φ]; + letI : Coalgebra ℂ (Matrix n n ℂ) := Coalgebra.ofFiniteDimensionalHilbertAlgebra) + +theorem lmul_toMatrix (x : Matrix n n ℂ) : + withMatrixQuantum[φ] + (onb.toMatrix (lmul x) = x ⊗ₖ (1 : Matrix n n ℂ)) := +by + withMatrixQuantumCtx[φ] + simp only [← Matrix.ext_iff, QuantumSet.n] + intro i j + simp_rw [OrthonormalBasis.toMatrix_apply, lmul_apply, Matrix.kroneckerMap_apply, + onb, Module.Dual.IsFaithfulPosMap.inner_coord hφ, + hφ.orthonormalBasis_apply, mul_assoc, Matrix.PosDef.rpow_mul_rpow, + neg_add_cancel, Matrix.PosDef.rpow_zero, mul_one, Matrix.mul_apply, + Matrix.single_eq, Matrix.one_apply, mul_boole, ite_and, Finset.sum_ite_eq, + Finset.mem_univ, if_true, eq_comm] + +theorem rmul_toMatrix (x : Matrix n n ℂ) : + withMatrixQuantum[φ] + (onb.toMatrix (rmul x) = (1 : Matrix n n ℂ) ⊗ₖ (modAut (1 / 2) x)ᵀ) := +by + withMatrixQuantumCtx[φ] + simp only [← Matrix.ext_iff, QuantumSet.n] + intro i j + simp_rw [OrthonormalBasis.toMatrix_apply, rmul_apply, Matrix.kroneckerMap_apply, + onb, Module.Dual.IsFaithfulPosMap.inner_coord hφ, + hφ.orthonormalBasis_apply, mul_assoc, + modAut, ← mul_assoc (Matrix.PosDef.rpow _ _), ← sig_apply, Matrix.mul_apply, + Matrix.single_eq, Matrix.one_apply, boole_mul, ite_and, + Finset.sum_ite_irrel, Finset.sum_const_zero, Finset.sum_ite_eq, + Finset.mem_univ, if_true, eq_comm] + rfl + +open Matrix + +theorem Matrix.single_transpose {R n p : Type*} [DecidableEq n] [DecidableEq p] + [Zero R] {i : n} {j : p} {α : R} : + (single i j α)ᵀ = single j i α := +by ext; simp_rw [transpose_apply, single, of_apply, and_comm] + +lemma Module.Dual.IsFaithfulPosMap.inner_coord_onb + (y : Matrix n n ℂ) (i j : n) : + withMatrixQuantum[φ] + (inner ℂ (onb (i, j)) y = (y * hφ.matrixIsPosDef.rpow (1 / 2)) i j) := +by + withMatrixQuantumCtx[φ] + exact hφ.inner_coord _ _ + +/-- Matrix transpose as a star-algebra equivalence to the opposite algebra. -/ +noncomputable abbrev Matrix.transposeStarAlgEquiv (ι : Type*) [Fintype ι] [DecidableEq ι] : + Matrix ι ι ℂ ≃⋆ₐ[ℂ] (Matrix ι ι ℂ)ᵐᵒᵖ := +StarAlgEquiv.ofAlgEquiv (transposeAlgEquiv ι ℂ ℂ) (fun _ => rfl) +theorem Matrix.transposeStarAlgEquiv_apply {ι : Type*} [Fintype ι] [DecidableEq ι] + (x : Matrix ι ι ℂ) : + Matrix.transposeStarAlgEquiv ι x = MulOpposite.op (xᵀ) := +rfl +theorem Matrix.transposeStarAlgEquiv_symm_apply {ι : Type*} [Fintype ι] [DecidableEq ι] + (x : (Matrix ι ι ℂ)ᵐᵒᵖ) : + (Matrix.transposeStarAlgEquiv ι).symm x = x.unopᵀ := +rfl + +theorem QuantumSet.Psi_symm_transpose_kroneckerToTensor_toMatrix_rankOne + (x y : Matrix n n ℂ) : + withMatrixQuantum[φ] + ((QuantumSet.Psi 0 (1 / 2)).symm + ((StarAlgEquiv.lTensor _ (transposeStarAlgEquiv n)) + (kroneckerToTensor + (onb.toMatrix ((rankOne ℂ x y) : Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ)))) = + lmul (x * φ.matrix) * (LinearMap.adjoint (rmul (φ.matrix * y)))) := +by + withMatrixQuantumCtx[φ] + simp only [← StarAlgEquiv.coe_toAlgEquiv, + ← orthonormalBasis_toMatrix_eq_basis_toMatrix, + LinearMap.toMatrixAlgEquiv, AlgEquiv.ofLinearEquiv_apply, + rankOne_toMatrix_of_onb, conjTranspose_replicateCol] + rw [show replicateCol (Fin 1) (onb.repr x).ofLp * + replicateRow (Fin 1) (star (onb.repr y).ofLp) = + vecMulVec (onb.repr x).ofLp (star (onb.repr y).ofLp) from + (Matrix.vecMulVec_eq (Fin 1) (onb.repr x).ofLp + (star (onb.repr y).ofLp)).symm] + rw [Matrix.kmul_representation (vecMulVec _ _)] + simp only [map_sum, _root_.map_smul, kroneckerToTensor, tensorToKronecker_symm_apply, + kroneckerToTensorProduct_apply, StarAlgEquiv.coe_toAlgEquiv, + StarAlgEquiv.lTensor_tmul, QuantumSet.Psi_symm_apply, + QuantumSet.Psi_invFun_apply, vecMulVec_apply, neg_zero, starAlgebra.modAut_zero, + transposeStarAlgEquiv_apply, MulOpposite.unop_op, AlgEquiv.one_apply] + simp_rw [← rankOne_lm_smul_smul, Pi.star_apply, star_star, + single_transpose, star_eq_conjTranspose, single_conjTranspose, + star_one] + ext1 + simp only [LinearMap.sum_apply, ContinuousLinearMap.coe_coe, + rankOne_apply, inner_smul_left, QuantumSet.modAut_isSymmetric, + Module.End.mul_apply, rmul_adjoint, rmul_apply, lmul_apply, + OrthonormalBasis.repr_apply_apply, inner_single_left, + Module.Dual.IsFaithfulPosMap.inner_coord_onb (hφ := hφ)] + simp_rw [starRingEnd_apply, smul_smul, mul_assoc, + ← mul_comm _ ((modAut (-(1/2)) (_ : Matrix n n ℂ) * φ.matrix) _ _), + ] + rw [Finset.sum_sum_comm_sum] + simp only [← Finset.sum_smul, ← Finset.mul_sum, ← mul_apply] + rw [Matrix.k (φ := φ)] + simp_rw [mul_comm (star _), ← conjTranspose_apply, ← mul_apply, ← smul_single', + conjTranspose_apply, modAut, sig_apply, star_eq_conjTranspose, conjTranspose_mul, + (PosDef.rpow.isPosDef _ _).1.eq, hφ.matrixIsPosDef.1.eq] + rw [← matrix_eq_sum_single] + rw [show (modAut (-(1 / 2)) : Matrix n n ℂ ≃ₐ[ℂ] Matrix n n ℂ) = + hφ.sig (-(1 / 2)) from rfl] + simp only [Module.Dual.IsFaithfulPosMap.sig_apply, neg_neg] + simp_rw [← mul_assoc] + nth_rw 1 [mul_assoc _ (PosDef.rpow _ _) (PosDef.rpow _ _)] + rw [PosDef.rpow_mul_rpow] + simp only [mul_assoc] + nth_rw 5 [← mul_assoc] + nth_rw 3 [← PosDef.rpow_one_eq_self hφ.matrixIsPosDef] + nth_rw 5 [← PosDef.rpow_one_eq_self hφ.matrixIsPosDef] + nth_rw 7 [← PosDef.rpow_one_eq_self hφ.matrixIsPosDef] + simp_rw [PosDef.rpow_mul_rpow] + nth_rw 4 [← mul_assoc] + rw [PosDef.rpow_mul_rpow] + ring_nf + simp only [PosDef.rpow_zero, mul_one] + +theorem QuantumGraph.Real.matrix_isOrthogonalProjection + : withMatrixCoalgebraQuantum[φ] + ∀ {A : Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ}, (hA : QuantumGraph.Real _ A) → + (ContinuousLinearMap.toLinearMapAlgEquiv.symm + ((onb.toMatrix.symm (tensorToKronecker + ((StarAlgEquiv.lTensor _ (transposeStarAlgEquiv n).symm) + ((QuantumSet.Psi 0 (1 / 2)) A)))) + : Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ)).IsOrthogonalProjection := +by + withMatrixCoalgebraQuantumCtx[φ] + intro A hA + rw [ContinuousLinearMap.toLinearMapAlgEquiv_symm_apply, + LinearMap.isOrthogonalProjection_iff] + rw [IsIdempotentElem, ← _root_.map_mul, ← map_mul tensorToKronecker, + ← map_mul (StarAlgEquiv.lTensor _ _), ← Psi.schurMul, hA.1] + refine ⟨rfl, ?_⟩ + rw [isSelfAdjoint_iff, ← map_star] + simp_rw [tensorToKronecker, AlgEquiv.coe_mk, Equiv.coe_fn_mk] + rw [TensorProduct.toKronecker_star, ← map_star] + congr + simpa [QuantumSet.k] using + (quantumGraphReal_iff_Psi_isIdempotentElem_and_isSelfAdjoint.mp hA).2 + +/-- The submodule corresponding to a real matrix quantum graph. -/ +noncomputable def QuantumGraph.Real.matrix_submodule + : withMatrixCoalgebraQuantum[φ] + ∀ {A : Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ}, (hA : QuantumGraph.Real _ A) → + Submodule ℂ (Matrix n n ℂ) := +by + withMatrixCoalgebraQuantumCtx[φ] + intro A hA + choose U hU using orthogonal_projection_iff.mpr ((And.comm.mp + (ContinuousLinearMap.isOrthogonalProjection_iff'.mp + hA.matrix_isOrthogonalProjection))) + exact U + +lemma QuantumGraph.Real.matrix_orthogonalProjection_eq + : withMatrixCoalgebraQuantum[φ] + ∀ {A : Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ}, (hA : QuantumGraph.Real _ A) → + orthogonalProjection' (hA.matrix_submodule (φ := φ)) = + ContinuousLinearMap.toLinearMapAlgEquiv.symm ((onb.toMatrix.symm + (tensorToKronecker + ((StarAlgEquiv.lTensor (Matrix n n ℂ) + (transposeStarAlgEquiv n).symm) + ((QuantumSet.Psi 0 (1 / 2)) A))))) := +by + withMatrixCoalgebraQuantumCtx[φ] + intro A hA + rw [matrix_submodule] + generalize_proofs + (expose_names; exact pf_24) +-- QuantumGraph.Real.matrix_submodule.proof_19 hA + +theorem StarAlgEquiv.lTensor_symm {R A B C : Type*} + [RCLike R] [Ring A] [Ring B] [Ring C] [Algebra R A] [Algebra R B] [Algebra R C] + [StarAddMonoid A] [StarAddMonoid B] [StarAddMonoid C] [StarModule R A] + [StarModule R B] [StarModule R C] [Module.Finite R A] [Module.Finite R B] [Module.Finite R C] + (f : A ≃⋆ₐ[R] B) : + (StarAlgEquiv.lTensor C f).symm = StarAlgEquiv.lTensor C f.symm := +rfl + +theorem QuantumGraph.Real.matrix_eq_of_orthonormalBasis + : withMatrixCoalgebraQuantum[φ] + ∀ {A : Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ}, (hA : QuantumGraph.Real _ A) → + ∀ {ι : Type*} [Fintype ι], + (u : OrthonormalBasis ι ℂ (hA.matrix_submodule (φ := φ))) → + A = ∑ i, + lmul (R := ℂ) ((((u i : hA.matrix_submodule (φ := φ)) : Matrix n n ℂ) * φ.matrix)) * + (LinearMap.adjoint + (rmul (R := ℂ) + (φ.matrix * ((u i : hA.matrix_submodule (φ := φ)) : Matrix n n ℂ)))) := +by + withMatrixCoalgebraQuantumCtx[φ] + intro A hA ι _ u + simp_rw [← QuantumSet.Psi_symm_transpose_kroneckerToTensor_toMatrix_rankOne] + rw [← map_sum] + rw [← map_sum (StarAlgEquiv.lTensor (Matrix n n ℂ) (transposeStarAlgEquiv n))] + rw [← map_sum kroneckerToTensor] + rw [← map_sum onb.toMatrix] + rw [← ContinuousLinearMap.coe_sum] + rw [← OrthonormalBasis.orthogonalProjection'_eq_sum_rankOne u] + rw [hA.matrix_orthogonalProjection_eq] + simp only [ContinuousLinearMap.toLinearMapAlgEquiv_symm_apply] + simp only [LinearMap.coe_toContinuousLinearMap, + StarAlgEquiv.apply_symm_apply, kroneckerToTensor, tensorToKronecker] + simp only [AlgEquiv.symm_mk, AlgEquiv.coe_mk, Equiv.coe_fn_mk, + TensorProduct.toKronecker_to_tensorProduct, ← StarAlgEquiv.lTensor_symm, + StarAlgEquiv.apply_symm_apply, LinearEquiv.symm_apply_apply] + +theorem QuantumGraph.Real.matrix_submodule_exists_orthonormalBasis + : withMatrixCoalgebraQuantum[φ] + ∀ {A : Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ}, (hA : QuantumGraph.Real _ A) → + ∃ u : OrthonormalBasis + (Fin (Module.finrank ℂ (hA.matrix_submodule (φ := φ)))) ℂ + (hA.matrix_submodule (φ := φ)), + A = ∑ i, + lmul (R := ℂ) ((((u i : hA.matrix_submodule (φ := φ)) : Matrix n n ℂ) * φ.matrix)) * + (LinearMap.adjoint + (rmul (R := ℂ) + (φ.matrix * ((u i : hA.matrix_submodule (φ := φ)) : Matrix n n ℂ)))) := +by + withMatrixCoalgebraQuantumCtx[φ] + intro A hA + exact ⟨stdOrthonormalBasis ℂ _, (hA.matrix_eq_of_orthonormalBasis _)⟩ + +/-- Rank-one real quantum graph generated by a norm-one matrix. -/ +noncomputable abbrev QuantumGraph.Real.of_norm_one_matrix + : withMatrixQuantum[φ] + ({ x : Matrix n n ℂ // ‖x‖ = 1 } → + Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ) := +by + withMatrixQuantumCtx[φ] + exact fun u => + lmul (R := ℂ) (u * φ.matrix) * + (LinearMap.adjoint (rmul (R := ℂ) (φ.matrix * u))) + +-- theorem OrthonormalBasis.norm_eq_one +-- {ι 𝕜 E : Type*} [RCLike 𝕜] [NormedAddCommGroup E] +-- [InnerProductSpace 𝕜 E] [Fintype ι] [DecidableEq ι] +-- (u : OrthonormalBasis ι 𝕜 E) (i : ι) : +-- ‖u i‖ = 1 := +-- by +-- rw [@norm_eq_sqrt_inner 𝕜, Real.sqrt_eq_one] +-- simp_rw [orthonormal_iff_ite.mp u.orthonormal, if_true, RCLike.one_re] + +theorem orthogonalProjection'_of_finrank_eq_one + {𝕜 E : Type*} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] {U : Submodule 𝕜 E} (hU : Module.finrank 𝕜 U = 1) : + letI : Module.Finite 𝕜 U := Module.finite_of_finrank_eq_succ hU; + ∃ v : { x : E // ‖x‖ = 1 }, + orthogonalProjection' U = rankOne 𝕜 (v : E) (v : E) := +by + letI : Module.Finite 𝕜 U := Module.finite_of_finrank_eq_succ hU + let u : OrthonormalBasis (Fin 1) 𝕜 U := by + rw [← hU]; exact stdOrthonormalBasis 𝕜 U + rw [u.orthogonalProjection'_eq_sum_rankOne, Fin.sum_univ_one] + refine ⟨⟨u 0, u.norm_eq_one _⟩, rfl⟩ + +theorem QuantumSet.Psi_apply_matrix_one {n : Type*} [DecidableEq n] [Fintype n] + {φ : Module.Dual ℂ (Matrix n n ℂ)} [hφ : φ.IsFaithfulPosMap] : + withMatrixQuantum[φ] + (QuantumSet.Psi 0 (1 / 2) (1 : Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ) = + (StarAlgEquiv.lTensor _ (transposeStarAlgEquiv n)) + (kroneckerToTensor + (onb.toMatrix + ((rankOne ℂ (φ.matrix⁻¹) (φ.matrix⁻¹) : Matrix n n ℂ →ₗ[ℂ] _))))) := +by + withMatrixQuantumCtx[φ] + nth_rw 1 [← + rankOne.sum_orthonormalBasis_eq_id_lm + (@Module.Dual.IsFaithfulPosMap.orthonormalBasis n _ _ φ _)] + simp only [map_sum, QuantumSet.Psi_apply, QuantumSet.Psi_toFun_apply, + ← StarAlgEquiv.coe_toAlgEquiv, + ← orthonormalBasis_toMatrix_eq_basis_toMatrix, + LinearMap.toMatrixAlgEquiv, AlgEquiv.ofLinearEquiv_apply, + rankOne_toMatrix_of_onb, + ] + simp_rw [StarAlgEquiv.coe_toAlgEquiv, StarAlgEquiv.eq_apply_iff_symm_eq, + AlgEquiv.eq_apply_iff_symm_eq, map_sum, StarAlgEquiv.lTensor_symm_tmul, + kroneckerToTensor_symm_apply, + TensorProduct.toKronecker_apply, transposeStarAlgEquiv_symm_apply, + MulOpposite.unop_op, starAlgebra.modAut_zero, AlgEquiv.one_apply, + conjTranspose_replicateCol] + rw [show replicateCol (Fin 1) (onb.repr φ.matrix⁻¹).ofLp * + replicateRow (Fin 1) (star (onb.repr φ.matrix⁻¹).ofLp) = + vecMulVec (onb.repr φ.matrix⁻¹).ofLp + (star (onb.repr φ.matrix⁻¹).ofLp) from + (Matrix.vecMulVec_eq (Fin 1) (onb.repr φ.matrix⁻¹).ofLp + (star (onb.repr φ.matrix⁻¹).ofLp)).symm] + have : ∀ x, modAut (1 / 2) (hφ.orthonormalBasis x) + = (hφ.orthonormalBasis x.swap)ᴴ := + by + intro x + rw [show (modAut (1 / 2) : Matrix n n ℂ ≃ₐ[ℂ] Matrix n n ℂ) = + hφ.sig (1 / 2) from rfl] + simp only [Module.Dual.IsFaithfulPosMap.sig_apply, hφ.orthonormalBasis_apply, + conjTranspose_mul, + mul_assoc, PosDef.rpow_mul_rpow, neg_add_cancel, PosDef.rpow_zero, + mul_one, (PosDef.rpow.isPosDef _ _).1.eq, single_conjTranspose, + star_one] + rfl + simp only [this, star_eq_conjTranspose, conjTranspose_conjTranspose] + ext + simp only [sum_apply, kroneckerMap_apply, vecMulVec_apply, + Pi.star_apply, OrthonormalBasis.repr_apply_apply, transpose_apply, + Module.Dual.IsFaithfulPosMap.orthonormalBasis_apply, mul_apply, + single_eq, boole_mul] + simp_rw [ite_and, Finset.sum_ite_irrel, Finset.sum_const_zero, + Finset.sum_ite_eq, Finset.mem_univ, if_true, ite_mul, zero_mul, + Prod.swap, mul_ite, mul_zero, Finset.sum_product_univ, Finset.sum_ite_irrel, + Finset.sum_const_zero, Finset.sum_ite_eq', Finset.mem_univ, if_true] + rw [Module.Dual.IsFaithfulPosMap.inner_coord_onb, + Module.Dual.IsFaithfulPosMap.inner_coord_onb (hφ := hφ), + ← PosDef.rpow_neg_one_eq_inv_self hφ.matrixIsPosDef] + simp only [PosDef.rpow_mul_rpow, mul_comm] + ring_nf + rw [← conjTranspose_apply, (PosDef.rpow.isPosDef _ _).1.eq] + +theorem + Module.Dual.IsFaithfulPosMap.inner_dualMatrix_right + (x : Matrix n n ℂ) : + withMatrixQuantum[φ] + (inner ℂ x φ.matrix⁻¹ = star (x : Matrix n n ℂ).trace) := +by + withMatrixQuantumCtx[φ] + simp only [hφ.inner_eq'] + letI := hφ.matrixIsPosDef.invertible + rw [trace_mul_cycle, inv_mul_of_invertible, one_mul, trace_conjTranspose] + +theorem QuantumGraph.Real.of_norm_one_matrix_is_irreflexive_iff + [Nontrivial n] (x : { x : Matrix n n ℂ // ‖x‖ = 1 }) : + withMatrixCoalgebraQuantum[φ] + (of_norm_one_matrix (φ := φ) x •ₛ 1 = 0 ↔ (x : Matrix n n ℂ).trace = 0) := +by + withMatrixCoalgebraQuantumCtx[φ] + simp_rw [of_norm_one_matrix, + ← QuantumSet.Psi_symm_transpose_kroneckerToTensor_toMatrix_rankOne, + ← + Function.Injective.eq_iff (QuantumSet.Psi 0 (1 / 2)).injective, + Psi.schurMul, LinearEquiv.apply_symm_apply, QuantumSet.Psi_apply_matrix_one] + rw [← _root_.map_mul] + rw [← _root_.map_mul] + rw [← _root_.map_mul onb.toMatrix] + rw [LinearEquiv.map_zero] + simp only [map_eq_zero_iff _ (StarAlgEquiv.injective _), + map_eq_zero_iff _ (AlgEquiv.injective _)] + simp only [Module.End.mul_eq_comp, LinearMap.comp_rankOne, + ContinuousLinearMap.coe_coe, rankOne_apply, + ContinuousLinearMap.coe_eq_zero, rankOne.eq_zero_iff, smul_eq_zero, + hφ.inner_dualMatrix_right, star_eq_zero] + letI := hφ.matrixIsPosDef.invertible + simp only [Invertible.ne_zero, or_false, ne_zero_of_norm_ne_zero + (a := (x : Matrix n n ℂ)) + (by simp only [x.property, ne_eq, one_ne_zero, not_false_eq_true])] + +/-- Normalize a nonzero vector to a unit vector. -/ +noncomputable def normalize_of_ne_zero {E : Type*} + [NormedAddCommGroup E] [InnerProductSpace ℂ E] + {a : E} (ha : a ≠ 0) : + { x : E // ‖x‖ = 1 } := +by + use ((1 / ‖a‖) : ℂ) • a + rw [norm_smul, norm_div] + simp only [norm_one, Complex.norm_real, norm_norm, one_div] + exact inv_mul_cancel₀ (norm_ne_zero_iff.mpr ha) + +theorem Module.Dual.IsFaithfulPosMap.norm_sq_dualMatrix_inv : + withMatrixQuantum[φ] + ((‖φ.matrix⁻¹‖ : ℂ) ^ 2 = (φ.matrix⁻¹).trace) := +by + withMatrixQuantumCtx[φ] + rw [← Complex.ofReal_pow, ← inner_self_eq_norm_sq (𝕜 := ℂ)] + simp only [RCLike.re_to_complex] + rw [hφ.inner_dualMatrix_right, ← trace_conjTranspose, + hφ.matrixIsPosDef.inv.1.eq] + refine Complex.conj_eq_iff_re.mp ?_ + simp only [starRingEnd_apply, ← trace_conjTranspose, hφ.matrixIsPosDef.inv.1.eq] + +theorem QuantumGraph.Real.of_norm_one_matrix_eq_trivialGraph + [Nontrivial n] : + withMatrixCoalgebraQuantum[φ] + letI : QuantumSetDeltaForm (Matrix n n ℂ) := Matrix.quantumSetDeltaForm (φ := φ) + (of_norm_one_matrix (φ := φ) (hφ := hφ) + (normalize_of_ne_zero + (hφ.matrixIsPosDef.inv.invertible.ne_zero)) + = Qam.trivialGraph (Matrix n n ℂ)) := +by + withMatrixCoalgebraQuantumCtx[φ] + letI : QuantumSetDeltaForm (Matrix n n ℂ) := Matrix.quantumSetDeltaForm (φ := φ) + letI := hφ.matrixIsPosDef.invertible + simp only [of_norm_one_matrix, normalize_of_ne_zero, + Qam.trivialGraph_eq, smul_mul_assoc, + inv_mul_of_invertible, rmul_adjoint, StarMul.star_mul, star_smul, + _root_.map_smul] + simp only [← StarMul.star_mul, mul_inv_of_invertible, star_one, _root_.map_one, + rmul_one, lmul_one, one_mul, smul_smul, star_div₀] + simp only [one_div, RCLike.star_def, Complex.conj_ofReal, ← pow_two] + simp only [inv_pow] + simp only [QuantumSetDeltaForm.delta, ← hφ.norm_sq_dualMatrix_inv] + +theorem QuantumGraph.Real.of_norm_one_matrix_is_reflexive_iff + [Nontrivial n] (x : { x : Matrix n n ℂ // ‖x‖ = 1 }) : + withMatrixCoalgebraQuantum[φ] + (of_norm_one_matrix (φ := φ) x •ₛ 1 = 1 ↔ + ∃ α : ℂˣ, + (x : Matrix n n ℂ) = (α : ℂ) • φ.matrix⁻¹) := +by + withMatrixCoalgebraQuantumCtx[φ] + simp_rw [of_norm_one_matrix, + ← QuantumSet.Psi_symm_transpose_kroneckerToTensor_toMatrix_rankOne, + ← Function.Injective.eq_iff (QuantumSet.Psi 0 (1 / 2)).injective, + Psi.schurMul, LinearEquiv.apply_symm_apply, QuantumSet.Psi_apply_matrix_one] + rw [← _root_.map_mul] + rw [← _root_.map_mul] + rw [← _root_.map_mul onb.toMatrix] + simp only [(StarAlgEquiv.injective _).eq_iff, (AlgEquiv.injective _).eq_iff] + simp only [Module.End.mul_eq_comp, LinearMap.comp_rankOne, ContinuousLinearMap.coe_coe, + rankOne_apply, ContinuousLinearMap.coe_inj, hφ.inner_dualMatrix_right] + rw [← sub_eq_zero] + simp_rw [← LinearMap.sub_apply, ← map_sub] + letI : Invertible (φ.matrix) := hφ.matrixIsPosDef.invertible + rw [rankOne.eq_zero_iff, sub_eq_zero] + simp only [Invertible.ne_zero, or_false, ← trace_conjTranspose] + constructor + · intro h + rw [← h] + have htrace : ((x : Matrix n n ℂ)ᴴ).trace ≠ 0 := by + intro hx + rw [hx, zero_smul, eq_comm] at h + simp only [Invertible.ne_zero] at h + let α := Units.mk0 (((x : Matrix n n ℂ)ᴴ).trace) htrace + have hα : α = ((x : Matrix n n ℂ)ᴴ).trace := rfl + use α⁻¹ + simp only [← hα, smul_smul, Units.inv_mul, one_smul] + · intro ⟨α, hα⟩ + simp_rw [hα, conjTranspose_smul, trace_smul, hφ.matrixIsPosDef.inv.1.eq, + smul_smul, smul_eq_mul] + rw [mul_rotate _ _ (α : ℂ), mul_assoc _ _ (star (α : ℂ)), Complex.star_def, + Complex.mul_conj, Complex.normSq_eq_norm_sq, + ← hφ.norm_sq_dualMatrix_inv, ← Complex.ofReal_pow, + ← Complex.ofReal_mul, ← mul_pow, mul_comm, + ← norm_smul, ← hα, x.property, one_pow, Complex.ofReal_one, one_smul] + +theorem Matrix.traceLinearMap_comp_tensorToKronecker {n : Type*} [DecidableEq n] [Fintype n] : + Matrix.traceLinearMap (n × n) ℂ ℂ ∘ₗ TensorProduct.toKronecker + = LinearMap.mul' ℂ _ + ∘ₗ (TensorProduct.map + (Matrix.traceLinearMap n ℂ ℂ) (Matrix.traceLinearMap n ℂ ℂ)) := +by ext; simp [TensorProduct.toKronecker_apply, trace_kronecker] + +theorem traceLinearMap_comp_transposeStarAlgEquiv_symm + {n : Type*} [DecidableEq n] [Fintype n] : + traceLinearMap n ℂ ℂ ∘ₗ (transposeStarAlgEquiv n).symm.toLinearMap + = traceLinearMap n ℂ ℂ ∘ₗ (unop ℂ).toLinearMap := +by rfl + +open scoped InnerProductSpace +theorem QuantumGraph.NumOfEdges_eq {A : Type*} [starAlgebra A] [QuantumSet A] + (B : A →ₗ[ℂ] A) : + QuantumGraph.NumOfEdges B = ⟪1, B 1⟫_ℂ := +rfl + +-- set_option maxHeartbeats 0 in +theorem QuantumGraph.Real.matrix_submodule_finrank_eq_numOfEdges_of_counit_eq_trace + : withMatrixCoalgebraQuantum[φ] + (Coalgebra.counit (R := ℂ) (A := Matrix n n ℂ) = Matrix.traceLinearMap n ℂ ℂ) → + ∀ {A : Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ}, + (hA : QuantumGraph.Real _ A) → + (Module.finrank ℂ (hA.matrix_submodule (φ := φ)) : ℂ) = QuantumGraph.NumOfEdges A := +by + withMatrixCoalgebraQuantumCtx[φ] + intro hc A hA + simp only [← _root_.orthogonalProjection_trace, hA.matrix_orthogonalProjection_eq] + simp only [ContinuousLinearMap.toLinearMapAlgEquiv_symm_apply] + simp only [LinearMap.coe_toContinuousLinearMap] + rw [LinearMap.trace_eq_matrix_trace ℂ onb.toBasis] + have htoMatrix : + (LinearMap.toMatrix onb.toBasis onb.toBasis) = + (onb.toMatrix : + (Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ) ≃⋆ₐ[ℂ] + Matrix (n × n) (n × n) ℂ).toAlgEquiv.toLinearEquiv := by + rw [← orthonormalBasis_toMatrix_eq_basis_toMatrix onb] + rfl + rw [htoMatrix] + change (((onb.toMatrix : + (Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ) ≃⋆ₐ[ℂ] + Matrix (n × n) (n × n) ℂ) + ((onb.toMatrix : + (Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ) ≃⋆ₐ[ℂ] + Matrix (n × n) (n × n) ℂ).symm + (tensorToKronecker + ((StarAlgEquiv.lTensor (Matrix n n ℂ) (transposeStarAlgEquiv n).symm) + ((QuantumSet.Psi 0 (1 / 2)) A))))).trace) = + (QuantumGraph.NumOfEdges A : ℂ) + rw [StarAlgEquiv.apply_symm_apply] + simp only [tensorToKronecker_apply] + rw [← Matrix.traceLinearMap_apply _ ℂ, ← LinearMap.comp_apply] + change (Matrix.traceLinearMap (n × n) ℂ ℂ ∘ₗ TensorProduct.toKronecker) + ((StarAlgEquiv.lTensor (Matrix n n ℂ) (transposeStarAlgEquiv n).symm) + ((QuantumSet.Psi 0 (1 / 2)) A)) = + QuantumGraph.NumOfEdges A + rw [Matrix.traceLinearMap_comp_tensorToKronecker] + rw [← StarAlgEquiv.toLinearMap_apply, + StarAlgEquiv.lTensor_toLinearMap, ← LinearMap.comp_apply, + LinearMap.comp_assoc, LinearMap.map_comp_lTensor, + traceLinearMap_comp_transposeStarAlgEquiv_symm] + simp only [QuantumGraph.NumOfEdges_eq] + rw [oneInner_map_one_eq_oneInner_Psi_map _ 0 (1 / 2)] + rw [← bra_apply_apply ℂ (1 : Matrix n n ℂ ⊗[ℂ] (Matrix n n ℂ)ᵐᵒᵖ), + ← ContinuousLinearMap.coe_coe, + ← Coalgebra.counit_self_tensor_mulOpposite_eq_bra_one] + simp only [TensorProduct.instCoalgebraStruct'_counit, hc, LinearMap.comp_apply] + congr 1 + · apply TensorProduct.ext' + simp [mul_comm] + · rw [TensorProduct.AlgebraTensorModule.map_eq] + change (TensorProduct.map (traceLinearMap n ℂ ℂ) + (traceLinearMap n ℂ ℂ ∘ₗ (unop ℂ).toLinearMap)) ((QuantumSet.Psi 0 (1 / 2)) A) = + (TensorProduct.map (traceLinearMap n ℂ ℂ) + (Coalgebra.counit (R := ℂ) (A := (Matrix n n ℂ)ᵐᵒᵖ))) ((QuantumSet.Psi 0 (1 / 2)) A) + rw [Coalgebra.counit_mulOpposite, hc] + +theorem Matrix.traceLinearMap_dualMatrix_eq + {n : Type*} [DecidableEq n] [Fintype n] : + -- {φ : Module.Dual ℂ (Matrix n n ℂ)} [hφ : φ.IsFaithfulPosMap] + -- (hc : Coalgebra.counit (R := ℂ) (A := Matrix n n ℂ) = Matrix.traceLinearMap n ℂ ℂ) : + -- φ.matrix = 1 := + Module.Dual.matrix (Matrix.traceLinearMap n ℂ ℂ) = 1 := +by + refine Eq.symm (Module.Dual.apply_eq_of _ 1 (fun _ => ?_)) + simp only [one_mul] + rfl + +theorem QuantumGraph.Real.of_norm_one_matrix_eq_of_norm_one_matrix_iff + {x y : { x : Matrix n n ℂ // ‖x‖ = 1 }} : + withMatrixQuantum[φ] + (of_norm_one_matrix (φ := φ) x = of_norm_one_matrix (φ := φ) y + ↔ ∃ α : ℂˣ, (x : Matrix n n ℂ) = (α : ℂ) • (y : Matrix n n ℂ)) := +by + withMatrixQuantumCtx[φ] + simp only [of_norm_one_matrix] + simp only [← @QuantumSet.Psi_symm_transpose_kroneckerToTensor_toMatrix_rankOne, + (LinearEquiv.injective _).eq_iff, + (StarAlgEquiv.injective _).eq_iff, (AlgEquiv.injective _).eq_iff] + constructor + · simp_rw [ContinuousLinearMap.coe_inj]; + exact colinear_of_rankOne_self_eq_rankOne_self _ _ + · rintro ⟨α, hα⟩ + have := x.property + simp only [hα, norm_smul, y.property, mul_one] at this + simp only [hα, _root_.map_smul, map_smulₛₗ, + LinearMap.smul_apply, ContinuousLinearMap.coe_smul] + rw [smul_smul, RCLike.conj_mul, this, RCLike.ofReal_one, one_pow, one_smul] + +theorem QuantumGraph.Real.reflexive_matrix_numOfEdges_eq_one_iff_eq_trivialGraph_of_counit_eq_trace + [Nontrivial n] + : withMatrixCoalgebraQuantum[φ] + letI : QuantumSetDeltaForm (Matrix n n ℂ) := Matrix.quantumSetDeltaForm (φ := φ) + (Coalgebra.counit (R := ℂ) (A := Matrix n n ℂ) = Matrix.traceLinearMap n ℂ ℂ) → + ∀ {A : Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ}, (hA : QuantumGraph.Real _ A) → + A •ₛ 1 = 1 → + (QuantumGraph.NumOfEdges A = 1 ↔ A = Qam.trivialGraph _) := +by + withMatrixCoalgebraQuantumCtx[φ] + letI : QuantumSetDeltaForm (Matrix n n ℂ) := Matrix.quantumSetDeltaForm (φ := φ) + intro hc A hA hA₂ + constructor + · rw [← matrix_submodule_finrank_eq_numOfEdges_of_counit_eq_trace hc hA] + simp only [Nat.cast_eq_one] + letI := hφ.matrixIsPosDef.invertible + intro h + -- obtain ⟨u, hu⟩ := orthogonalProjection'_of_finrank_eq_one h + let u : OrthonormalBasis (Fin 1) ℂ _ := + by rw [← h]; exact stdOrthonormalBasis ℂ (hA.matrix_submodule (φ := φ)) + let u' : { x : Matrix n n ℂ // ‖x‖ = 1 } := ⟨u 0, u.norm_eq_one _⟩ + have : A = of_norm_one_matrix u' := + by + rw [hA.matrix_eq_of_orthonormalBasis u] + simp only [Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Finset.sum_singleton] + rfl + rw [this, ← of_norm_one_matrix_eq_trivialGraph, of_norm_one_matrix_eq_of_norm_one_matrix_iff, + normalize_of_ne_zero] + simp only [this] at * + rw [of_norm_one_matrix_is_reflexive_iff (φ := φ) u'] at hA₂ + obtain ⟨α, hα⟩ := hA₂ + simp only [u'] at * + let α' : ℂˣ := Units.mk0 ‖φ.matrix⁻¹‖ (by simp only [ne_eq, Complex.ofReal_eq_zero, + norm_eq_zero, Invertible.ne_zero, not_false_eq_true]) + have hα' : α' = (‖φ.matrix⁻¹‖ : ℂ) := rfl + use α * α' + rw [hα] + simp only [Units.val_mul, α', Units.val_mk0, smul_smul, one_div] + simp only [← hα'] + simp only [isUnit_iff_ne_zero, ne_eq, Units.ne_zero, not_false_eq_true, + IsUnit.mul_inv_cancel_right] + · rintro rfl + rw [QuantumGraph.NumOfEdges_eq, Qam.trivialGraph_eq, + LinearMap.smul_apply, inner_smul_right, Module.End.one_apply] + have : φ = Matrix.traceLinearMap n ℂ ℂ := by + rw [← hc]; exact Eq.symm counit_eq_dual + simp only [QuantumSetDeltaForm.delta, this, + Matrix.traceLinearMap_dualMatrix_eq, inv_one, + hφ.inner_eq', one_mul, conjTranspose_one] + rw [inv_mul_cancel₀] + simp only [trace_one, ne_eq, Nat.cast_eq_zero, Fintype.card_ne_zero, not_false_eq_true] + +theorem counit_eq_traceLinearMap_of_counit_eq_piMat_traceLinearMap + {ι : Type*} [DecidableEq ι] [Fintype ι] {p : ι → Type*} [Π i, Fintype (p i)] + [Π i, DecidableEq (p i)] + {φ : Π i, Module.Dual ℂ (Matrix (p i) (p i) ℂ)} + [hφ : Π i, (φ i).IsFaithfulPosMap] + : withPiBlockCoalgebraQuantum[φ] + letI := fun i => (Coalgebra.ofFiniteDimensionalHilbertAlgebra + (R := ℂ) (A := Mat ℂ (p i)) : Coalgebra ℂ (Mat ℂ (p i))) + (Coalgebra.counit (R := ℂ) (A := PiMat ℂ ι p) = PiMat.traceLinearMap) → + ∀ i : ι, + Coalgebra.counit (R := ℂ) (A := Mat ℂ (p i)) = traceLinearMap (p i) ℂ ℂ := +by + withPiBlockCoalgebraQuantumCtx[φ] + letI := fun i => (Coalgebra.ofFiniteDimensionalHilbertAlgebra + (R := ℂ) (A := Mat ℂ (p i)) : Coalgebra ℂ (Mat ℂ (p i))) + intro hc i + simp only [PiMat.counit_eq_dual, counit_eq_dual, LinearMap.ext_iff] at hc ⊢ + intro x + specialize hc (includeBlock ((includeBlock x) i)) + rw [Module.Dual.pi.apply_single_block, includeBlock_apply_same] at hc + rw [hc] + simp only [LinearMap.coe_comp, Function.comp_apply, AlgHom.toLinearMap_apply, + traceLinearMap_apply, blockDiagonal'AlgHom_apply, blockDiagonal'_includeBlock_trace'] + +theorem QuantumGraph.Real.PiMatFinTwo_same_isSelfAdjoint_reflexive_and_numOfEdges_eq_one + {φ : Π i, Module.Dual ℂ (Matrix (PiFinTwo_same n i) (PiFinTwo_same n i) ℂ)} + [hφ : Π i, (φ i).IsFaithfulPosMap] + [Nontrivial n] + : withPiBlockCoalgebraQuantum[φ] + letI := fun i => (Coalgebra.ofFiniteDimensionalHilbertAlgebra + (R := ℂ) (A := Mat ℂ (PiFinTwo_same n i)) : + Coalgebra ℂ (Mat ℂ (PiFinTwo_same n i))) + letI := fun i => (Matrix.quantumSetDeltaForm (φ := φ i) : + QuantumSetDeltaForm (Mat ℂ (PiFinTwo_same n i))) + (Coalgebra.counit (R := ℂ) (A := PiMat ℂ (Fin 2) (PiFinTwo_same n)) = + PiMat.traceLinearMap) → + ∀ {A : PiMat ℂ (Fin 2) (PiFinTwo_same n) →ₗ[ℂ] + PiMat ℂ (Fin 2) (PiFinTwo_same n)}, + (hA : QuantumGraph.Real _ A) → + LinearMap.adjoint A = A → + A •ₛ 1 = 1 → + QuantumGraph.NumOfEdges A = 1 → + A = LinearMap.adjoint (LinearMap.proj 0) + ∘ₗ Qam.trivialGraph (Mat ℂ (PiFinTwo_same n 0)) + ∘ₗ LinearMap.proj 0 + ∨ + A = LinearMap.adjoint (LinearMap.proj 1) + ∘ₗ Qam.trivialGraph (Mat ℂ (PiFinTwo_same n 1)) + ∘ₗ LinearMap.proj 1 := +by + withPiBlockCoalgebraQuantumCtx[φ] + letI := fun i => (Coalgebra.ofFiniteDimensionalHilbertAlgebra + (R := ℂ) (A := Mat ℂ (PiFinTwo_same n i)) : + Coalgebra ℂ (Mat ℂ (PiFinTwo_same n i))) + letI := fun i => (Matrix.quantumSetDeltaForm (φ := φ i) : + QuantumSetDeltaForm (Mat ℂ (PiFinTwo_same n i))) + intro hc A hA hA₂ hA₃ hA₄ + obtain (hf | hf) := hA.piFinTwo_same_exists_matrix_map_eq_map_of_adjoint_and_dim_eq_one hA₂ + (by rw [← Nat.cast_inj (R := ℂ), + QuantumGraph.dim_of_piMat_submodule_eq_numOfEdges_of_trace_counit (hφ := hφ) hc, hA₄, + Nat.cast_one]) + on_goal 1 => + let i : Fin 2 := 0 + let f := LinearMap.proj i ∘ₗ A ∘ₗ LinearMap.adjoint (LinearMap.proj i) + left + on_goal 2 => + let i : Fin 2 := 1 + let f := LinearMap.proj i ∘ₗ A ∘ₗ LinearMap.adjoint (LinearMap.proj i) + right + all_goals + have hf₁ : f = LinearMap.proj i ∘ₗ A ∘ₗ LinearMap.adjoint (LinearMap.proj i) := rfl + have hf₂ : QuantumGraph.Real _ f := QuantumGraph.Real.conj_proj_isReal hA _ + have hf₃ : f •ₛ 1 = 1 := by + let proj : PiMat ℂ (Fin 2) (PiFinTwo_same n) →ₗ[ℂ] Mat ℂ (PiFinTwo_same n i) := + LinearMap.proj i + let adj : Mat ℂ (PiFinTwo_same n i) →ₗ[ℂ] PiMat ℂ (Fin 2) (PiFinTwo_same n) := + LinearMap.adjoint proj + have hcomp : (proj ∘ₗ A ∘ₗ adj) •ₛ (proj ∘ₗ adj) = + (proj ∘ₗ (A •ₛ 1)) ∘ₗ adj := by + calc + (proj ∘ₗ A ∘ₗ adj) •ₛ (proj ∘ₗ adj) + = ((proj ∘ₗ A) •ₛ proj) ∘ₗ adj := by + simpa only [proj, adj, LinearMap.comp_assoc] using + (schurMul_comp_proj_adjoint (hφ := hφ) (LinearMap.proj i ∘ₗ A) + (LinearMap.proj i) i) + _ = (proj ∘ₗ (A •ₛ 1)) ∘ₗ adj := by + congr 1 + simpa only [proj, LinearMap.comp_one] using + (schurMul_proj_comp (hφ := hφ) A 1 i) + rw [hf₁] + simpa only [proj, adj, hA₃, LinearMap.one_comp, LinearMap.proj_adjoint, + LinearMap.proj_comp_single_same] using hcomp + have hf₄ : QuantumGraph.NumOfEdges f = 1 := by + rw [QuantumGraph.NumOfEdges_eq, ← hf] at hA₄ + simp only [LinearMap.comp_apply, LinearMap.adjoint_inner_right] at hA₄ + simp only [← LinearMap.comp_apply, ← LinearMap.comp_assoc] at hA₄ + rw [LinearMap.comp_assoc _ A _, ← hf₁, LinearMap.comp_apply, LinearMap.proj_apply, + Pi.one_apply] at hA₄ + exact hA₄ + rw [reflexive_matrix_numOfEdges_eq_one_iff_eq_trivialGraph_of_counit_eq_trace + (counit_eq_traceLinearMap_of_counit_eq_piMat_traceLinearMap hc _) hf₂ (by rw [hf₃])] at hf₄ + rw [← hf₄, hf₁] + simp only [i, LinearMap.comp_assoc, hf] + +/-- Isomorphism data between two quantum graphs via a star-algebra equivalence. -/ +class QuantumGraph.equiv + {A B : Type*} [starAlgebra A] [QuantumSet A] [starAlgebra B] [QuantumSet B] + (x : A →ₗ[ℂ] A) (y : B →ₗ[ℂ] B) (f : A ≃⋆ₐ[ℂ] B) : Prop where + /-- The equivalence is isometric. -/ + isIsometry : Isometry f + /-- The equivalence intertwines the adjacency maps. -/ + prop : f.toLinearMap ∘ₗ x = y ∘ₗ f.toLinearMap + +lemma QuantumGraph.equiv_prop {A B : Type*} [starAlgebra A] [QuantumSet A] + [starAlgebra B] [QuantumSet B] + (x : A →ₗ[ℂ] A) (y : B →ₗ[ℂ] B) {f : A ≃⋆ₐ[ℂ] B} (hf : QuantumGraph.equiv x y f) : + f.toLinearMap ∘ₗ x = y ∘ₗ f.toLinearMap := +hf.prop + +lemma QuantumGraph.equiv_prop' {A B : Type*} [starAlgebra A] [QuantumSet A] + [starAlgebra B] [QuantumSet B] + (x : A →ₗ[ℂ] A) (y : B →ₗ[ℂ] B) {f : A ≃⋆ₐ[ℂ] B} (hf : QuantumGraph.equiv x y f) : + f.toLinearMap ∘ₗ x ∘ₗ LinearMap.adjoint f.toLinearMap = y := +by + rw [← LinearMap.comp_assoc, hf.prop, + QuantumSet.starAlgEquiv_isometry_iff_adjoint_eq_symm.mp hf.isIsometry, + eq_comm, ← StarAlgEquiv.comp_eq_iff] + +lemma Pi.eq_sum_single_proj (R : Type*) {ι : Type*} [Semiring R] + [Fintype ι] [DecidableEq ι] + {φ : ι → Type*} [(i : ι) → AddCommMonoid (φ i)] + [(i : ι) → Module R (φ i)] + (x : Π i, φ i) : + x = ∑ i, Pi.single (i : ι) (x i) := +by + simp_rw [← LinearMap.proj_apply (R := R) (φ := φ), ← LinearMap.single_apply (R:=R), + ← LinearMap.comp_apply, ← LinearMap.sum_apply, LinearMap.sum_single_comp_proj] + rfl + +/-- Swap the two equal blocks of a `Fin 2`-indexed `PiMat` as a star-algebra equivalence. -/ +noncomputable def PiMat_finTwo_same_swapStarAlgEquiv {n : Type*} [Fintype n] [DecidableEq n] : + PiMat ℂ (Fin 2) (PiFinTwo_same n) ≃⋆ₐ[ℂ] PiMat ℂ (Fin 2) (PiFinTwo_same n) := +StarAlgEquiv.ofAlgEquiv (PiMat_finTwo_same_swapAlgEquiv (n := n)) +(fun x => by + rw [Pi.eq_sum_single_proj ℂ x] + simp only [Fin.sum_univ_two, Fin.isValue, star_add, map_add, ← Pi.single_star, + PiMat_finTwo_same_swapAlgEquiv_apply_piSingle_one, + PiMat_finTwo_same_swapAlgEquiv_apply_piSingle_zero]) + +lemma PiMat_finTwo_same_swapStarAlgEquiv_apply {n : Type*} [Fintype n] [DecidableEq n] + (x : PiMat ℂ (Fin 2) (PiFinTwo_same n)) : + PiMat_finTwo_same_swapStarAlgEquiv x = + Pi.single (0 : Fin 2) (x 1) + Pi.single (1 : Fin 2) (x 0) := +by + nth_rw 1 [Pi.eq_sum_single_proj ℂ x] + simp only [Fin.sum_univ_two, Fin.isValue, map_add, + PiMat_finTwo_same_swapStarAlgEquiv, StarAlgEquiv.ofAlgEquiv_coe, + PiMat_finTwo_same_swapAlgEquiv_apply_piSingle_one, + PiMat_finTwo_same_swapAlgEquiv_apply_piSingle_zero, add_comm] + +lemma PiMat_finTwo_same_swapStarAlgEquiv_toAlgEquiv {n : Type*} [Fintype n] [DecidableEq n] : + (PiMat_finTwo_same_swapStarAlgEquiv (n := n)).toAlgEquiv = PiMat_finTwo_same_swapAlgEquiv := +rfl + +theorem PiMat_finTwo_same_swapStarAlgEquiv_symm {n : Type*} [Fintype n] [DecidableEq n] : + (PiMat_finTwo_same_swapStarAlgEquiv (n := n)).symm + = PiMat_finTwo_same_swapStarAlgEquiv := +rfl + +/-- The constant two-block functional used for two identical matrix summands. -/ +abbrev PiFinTwo_sameFunctional {n : Type*} + (φ : Module.Dual ℂ (Matrix n n ℂ)) : + (i : Fin 2) → Module.Dual ℂ + (Matrix (PiFinTwo_same n i) (PiFinTwo_same n i) ℂ) := + fun _ => φ + +lemma PiMat_finTwo_same_swapStarAlgEquiv_isometry : + letI : ∀ i, (PiFinTwo_sameFunctional φ i).IsFaithfulPosMap := fun _ => hφ + withPiBlockQuantum[PiFinTwo_sameFunctional φ] + (LinearMap.adjoint PiMat_finTwo_same_swapStarAlgEquiv.toLinearMap + = (PiMat_finTwo_same_swapStarAlgEquiv (n := n)).symm.toLinearMap) := +by + let ψ := PiFinTwo_sameFunctional φ + letI : ∀ i, (ψ i).IsFaithfulPosMap := fun _ => hφ + withPiBlockQuantumCtx[ψ] + simp only [PiMat_finTwo_same_swapStarAlgEquiv_symm] + apply LinearMap.ext + intro x + apply ext_inner_left ℂ + intro y + simp only [LinearMap.adjoint_inner_right, StarAlgEquiv.toLinearMap_apply, + PiMat_finTwo_same_swapStarAlgEquiv_apply] + nth_rw 1 [Pi.eq_sum_single_proj ℂ x] + nth_rw 3 [Pi.eq_sum_single_proj ℂ y] + simp only [Fin.isValue, Fin.sum_univ_two] + simp only [inner, Fin.isValue, Pi.add_apply, Fin.sum_univ_two, + Pi.single_eq_same, ne_eq, zero_ne_one, not_false_eq_true, + Pi.single_eq_of_ne, add_comm, zero_add, one_ne_zero] + rw [inner_pi_eq_sum (ψ := ψ)] + simp [PiFinTwo_sameFunctional, Module.Dual.IsFaithfulPosMap.inner_eq, Fin.sum_univ_two] + simp [ψ, PiFinTwo_sameFunctional] + +theorem PiMat_finTwo_same_swapStarAlgEquiv_comp_linearMapSingle_zero + {n : Type*} [Fintype n] [DecidableEq n] : + (PiMat_finTwo_same_swapStarAlgEquiv (n := n)).toLinearMap + ∘ₗ (LinearMap.single ℂ (fun (j : Fin 2) => Mat ℂ (PiFinTwo_same n j)) 0) + = LinearMap.single ℂ (fun (j : Fin 2) => Mat ℂ (PiFinTwo_same n j)) 1 := +PiMat_finTwo_same_swapAlgEquiv_comp_linearMapSingle_zero +theorem PiMat_finTwo_same_swapStarAlgEquiv_comp_linearMapSingle_one + {n : Type*} [Fintype n] [DecidableEq n] : + (PiMat_finTwo_same_swapStarAlgEquiv (n := n)).toLinearMap + ∘ₗ (LinearMap.single ℂ (fun (j : Fin 2) => Mat ℂ (PiFinTwo_same n j)) 1) + = LinearMap.single ℂ (fun (j : Fin 2) => Mat ℂ (PiFinTwo_same n j)) 0 := +PiMat_finTwo_same_swapAlgEquiv_comp_linearMapSingle_one +theorem PiMat_finTwo_same_proj_zero_comp_swapStarAlgEquiv + {n : Type*} [Fintype n] [DecidableEq n] : + LinearMap.proj 0 ∘ₗ (PiMat_finTwo_same_swapStarAlgEquiv (n := n)).toLinearMap + = LinearMap.proj 1 := +rfl +theorem PiMat_finTwo_same_proj_one_comp_swapStarAlgEquiv + {n : Type*} [Fintype n] [DecidableEq n] : + LinearMap.proj 1 ∘ₗ (PiMat_finTwo_same_swapStarAlgEquiv (n := n)).toLinearMap + = LinearMap.proj 0 := +rfl + +theorem + QuantumGraph.Real.piMatFinTwo_same_eq_zero_of_isSelfAdjoint_and_reflexive_and_numOfEdges_eq_one + [Nontrivial n] + : letI : ∀ i, (PiFinTwo_sameFunctional φ i).IsFaithfulPosMap := fun _ => hφ + withPiBlockCoalgebraQuantum[PiFinTwo_sameFunctional φ] + (Coalgebra.counit (R := ℂ) (A := PiMat ℂ (Fin 2) (PiFinTwo_same n)) = + PiMat.traceLinearMap) → + ∀ {A : PiMat ℂ (Fin 2) (PiFinTwo_same n) →ₗ[ℂ] + PiMat ℂ (Fin 2) (PiFinTwo_same n)}, + (hA : QuantumGraph.Real _ A) → + LinearMap.adjoint A = A → + A •ₛ 1 = 1 → + QuantumGraph.NumOfEdges A = 1 → + A = 0 := +by + let ψ := PiFinTwo_sameFunctional φ + letI : ∀ i, (ψ i).IsFaithfulPosMap := fun _ => hφ + withPiBlockCoalgebraQuantumCtx[ψ] + letI := fun i => (Coalgebra.ofFiniteDimensionalHilbertAlgebra + (R := ℂ) (A := Mat ℂ (PiFinTwo_same n i)) : + Coalgebra ℂ (Mat ℂ (PiFinTwo_same n i))) + intro hc A hA hA₂ hA₃ hA₄ + rw [← QuantumGraph.dim_of_piMat_submodule_eq_numOfEdges_of_trace_counit hc hA.toQuantumGraph, + Nat.cast_eq_one] at hA₄ + obtain ⟨i, hi, hf⟩ := + hA.exists_unique_includeMap_of_adjoint_and_dim_ofPiMat_submodule_eq_one hA₂ hA₄ + let p : (j : Fin 2) → PiMat ℂ (Fin 2) (PiFinTwo_same n) →ₗ[ℂ] + Mat ℂ (PiFinTwo_same n j) := fun j => LinearMap.proj j + have hp : ∀ j, p j = LinearMap.proj j := fun j => rfl + have : ∀ j, p j ∘ₗ LinearMap.adjoint (p j) = 1 := + fun j => by + simp only [LinearMap.proj_adjoint, p, Module.End.one_eq_id, LinearMap.proj_comp_single_same] + have this' : ∀ j, (p j ∘ₗ A ∘ₗ LinearMap.adjoint (p j)) •ₛ 1 = 1 := + fun j => by + calc (p j ∘ₗ A ∘ₗ LinearMap.adjoint (p j)) •ₛ 1 + = (p j ∘ₗ A ∘ₗ LinearMap.adjoint (p j) ∘ₗ 1) •ₛ (p j ∘ₗ 1 ∘ₗ LinearMap.adjoint (p j)) := + by simp only [LinearMap.one_comp, LinearMap.comp_one, this] + _ = p j ∘ₗ ((A ∘ₗ LinearMap.adjoint (p j)) •ₛ (1 ∘ₗ LinearMap.adjoint (p j))) := + by + simp only [p] + rw [schurMul_proj_comp (hφ := fun _ => hφ)] + simp only [LinearMap.comp_one] + _ = p j ∘ₗ (A •ₛ 1) ∘ₗ LinearMap.adjoint (p j) := + by + simp only [p] + rw [schurMul_comp_proj_adjoint (hφ := fun _ => hφ)] + _ = 1 := by simp only [hA₃, LinearMap.one_comp, this] + have := + calc + LinearMap.adjoint (p i) ∘ₗ p i + ∑ j ∈ Finset.univ \ {i}, LinearMap.adjoint (p j) ∘ₗ p j + = ∑ j, LinearMap.adjoint (p j) ∘ₗ p j := + by + simp only [Finset.subset_univ, Finset.sum_sdiff_eq_sub, Fin.sum_univ_two, Fin.isValue, + Finset.sum_singleton, add_sub_cancel, p] + _ = 1 := + by + rw [Module.End.one_eq_id, ← LinearMap.sum_single_comp_proj] + simp only [p, LinearMap.proj_adjoint] + _ = A •ₛ 1 := hA₃.symm + _ = ∑ j, (LinearMap.adjoint (p i) ∘ₗ (p i) ∘ₗ A ∘ₗ LinearMap.adjoint (p i) ∘ₗ (p i)) + •ₛ (LinearMap.adjoint (p j) ∘ₗ 1 ∘ₗ p j) := + by + simp only [p, hi] + simp_rw [← map_sum, + LinearMap.one_comp] + congr + rw [Module.End.one_eq_id, ← LinearMap.sum_single_comp_proj] + simp only [LinearMap.proj_adjoint] + _ = (LinearMap.adjoint (p i) ∘ₗ (p i) ∘ₗ A ∘ₗ LinearMap.adjoint (p i) ∘ₗ (p i)) + •ₛ (LinearMap.adjoint (p i) ∘ₗ 1 ∘ₗ p i) + + ∑ j ∈ Finset.univ \ {i}, + (LinearMap.adjoint (p i) ∘ₗ (p i) ∘ₗ A ∘ₗ LinearMap.adjoint (p i) ∘ₗ (p i)) + •ₛ (LinearMap.adjoint (p j) ∘ₗ 1 ∘ₗ p j) := + by + simp only [schurMul_apply_apply, Fin.sum_univ_two, Fin.isValue, Finset.subset_univ, + Finset.sum_sdiff_eq_sub, Finset.sum_singleton, add_sub_cancel,] + _ = LinearMap.adjoint (p i) ∘ₗ p i := + by + simp only [p, schurMul_proj_adjoint_comp] + simp only [← LinearMap.comp_assoc, schurMul_comp_proj] + simp only [LinearMap.comp_assoc, ← hp, this'] + simp only [LinearMap.one_comp, add_eq_left] + apply Finset.sum_eq_zero + simp only [Finset.mem_sdiff, Finset.mem_univ, Finset.mem_singleton, true_and] + push Not + intro j hj + rw [schurMul_proj_adjoint_comp_of_ne_eq_zero (hφ := fun _ => hφ) hj.symm] + simp only [Finset.subset_univ, Finset.sum_sdiff_eq_sub, Fin.sum_univ_two, Fin.isValue, + Finset.sum_singleton, add_sub_cancel, LinearMap.ext_iff, LinearMap.add_apply, + LinearMap.comp_apply, LinearMap.proj_apply, LinearMap.proj_adjoint_apply, funext_iff, + Pi.add_apply, p] at this + have hii : i = 0 ∨ i = 1 := Fin.exists_fin_two.mp ⟨i, rfl⟩ + specialize this 1 (if i = 0 then 1 else 0) + rcases hii with (hii | hii) + <;> rw [hii] at this + <;> simp only [add_eq_left, add_eq_right, includeBlock_apply, dite_eq_right_iff] at this + <;> simp only [Fin.isValue, ↓reduceIte, ↓dreduceIte, Pi.one_apply, eq_mp_eq_cast, cast_eq, + one_ne_zero, imp_false, not_true_eq_false] at this + +-- theorem QuantumGraph.Real.piMatFinTwo_same_isSelfAdjoint_reflexive_and_numOfEdges_eq_one_equiv +-- [Nontrivial n] +-- (hc : Coalgebra.counit (R := ℂ) (A := PiMat ℂ (Fin 2) (PiFinTwo_same n)) = +-- PiMat.traceLinearMap) +-- {A B : PiMat ℂ (Fin 2) (PiFinTwo_same n) →ₗ[ℂ] PiMat ℂ (Fin 2) (PiFinTwo_same n)} +-- (hA : QuantumGraph.Real _ A) (hA₂ : LinearMap.adjoint A = A) (hA₃ : A •ₛ 1 = 1) +-- (hA₄ : QuantumGraph.NumOfEdges A = 1) +-- (hB : QuantumGraph.Real _ B) (hB₂ : LinearMap.adjoint B = B) (hB₃ : B •ₛ 1 = 1) +-- (hB₄ : QuantumGraph.NumOfEdges B = 1) : +-- ∃ f : PiMat ℂ (Fin 2) (PiFinTwo_same n) ≃⋆ₐ[ℂ] PiMat ℂ (Fin 2) (PiFinTwo_same n), +-- QuantumGraph.equiv A B f := +-- by +-- have hA₅ := hA.PiMatFinTwo_same_isSelfAdjoint_reflexive_and_numOfEdges_eq_one hc hA₂ hA₃ hA₄ +-- have hB₅ := hB.PiMatFinTwo_same_isSelfAdjoint_reflexive_and_numOfEdges_eq_one hc hB₂ hB₃ hB₄ +-- have H1 : ∀ i : Fin 2, (A = LinearMap.adjoint (LinearMap.proj i) +-- ∘ₗ Qam.trivialGraph (Mat ℂ (PiFinTwo_same n i)) ∘ₗ LinearMap.proj i +-- ∧ B = LinearMap.adjoint (LinearMap.proj i) +-- ∘ₗ Qam.trivialGraph (Mat ℂ (PiFinTwo_same n i)) ∘ₗ LinearMap.proj i) +-- → +-- QuantumGraph.equiv A B (StarAlgEquiv.refl) := +-- by +-- intro i h +-- refine ⟨fun x1 ↦ congrFun rfl, ?_⟩ +-- apply LinearMap.ext +-- simp only [h, Fin.isValue, LinearMap.coe_comp, LinearMap.coe_proj, Function.comp_apply, +-- Function.eval, StarAlgEquiv.toLinearMap_apply, StarAlgEquiv.coe_refl, id_eq, implies_true] +-- have H2 : +-- ((A = LinearMap.adjoint (LinearMap.proj 0) +-- ∘ₗ Qam.trivialGraph (Mat ℂ (PiFinTwo_same n 0)) ∘ₗ LinearMap.proj 0 +-- ∧ B = LinearMap.adjoint (LinearMap.proj 1) +-- ∘ₗ Qam.trivialGraph (Mat ℂ (PiFinTwo_same n 1)) ∘ₗ LinearMap.proj 1) +-- ∨ +-- (A = LinearMap.adjoint (LinearMap.proj 1) +-- ∘ₗ Qam.trivialGraph (Mat ℂ (PiFinTwo_same n 1)) ∘ₗ LinearMap.proj 1 +-- ∧ B = LinearMap.adjoint (LinearMap.proj 0) +-- ∘ₗ Qam.trivialGraph (Mat ℂ (PiFinTwo_same n 0)) ∘ₗ LinearMap.proj 0)) +-- → QuantumGraph.equiv A B (PiMat_finTwo_same_swapStarAlgEquiv) := +-- by +-- rintro (h | h) +-- all_goals +-- constructor +-- . rw [QuantumSet.starAlgEquiv_isometry_iff_adjoint_eq_symm] +-- exact PiMat_finTwo_same_swapStarAlgEquiv_isometry +-- . simp_rw [h.1, h.2, LinearMap.comp_assoc] +-- simp only [PiMat_finTwo_same_proj_one_comp_swapStarAlgEquiv, +-- PiMat_finTwo_same_proj_zero_comp_swapStarAlgEquiv, +-- ← LinearMap.comp_assoc, LinearMap.proj_adjoint, +-- PiMat_finTwo_same_swapStarAlgEquiv_comp_linearMapSingle_zero, +-- PiMat_finTwo_same_swapStarAlgEquiv_comp_linearMapSingle_one] +-- obtain (hf | hf) := hA₅ +-- . obtain (hg | hg) := hB₅ +-- . exact ⟨_, H1 _ ⟨hf, hg⟩⟩ +-- . exact ⟨_, H2 (Or.inl ⟨hf, hg⟩)⟩ +-- . obtain (hg | hg) := hB₅ +-- . exact ⟨_, H2 (Or.inr ⟨hf, hg⟩)⟩ +-- . exact ⟨_, H1 _ ⟨hf, hg⟩⟩ diff --git a/LeanPool/Monlib4/QuantumGraph/Nontracial.lean b/LeanPool/Monlib4/QuantumGraph/Nontracial.lean new file mode 100644 index 0000000000..c98fd94136 --- /dev/null +++ b/LeanPool/Monlib4/QuantumGraph/Nontracial.lean @@ -0,0 +1,303 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.LinearAlgebra.Ips.MatIps +import LeanPool.Monlib4.LinearAlgebra.Ips.Nontracial +import LeanPool.Monlib4.LinearAlgebra.Ips.TensorHilbert +import LeanPool.Monlib4.LinearAlgebra.IsReal +import LeanPool.Monlib4.LinearAlgebra.Ips.Frob +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.FiniteDimensional +import LeanPool.Monlib4.LinearAlgebra.Ips.OpUnop +import LeanPool.Monlib4.LinearAlgebra.LmulRmul +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.SchurMul +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Symm +import LeanPool.Monlib4.LinearAlgebra.QuantumSet.Instances + +/-! + # Quantum graphs: quantum adjacency matrices + + This file defines the quantum adjacency matrix of a quantum graph. +-/ + + +variable {n p : Type _} [Fintype n] [Fintype p] [DecidableEq n] [DecidableEq p] + +open scoped TensorProduct BigOperators Kronecker + +local notation "ℍ" => Matrix n n ℂ +local notation "ℍ₂" => Matrix p p ℂ + +local notation "⊗K" => Matrix (n × n) (n × n) ℂ + +local notation "l(" x ")" => x →ₗ[ℂ] x + +local notation "L(" x ")" => x →L[ℂ] x + +local notation "e_{" i "," j "}" => Matrix.stdBasisMatrix i j (1 : ℂ) + +variable {φ : Module.Dual ℂ (Matrix n n ℂ)} {ψ : Module.Dual ℂ (Matrix p p ℂ)} + +open scoped Matrix + +open Matrix + +local notation "|" x "⟩⟨" y "|" => @rankOne ℂ _ _ _ _ _ _ _ x y + +local notation "m" => LinearMap.mul' ℂ ℍ + +local notation "η" => Algebra.linearMap ℂ ℍ + +local notation x " ⊗ₘ " y => TensorProduct.map x y + +local notation "υ" => + LinearEquiv.toLinearMap (TensorProduct.assoc ℂ (Matrix n n ℂ) (Matrix n n ℂ) (Matrix n n ℂ)) + +local notation "υ⁻¹" => + LinearEquiv.toLinearMap (LinearEquiv.symm (TensorProduct.assoc ℂ (Matrix n n ℂ) (Matrix n n + ℂ) (Matrix n n ℂ))) + +local notation "ϰ" => + LinearEquiv.toLinearMap ((TensorProduct.comm ℂ (Matrix n n ℂ) ℂ)) + +local notation "ϰ⁻¹" => + LinearEquiv.toLinearMap (LinearEquiv.symm (TensorProduct.comm ℂ (Matrix n n ℂ) ℂ)) + +local notation "τ" => + LinearEquiv.toLinearMap (TensorProduct.lid ℂ (Matrix n n ℂ)) + +local notation "τ⁻¹" => + LinearEquiv.toLinearMap (LinearEquiv.symm (TensorProduct.lid ℂ (Matrix n n ℂ))) + +local notation "id" => (1 : Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ) + +open TensorProduct + +theorem Finset.sum_fin_one {α : Type _} [AddCommMonoid α] (f : Fin 1 → α) : ∑ i, f i = f 0 := by + have h : (Finset.univ : Finset (Fin 1)) = {0} := by + ext i + simp [Subsingleton.elim i 0] + rw [h, Finset.sum_singleton] + +-- theorem LinearMap.IsReal.adjoint_isReal_iff_commute_with_sig [hφ : φ.IsFaithfulPosMap] {f : ℍ +-- →ₗ[ℂ] ℍ} (hf : LinearMap.IsReal f) : +-- LinearMap.IsReal (LinearMap.adjoint f) ↔ Commute f (hφ.sig 1).toLinearMap := +-- by +-- rw [LinearMap.isReal_iff] at hf +-- let σ := hφ.sig +-- have : Commute f (σ 1).toLinearMap ↔ Commute (LinearMap.adjoint f) (σ 1).toLinearMap := +-- by +-- simp_rw [σ] +-- nth_rw 2 [← Module.Dual.IsFaithfulPosMap.sig_adjoint] +-- rw [commute.adjoint_adjoint_lm] +-- rw [this] +-- clear this +-- rw [LinearMap.isReal_iff, LinearMap.adjoint_real_apply, hf, ← LinearMap.comp_assoc, +-- comp_sig_eq, +-- neg_neg] +-- simp_rw [Commute, SemiconjBy, LinearMap.mul_eq_comp, @eq_comm _ _ ((σ 1).toLinearMap ∘ₗ _)] + +theorem sig_apply_posDef_matrix_hMul [hφ : φ.IsFaithfulPosMap] (t : ℝ) (x : ℍ) : + hφ.sig t (hφ.matrixIsPosDef.rpow t * x) = x * hφ.matrixIsPosDef.rpow t := by + simp_rw [Module.Dual.IsFaithfulPosMap.sig_apply, ← Matrix.mul_assoc, PosDef.rpow_mul_rpow, + neg_add_cancel, PosDef.rpow_zero, Matrix.one_mul] + +theorem sig_apply_posDef_matrix_mul' [hφ : φ.IsFaithfulPosMap] (x : ℍ) : + hφ.sig 1 (φ.matrix * x) = x * φ.matrix := + by + nth_rw 2 [← PosDef.rpow_one_eq_self hφ.matrixIsPosDef] + rw [← sig_apply_posDef_matrix_hMul, PosDef.rpow_one_eq_self] + +theorem sig_apply_matrix_hMul_posDef [hφ : φ.IsFaithfulPosMap] (t : ℝ) (x : ℍ) : + hφ.sig t (x * hφ.matrixIsPosDef.rpow (-t)) = hφ.matrixIsPosDef.rpow (-t) * x := + by + simp_rw [Module.Dual.IsFaithfulPosMap.sig_apply, Matrix.mul_assoc, PosDef.rpow_mul_rpow, + neg_add_cancel, PosDef.rpow_zero, Matrix.mul_one] + +theorem sig_apply_matrix_hMul_posDef' [hφ : φ.IsFaithfulPosMap] (x : ℍ) : hφ.sig (-1) (x * + φ.matrix) = φ.matrix * x := + by + nth_rw 2 [← PosDef.rpow_one_eq_self hφ.matrixIsPosDef] + nth_rw 2 [← neg_neg (1 : ℝ)] + rw [← sig_apply_matrix_hMul_posDef, neg_neg, PosDef.rpow_one_eq_self] + +theorem sig_apply_matrix_hMul_posDef'' [hφ : φ.IsFaithfulPosMap] (x : ℍ) : hφ.sig 1 (x * + φ.matrix⁻¹) = φ.matrix⁻¹ * x := + by + nth_rw 2 [← PosDef.rpow_neg_one_eq_inv_self hφ.matrixIsPosDef] + rw [← sig_apply_matrix_hMul_posDef, PosDef.rpow_neg_one_eq_inv_self] + +theorem sig_apply_basis [hφ : φ.IsFaithfulPosMap] (i : n × n) : + hφ.sig 1 (hφ.basis i) = + φ.matrix⁻¹ * e_{i.1,i.2} * hφ.matrixIsPosDef.rpow (1 / 2) := + by + rw [Module.Dual.IsFaithfulPosMap.basis_apply] + simp_rw [Module.Dual.IsFaithfulPosMap.sig_apply, Matrix.mul_assoc, PosDef.rpow_mul_rpow, + PosDef.rpow_neg_one_eq_inv_self] + norm_num + +omit [DecidableEq n] in +theorem Qam.symm'_symm_real_apply_adjoint_tFAE [hφ : φ.IsFaithfulPosMap] (A : ℍ →ₗ[ℂ] ℍ) : + letI : DecidableEq n := Classical.decEq n + withMatrixQuantum[φ] + (List.TFAE + [symmMap ℂ ℍ _ A = A, (symmMap ℂ ℍ _).symm A = A, + A.real = LinearMap.adjoint A, + ∀ x y, φ (A x * y) = φ (x * A y)]) := +by + classical + exact withMatrixQuantum[φ] (by + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + suffices φ = Coalgebra.counit by + simp_rw [this] + exact symmMap_eq_self_tfae _ rfl + ext + simp_rw [← Coalgebra.inner_eq_counit', Module.Dual.IsFaithfulPosMap.inner_eq, + conjTranspose_one, one_mul]) + +theorem sig_comp_eq_iff [hφ : φ.IsFaithfulPosMap] (t : ℝ) (A B : ℍ →ₗ[ℂ] ℍ) : + (hφ.sig t).toLinearMap.comp A = B ↔ A = (hφ.sig (-t)).toLinearMap.comp B := +by + rw [AlgEquiv.comp_linearMap_eq_iff, Module.Dual.IsFaithfulPosMap.sig_symm_eq] + +theorem stdBasisMatrix_squash (i j k l : n) (x : Matrix n n ℂ) : + e_{i,j} * x * e_{k,l} = x j k • e_{i,l} := by + ext i_1 j_1 + simp [Matrix.mul_apply, Matrix.smul_apply, Matrix.stdBasisMatrix, Matrix.single, + smul_eq_mul, ite_and] + split_ifs <;> rfl + +open scoped ComplexOrder +private theorem nontracial_basis_apply {Q : ℍ} (hQ : Q.PosDef) (i j k l : n) : + (e_{i,j} * hQ.rpow (-(1 / 2))) k l = ite (i = k) (hQ.rpow (-(1 / 2)) j l) 0 := by + simp [Matrix.mul_apply, Matrix.stdBasisMatrix, Matrix.single, ite_and] + +-- theorem tenSwap_sig [hφ : φ.IsFaithfulPosMap] (x y : ℝ) : +-- (tenSwap : l(ℍ ⊗[ℂ] ℍᵐᵒᵖ)) ∘ₗ +-- TensorProduct.map ((hφ.sig x).toLinearMap : l(ℍ)) (sigop hφ y : l(ℍᵐᵒᵖ)) = +-- (((hφ.sig y).toLinearMap : l(ℍ)) ⊗ₘ sigop hφ x : l(ℍ ⊗[ℂ] ℍᵐᵒᵖ)) ∘ₗ tenSwap := +-- by +-- rw [TensorProduct.ext_iff] +-- intro x y +-- simp only [LinearMap.comp_apply, map_tmul, tenSwap_apply, op_apply, unop_apply, +-- MulOpposite.unop_op, MulOpposite.op_unop] +-- rfl + +private theorem Psi.adjoint_rank_one [hφ : φ.IsFaithfulPosMap] (a b : ℍ) (t s : ℝ) : + withMatrixQuantum[φ] + (hφ.psi (ψ := φ) t s (LinearMap.adjoint ((|a⟩⟨b|).toLinearMap)) = + ((hφ.sig (t - s)).toLinearMap ⊗ₘ (hφ.sig (t - s)).op.toLinearMap) + (tenSwap ℂ (Star.star (hφ.psi (ψ := φ) t s (|a⟩⟨b|).toLinearMap)))) := + by + exact withMatrixQuantum[φ] (by + rw [ContinuousLinearMap.linearMap_adjoint, rankOne_adjoint] + dsimp [Module.Dual.IsFaithfulPosMap.psi] + simp_rw [QuantumSet.Psi_toFun_apply, tensor_op_star_apply, unop_apply, op_apply, + MulOpposite.unop_op, star_eq_conjTranspose, conjTranspose_conjTranspose, ← + LinearMap.comp_apply] + simp only [LinearMap.coe_comp, Function.comp_apply] + simp only [TensorProduct.comm_tmul, map_tmul, LinearEquiv.coe_coe, unop_apply, op_apply, + MulOpposite.unop_op, AlgEquiv.toLinearMap_apply, LinearMap.op_apply] + change modAut t b ⊗ₜ[ℂ] MulOpposite.op ((modAut s) a)ᴴ = + modAut (t - s) (modAut s b) ⊗ₜ[ℂ] + MulOpposite.op (modAut (t - s) ((modAut t) a)ᴴ) + rw [← star_eq_conjTranspose, ← star_eq_conjTranspose, starAlgebra.modAut_star, + starAlgebra.modAut_star, QuantumSet.modAut_apply_modAut, QuantumSet.modAut_apply_modAut] + ring_nf) + +-- set_option maxHeartbeats 0 in +-- set_option synthInstance.maxHeartbeats 0 in +-- theorem map_sig_star [hφ : φ.IsFaithfulPosMap] (t s : ℝ) (x : ℍ ⊗[ℂ] ℍᵐᵒᵖ) : +-- star (((hφ.sig t).toLinearMap ⊗ₘ (hφ.sig s).op.toLinearMap) x) = +-- ((hφ.sig (-t)).toLinearMap ⊗ₘ (hφ.sig (-s)).op.toLinearMap) (star x) := +-- x.induction_on +-- (by simp only [star_zero, map_zero]) +-- (fun _ _ => +-- by simp only [map_tmul, tensor_op_star_apply, Module.Dual.IsFaithfulPosMap.sig_conjTranspose, +-- LinearMap.comp_apply, op_apply, unop_apply, MulOpposite.unop_op, MulOpposite.op_unop, +-- AlgEquiv.toLinearMap_apply, sigop, star_eq_conjTranspose]) +-- (fun z w hz hw => by simp only [_root_.map_add, hz, hw, StarAddMonoid.star_add]) + +theorem map_sig_mulLeft_injective [hφ : φ.IsFaithfulPosMap] (t s : ℝ) : + Function.Injective + (LinearMap.mulLeft ℂ + (hφ.matrixIsPosDef.rpow t ⊗ₜ[ℂ] + ((op ℂ (A := ℍ)).toLinearMap : ℍ →ₗ[ℂ] ℍᵐᵒᵖ) + (hφ.matrixIsPosDef.rpow s))) := + by + intro a b h + have : + ∀ a, + a = + (LinearMap.mulLeft ℂ + (hφ.matrixIsPosDef.rpow (-t) ⊗ₜ[ℂ] + ((op ℂ (A := ℍ)).toLinearMap : ℍ →ₗ[ℂ] ℍᵐᵒᵖ) + (hφ.matrixIsPosDef.rpow (-s)))) + (LinearMap.mulLeft ℂ + (hφ.matrixIsPosDef.rpow t ⊗ₜ[ℂ] + ((op ℂ (A := ℍ)).toLinearMap : ℍ →ₗ[ℂ] ℍᵐᵒᵖ) + (hφ.matrixIsPosDef.rpow s)) + a) := + by + intro a + simp_rw [← LinearMap.comp_apply, ← LinearMap.mulLeft_mul, Algebra.TensorProduct.tmul_mul_tmul, + LinearEquiv.coe_coe, op_apply, ← MulOpposite.op_mul, PosDef.rpow_mul_rpow, neg_add_cancel, + add_neg_cancel, PosDef.rpow_zero, MulOpposite.op_one, ← Algebra.TensorProduct.one_def, + LinearMap.mulLeft_one, LinearMap.id_apply] + rw [this a, h, ← this] + +theorem map_sig_mulRight_injective [hφ : φ.IsFaithfulPosMap] (t s : ℝ) : + Function.Injective + (LinearMap.mulRight ℂ + (hφ.matrixIsPosDef.rpow t ⊗ₜ[ℂ] + ((op ℂ (A := ℍ)).toLinearMap : ℍ →ₗ[ℂ] ℍᵐᵒᵖ) + (hφ.matrixIsPosDef.rpow s))) := + by + intro a b h + have : + ∀ a, + a = + (LinearMap.mulRight ℂ + (hφ.matrixIsPosDef.rpow (-t) ⊗ₜ[ℂ] + ((op ℂ (A := ℍ)).toLinearMap : ℍ →ₗ[ℂ] ℍᵐᵒᵖ) + (hφ.matrixIsPosDef.rpow (-s)))) + (LinearMap.mulRight ℂ + (hφ.matrixIsPosDef.rpow t ⊗ₜ[ℂ] + ((op ℂ (A := ℍ)).toLinearMap : ℍ →ₗ[ℂ] ℍᵐᵒᵖ) + (hφ.matrixIsPosDef.rpow s)) + a) := + by + intro a + simp_rw [← LinearMap.comp_apply, ← LinearMap.mulRight_mul, Algebra.TensorProduct.tmul_mul_tmul, + LinearEquiv.coe_coe, op_apply, ← MulOpposite.op_mul, PosDef.rpow_mul_rpow, neg_add_cancel, + add_neg_cancel, PosDef.rpow_zero, MulOpposite.op_one, ← Algebra.TensorProduct.one_def, + LinearMap.mulRight_one, LinearMap.id_apply] + rw [this a, h, ← this] + +theorem LinearMap.matrix.mulRight_adjoint [hφ : φ.IsFaithfulPosMap] (x : ℍ) : + withMatrixQuantum[φ] + (LinearMap.adjoint (LinearMap.mulRight ℂ x) = + LinearMap.mulRight ℂ (hφ.sig (-1) xᴴ)) := + by + exact withMatrixQuantum[φ] (by + symm + rw [@LinearMap.eq_adjoint_iff ℂ _] + intro a b + simp_rw [LinearMap.mulRight_apply, Module.Dual.IsFaithfulPosMap.sig_apply, + neg_neg, PosDef.rpow_one_eq_self, PosDef.rpow_neg_one_eq_inv_self, ← + Module.Dual.IsFaithfulPosMap.inner_left_conj]) + +omit [DecidableEq n] in +theorem LinearMap.matrix.mulLeft_adjoint [hφ : φ.IsFaithfulPosMap] (x : ℍ) : + letI : DecidableEq n := Classical.decEq n + withMatrixQuantum[φ] + (LinearMap.adjoint (LinearMap.mulLeft ℂ x) = LinearMap.mulLeft ℂ xᴴ) := + by + classical + exact withMatrixQuantum[φ] (by + symm + rw [@LinearMap.eq_adjoint_iff ℂ _] + intro a b + simp_rw [LinearMap.mulLeft_apply, ← + Module.Dual.IsFaithfulPosMap.inner_right_hMul]) diff --git a/LeanPool/Monlib4/QuantumGraph/OfClassicalGraph.lean b/LeanPool/Monlib4/QuantumGraph/OfClassicalGraph.lean new file mode 100644 index 0000000000..05e3849965 --- /dev/null +++ b/LeanPool/Monlib4/QuantumGraph/OfClassicalGraph.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Combinatorics.SimpleGraph.AdjMatrix +import LeanPool.Monlib4.QuantumGraph.Basic +import LeanPool.Monlib4.QuantumGraph.Example +import LeanPool.Monlib4.QuantumGraph.Grad + +noncomputable instance {n : Type*} : + starAlgebra (PiQ (fun _ : n => ℂ)) := +piStarAlgebra +noncomputable instance {n : Type*} [Fintype n] : + QuantumSet (PiQ (fun _ : n => ℂ)) := by + letI : Fact (∀ i : n, (QuantumSet.k (A := ℂ)) = 0) := Fact.mk (fun _ => rfl) + infer_instance + +open scoped InnerProductSpace + +theorem EuclideanSpace.comul_eq {n : Type*} [Fintype n] [DecidableEq n] (x : PiQ (fun _ : n => ℂ)) + : + let e : ∀ _ : n, (PiQ (fun _ : n => ℂ)) := fun i => PiLp.single 2 i (1 : ℂ) + (Coalgebra.comul : PiQ (fun _ : n => ℂ) →ₗ[ℂ] _) x + = ∑ i, x i • (e i ⊗ₜ[ℂ] e i) := +by + intro e + have : ∀ y i, ⟪e i, y⟫_ℂ = y i := fun y i => by + simpa [e] using (EuclideanSpace.basisFun_inner (𝕜 := ℂ) (ι := n) y i) + rw [TensorProduct.inner_ext_iff'] + intro a b + simp only [TensorProduct.inner_tmul, Coalgebra.comul, LinearMap.adjoint_inner_left, + LinearMap.mul'_apply, sum_inner, inner_smul_left, this] + simp only [PiLp.inner_apply, RCLike.inner_apply'] + rfl + +open scoped Matrix +/-- a finite simple graph is a quantum graph -/ +theorem SimpleGraph.toQuantumGraph {V : Type*} [Fintype V] [DecidableEq V] (G : SimpleGraph V) : + letI : DecidableRel G.Adj := Classical.decRel G.Adj + QuantumGraph _ (Matrix.toEuclideanLin (SimpleGraph.adjMatrix ℂ G)) := +by + letI : DecidableRel G.Adj := Classical.decRel G.Adj + let e : ∀ _ : V, EuclideanSpace ℂ V := fun i => PiLp.single 2 i (1 : ℂ) + have he : ∀ i, e i = PiLp.single 2 i (1 : ℂ) := fun _ => rfl + have : ∀ (i : V) (a : Matrix V V ℂ), + ((Matrix.toEuclideanLin a (e i)) : EuclideanSpace ℂ V) = + (aᵀ i) := fun _ _ => by + simp only [Matrix.toEuclideanLin_apply'] + ext + simp [Matrix.mulVec, dotProduct, e, Matrix.transpose_apply] + constructor + ext1 x + simp only [schurMul_apply_apply, LinearMap.coe_comp, Function.comp_apply, + EuclideanSpace.comul_eq, ← he] + simp_rw [map_sum, LinearMapClass.map_smul, TensorProduct.map_tmul, LinearMap.mul'_apply] + ext1 j + simp [this, Matrix.mulVec, dotProduct, Matrix.transpose_apply, SimpleGraph.adjMatrix, + Matrix.of_apply, smul_eq_mul, mul_ite, mul_one, mul_zero, ← ite_and, and_self] + +theorem quantumGraph_numOfEdges_of_classical + {V : Type*} [Fintype V] [DecidableEq V] (G : SimpleGraph V) : + letI : DecidableRel G.Adj := Classical.decRel G.Adj + QuantumGraph.NumOfEdges (Matrix.toEuclideanLin (SimpleGraph.adjMatrix ℂ G)) + = ∑ i, ∑ j, SimpleGraph.adjMatrix ℂ G i j := +by + have hOne : ∀ i : V, (1 : EuclideanSpace ℂ V) i = (1 : ℂ) := fun i => rfl + simp [QuantumGraph.NumOfEdges, Matrix.mulVec, dotProduct, PiLp.inner_apply, hOne] + +theorem SimpleGraph.conjTranspose_adjMatrix {V α : Type*} (G : SimpleGraph V) + [DecidableRel G.Adj] [NonAssocSemiring α] [StarRing α] : + (SimpleGraph.adjMatrix α G)ᴴ = SimpleGraph.adjMatrix α G := +by + ext + simp [star_ite, star_one, star_zero, adj_comm] + +theorem SimpleGraph.adjMatrix_toEuclideanLin_isReal + {V : Type*} [Fintype V] [DecidableEq V] (G : SimpleGraph V) : + letI : DecidableRel G.Adj := Classical.decRel G.Adj + LinearMap.IsReal (Matrix.toEuclideanLin (SimpleGraph.adjMatrix ℂ G)) := +by + intro + ext + simp [Matrix.mulVec, dotProduct, SimpleGraph.adjMatrix, Matrix.of_apply] + +theorem SimpleGraph.adjMatrix_toEuclideanLin_symmMap + {V : Type*} [Fintype V] [DecidableEq V] (G : SimpleGraph V) : + letI : DecidableRel G.Adj := Classical.decRel G.Adj + symmMap ℂ _ _ (Matrix.toEuclideanLin (SimpleGraph.adjMatrix ℂ G)) + = Matrix.toEuclideanLin (SimpleGraph.adjMatrix ℂ G) := +by + simp only [symmMap_apply, + LinearMap.real_of_isReal (SimpleGraph.adjMatrix_toEuclideanLin_isReal G), + ← Matrix.toEuclideanLin_conjTranspose_eq_adjoint, + SimpleGraph.conjTranspose_adjMatrix] + +theorem SimpleGraph.adjMatrix_irreflexive + {V : Type*} [Fintype V] [DecidableEq V] (G : SimpleGraph V) : + letI : DecidableRel G.Adj := Classical.decRel G.Adj + (Matrix.toEuclideanLin (SimpleGraph.adjMatrix ℂ G)) •ₛ 1 = 0 := +by + letI : DecidableRel G.Adj := Classical.decRel G.Adj + ext1 x + simp only [schurMul_apply_apply, LinearMap.comp_apply] + rw [EuclideanSpace.comul_eq] + simp only [map_sum, map_smul, TensorProduct.map_tmul, LinearMap.mul'_apply, + Module.End.one_apply] + ext i + simp [Matrix.mulVec, dotProduct, SimpleGraph.adjMatrix, Matrix.of_apply, Pi.single_apply, + SimpleGraph.irrefl] diff --git a/LeanPool/Monlib4/QuantumGraph/PiMat.lean b/LeanPool/Monlib4/QuantumGraph/PiMat.lean new file mode 100644 index 0000000000..a6a014cd82 --- /dev/null +++ b/LeanPool/Monlib4/QuantumGraph/PiMat.lean @@ -0,0 +1,2029 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.QuantumGraph.Basic +import LeanPool.Monlib4.QuantumGraph.Example +import LeanPool.Monlib4.LinearAlgebra.TensorProduct.Submodule +import LeanPool.Monlib4.RepTheory.AutMat +import Mathlib.LinearAlgebra.TensorProduct.Basis +import Mathlib.LinearAlgebra.TensorProduct.Finiteness + +variable {ι : Type*} {p : ι → Type*} [Fintype ι] [DecidableEq ι] + [Π i, Fintype (p i)] [Π i, DecidableEq (p i)] + {φ : Π i, Module.Dual ℂ (Matrix (p i) (p i) ℂ)} + [hφ : Π i, (φ i).IsFaithfulPosMap] + +open scoped Functional MatrixOrder ComplexOrder TensorProduct Matrix + +/-- Introduce the quantum-set instances for a product of matrix blocks in a proof. -/ +syntax "withPiQuantumCtx" "[" term "]" : tactic +macro_rules + | `(tactic| withPiQuantumCtx[$ψ]) => + `(tactic| + letI := PiMat.isStarAlgebra (ψ := $ψ); + letI := Module.Dual.pi.IsFaithfulPosMap.quantumSet (ψ := $ψ); + letI := Module.Dual.PiNormedAddCommGroup (φ := $ψ); + letI := (Module.Dual.PiNormedAddCommGroup (φ := + $ψ)).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace; + letI := (Module.Dual.PiNormedAddCommGroup (φ := $ψ)).toSeminormedAddCommGroup; + letI := Module.Dual.pi.InnerProductSpace (φ := $ψ)) + +/-- Introduce the quantum-set instances for a single matrix algebra in a proof. -/ +syntax "withMatrixQuantumCtx" "[" term "]" : tactic +macro_rules + | `(tactic| withMatrixQuantumCtx[$φ]) => + `(tactic| + letI := Matrix.isStarAlgebra (φ := $φ); + letI := Module.Dual.IsFaithfulPosMap.quantumSet (φ := $φ); + letI := Module.Dual.NormedAddCommGroup $φ; + letI := (Module.Dual.NormedAddCommGroup + $φ).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace; + letI := (Module.Dual.NormedAddCommGroup $φ).toSeminormedAddCommGroup; + letI := Module.Dual.InnerProductSpace (φ := $φ)) + +private noncomputable abbrev PiMatTensorTo (ι : Type*) + (p : ι → Type*) [Fintype ι] [DecidableEq ι] + [Π i, DecidableEq (p i)] [Π i, Fintype (p i)] : + (PiMat ℂ ι p ⊗[ℂ] PiMat ℂ ι p) ≃⋆ₐ[ℂ] (i : ι × ι) → + (Matrix (p i.1) (p i.1) ℂ ⊗[ℂ] Matrix (p i.2) (p i.2) ℂ) := +StarAlgEquiv.ofAlgEquiv (directSumTensorAlgEquiv ℂ + (fun i ↦ Matrix (p i) (p i) ℂ) (fun i ↦ Matrix (p i) (p i) ℂ)) + (fun x => x.induction_on + (by simp only [star_zero, map_zero]) + (fun _ _ => by + ext + simp only [Pi.star_apply, TensorProduct.star_tmul, + directSumTensorAlgEquiv_apply, directSumTensorToFun_apply]) + (fun _ _ h1 h2 => by simp only [star_add, map_add, h1, h2])) + +/-- +Transpose each matrix block of a `PiMat` as a star-algebra equivalence to the opposite algebra. +-/ +@[simps] +noncomputable def PiMat.transposeStarAlgEquiv + (ι : Type*) (p : ι → Type*) [Π i, Fintype (p i)] : + PiMat ℂ ι p ≃⋆ₐ[ℂ] (PiMat ℂ ι p)ᵐᵒᵖ where + toFun x := MulOpposite.op (fun i => (x i)ᵀ) + invFun x i := (MulOpposite.unop x i)ᵀ + left_inv _ := rfl + right_inv _ := rfl + map_mul' _ _ := by + simp only [Pi.mul_apply, Matrix.transpose_mul] + rfl + map_add' _ _ := rfl + map_smul' _ _ := by + -- simp only [MulOpposite.op_inj, Matrix.transpose_smul] + rfl + map_star' _ := rfl + +/-- Matrix algebra as endomorphisms of Euclidean space, as a star-algebra equivalence. -/ +noncomputable abbrev Matrix.toEuclideanStarAlgEquiv + {n : Type*} [Fintype n] [DecidableEq n] : + (Matrix n n ℂ) ≃⋆ₐ[ℂ] EuclideanSpace ℂ n →ₗ[ℂ] EuclideanSpace ℂ n := +StarAlgEquiv.ofAlgEquiv +(AlgEquiv.ofLinearEquiv (Matrix.toEuclideanLin) + (by + exact Matrix.toLpLin_one (p := (2 : ENNReal))) + (fun x y => by + simp only [Matrix.toLpLin_eq_toLin, + Matrix.toLin_mul (PiLp.basisFun 2 ℂ n) (PiLp.basisFun 2 ℂ n)] + rfl)) +(fun _ => by + simp only [AlgEquiv.ofLinearEquiv_apply, Matrix.toEuclideanLin_eq_toLin_orthonormal, + LinearMap.star_eq_adjoint, Matrix.star_eq_conjTranspose, + Matrix.toLin_conjTranspose]) +theorem Matrix.toEuclideanStarAlgEquiv_coe {n : Type*} [Fintype n] [DecidableEq n] : + ⇑(Matrix.toEuclideanStarAlgEquiv : + Matrix n n ℂ ≃⋆ₐ[ℂ] EuclideanSpace ℂ n →ₗ[ℂ] EuclideanSpace ℂ n) = + Matrix.toEuclideanLin := rfl + +/-- Tensor-product equivalence for direct products of matrix algebras. -/ +@[simps!] +noncomputable def PiMatTensorProductEquiv + {ι₁ ι₂ : Type*} {p₁ : ι₁ → Type*} {p₂ : ι₂ → Type*} + [Fintype ι₁] [DecidableEq ι₁] [Fintype ι₂] [DecidableEq ι₂] + [Π i, Fintype (p₁ i)] [Π i, DecidableEq (p₁ i)] + [Π i, Fintype (p₂ i)] [Π i, DecidableEq (p₂ i)] : + (PiMat ℂ ι₁ p₁) ⊗[ℂ] (PiMat ℂ ι₂ p₂) ≃⋆ₐ[ℂ] + PiMat ℂ (ι₁ × ι₂) (fun i : ι₁ × ι₂ => p₁ i.1 × p₂ i.2) := +StarAlgEquiv.ofAlgEquiv + ((directSumTensorAlgEquiv ℂ _ _).trans + (AlgEquiv.piCongrRight (fun i => tensorToKronecker))) + (fun x => by + ext1 + simp only [Pi.star_apply] + obtain ⟨S, rfl⟩ := TensorProduct.exists_finset x + simp only [AlgEquiv.trans_apply, AlgEquiv.piCongrRight_apply, directSumTensorAlgEquiv_apply, + tensorToKronecker_apply] + simp only [TensorProduct.star_tmul, map_sum, Finset.sum_apply, star_sum, + directSumTensorToFun_apply, Pi.star_apply, TensorProduct.toKronecker_star]) + +theorem PiMatTensorProductEquiv_tmul_apply + {ι₁ ι₂ : Type*} {p₁ : ι₁ → Type*} {p₂ : ι₂ → Type*} + [Fintype ι₁] [DecidableEq ι₁] [Fintype ι₂] [DecidableEq ι₂] + [Π i, Fintype (p₁ i)] [Π i, DecidableEq (p₁ i)] + [Π i, Fintype (p₂ i)] [Π i, DecidableEq (p₂ i)] + (x : PiMat ℂ ι₁ p₁) (y : PiMat ℂ ι₂ p₂) (r : ι₁ × ι₂) + (a b : p₁ r.1 × p₂ r.2) : + (PiMatTensorProductEquiv (x ⊗ₜ[ℂ] y)) r a b = x r.1 a.1 b.1 * y r.2 a.2 b.2 := by + simp_rw [PiMatTensorProductEquiv_apply, directSumTensorToFun_apply, + TensorProduct.toKronecker_apply] + rfl +open scoped Kronecker +theorem PiMatTensorProductEquiv_tmul + {ι₁ ι₂ : Type*} {p₁ : ι₁ → Type*} {p₂ : ι₂ → Type*} + [Fintype ι₁] [DecidableEq ι₁] [Fintype ι₂] [DecidableEq ι₂] + [Π i, Fintype (p₁ i)] [Π i, DecidableEq (p₁ i)] + [Π i, Fintype (p₂ i)] [Π i, DecidableEq (p₂ i)] + (x : PiMat ℂ ι₁ p₁) (y : PiMat ℂ ι₂ p₂) : + (PiMatTensorProductEquiv (x ⊗ₜ[ℂ] y)) = fun r : ι₁ × ι₂ => (x r.1 ⊗ₖ y r.2) := by + ext; simp only [PiMatTensorProductEquiv_tmul_apply]; rfl + +theorem PiMatTensorProductEquiv_tmul_apply' + {ι₁ ι₂ : Type*} {p₁ : ι₁ → Type*} {p₂ : ι₂ → Type*} + [Fintype ι₁] [DecidableEq ι₁] [Fintype ι₂] [DecidableEq ι₂] + [Π i, Fintype (p₁ i)] [Π i, DecidableEq (p₁ i)] + [Π i, Fintype (p₂ i)] [Π i, DecidableEq (p₂ i)] + (x : PiMat ℂ ι₁ p₁) (y : PiMat ℂ ι₂ p₂) (r : ι₁ × ι₂) + (a c : p₁ r.1) (b d : p₂ r.2) : + (PiMatTensorProductEquiv (x ⊗ₜ[ℂ] y)) r (a, b) (c, d) = x r.1 a c * y r.2 b d := +PiMatTensorProductEquiv_tmul_apply _ _ _ _ _ + +open scoped FiniteDimensional in +/-- The forgetful equivalence from continuous endomorphisms to linear endomorphisms, +as a star algebra equivalence. -/ +noncomputable def ContinuousLinearMap.toLinearMapStarAlgEquiv {𝕜 B : Type*} [RCLike 𝕜] + [NormedAddCommGroup B] [InnerProductSpace 𝕜 B] [FiniteDimensional 𝕜 B] [CompleteSpace B] : + (B →L[𝕜] B) ≃⋆ₐ[𝕜] (B →ₗ[𝕜] B) := +StarAlgEquiv.ofAlgEquiv ContinuousLinearMap.toLinearMapAlgEquiv + (fun _ => by simp only [ContinuousLinearMap.toLinearMapAlgEquiv_apply]; rfl) + +/-- Convert each block of a `PiMat` to a Euclidean-space linear map. -/ +noncomputable abbrev PiMat_toEuclideanLM : + (PiMat ℂ ι p) ≃⋆ₐ[ℂ] (Π i, EuclideanSpace ℂ (p i) →ₗ[ℂ] EuclideanSpace ℂ (p i)) := +StarAlgEquiv.piCongrRight (fun _ => Matrix.toEuclideanStarAlgEquiv) + +/-- Trace functional on a product of matrix blocks. -/ +@[simps!] +noncomputable abbrev PiMat.traceLinearMap : + (PiMat ℂ ι p) →ₗ[ℂ] ℂ := +Matrix.traceLinearMap _ _ _ ∘ₗ Matrix.blockDiagonal'AlgHom.toLinearMap + +/-- Coalgebra structure on a finite product of matrix blocks. -/ +@[reducible] +noncomputable def PiMat.finiteDimensionalHilbertCoalgebraStruct : + CoalgebraStruct ℂ (PiMat ℂ ι p) := by + withPiQuantumCtx[φ] + exact (Coalgebra.ofFiniteDimensionalHilbertAlgebra (R := ℂ) + (A := PiMat ℂ ι p)).toCoalgebraStruct + +theorem QuantumGraph.PiMat_existsSubmoduleIsProj : + withPiQuantum[φ] + ∀ {f : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + QuantumGraph (PiMat ℂ ι p) f → ∀ t r : ℝ, + ∃ u : Π i : ι × ι, Submodule ℂ (EuclideanSpace ℂ (p i.1 × p i.2)), + ∀ i : ι × ι, LinearMap.IsProj (u i) + (PiMat_toEuclideanLM (PiMatTensorProductEquiv + ((StarAlgEquiv.lTensor _ + (PiMat.transposeStarAlgEquiv ι p).symm) (QuantumSet.Psi t r f))) i) := +by + withPiQuantumCtx[φ] + intro f hf t r + let q : Π i : ι × ι, EuclideanSpace ℂ (p i.1 × p i.2) →ₗ[ℂ] + EuclideanSpace ℂ (p i.1 × p i.2) := + PiMat_toEuclideanLM (PiMatTensorProductEquiv ((StarAlgEquiv.lTensor _ + (PiMat.transposeStarAlgEquiv ι p).symm) (QuantumSet.Psi t r f))) + have : ∀ i, IsIdempotentElem (q i) := + by + rw [← isIdempotentElem_pi_iff (a := q)] + dsimp [q] + simp_rw [IsIdempotentElem.mulEquiv] + simpa [QuantumSet.Psi_apply] using + (schurIdempotent_iff_Psi_isIdempotentElem (A := PiMat ℂ ι p) + (B := PiMat ℂ ι p) f t r).mp hf.isIdempotentElem + simp_rw [← LinearMap.isProj_iff_isIdempotentElem] at this + exact ⟨fun i => (this i).choose, fun i => (this i).choose_spec⟩ + + +/-- Submodules associated to the block components of a `PiMat` quantum graph. -/ +noncomputable def QuantumGraph.PiMat_submodule : + withPiQuantum[φ] + ∀ {f : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + QuantumGraph (PiMat ℂ ι p) f → ℝ → ℝ → + Π i : ι × ι, Submodule ℂ (EuclideanSpace ℂ (p i.1 × p i.2)) := +by + withPiQuantumCtx[φ] + intro f hf t r + exact Classical.choose (QuantumGraph.PiMat_existsSubmoduleIsProj hf t r) + +theorem QuantumGraph.PiMat_submoduleIsProj : + withPiQuantum[φ] + ∀ {f : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + (hf : QuantumGraph (PiMat ℂ ι p) f) → ∀ (t r : ℝ) (i : ι × ι), + LinearMap.IsProj (hf.PiMat_submodule t r i) + (PiMat_toEuclideanLM (PiMatTensorProductEquiv ((StarAlgEquiv.lTensor _ + (PiMat.transposeStarAlgEquiv ι p).symm) (QuantumSet.Psi t r f))) i) := +by + withPiQuantumCtx[φ] + intro f hf t r i + exact Classical.choose_spec (QuantumGraph.PiMat_existsSubmoduleIsProj hf t r) i + +theorem QuantumGraph.PiMat_submoduleIsProj_codRestrict : + withPiQuantum[φ] + ∀ {f : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + (hf : QuantumGraph (PiMat ℂ ι p) f) → ∀ (t r : ℝ) (i : ι × ι), + (Submodule.subtype _).comp (QuantumGraph.PiMat_submoduleIsProj hf t r i).codRestrict + = (PiMat_toEuclideanLM (PiMatTensorProductEquiv ((StarAlgEquiv.lTensor _ + (PiMat.transposeStarAlgEquiv ι p).symm) (QuantumSet.Psi t r f))) i) := +by + withPiQuantumCtx[φ] + intros + rfl + +/-- Sum of the dimensions of the block submodules associated to a `PiMat` quantum graph. -/ +noncomputable def QuantumGraph.dim_of_piMat_submodule : + withPiQuantum[φ] + ∀ {f : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, QuantumGraph _ f → ℕ := +by + withPiQuantumCtx[φ] + intro f hf + exact ∑ i : ι × ι, Module.finrank ℂ (hf.PiMat_submodule 0 (1 / 2) i) + +theorem PiMat.traceLinearMap_comp_piMatTensorProductEquiv_eq : + (PiMat.traceLinearMap : (PiMat ℂ (ι × ι) fun i ↦ p i.1 × p i.2) →ₗ[ℂ] ℂ) ∘ₗ + PiMatTensorProductEquiv.toLinearMap + = LinearMap.mul' ℂ _ ∘ₗ (TensorProduct.map PiMat.traceLinearMap PiMat.traceLinearMap) := +by + apply TensorProduct.ext' + intro x y + simp only [LinearMap.comp_apply, StarAlgEquiv.toLinearMap_apply, PiMatTensorProductEquiv_tmul, + TensorProduct.map_tmul, LinearMap.mul'_apply, + AlgHom.toLinearMap_apply, Matrix.blockDiagonal'AlgHom_apply, + Matrix.traceLinearMap_apply, + Matrix.trace_blockDiagonal', Matrix.trace_kronecker, + Finset.mul_sum, Finset.sum_mul, Finset.sum_product_univ] + rw [Finset.sum_comm] + +lemma PiMat.transposeStarAlgEquiv_symm_is_tracePreserving (x : (PiMat ℂ ι p)ᵐᵒᵖ) : + PiMat.traceLinearMap ((PiMat.transposeStarAlgEquiv ι p).symm x) = + PiMat.traceLinearMap (MulOpposite.unop x) := +rfl + +lemma PiMat.traceLinearMap_comp_transposeStarAlgEquiv_symm : + PiMat.traceLinearMap ∘ₗ (PiMat.transposeStarAlgEquiv ι p).symm.toLinearMap + = PiMat.traceLinearMap ∘ₗ (unop ℂ (A := PiMat ℂ ι p)).toLinearMap := +rfl + +theorem QuantumGraph.dim_of_piMat_submodule_eq_trace : + withPiQuantum[φ] + ∀ {f : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, (hf : QuantumGraph _ f) → + QuantumGraph.dim_of_piMat_submodule hf = + PiMat.traceLinearMap + (PiMatTensorProductEquiv + ((StarAlgEquiv.lTensor _ (PiMat.transposeStarAlgEquiv ι p).symm) + (QuantumSet.Psi 0 (1 / 2) f))) := +by + withPiQuantumCtx[φ] + intro f hf + rw [PiMat.traceLinearMap_apply, Matrix.blockDiagonal'AlgHom_apply, + Matrix.trace_blockDiagonal', dim_of_piMat_submodule] + simp only [Nat.cast_sum, PiMatTensorProductEquiv_apply] + congr + ext i + rw [← LinearMap.IsProj.trace (QuantumGraph.PiMat_submoduleIsProj hf 0 (1 / 2) i)] + simp only [StarAlgEquiv.piCongrRight_apply, + Matrix.toEuclideanStarAlgEquiv_coe, + PiMatTensorProductEquiv_apply, EuclideanSpace.trace_eq_matrix_trace', + LinearEquiv.symm_apply_apply] + +theorem Coalgebra.counit_mulOpposite {A : Type*} + [Semiring A] [Algebra ℂ A] [CoalgebraStruct ℂ A] : + Coalgebra.counit (R := ℂ) (A := Aᵐᵒᵖ) = Coalgebra.counit ∘ₗ (unop ℂ).toLinearMap := +rfl + +theorem StarAlgEquiv.lTensor_toLinearMap {R A B C : Type*} + [RCLike R] [Ring A] [Ring B] [Ring C] [Algebra R A] + [Algebra R B] [Algebra R C] [StarAddMonoid A] [StarAddMonoid B] + [StarAddMonoid C] [StarModule R A] [StarModule R B] + [StarModule R C] [Module.Finite R A] [Module.Finite R B] + [Module.Finite R C] (f : A ≃⋆ₐ[R] B) : + (StarAlgEquiv.lTensor C f).toLinearMap = LinearMap.lTensor C f.toLinearMap := +rfl + +attribute [local instance] Algebra.ofIsScalarTowerSmulCommClass + +-- noncomputable instance MulOppositeCoalgebra {A : Type*} [Semiring A] [Algebra ℂ A] +-- [Coalgebra ℂ A] : +-- Coalgebra ℂ Aᵐᵒᵖ where +-- coassoc := sorry +-- rTensor_counit_comp_comul := sorry +-- lTensor_counit_comp_comul := sorry + +-- remove this... +noncomputable instance TensorProduct.instCoalgebraStruct' + {R S A B : Type*} [CommSemiring R] [CommSemiring S] [AddCommMonoid A] [AddCommMonoid B] + [Algebra R S] [Module R A] [Module S A] [Module R B] [CoalgebraStruct R B] + [CoalgebraStruct S A] [IsScalarTower R S A] : CoalgebraStruct S (A ⊗[R] B) where + comul := + AlgebraTensorModule.tensorTensorTensorComm R S R S A A B B ∘ₗ + AlgebraTensorModule.map CoalgebraStruct.comul CoalgebraStruct.comul + counit := AlgebraTensorModule.rid R S S ∘ₗ + AlgebraTensorModule.map CoalgebraStruct.counit CoalgebraStruct.counit + +lemma TensorProduct.instCoalgebraStruct'_counit + {R S A B : Type*} [CommSemiring R] [CommSemiring S] [AddCommMonoid A] [AddCommMonoid B] + [Algebra R S] [Module R A] [Module S A] [Module R B] [CoalgebraStruct R B] + [CoalgebraStruct S A] [IsScalarTower R S A] : + (TensorProduct.instCoalgebraStruct' : CoalgebraStruct S (A ⊗[R] B)).counit = + AlgebraTensorModule.rid R S S ∘ₗ + AlgebraTensorModule.map CoalgebraStruct.counit CoalgebraStruct.counit := +rfl + +-- attribute [local instance] TensorProduct.instCoalgebraStruct' + +-- instance : +-- Coalgebra ℂ (PiMat ℂ ι p ⊗[ℂ] (PiMat ℂ ι p)ᵐᵒᵖ) := +-- Coalgebra.ofFiniteDimensionalHilbertAlgebra (R := ℂ) (A := PiMat ℂ ι p ⊗[ℂ] (PiMat ℂ ι p)ᵐᵒᵖ) + +theorem QuantumGraph.dim_of_piMat_submodule_eq_trace_counit : + withPiQuantum[φ] + (Coalgebra.counit (R := ℂ) (A := PiMat ℂ ι p)) = PiMat.traceLinearMap → + ∀ {f : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, (hf : QuantumGraph _ f) → + QuantumGraph.dim_of_piMat_submodule hf = + (Coalgebra.counit (R := ℂ)) (QuantumSet.Psi 0 (1 / 2) f) := +by + withPiQuantumCtx[φ] + intro hc f hf + simp only [TensorProduct.instCoalgebraStruct'_counit, + LinearMap.coe_comp, Function.comp_apply, hc, Coalgebra.counit_mulOpposite] + rw [QuantumGraph.dim_of_piMat_submodule_eq_trace] + simp only [← StarAlgEquiv.toLinearMap_apply, ← LinearMap.comp_apply, + ← LinearMap.comp_assoc, + PiMat.traceLinearMap_comp_piMatTensorProductEquiv_eq, + StarAlgEquiv.lTensor_toLinearMap] + rw [LinearMap.comp_assoc, LinearMap.map_comp_lTensor] + simp only [one_div, QuantumSet.Psi_apply, LinearMap.coe_comp, Function.comp_apply, + LinearEquiv.coe_coe] + congr 1 + ext; simp + +-- set_option maxHeartbeats 500000 in +theorem Coalgebra.counit_self_tensor_mulOpposite_eq_bra_one + {A : Type*} [NormedAddCommGroupOfRing A] + [InnerProductSpace ℂ A] [SMulCommClass ℂ A A] [IsScalarTower ℂ A A] [FiniteDimensional ℂ A] : + Coalgebra.counit (R := ℂ) (A := A ⊗[ℂ] Aᵐᵒᵖ) + = (bra ℂ (1 : A ⊗[ℂ] Aᵐᵒᵖ)).toLinearMap := +by + -- letI : FiniteDimensional ℂ (A ⊗[ℂ] Aᵐᵒᵖ) := by infer_instance + -- -- letI + -- letI := TensorProduct.instNormedAddCommGroupOfRing (R:= ℂ) (A := A) (B := Aᵐᵒᵖ) + -- exact @Coalgebra.counit_eq_bra_one ℂ (A ⊗[ℂ] Aᵐᵒᵖ) + -- _ _ _ _ _ _ + apply TensorProduct.ext' + intro x y + -- rw [TensorProduct.counit_def] + simp only [TensorProduct.instCoalgebraStruct'_counit, LinearMap.coe_comp, Function.comp_apply, + Algebra.TensorProduct.one_def, + ContinuousLinearMap.coe_coe, innerSL_apply_apply, TensorProduct.inner_tmul, + Coalgebra.inner_eq_counit', Coalgebra.counit_mulOpposite_eq, + MulOpposite.inner_eq, MulOpposite.unop_one, + TensorProduct.AlgebraTensorModule.map_tmul] + simp only [LinearEquiv.coe_coe, TensorProduct.AlgebraTensorModule.rid_tmul, smul_eq_mul, mul_comm] + +lemma QuantumGraph.NumOfEdges_apply {A : Type*} [starAlgebra A] [QuantumSet A] + (f : A →ₗ[ℂ] A) : NumOfEdges f = inner ℂ 1 (f 1) := +rfl + +-- instance {A : Type*} [NormedAddCommGroupOfRing A] : +-- NormedAddCommGroupOfRing Aᵐᵒᵖ where +-- noncomputable instance {A : Type*} [NormedAddCommGroup A] +-- [InnerProductSpace ℂ A] : InnerProductSpace ℂ Aᵐᵒᵖ where +-- norm_sq_eq_re_inner _ := by +-- simp [MulOpposite.inner_eq, norm_eq_sqrt_re_inner (𝕜 := ℂ)] +-- rw [← RCLike.re_eq_complex_re] +-- exact Real.sq_sqrt (inner_self_nonneg) +-- conj_inner_symm _ _ := inner_conj_symm _ _ +-- add_left _ _ _ := inner_add_left _ _ _ +-- smul_left x y _ := inner_smul_left _ _ _ +-- noncomputable instance {A : Type*} [NormedAddCommGroupOfRing A] [InnerProductSpace ℂ A] +-- [SMulCommClass ℂ A A] [IsScalarTower ℂ A A] +-- [FiniteDimensional ℂ A] : +-- NormedAddCommGroupOfRing (A ⊗[ℂ] Aᵐᵒᵖ) where + +omit [DecidableEq ι] in +private lemma Coalgebra.counit_piMat_eq_moduleDual_pi : + letI : DecidableEq ι := Classical.decEq ι + withPiQuantum[φ] + ∀ x : PiMat ℂ ι p, + CoalgebraStruct.counit (R := ℂ) (A := PiMat ℂ ι p) x = Module.Dual.pi φ x := by + classical + withPiQuantumCtx[φ] + intro x + rw [← congrFun (QuantumSet.inner_eq_counit' (B := PiMat ℂ ι p)) x] + rw [Module.Dual.pi.IsFaithfulPosMap.inner_eq, star_one, one_mul] + +omit [DecidableEq ι] in +private lemma Coalgebra.counit_self_tensor_mulOpposite_eq_bra_one_piMat : + letI : DecidableEq ι := Classical.decEq ι + withPiQuantum[φ] + CoalgebraStruct.counit (R:= ℂ) (A:= PiMat ℂ ι p ⊗[ℂ] (PiMat ℂ ι p)ᵐᵒᵖ) = + ((bra ℂ) (1 : PiMat ℂ ι p ⊗[ℂ] (PiMat ℂ ι p)ᵐᵒᵖ)).toLinearMap := +by + classical + withPiQuantumCtx[φ] + apply TensorProduct.ext' + intro x y + simp only [TensorProduct.instCoalgebraStruct'_counit, LinearMap.coe_comp, + LinearEquiv.coe_coe, Function.comp_apply, TensorProduct.AlgebraTensorModule.map_tmul, + counit_mulOpposite_eq, TensorProduct.AlgebraTensorModule.rid_tmul, smul_eq_mul, + mul_comm, Algebra.TensorProduct.one_def, ContinuousLinearMap.toLinearMap_innerSL_apply, + innerₛₗ_apply_apply, TensorProduct.inner_tmul, MulOpposite.inner_eq, + MulOpposite.unop_one] + have hx : Coalgebra.counit x = inner ℂ 1 x := + by + rw [Coalgebra.counit_piMat_eq_moduleDual_pi (φ := φ)] + rw [Module.Dual.pi.IsFaithfulPosMap.inner_eq (ψ := φ)] + simp + have hy : Coalgebra.counit (MulOpposite.unop y) = inner ℂ 1 (MulOpposite.unop y) := + by + rw [Coalgebra.counit_piMat_eq_moduleDual_pi (φ := φ)] + rw [Module.Dual.pi.IsFaithfulPosMap.inner_eq (ψ := φ)] + simp + rw [hx, hy] + +theorem QuantumGraph.dim_of_piMat_submodule_eq_numOfEdges_of_trace_counit : + withPiQuantum[φ] + (Coalgebra.counit (R := ℂ) (A := PiMat ℂ ι p)) = PiMat.traceLinearMap → + ∀ {f : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, (hf : QuantumGraph _ f) → + hf.dim_of_piMat_submodule = QuantumGraph.NumOfEdges f := +by + withPiQuantumCtx[φ] + intro hc f hf + rw [QuantumGraph.dim_of_piMat_submodule_eq_trace_counit hc, + NumOfEdges_apply, oneInner_map_one_eq_oneInner_Psi_map _ 0 (1/2)] + simp only [Coalgebra.counit_self_tensor_mulOpposite_eq_bra_one_piMat] + rfl + + -- rw [Coalgebra.counit_eq_bra_one] + -- rw [Coalgebra.counit_self_tensor_mulOpposite_eq_bra_one] + -- rfl + +theorem QuantumGraph.dim_of_piMat_submodule_eq_rank_top_iff : + withPiQuantum[φ] + ∀ {f : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, (hf : QuantumGraph _ f) → + QuantumGraph.dim_of_piMat_submodule hf = + ∑ i : ι × ι, Fintype.card (p i.1) * Fintype.card (p i.2) + ↔ f = Qam.completeGraph _ _ := +by + withPiQuantumCtx[φ] + intro f hf + calc + QuantumGraph.dim_of_piMat_submodule hf = ∑ i : ι × ι, Fintype.card (p i.1) * + Fintype.card (p i.2) + ↔ ∑ i : ι × ι, Module.finrank ℂ ↥(hf.PiMat_submodule 0 (1 / 2) i) + = ∑ i : ι × ι, Fintype.card (p i.1) * Fintype.card (p i.2) := by rfl + _ ↔ ∀ i, Module.finrank ℂ ↥(hf.PiMat_submodule 0 (1 / 2) i) + = Fintype.card (p i.1) * Fintype.card (p i.2) := by + rw [← Nat.cast_inj (R := ℂ)] + simp only [Nat.cast_sum] + rw [eq_comm, ← sub_eq_zero, ← Finset.sum_sub_distrib] + rw [Finset.sum_eq_zero_iff_of_nonneg] + · simp_rw [sub_eq_zero, Nat.cast_inj, Finset.mem_univ, true_imp_iff, + ← Fintype.card_prod, ← finrank_euclideanSpace (𝕜 := ℂ), + @eq_comm _ _ (Module.finrank ℂ (hf.PiMat_submodule 0 (1/2) _))] + · simp only [Finset.mem_univ, sub_nonneg, true_implies, Nat.cast_le] + intro i + calc Module.finrank ℂ (↥(hf.PiMat_submodule 0 (1 / 2) i)) + ≤ Module.finrank ℂ (EuclideanSpace ℂ (p i.1 × p i.2)) := + Submodule.finrank_le _ + _ = Fintype.card (p i.1) * Fintype.card (p i.2) := by + simp only [finrank_euclideanSpace, Fintype.card_prod] + _ ↔ + ∀ i, hf.PiMat_submodule 0 (1 / 2) i = (⊤ : Submodule ℂ (EuclideanSpace ℂ (p i.1 × p i.2))) := + by + simp_rw [← Fintype.card_prod, ← finrank_euclideanSpace (𝕜 := ℂ)] + constructor + · intro h i + exact Submodule.eq_top_of_finrank_eq (h i) + · intro h i + rw [h] + simp only [finrank_top] + _ ↔ + ∀ i, (PiMat_toEuclideanLM (PiMatTensorProductEquiv ((StarAlgEquiv.lTensor _ + (PiMat.transposeStarAlgEquiv ι p).symm) (QuantumSet.Psi 0 (1/2) f))) i) + = LinearMap.id := by + simp_rw [LinearMap.IsProj.codRestrict_eq_dim_iff (hf.PiMat_submoduleIsProj 0 (1/2) _), + LinearMap.IsProj.subtype_comp_codRestrict] + _ + ↔ (PiMat_toEuclideanLM (PiMatTensorProductEquiv ((StarAlgEquiv.lTensor _ + (PiMat.transposeStarAlgEquiv ι p).symm) (QuantumSet.Psi 0 (1/2) f)))) + = 1 := by + rw [funext_iff]; exact Iff.rfl + _ ↔ f = Qam.completeGraph _ _ := + by + rw [eq_comm] + simp_rw [StarAlgEquiv.eq_apply_iff_symm_eq, map_one] + rw [← LinearEquiv.symm_apply_eq, QuantumSet.Psi_symm_one, eq_comm] + +theorem QuantumGraph.CompleteGraph_dim_of_piMat_submodule : + withPiQuantum[φ] + QuantumGraph.dim_of_piMat_submodule + (⟨Qam.Nontracial.CompleteGraph.qam⟩ : + QuantumGraph _ (Qam.completeGraph (PiMat ℂ ι p) (PiMat ℂ ι p))) + = ∑ i : ι × ι, Fintype.card (p i.1) * Fintype.card (p i.2) := +by + withPiQuantumCtx[φ] + rw [QuantumGraph.dim_of_piMat_submodule_eq_rank_top_iff] + +open scoped InnerProductSpace +omit [DecidableEq ι] in +theorem Algebra.linearMap_adjoint_eq_dual : + letI : DecidableEq ι := Classical.decEq ι + withPiQuantum[φ] + LinearMap.adjoint (Algebra.linearMap ℂ (PiMat ℂ ι p)) + = Module.Dual.pi φ := +by + classical + withPiQuantumCtx[φ] + rw [← Module.Dual.pi.IsFaithfulPosMap.adjoint_eq, LinearMap.adjoint_adjoint] + +theorem exists_dim_of_piMat_submodule_ne_inner_one_map_one_of_IsFaithfulState : + withPiQuantum[φ] + (Module.Dual.pi φ).IsUnital → + 1 < Module.finrank ℂ (PiMat ℂ ι p) → + ∃ (A : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p) + (hA : QuantumGraph (PiMat ℂ ι p) A), + QuantumGraph.NumOfEdges A ≠ QuantumGraph.dim_of_piMat_submodule hA := +by + withPiQuantumCtx[φ] + intro hφ₂ hB + use Qam.completeGraph _ _, ⟨Qam.Nontracial.CompleteGraph.qam⟩ + rw [QuantumGraph.CompleteGraph_dim_of_piMat_submodule, Qam.completeGraph, + QuantumGraph.NumOfEdges] + simp only [LinearMap.coe_mk, AddHom.coe_mk, ContinuousLinearMap.coe_coe, + rankOne_apply_apply_apply, ne_eq] + have : ⟪(1 : PiMat ℂ ι p), 1⟫_ℂ = 1 := + by + rw [Module.Dual.pi.IsFaithfulPosMap.inner_eq (ψ := φ)] + simpa [Module.Dual.IsUnital] using hφ₂ + simp_rw [ne_eq, this, one_smul, this] + rw [← Nat.cast_one, Nat.cast_inj] + simp only [Module.finrank_pi_fintype, Module.finrank_matrix, ← pow_two, + Module.finrank_self, mul_one] at hB + have := + calc ∑ i : ι × ι, Fintype.card (p i.1) * Fintype.card (p i.2) + = ∑ i : ι, ∑ j : ι, Fintype.card (p i) * Fintype.card (p j) := + by simp_rw [Finset.sum_product_univ] + _ = (∑ i : ι, Fintype.card (p i)) ^ 2 := + by simp_rw [← Finset.mul_sum, ← Finset.sum_mul, pow_two] + rw [this, eq_comm, ← one_pow 2, sq_eq_sq₀ (by simp) (by simp)] + contrapose! hB + calc ∑ x : ι, Fintype.card (p x) ^ 2 ≤ (∑ i : ι, Fintype.card (p i)) ^ 2 := + Finset.sum_sq_le_sq_sum_of_nonneg (by simp) + _ = 1 := by rw [hB, one_pow] + +theorem QuantumGraph.Real.PiMat_isOrthogonalProjection : + withPiQuantum[φ] + ∀ {A : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + QuantumGraph.Real (PiMat ℂ ι p) A → ∀ i : ι × ι, + ContinuousLinearMap.IsOrthogonalProjection + (LinearMap.toContinuousLinearMap + (PiMat_toEuclideanLM (PiMatTensorProductEquiv ((StarAlgEquiv.lTensor _ + (PiMat.transposeStarAlgEquiv ι p).symm) (QuantumSet.Psi 0 (1 / 2) A))) i)) := +by + withPiQuantumCtx[φ] + intro A hA i + have this' : k (PiMat ℂ ι p) = 0 := by rfl + rw [← zero_add (1 / 2 : ℝ)] + nth_rw 2 [← this'] + simp only [LinearMap.isOrthogonalProjection_iff, IsIdempotentElem, + ← Pi.mul_apply _ _ i, ← map_mul, + IsSelfAdjoint, ← Pi.star_apply _ i, ← map_star] + simp only [(quantumGraphReal_iff_Psi_isIdempotentElem_and_isSelfAdjoint.mp hA).1.eq, + (quantumGraphReal_iff_Psi_isIdempotentElem_and_isSelfAdjoint.mp hA).2.star_eq, and_self] + +/-- Block submodules associated to a real `PiMat` quantum graph. -/ +noncomputable def QuantumGraph.Real.PiMat_submodule : + withPiQuantum[φ] + ∀ {A : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + QuantumGraph.Real (PiMat ℂ ι p) A → + Π i : ι × ι, Submodule ℂ (EuclideanSpace ℂ (p i.1 × p i.2)) := +by + withPiQuantumCtx[φ] + intro A hA i + exact Classical.choose + (orthogonal_projection_iff.mpr + (And.comm.mp + (ContinuousLinearMap.isOrthogonalProjection_iff'.mp + (QuantumGraph.Real.PiMat_isOrthogonalProjection hA i)))) + +theorem QuantumGraph.Real.PiMat_submoduleOrthogonalProjection : + withPiQuantum[φ] + ∀ {A : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + (hA : QuantumGraph.Real (PiMat ℂ ι p) A) → ∀ i : ι × ι, + (orthogonalProjection' (hA.PiMat_submodule i)) = + (LinearMap.toContinuousLinearMap + ((PiMat_toEuclideanLM (PiMatTensorProductEquiv + ((StarAlgEquiv.lTensor (PiMat ℂ ι p) (PiMat.transposeStarAlgEquiv ι p).symm) + (QuantumSet.Psi 0 (1/2) A))) i))) := +by + withPiQuantumCtx[φ] + intro A hA i + exact Classical.choose_spec + (orthogonal_projection_iff.mpr + (And.comm.mp + (ContinuousLinearMap.isOrthogonalProjection_iff'.mp + (QuantumGraph.Real.PiMat_isOrthogonalProjection hA i)))) + +/-- Orthonormal basis of a block submodule associated to a real `PiMat` quantum graph. -/ +noncomputable def QuantumGraph.Real.PiMat_orthonormalBasis : + withPiQuantum[φ] + ∀ {A : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + (hA : QuantumGraph.Real (PiMat ℂ ι p) A) → ∀ i : ι × ι, + OrthonormalBasis (Fin (Module.finrank ℂ (hA.PiMat_submodule i))) ℂ + (hA.PiMat_submodule i) := +by + withPiQuantumCtx[φ] + intro A hA i + exact stdOrthonormalBasis ℂ (hA.PiMat_submodule i) + +theorem EuclideanSpace.prod_exists_finset {n m : Type*} [Fintype n] [DecidableEq n] + [Fintype m] [DecidableEq m] (x : EuclideanSpace ℂ (n × m)) : + ∃ S : Finset ((EuclideanSpace ℂ n) × EuclideanSpace ℂ m), + x = ∑ s ∈ S, euclideanSpaceTensor' (R := ℂ) (s.1 ⊗ₜ[ℂ] s.2) := +by + obtain ⟨S, hS⟩ := TensorProduct.exists_finset ((euclideanSpaceTensor' (R:=ℂ)).symm x) + use S + apply_fun (euclideanSpaceTensor' (R:=ℂ)).symm using LinearEquiv.injective _ + simp only [map_sum, LinearIsometryEquiv.symm_apply_apply, hS] + +theorem QuantumSet.PiMat_n : + withPiQuantum[φ] + n (PiMat ℂ ι p) = ((i : ι) × (p i × p i)) := +rfl + +open Kronecker + +@[simp] +theorem Matrix.ite_kronecker {α n m p q : Type*} [MulZeroClass α] (x₁ : Matrix n m α) + (x₂ : Matrix p q α) (P : Prop) [Decidable P] : + (if P then x₁ else 0) ⊗ₖ x₂ = if P then x₁ ⊗ₖ x₂ else 0 := +by + split + next h => simp_all only + next h => simp_all only [zero_mul, implies_true, kroneckerMap_zero_left] +@[simp] +theorem Matrix.dite_kronecker {α n m p q : Type*} [MulZeroClass α] + (P : Prop) [Decidable P] + (x₁ : P → Matrix n m α) (x₂ : Matrix p q α) : + (dite P (fun p => x₁ p) (fun _ => 0)) ⊗ₖ x₂ = dite P (fun p => x₁ p ⊗ₖ x₂) (fun _ => 0) := +by + split + next h => simp_all only + next h => simp_all only [zero_mul, implies_true, kroneckerMap_zero_left] + +@[simp] +theorem Matrix.kronecker_ite {α n m p q : Type*} [MulZeroClass α] (x₁ : Matrix n m α) + (x₂ : Matrix p q α) (P : Prop) [Decidable P] : + x₁ ⊗ₖ (if P then x₂ else 0) = if P then x₁ ⊗ₖ x₂ else 0 := +by + split + next h => simp_all only + next h => simp_all only [mul_zero, implies_true, kroneckerMap_zero_right] +@[simp] +theorem Matrix.kronecker_dite {α n m p q : Type*} [MulZeroClass α] + (x₁ : Matrix n m α) (P : Prop) [Decidable P] (x₂ : P → Matrix p q α) : + x₁ ⊗ₖ (dite P (fun p => x₂ p) (fun _ => 0)) = dite P (fun p => x₁ ⊗ₖ x₂ p) (fun _ => 0) := +by + split + next h => simp_all only + next h => simp_all only [mul_zero, implies_true, kroneckerMap_zero_right] + +theorem Matrix.vecMulVec_kronecker_vecMulVec {α n m p q : Type*} [CommSemiring α] + (x : n → α) (y : m → α) (z : p → α) (w : q → α) : + (vecMulVec x y) ⊗ₖ (vecMulVec z w) = + vecMulVec (reshape (vecMulVec x z)) (reshape (vecMulVec y w)) := +by + ext + simp only [kroneckerMap_apply, vecMulVec_apply, reshape_apply] + ring_nf + +@[simp] +theorem Matrix.vecMulVec_toEuclideanLin {n m : Type*} [Fintype n] + [Fintype m] [DecidableEq m] (x : EuclideanSpace ℂ n) (y : EuclideanSpace ℂ m) : + toEuclideanLin (vecMulVec x y) = rankOne ℂ x (star y) := +by + classical + apply_fun Matrix.toEuclideanLin.symm using LinearEquiv.injective _ + simp only [LinearEquiv.symm_apply_apply] + convert + (InnerProductSpace.symm_toEuclideanLin_rankOne (𝕜 := ℂ) (x := x) (y := star y)).symm + using 2 + ext i + simp [PiLp.star_apply] + +open Matrix in +theorem EuclideanSpaceTensor_apply_eq_reshape_vecMulVec {n m : Type*} [Fintype n] + [DecidableEq n] [Fintype m] [DecidableEq m] + (x : EuclideanSpace ℂ n) (y : EuclideanSpace ℂ m) : + euclideanSpaceTensor' (R:=ℂ) (x ⊗ₜ[ℂ] y) = reshape (vecMulVec x y) := +by + ext1 + simp only [euclideanSpaceTensor'_apply, reshape_apply, vecMulVec_apply] + +theorem Matrix.vecMulVec_conj {α n m : Type*} [CommSemiring α] [StarMul α] (x : n → α) (y : m → α) : + (vecMulVec x y)ᴴᵀ = vecMulVec (star x) (star y) := +by + ext + simp only [conj_apply, vecMulVec_apply, Pi.star_apply, star_mul'] + +theorem rankOne_euclideanSpaceTensor_eq_toEuclideanLin_vecMulVec {n m : Type*} [Fintype n] + [DecidableEq n] [Fintype m] [DecidableEq m] + (x y : EuclideanSpace ℂ n) (z w : EuclideanSpace ℂ m) : + rankOne ℂ (euclideanSpaceTensor' (R := ℂ) (x ⊗ₜ[ℂ] z)) + (euclideanSpaceTensor' (R := ℂ) (y ⊗ₜ[ℂ] w)) = + LinearMap.toContinuousLinearMap (Matrix.toEuclideanLin + (Matrix.vecMulVec + (Matrix.reshape (Matrix.vecMulVec x.ofLp z.ofLp)) + (Matrix.reshape (Matrix.vecMulVec (star y.ofLp) (star w.ofLp))))) := +by + let xz : EuclideanSpace ℂ (n × m) := euclideanSpaceTensor' (R := ℂ) (x ⊗ₜ[ℂ] z) + let yw : EuclideanSpace ℂ (n × m) := euclideanSpaceTensor' (R := ℂ) (y ⊗ₜ[ℂ] w) + have hxz : xz.ofLp = Matrix.reshape (Matrix.vecMulVec x.ofLp z.ofLp) := by + exact EuclideanSpaceTensor_apply_eq_reshape_vecMulVec x z + have hyw : yw.ofLp = Matrix.reshape (Matrix.vecMulVec y.ofLp w.ofLp) := by + exact EuclideanSpaceTensor_apply_eq_reshape_vecMulVec y w + have hsyw : + (star yw).ofLp = Matrix.reshape (Matrix.vecMulVec (star y.ofLp) (star w.ofLp)) := by + change star yw.ofLp = Matrix.reshape (Matrix.vecMulVec (star y.ofLp) (star w.ofLp)) + rw [hyw] + ext a + simp [Matrix.reshape_apply, Matrix.vecMulVec_apply] + have hss : star (star yw) = yw := by + ext a + simp + calc + rankOne ℂ (euclideanSpaceTensor' (R := ℂ) (x ⊗ₜ[ℂ] z)) + (euclideanSpaceTensor' (R := ℂ) (y ⊗ₜ[ℂ] w)) + = rankOne ℂ xz yw := rfl + _ = rankOne ℂ xz (star (star yw)) := by rw [hss] + _ = LinearMap.toContinuousLinearMap (Matrix.toEuclideanLin (Matrix.vecMulVec xz (star yw))) := + by + apply ContinuousLinearMap.ext + intro v + change (rankOne ℂ xz (star (star yw))) v = + (Matrix.toEuclideanLin (Matrix.vecMulVec xz (star yw))) v + rw [Matrix.vecMulVec_toEuclideanLin] + change (rankOne ℂ xz (star (star yw))) v = (rankOne ℂ xz (star (star yw))) v + rfl + _ = LinearMap.toContinuousLinearMap (Matrix.toEuclideanLin + (Matrix.vecMulVec + (Matrix.reshape (Matrix.vecMulVec x.ofLp z.ofLp)) + (Matrix.reshape (Matrix.vecMulVec (star y.ofLp) (star w.ofLp))))) := by + rw [show Matrix.vecMulVec xz (star yw) = Matrix.vecMulVec + (Matrix.reshape (Matrix.vecMulVec x.ofLp z.ofLp)) + (Matrix.reshape (Matrix.vecMulVec (star y.ofLp) (star w.ofLp))) by + rw [← hxz, ← hsyw] + rfl] + +theorem Matrix.includeBlock_apply_block {R k : Type*} [CommSemiring R] [DecidableEq k] + {s : k → Type*} {i : k} (x : Matrix (s i) (s i) R) (j : k) : + (Matrix.includeBlock x : PiMat R k s) j = + dite (i = j) (fun h => Eq.mp (by rw [h]) x) fun _ => 0 := by + rw [Matrix.includeBlock_apply] + +/-- A chosen finite support representation of a tensor. -/ +noncomputable def TensorProduct.chooseFinset {R M N : Type*} [CommSemiring R] + [AddCommMonoid M] [AddCommMonoid N] [Module R M] [Module R N] + (x : TensorProduct R M N) : + Finset (M × N) := +Classical.choose (TensorProduct.exists_finset x) +theorem TensorProduct.chooseFinset_spec {R M N : Type*} [CommSemiring R] + [AddCommMonoid M] [AddCommMonoid N] [Module R M] [Module R N] + (x : TensorProduct R M N) : + x = ∑ s ∈ (TensorProduct.chooseFinset x), s.1 ⊗ₜ s.2 := +by + exact Classical.choose_spec (TensorProduct.exists_finset x) + +/-- A product-coordinate decomposition of Euclidean space vectors. -/ +-- changed from choosing some `Finset (_ × _)` like above to the following +noncomputable def EuclideanSpace.prod_choose {n m : Type*} [Fintype n] [DecidableEq n] + [Fintype m] [DecidableEq m] (x : EuclideanSpace ℂ (n × m)) : + (n × m) → ((EuclideanSpace ℂ n) × EuclideanSpace ℂ m) := + let p₁ : Module.Basis n ℂ (EuclideanSpace ℂ n) := (EuclideanSpace.basisFun n ℂ).toBasis + let p₂ : Module.Basis m ℂ (EuclideanSpace ℂ m) := (EuclideanSpace.basisFun m ℂ).toBasis + let a := fun i : n × m => + (((p₁.tensorProduct p₂).repr ((euclideanSpaceTensor' (R := ℂ)).symm x)) i • p₁ i.1) + (fun (i : n × m) => (a i, p₂ i.2)) + +theorem EuclideanSpace.sum_apply {n : Type*} {𝕜 : Type*} [RCLike 𝕜] + {ι : Type*} (s : Finset ι) + (x : ι → EuclideanSpace 𝕜 n) (j : n) : + (∑ i ∈ s, x i) j = ∑ i ∈ s, (x i j) := +by + simp [WithLp.ofLp_sum, Finset.sum_apply] + +theorem Module.Basis.tensorProduct_repr_tmul_apply' {R M N ι κ : Type*} [CommSemiring R] + [AddCommMonoid M] [Module R M] [AddCommMonoid N] [Module R N] + (b : Module.Basis ι R M) (c : Module.Basis κ R N) (m : M) (n : N) (i : ι × κ) : + ((b.tensorProduct c).repr (m ⊗ₜ[R] n)) i = (c.repr n) i.2 * (b.repr m) i.1 := +by + simpa [smul_eq_mul, mul_comm] using + Module.Basis.tensorProduct_repr_tmul_apply b c m n i.1 i.2 + +-- theorem PiLp.ext_iff {p : ENNReal} {ι : Type*} {α : ι → Type*} {x : PiLp p α} +-- {y : PiLp p α} : +-- x = y ↔ (∀ (i : ι), x i = y i) := +-- by simp [← funext_iff] + +theorem EuclideanSpace.prod_choose_spec {n m : Type*} [Fintype n] [DecidableEq n] + [Fintype m] [DecidableEq m] (x : EuclideanSpace ℂ (n × m)) : + x = ∑ s : n × m, euclideanSpaceTensor' (R:=ℂ) + (((EuclideanSpace.prod_choose x s).1) ⊗ₜ ((EuclideanSpace.prod_choose x s).2)) := +by + have := TensorProduct.of_basis_eq_span ((euclideanSpaceTensor' (R := + ℂ)).symm x) (EuclideanSpace.basisFun n ℂ).toBasis (EuclideanSpace.basisFun m ℂ).toBasis + apply_fun (euclideanSpaceTensor' (R := ℂ)).symm using LinearIsometryEquiv.injective _ + simp only [map_sum, LinearIsometryEquiv.symm_apply_apply] + rw [this, ← Finset.sum_product'] + simp only [Finset.univ_product_univ, ← TensorProduct.tmul_smul] + simp only [← TensorProduct.smul_tmul] + let p₁ := (EuclideanSpace.basisFun n ℂ).toBasis + let p₂ := (EuclideanSpace.basisFun m ℂ).toBasis + let a := fun i : n × m => (((p₁.tensorProduct p₂).repr ((euclideanSpaceTensor' (R := + ℂ)).symm x)) i • p₁ i.1) + have ha : ∀ i, a i = (((p₁.tensorProduct p₂).repr ((euclideanSpaceTensor' (R := + ℂ)).symm x)) i • p₁ i.1) := fun i => rfl + simp only [p₁, p₂, ← ha] + rfl + +omit [Fintype ι] in +private theorem PiMat_eq_left_block_miss {a b c : ι} (h : a ≠ b) + (x : Matrix (p a) (p a) ℂ) (y : Matrix (p c) (p c) ℂ) : + LinearMap.toContinuousLinearMap (Matrix.toEuclideanLin + (Matrix.kroneckerMap (fun x y : ℂ => x * y) + ((Matrix.includeBlock x : PiMat ℂ ι p) b) y)) = 0 := by + rw [Matrix.includeBlock_apply_ne_same _ h] + simp [Matrix.kroneckerMap_zero_left] + +omit [Fintype ι] in +private theorem PiMat_eq_right_block_miss {a b c : ι} (h : a ≠ c) + (x : Matrix (p b) (p b) ℂ) (y : Matrix (p a) (p a) ℂ) : + LinearMap.toContinuousLinearMap (Matrix.toEuclideanLin + (Matrix.kroneckerMap (fun x y : ℂ => x * y) x + (((Matrix.includeBlock y : PiMat ℂ ι p) c)ᵀ))) = 0 := by + rw [Matrix.includeBlock_apply_ne_same _ h] + simp [Matrix.transpose_zero, Matrix.kroneckerMap_zero_right] + +private theorem PiMat_eq_left_block_miss_sum {b j c : ι} (h : j ≠ b) + {β : ι → Type*} [∀ k, Fintype (β k)] + (X : (k : ι) → β k → p j → p k → p j → p k → Matrix (p j) (p j) ℂ) + (Y : (k : ι) → β k → p j → p k → p j → p k → Matrix (p c) (p c) ℂ) : + (∑ k, ∑ q, ∑ s1, ∑ s2, ∑ t1, ∑ t2, + LinearMap.toContinuousLinearMap (Matrix.toEuclideanLin + (Matrix.kroneckerMap (fun x y : ℂ => x * y) + ((Matrix.includeBlock (X k q s1 s2 t1 t2) : PiMat ℂ ι p) b) + (Y k q s1 s2 t1 t2)))) = 0 := by + apply Fintype.sum_eq_zero + intro k + apply Fintype.sum_eq_zero + intro q + apply Fintype.sum_eq_zero + intro s1 + apply Fintype.sum_eq_zero + intro s2 + apply Fintype.sum_eq_zero + intro t1 + apply Fintype.sum_eq_zero + intro t2 + exact PiMat_eq_left_block_miss h _ _ + +omit [Fintype ι] in +private theorem PiMat_eq_right_block_miss_sum {b j c : ι} (h : j ≠ c) + {β : Type*} [Fintype β] + (X : β → p b → p j → p b → p j → Matrix (p b) (p b) ℂ) + (Y : β → p b → p j → p b → p j → Matrix (p j) (p j) ℂ) : + (∑ q, ∑ s1, ∑ s2, ∑ t1, ∑ t2, + LinearMap.toContinuousLinearMap (Matrix.toEuclideanLin + (Matrix.kroneckerMap (fun x y : ℂ => x * y) + ((Matrix.includeBlock (X q s1 s2 t1 t2) : PiMat ℂ ι p) b) + ((((1 : PiMat ℂ ι p ≃ₐ[ℂ] PiMat ℂ ι p) + (Matrix.includeBlock (Y q s1 s2 t1 t2) : PiMat ℂ ι p)) c)ᵀ)))) = 0 := by + apply Fintype.sum_eq_zero + intro q + apply Fintype.sum_eq_zero + intro s1 + apply Fintype.sum_eq_zero + intro s2 + apply Fintype.sum_eq_zero + intro t1 + apply Fintype.sum_eq_zero + intro t2 + simp only [AlgEquiv.one_apply] + exact PiMat_eq_right_block_miss h _ _ + +theorem QuantumGraph.Real.PiMat_eq : + withPiQuantum[φ] + ∀ {A : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + (hA : QuantumGraph.Real (PiMat ℂ ι p) A) → + let S : (i : ι × ι) → + (j : (Fin (Module.finrank ℂ (hA.PiMat_submodule i)))) + → (((p i.1) × (p i.2)) → + (((EuclideanSpace ℂ (p i.1)) × (EuclideanSpace ℂ (p i.2))))) + := fun i j => EuclideanSpace.prod_choose + (((hA.PiMat_orthonormalBasis i j : hA.PiMat_submodule i) : + EuclideanSpace ℂ (p i.1 × p i.2))) + A = ∑ i : ι × ι, ∑ j, ∑ s : (p i.1 × p i.2), ∑ l : (p i.1 × p i.2), + -- in S i j, ∑ p in S i j, + rankOne ℂ (Matrix.includeBlock + (Matrix.vecMulVec (S i j s).1 (star (S i j l).1))) + (modAut (- (1 / 2)) (Matrix.includeBlock + ((Matrix.vecMulVec (S i j s).2 (star (S i j l).2))ᴴᵀ))) := +by + withPiQuantumCtx[φ] + intro A hA S + have hS : ∀ (i : ι × ι) j, (hA.PiMat_orthonormalBasis i j) + = ∑ t, euclideanSpaceTensor' (R:=ℂ) ((S i j t).1 ⊗ₜ[ℂ] (S i j t).2) := + fun i j => EuclideanSpace.prod_choose_spec _ + apply_fun (QuantumSet.Psi 0 (1/2)) using LinearEquiv.injective _ + apply_fun + (StarAlgEquiv.lTensor (PiMat ℂ ι p) (PiMat.transposeStarAlgEquiv ι p).symm).trans + (PiMatTensorProductEquiv.trans PiMat_toEuclideanLM) + simp only [StarAlgEquiv.trans_apply] + ext1 i + apply_fun LinearMap.toContinuousLinearMap using LinearEquiv.injective _ + rw [← QuantumGraph.Real.PiMat_submoduleOrthogonalProjection hA i, + OrthonormalBasis.orthogonalProjection'_eq_sum_rankOne (hA.PiMat_orthonormalBasis i)] + simp only [ContinuousLinearMap.coe_sum, map_sum, + QuantumSet.Psi_apply, QuantumSet.Psi_toFun_apply, + StarAlgEquiv.lTensor_tmul, + PiMat_toEuclideanLM] + simp only [starAlgebra.modAut_zero, AlgEquiv.one_apply, one_div, + starAlgebra.modAut_star, Finset.sum_apply, StarAlgEquiv.piCongrRight_apply, + PiMatTensorProductEquiv_apply, StarAlgEquiv.ofAlgEquiv_coe, AlgEquiv.ofLinearEquiv_apply, + map_sum, directSumTensorToFun_apply, + PiMat.transposeStarAlgEquiv_symm_apply, + MulOpposite.unop_op] + simp only [TensorProduct.toKronecker_apply] + simp only [QuantumSet.modAut_apply_modAut, add_neg_cancel, starAlgebra.modAut_zero] + simp only [Matrix.includeBlock_conjTranspose, Matrix.conj_conjTranspose] + conv_lhs => + rw [Finset.sum_congr rfl (by intro j _; rw [hS i j])] + conv_rhs => + rw [Fintype.sum_eq_single i (fun j hj => by + rcases j with ⟨j₁, j₂⟩ + by_cases h₁ : j₁ = i.1 + · subst j₁ + have h₂ : j₂ ≠ i.2 := by + intro h₂ + apply hj + ext <;> simp [h₂] + apply Fintype.sum_eq_zero + intro q + apply Fintype.sum_eq_zero + intro s + apply Fintype.sum_eq_zero + intro t + simp only [AlgEquiv.one_apply] + exact PiMat_eq_right_block_miss h₂ _ _ + · apply Fintype.sum_eq_zero + intro q + apply Fintype.sum_eq_zero + intro s + apply Fintype.sum_eq_zero + intro t + exact PiMat_eq_left_block_miss h₁ _ _)] + simp only [AlgEquiv.one_apply, Matrix.includeBlock_apply_same] + simp only [map_sum] + simp only [LinearMap.coe_sum, Finset.sum_apply, + Matrix.transpose_transpose, Matrix.vecMulVec_kronecker_vecMulVec] + congr 1 + ext1 + rw [Finset.sum_comm] + simp only [Finset.sum_product_univ, + rankOne_euclideanSpaceTensor_eq_toEuclideanLin_vecMulVec] + +noncomputable section deltaForm +variable {d : ℂ} [Nonempty ι] [hφ₂ : Fact (∀ i, (φ i).matrix⁻¹.trace = d)] + [Π i, Nontrivial (p i)] + +theorem QuantumGraph.trivialGraph : + withPiQuantum[φ] + letI : QuantumSetDeltaForm (PiMat ℂ ι p) := PiMat.quantumSetDeltaForm (d := d) (φ := φ) + QuantumGraph _ (Qam.trivialGraph (PiMat ℂ ι p)) := +by + withPiQuantumCtx[φ] + letI : QuantumSetDeltaForm (PiMat ℂ ι p) := PiMat.quantumSetDeltaForm (d := d) (φ := φ) + exact ⟨Qam.Nontracial.TrivialGraph.qam⟩ + +omit [Fintype ι] [DecidableEq ι] + [Nonempty ι] [∀ (i : ι), Nontrivial (p i)] in +theorem PiMat.piAlgEquiv_trace_apply + (f : (i : ι) → (Matrix (p i) (p i) ℂ ≃ₐ[ℂ] Matrix (p i) (p i) ℂ)) + (x : PiMat ℂ ι p) (a : ι) : + ((AlgEquiv.piCongrRight f x) a).trace = (x a).trace := +by + calc (((AlgEquiv.piCongrRight f) x) a).trace + = ((f a) (x a)).trace := rfl + _ = (x a).trace := Matrix.aut_mat_inner_trace_preserving _ _ + +omit [Nonempty ι] [∀ (i : ι), Nontrivial (p i)] in +omit [Fintype ι] [DecidableEq ι] in +theorem PiMat.modAut_trace_apply [Finite ι] : + withPiQuantum[φ] + ∀ (r : ℝ) (x : PiMat ℂ ι p) (a : ι), (modAut r x a).trace = (x a).trace := +by + classical + letI := Fintype.ofFinite ι + withPiQuantumCtx[φ] + intro r x a + exact PiMat.piAlgEquiv_trace_apply _ _ _ + +omit [Nonempty ι] [∀ (i : ι), Nontrivial (p i)] in +theorem PiMat.orthonormalBasis_trace : + withPiQuantum[φ] + ∀ (a : n (PiMat ℂ ι p)) (i : ι), + (QuantumSet.onb (A := (PiMat ℂ ι p)) a i).trace = + if a.1 = i then (hφ a.1).matrixIsPosDef.rpow (-(1 / 2)) a.2.2 a.2.1 else 0 := +by + withPiQuantumCtx[φ] + intro a i + calc (QuantumSet.onb (A := (PiMat ℂ ι p)) a i).trace + = ∑ j, QuantumSet.onb (A := PiMat ℂ ι p) a i j j := rfl + _ = ∑ j, (Module.Dual.pi.IsFaithfulPosMap.orthonormalBasis hφ) a i j j := rfl + _ = ∑ j, Matrix.includeBlock (Matrix.single a.2.1 a.2.2 1 + * (hφ a.1).matrixIsPosDef.rpow (-(1 / 2))) i j j + := by simp only [Module.Dual.pi.IsFaithfulPosMap.orthonormalBasis_apply] + _ = if a.1 = i then (hφ a.1).matrixIsPosDef.rpow (-(1 / 2)) a.2.2 a.2.1 else 0 := + by + split + next h => + subst h + simp only [Matrix.includeBlock_apply, dif_pos] + simp only [one_div, eq_mp_eq_cast, cast_eq] + simp only [← Matrix.trace_iff, Matrix.single_hMul_trace] + next h => + simp_all only [one_div, Matrix.includeBlock_apply] + simp only [↓reduceDIte, Matrix.zero_apply, Finset.sum_const_zero] + +open QuantumSet in +theorem QuantumGraph.trivialGraph_dim_of_piMat_submodule : + withPiQuantum[φ] + letI : QuantumSetDeltaForm (PiMat ℂ ι p) := PiMat.quantumSetDeltaForm (d := d) (φ := φ) + (QuantumGraph.trivialGraph : + QuantumGraph _ (Qam.trivialGraph (PiMat ℂ ι p))).dim_of_piMat_submodule = + Fintype.card ι := +by + withPiQuantumCtx[φ] + letI : QuantumSetDeltaForm (PiMat ℂ ι p) := PiMat.quantumSetDeltaForm (d := d) (φ := φ) + rw [← Nat.cast_inj (R := ℂ)] + rw [QuantumGraph.dim_of_piMat_submodule_eq_trace, Qam.trivialGraph_eq] + simp_rw [map_smul] + rw [← rankOne.sum_orthonormalBasis_eq_id_lm (QuantumSet.onb)] + simp only [map_sum, Psi_apply, Psi_toFun_apply, StarAlgEquiv.lTensor_tmul, + ] + simp only [starAlgebra.modAut_zero, AlgEquiv.one_apply, one_div, starAlgebra.modAut_star, + LinearMap.coe_comp, Function.comp_apply, AlgHom.toLinearMap_apply, Matrix.traceLinearMap_apply, + smul_eq_mul] + simp only [Matrix.blockDiagonal'AlgHom_apply, Matrix.trace_blockDiagonal'] + simp only [PiMatTensorProductEquiv_tmul, Matrix.trace_kronecker, + PiMat.transposeStarAlgEquiv_symm_apply, MulOpposite.unop_op] + simp only [Matrix.trace_transpose (R:=ℂ), + PiMat.orthonormalBasis_trace, PiMat.modAut_trace_apply] + simp only [Pi.star_apply, Matrix.star_eq_conjTranspose, Matrix.trace_conjTranspose, + PiMat.orthonormalBasis_trace] + simp only [ite_mul, zero_mul, star_ite, star_zero, mul_ite, mul_zero] + simp only [Finset.sum_product_univ, Finset.sum_ite_eq, Finset.mem_univ, if_true] + simp only [← Matrix.conjTranspose_apply, (Matrix.PosDef.rpow.isPosDef _ _).1.eq] + calc + (QuantumSetDeltaForm.delta (PiMat ℂ ι p))⁻¹ * + ∑ x : Σ i, p i × p i, + (hφ x.1).matrixIsPosDef.rpow (-(1 / 2)) x.2.2 x.2.1 + * (hφ x.1).matrixIsPosDef.rpow (-(1 / 2)) x.2.1 x.2.2 + = (QuantumSetDeltaForm.delta (PiMat ℂ ι p))⁻¹ * + ∑ x, ∑ x_1, ∑ x_2, (hφ x).matrixIsPosDef.rpow (-(1 / 2)) x_2 x_1 + * (hφ x).matrixIsPosDef.rpow (-(1 / 2)) x_1 x_2 := by + simp only [Finset.sum_sigma_univ, Finset.sum_product_univ] + _ = (QuantumSetDeltaForm.delta (PiMat ℂ ι p))⁻¹ * + ∑ x, ∑ x_1, ∑ x_2, (hφ x).matrixIsPosDef.rpow (-(1 / 2)) x_1 x_2 + * (hφ x).matrixIsPosDef.rpow (-(1 / 2)) x_2 x_1 := by simp only [mul_comm] + _ = (QuantumSetDeltaForm.delta (PiMat ℂ ι p))⁻¹ * + ∑ x, ∑ x_1, ((hφ x).matrixIsPosDef.rpow (-(1 / 2)) * + (hφ x).matrixIsPosDef.rpow (-(1 / 2))) x_1 x_1 := by simp only [← Matrix.mul_apply] + _ = (QuantumSetDeltaForm.delta (PiMat ℂ ι p))⁻¹ * + ∑ x, (φ x).matrix⁻¹.trace := by + simp only [Matrix.PosDef.rpow_mul_rpow, Matrix.trace_iff] + ring_nf + simp only [Matrix.PosDef.rpow_neg_one_eq_inv_self] + _ = (QuantumSetDeltaForm.delta (PiMat ℂ ι p))⁻¹ * + ∑ _ : ι, (QuantumSetDeltaForm.delta (PiMat ℂ ι p)) := by + simp only [(Fact.out : ∀ i, (φ i).matrix⁻¹.trace = d)] + rfl + _ = Fintype.card ι := by + rw [Finset.sum_const, mul_smul_comm, inv_mul_cancel₀ (ne_of_gt QuantumSetDeltaForm.delta_pos)] + rw [nsmul_eq_mul, mul_one] + rfl + +end deltaForm + +theorem StarAlgEquiv.piCongrRight_symm {R ι : Type*} {A₁ A₂ : ι → Type*} + [(i : ι) → Add (A₁ i)] [(i : ι) → Add (A₂ i)] [(i : ι) → Mul (A₁ i)] [(i : ι) → Mul (A₂ i)] + [(i : ι) → Star (A₁ i)] [(i : ι) → Star (A₂ i)] [(i : ι) → SMul R (A₁ i)] [(i : ι) → + SMul R (A₂ i)] + (e : (i : ι) → A₁ i ≃⋆ₐ[R] A₂ i) : + (StarAlgEquiv.piCongrRight e).symm = StarAlgEquiv.piCongrRight (fun i => (e i).symm) := +rfl + +theorem Matrix.k {n : Type*} [Fintype n] [DecidableEq n] + {φ : Module.Dual ℂ (Matrix n n ℂ)} [φ.IsFaithfulPosMap] : + withMatrixQuantum[φ] + k (Matrix n n ℂ) = 0 := +rfl + +theorem unitary.mul_inv_eq_iff {A : Type*} [Monoid A] [StarMul A] (U : ↥(unitary A)) + (x : A) (y : A) : x * (U⁻¹ : unitary A) = y ↔ x = y * U := + by + rw [unitary.inj_hMul (U : unitary A), mul_assoc] + rw [← Unitary.star_eq_inv] + simp only [Unitary.coe_star, SetLike.coe_mem, Unitary.star_mul_self_of_mem, mul_one] + +/-- Blockwise inner automorphism of a `PiMat`. -/ +noncomputable abbrev piInnerAut (U : (i : ι) → Matrix.unitaryGroup (p i) ℂ) : + PiMat ℂ ι p ≃⋆ₐ[ℂ] PiMat ℂ ι p := +(StarAlgEquiv.piCongrRight (fun i => Matrix.innerAutStarAlg (U i))) + +omit hφ in +theorem piInnerAut_apply_dualMatrix_iff' {U : (i : ι) → Matrix.unitaryGroup (p i) ℂ} : + piInnerAut U (Module.Dual.pi.matrixBlock φ) = Module.Dual.pi.matrixBlock φ ↔ + ∀ i, Matrix.innerAutStarAlg (U i) (φ i).matrix = (φ i).matrix := +by + simp only [funext_iff, StarAlgEquiv.piCongrRight_apply, + Module.Dual.pi.matrixBlock_apply] + +omit hφ in +theorem piInnerAut_apply_dualMatrix_iff {U : (i : ι) → Matrix.unitaryGroup (p i) ℂ} : + piInnerAut U (Module.Dual.pi.matrixBlock φ) = Module.Dual.pi.matrixBlock φ ↔ + ∀ (a : ι), (U a) * (φ a).matrix = (φ a).matrix * (U a) := +by + simp only [piInnerAut_apply_dualMatrix_iff', Matrix.innerAutStarAlg_apply'] + simp_rw [unitary.mul_inv_eq_iff] + +example : + withPiQuantum[φ] + ∀ {f : PiMat ℂ ι p ≃⋆ₐ[ℂ] PiMat ℂ ι p}, + @Isometry (PiMat ℂ ι p) (PiMat ℂ ι p) + (@EMetricSpace.toPseudoEMetricSpace (PiMat ℂ ι p) + (@MetricSpace.toEMetricSpace (PiMat ℂ ι p) InnerProductAlgebra.toMetricSpace)) + (@EMetricSpace.toPseudoEMetricSpace (PiMat ℂ ι p) + (@MetricSpace.toEMetricSpace (PiMat ℂ ι p) InnerProductAlgebra.toMetricSpace)) + f ↔ + LinearMap.adjoint f.toLinearMap = f.symm.toLinearMap := +by + withPiQuantumCtx[φ] + intro f + exact QuantumSet.starAlgEquiv_isometry_iff_adjoint_eq_symm + +theorem innerAutStarAlg_adjoint_eq_symm_of : + withPiQuantum[φ] + ∀ {U : (i : ι) → Matrix.unitaryGroup (p i) ℂ}, + piInnerAut U (Module.Dual.pi.matrixBlock φ) = Module.Dual.pi.matrixBlock φ → + LinearMap.adjoint (piInnerAut U).toLinearMap = (piInnerAut U).symm.toLinearMap := +by + withPiQuantumCtx[φ] + intro U hU + apply LinearMap.ext + intro x + apply ext_inner_left ℂ + intro y + simp only [LinearMap.adjoint_inner_right, StarAlgEquiv.toLinearMap_apply] + rw [piInnerAut_apply_dualMatrix_iff] at hU + simp only [Module.Dual.pi.IsFaithfulPosMap.inner_eq' (ψ := φ), + StarAlgEquiv.piCongrRight_apply (R := ℂ), StarAlgEquiv.piCongrRight_symm, + Matrix.innerAutStarAlg_apply, Matrix.innerAutStarAlg_symm_apply, Matrix.conjTranspose_mul] + apply Finset.sum_congr rfl + intro i _ + rw [← Matrix.unitaryGroup.star_coe_eq_coe_star (U i)] + have hstarU : + star (U i : Matrix (p i) (p i) ℂ) = (U i : Matrix (p i) (p i) ℂ)ᴴ := + rfl + rw [hstarU, Matrix.conjTranspose_conjTranspose] + change + (((φ i).matrix * + ((U i : Matrix (p i) (p i) ℂ) * + ((y i)ᴴ * (U i : Matrix (p i) (p i) ℂ)ᴴ)) * + x i).trace) = + (((φ i).matrix * (y i)ᴴ * + ((U i : Matrix (p i) (p i) ℂ)ᴴ * x i * U i)).trace) + rw [← Matrix.mul_assoc, ← Matrix.mul_assoc] + rw [← hU i] + simp only [Matrix.mul_assoc] + rw [Matrix.trace_mul_comm (U i : Matrix (p i) (p i) ℂ) + ((φ i).matrix * ((y i)ᴴ * ((U i : Matrix (p i) (p i) ℂ)ᴴ * x i)))] + simp only [Matrix.mul_assoc] + +/-- Real quantum graphs on `PiMat` are preserved by blockwise unitary conjugation. -/ +theorem QuantumGraph.Real.piMat_conj_unitary : + withPiQuantum[φ] + ∀ {A : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + QuantumGraph.Real (PiMat ℂ ι p) A → + ∀ {U : (i : ι) → Matrix.unitaryGroup (p i) ℂ}, + piInnerAut U (Module.Dual.pi.matrixBlock φ) = Module.Dual.pi.matrixBlock φ → + QuantumGraph.Real _ + ((piInnerAut U).toLinearMap ∘ₗ A ∘ₗ + LinearMap.adjoint (piInnerAut U).toLinearMap) := +by + withPiQuantumCtx[φ] + intro A hA U hU + constructor + · rw [← StarAlgEquiv.toAlgEquiv_toAlgHom_toLinearMap, + QuantumSet.schurMul_algHom_comp_algHom_adjoint, hA.1] + · have hadj := innerAutStarAlg_adjoint_eq_symm_of hU + simp_rw [hadj] + change LinearMap.IsReal + ((piInnerAut U).toAlgEquiv.toLinearMap ∘ₗ A ∘ₗ (piInnerAut U).symm.toAlgEquiv.toLinearMap) + exact (LinearMap.real_starAlgEquiv_conj_iff A (piInnerAut U)).mpr hA.isReal + +/-- A unitary matrix as a linear equivalence of Euclidean space. -/ +noncomputable abbrev Matrix.UnitaryGroup.toEuclideanLinearEquiv {n : + Type*} [Fintype n] [DecidableEq n] + (A : ↥(Matrix.unitaryGroup n ℂ)) : + EuclideanSpace ℂ n ≃ₗ[ℂ] EuclideanSpace ℂ n := +(WithLp.linearEquiv 2 ℂ (n → ℂ)).trans + ((Matrix.UnitaryGroup.toLinearEquiv A).trans + (WithLp.linearEquiv 2 ℂ (n → ℂ)).symm) +theorem Matrix.UnitaryGroup.toEuclideanLinearEquiv_apply {n : Type*} [Fintype n] [DecidableEq n] + (A : ↥(Matrix.unitaryGroup n ℂ)) (v : EuclideanSpace ℂ n) : + (Matrix.UnitaryGroup.toEuclideanLinearEquiv A) v = + WithLp.toLp 2 ((A : Matrix n n ℂ) *ᵥ v.ofLp) := +rfl + +/-- A unitary matrix as a linear isometry equivalence of Euclidean space. -/ +noncomputable def Matrix.UnitaryGroup.toEuclideanLinearIsometryEquiv {n : + Type*} [Fintype n] [DecidableEq n] + (A : ↥(Matrix.unitaryGroup n ℂ)) : + EuclideanSpace ℂ n ≃ₗᵢ[ℂ] EuclideanSpace ℂ n where + toLinearEquiv := Matrix.UnitaryGroup.toEuclideanLinearEquiv A + norm_map' x := by + change + ‖((EuclideanSpace.equiv n ℂ).symm ((A : Matrix n n ℂ) *ᵥ x) : + EuclideanSpace ℂ n)‖ = ‖x‖ + calc + ‖((EuclideanSpace.equiv n ℂ).symm ((A : Matrix n n ℂ) *ᵥ x) : + EuclideanSpace ℂ n)‖ + = √ (RCLike.re ((star ((A : Matrix n n ℂ) *ᵥ x)) ⬝ᵥ ((A : Matrix n n ℂ) *ᵥ x))) := ?_ + _ = √ (RCLike.re ((star x) ⬝ᵥ (((star (A : Matrix n n ℂ) * (A : Matrix n n ℂ)) *ᵥ x)))) := ?_ + _ = ‖x‖ := ?_ + · rw [norm_eq_sqrt_re_inner (𝕜 := ℂ), dotProduct_eq_inner] + rfl + · rw [star_mulVec, ← dotProduct_mulVec, mulVec_mulVec] + rfl + · rw [Matrix.UnitaryGroup.star_mul_self A, one_mulVec, + norm_eq_sqrt_re_inner (𝕜 := ℂ), dotProduct_eq_inner] + rfl + +theorem Matrix.UnitaryGroup.toEuclideanLinearIsometryEquiv_apply {n : + Type*} [Fintype n] [DecidableEq n] + (A : ↥(Matrix.unitaryGroup n ℂ)) (x : EuclideanSpace ℂ n) : + (Matrix.UnitaryGroup.toEuclideanLinearIsometryEquiv A) x = + WithLp.toLp 2 ((A : Matrix n n ℂ) *ᵥ x.ofLp) := +rfl +theorem Matrix.UnitaryGroup.toEuclideanLinearIsometryEquiv_symm_apply {n : + Type*} [Fintype n] [DecidableEq n] + (A : ↥(Matrix.unitaryGroup n ℂ)) (x : EuclideanSpace ℂ n) : + (Matrix.UnitaryGroup.toEuclideanLinearIsometryEquiv A).symm x = + WithLp.toLp 2 (((A⁻¹ : unitaryGroup n ℂ) : Matrix n n ℂ) *ᵥ x.ofLp) := +rfl +theorem Matrix.UnitaryGroup.toEuclideanLinearIsometryEquiv_apply' {n : + Type*} [Fintype n] [DecidableEq n] + (A : ↥(Matrix.unitaryGroup n ℂ)) (x : EuclideanSpace ℂ n) : + (Matrix.UnitaryGroup.toEuclideanLinearIsometryEquiv A).symm x = + WithLp.toLp 2 ((A : Matrix n n ℂ)ᴴ *ᵥ x.ofLp) := +rfl + +/-- Tensor-product Euclidean isometry induced by a pair of blockwise unitaries. -/ +noncomputable abbrev unitaryTensorEuclidean (U : (i : ι) → Matrix.unitaryGroup (p i) ℂ) (i : + ι × ι) := +(euclideanSpaceTensor'.symm.trans + ((LinearIsometryEquiv.TensorProduct.map (Matrix.UnitaryGroup.toEuclideanLinearIsometryEquiv + (U i.1)) + (Matrix.UnitaryGroup.toEuclideanLinearIsometryEquiv (Matrix.unitaryGroup.conj (U i.2)))).trans + euclideanSpaceTensor')) + +omit [Fintype ι] [DecidableEq ι] in +theorem unitaryTensorEuclidean_apply {U : (i : ι) → Matrix.unitaryGroup (p i) ℂ} (i : + ι × ι) (x : EuclideanSpace ℂ (p i.1)) (y : EuclideanSpace ℂ (p i.2)) : + (unitaryTensorEuclidean U i) (euclideanSpaceTensor' (R := ℂ) (x ⊗ₜ y)) + = euclideanSpaceTensor' (R := ℂ) + ((WithLp.toLp 2 ((U i.1 : Matrix _ _ ℂ) *ᵥ x.ofLp)) ⊗ₜ + WithLp.toLp 2 ((U i.2 : Matrix _ _ ℂ)ᴴᵀ *ᵥ y.ofLp)) := +by + rw [unitaryTensorEuclidean, LinearIsometryEquiv.trans_apply, + LinearIsometryEquiv.symm_apply_apply] + rfl + +omit [Fintype ι] [DecidableEq ι] in +theorem unitaryTensorEuclidean_apply' {U : (i : ι) → Matrix.unitaryGroup (p i) ℂ} (i : + ι × ι) (x : EuclideanSpace ℂ (p i.1 × p i.2)) : + (unitaryTensorEuclidean U i) x + = ∑ j : p i.1 × p i.2, euclideanSpaceTensor' (R := ℂ) + ((WithLp.toLp 2 ((U i.1 : Matrix _ _ ℂ) *ᵥ (x.prod_choose j).1.ofLp)) ⊗ₜ[ℂ] + WithLp.toLp 2 ((U i.2 : Matrix _ _ ℂ)ᴴᵀ *ᵥ (x.prod_choose j).2.ofLp)) := +by + simp only [← unitaryTensorEuclidean_apply] + rw [← map_sum, ← EuclideanSpace.prod_choose_spec] + +omit [Fintype ι] [DecidableEq ι] in +theorem unitaryTensorEuclidean_symm_apply {U : (i : ι) → Matrix.unitaryGroup (p i) ℂ} (i : + ι × ι) (x : EuclideanSpace ℂ (p i.1)) (y : EuclideanSpace ℂ (p i.2)) : + (unitaryTensorEuclidean U i).symm (euclideanSpaceTensor' (R := ℂ) (x ⊗ₜ y)) + = euclideanSpaceTensor' (R := ℂ) + ((WithLp.toLp 2 (((U i.1)ᴴ : Matrix _ _ ℂ) *ᵥ x.ofLp)) ⊗ₜ + WithLp.toLp 2 (((U i.2)ᵀ : Matrix _ _ ℂ) *ᵥ y.ofLp)) := +by + simp_rw [unitaryTensorEuclidean, LinearIsometryEquiv.symm_trans, LinearIsometryEquiv.trans_apply, + LinearIsometryEquiv.symm_apply_apply] + simp only [LinearIsometryEquiv.piLpCongrRight_symm, LinearIsometryEquiv.symm_symm, + LinearIsometryEquiv.TensorProduct.map_symm_apply, TensorProduct.map_tmul, LinearEquiv.coe_coe, + EmbeddingLike.apply_eq_iff_eq] + apply congrArg₂ (fun a b => a ⊗ₜ[ℂ] b) + · exact Matrix.UnitaryGroup.toEuclideanLinearIsometryEquiv_apply' (U i.1) x + · simpa [Matrix.unitaryGroup.conj_coe, Matrix.conj_conjTranspose] using + Matrix.UnitaryGroup.toEuclideanLinearIsometryEquiv_apply' + (Matrix.unitaryGroup.conj (U i.2)) y + +theorem QuantumGraph.Real.PiMat_submodule_eq_submodule_iff : + withPiQuantum[φ] + ∀ {A B : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + (hA : QuantumGraph.Real (PiMat ℂ ι p) A) → + (hB : QuantumGraph.Real (PiMat ℂ ι p) B) → + (∀ i, hA.PiMat_submodule i = hB.PiMat_submodule i) ↔ A = B := +by + intro A B hA hB + simp_rw [Submodule.eq_iff_orthogonalProjection_eq, ← ContinuousLinearMap.coe_inj, + QuantumGraph.Real.PiMat_submoduleOrthogonalProjection] + simp only [StarAlgEquiv.piCongrRight_apply, + PiMatTensorProductEquiv_apply, StarAlgEquiv.ofAlgEquiv_coe, AlgEquiv.ofLinearEquiv_apply, + LinearMap.coe_toContinuousLinearMap, EmbeddingLike.apply_eq_iff_eq, + ← tensorToKronecker_apply, ← directSumTensor_apply] + simp only [← funext_iff, EmbeddingLike.apply_eq_iff_eq] + +theorem Matrix.kronecker_mulVec_euclideanSpaceTensor' {n m : Type*} [Fintype n] [Fintype m] + [DecidableEq n] [DecidableEq m] (A : Matrix n n ℂ) (B : Matrix m m ℂ) (x : EuclideanSpace ℂ n) + (y : EuclideanSpace ℂ m) : + (A ⊗ₖ B) *ᵥ ((WithLp.equiv 2 _) (euclideanSpaceTensor' (R := ℂ) (x ⊗ₜ[ℂ] y))) + = WithLp.equiv 2 _ (euclideanSpaceTensor' (R := ℂ) + ((WithLp.toLp 2 (A *ᵥ x.ofLp)) ⊗ₜ (WithLp.toLp 2 (B *ᵥ y.ofLp)))) := +by + ext a + simp only [Matrix.mulVec, dotProduct, kroneckerMap_apply, WithLp.equiv] + calc + ∑ x_1 : n × m, + A a.1 x_1.1 * B a.2 x_1.2 * (Equiv.refl (WithLp 2 (n × m → + ℂ))) (euclideanSpaceTensor' (R:=ℂ) (x ⊗ₜ[ℂ] y)) x_1 + = ∑ x_1, A a.1 x_1.1 * B a.2 x_1.2 * ((euclideanSpaceTensor' (R := ℂ) (x ⊗ₜ[ℂ] y)) x_1) := rfl + _ = ∑ x_1 : n × m, A a.1 x_1.1 * B a.2 x_1.2 * (x x_1.1 * y x_1.2) := by + simp only [euclideanSpaceTensor'_apply] + _ = (euclideanSpaceTensor' (R := ℂ) + ((WithLp.toLp 2 (A *ᵥ x.ofLp)) ⊗ₜ[ℂ] (WithLp.toLp 2 (B *ᵥ y.ofLp)))) a := ?_ + _ = (Equiv.refl (WithLp 2 (n × m → ℂ))) (euclideanSpaceTensor' (R := ℂ) + ((WithLp.toLp 2 (A *ᵥ x.ofLp)) ⊗ₜ[ℂ] (WithLp.toLp 2 (B *ᵥ y.ofLp)))) a := rfl + rw [euclideanSpaceTensor'_apply] + simp_rw [mulVec, dotProduct, Finset.sum_mul, Finset.mul_sum, Finset.sum_product_univ, mul_assoc] + congr; ext; congr; ext + ring_nf + +theorem StarAlgEquiv.piCongrRight_apply_includeBlock {ι : Type*} + {p : ι → Type*} [∀ i, Fintype (p i)] [DecidableEq ι] + (f : Π i, Matrix (p i) (p i) ℂ ≃⋆ₐ[ℂ] Matrix (p i) (p i) ℂ) + (i : ι) (x : Matrix (p i) (p i) ℂ) : + (StarAlgEquiv.piCongrRight (fun a => f a)) (Matrix.includeBlock x) + = Matrix.includeBlock ((f i) x) := +by + ext + simp only [piCongrRight_apply, Matrix.includeBlock_apply] + aesop + +theorem Matrix.innerAutStarAlg_apply_vecMulVec {n 𝕜 : Type*} [Fintype n] [Field 𝕜] [StarRing 𝕜] + [DecidableEq n] (U : ↥(Matrix.unitaryGroup n 𝕜)) (x y : n → 𝕜) : + (Matrix.innerAutStarAlg U) (vecMulVec x y) = vecMulVec (U *ᵥ x) (Uᴴᵀ *ᵥ y) := +by + simp only [innerAutStarAlg_apply, Unitary.coe_star, mul_vecMulVec, vecMulVec_mul, + star_eq_conjTranspose] + rw [← Matrix.mulVec_transpose] + rfl +theorem Matrix.innerAutStarAlg_apply_vecMulVec_star {n 𝕜 : Type*} [Fintype n] [Field 𝕜] [StarRing 𝕜] + [DecidableEq n] (U : ↥(Matrix.unitaryGroup n 𝕜)) (x y : n → 𝕜) : + (Matrix.innerAutStarAlg U) (vecMulVec x (star y)) + = vecMulVec (U *ᵥ x) (star (U *ᵥ y)) := +by + simp only [innerAutStarAlg_apply, Unitary.coe_star, mul_vecMulVec, vecMulVec_mul, + star_eq_conjTranspose, star_mulVec] +theorem Matrix.innerAutStarAlg_apply_star_vecMulVec {n 𝕜 : Type*} [Fintype n] [Field 𝕜] [StarRing 𝕜] + [DecidableEq n] (U : ↥(Matrix.unitaryGroup n 𝕜)) (x y : n → 𝕜) : + (Matrix.innerAutStarAlg U) (vecMulVec (star x) y) + = (vecMulVec (Uᴴᵀ *ᵥ x) (star (Uᴴᵀ *ᵥ y)))ᴴᵀ := +by + rw [innerAutStarAlg_apply_vecMulVec, vecMulVec_conj, star_star, star_mulVec] + rw [← vecMul_transpose, conj_conjTranspose] + +theorem Matrix.PosSemidef.eq_iff_sq_eq_sq {n : Type*} [Fintype n] + [DecidableEq n] {A : Matrix n n ℂ} (hA : A.PosSemidef) {B : Matrix n n ℂ} + (hB : B.PosSemidef) : + A ^ 2 = B ^ 2 ↔ A = B := +by + letI : Algebra ℝ ℂ := RCLike.toNormedAlgebra.toAlgebra + haveI : NonUnitalContinuousFunctionalCalculus ℝ (Matrix n n ℂ) IsSelfAdjoint := + ContinuousFunctionalCalculus.toNonUnital + haveI : NonnegSpectrumClass ℝ (Matrix n n ℂ) := + Matrix.instNonnegSpectrumClass (n := n) (𝕜 := ℂ) + simpa [pow_two] using (CFC.mul_self_eq_mul_self_iff A B hA.nonneg hB.nonneg) + +omit [Fintype ι] [DecidableEq ι] in +theorem innerAutStarAlg_apply_dualMatrix_eq_iff_eq_sqrt {i : ι} + (U : Matrix.unitaryGroup (p i) ℂ) : + (Matrix.innerAutStarAlg U) (φ i).matrix = (φ i).matrix + ↔ (Matrix.innerAutStarAlg U) ((hφ i).matrixIsPosDef.rpow (1 / 2)) + = (hφ i).matrixIsPosDef.rpow (1 / 2) := +by + simp_rw [Matrix.innerAutStarAlg_apply_eq_innerAut_apply] + rw [← Matrix.PosSemidef.eq_iff_sq_eq_sq (Matrix.posDef_innerAut + (Matrix.PosDef.rpow.isPosDef _ _) _).posSemidef + (Matrix.PosDef.rpow.isPosDef _ _).posSemidef, + Matrix.innerAut.map_pow] + simp_rw [pow_two, Matrix.PosDef.rpow_mul_rpow, add_halves, Matrix.PosDef.rpow_one_eq_self] + +omit [Fintype ι] [DecidableEq ι] in +theorem PiMat.modAut [Finite ι] : + withPiQuantum[φ] + ∀ (r : ℝ) (x : PiMat ℂ ι p) (i : ι), + modAut r x i = sig (hφ i) r (x i) := +by + classical + letI := Fintype.ofFinite ι + withPiQuantumCtx[φ] + intro r x i + rfl + +theorem Matrix.counit_eq_dual {n : Type*} [Fintype n] [DecidableEq n] + {φ : Module.Dual ℂ (Matrix n n ℂ)} [φ.IsFaithfulPosMap] : + withMatrixQuantum[φ] + Coalgebra.counit (R := ℂ) (A := Matrix n n ℂ) = φ := +by + withMatrixQuantumCtx[φ] + ext + simp only [← Coalgebra.inner_eq_counit'] + rw [@Module.Dual.IsFaithfulPosMap.inner_eq, conjTranspose_one, one_mul] + +omit [DecidableEq ι] in +theorem PiMat.counit_eq_dual : + letI : DecidableEq ι := Classical.decEq ι + withPiQuantum[φ] + (Coalgebra.counit (R := ℂ) (A := PiMat ℂ ι p)) = Module.Dual.pi φ := +by + classical + withPiQuantumCtx[φ] + apply LinearMap.ext + intro x + rw [← congrFun (QuantumSet.inner_eq_counit' (B := PiMat ℂ ι p)) x] + rw [Module.Dual.pi.IsFaithfulPosMap.inner_eq, star_one, one_mul] + +omit [DecidableEq ι] in +theorem modAut_eq_id_iff : + letI : DecidableEq ι := Classical.decEq ι + withPiQuantum[φ] + ∀ r : ℝ, + (modAut r : PiMat ℂ ι p ≃ₐ[ℂ] PiMat ℂ ι p) = 1 + ↔ r = 0 ∨ Module.Dual.IsTracial + (Coalgebra.counit (R := ℂ) (A := PiMat ℂ ι p)) := +by + classical + withPiQuantumCtx[φ] + intro r + rw [PiMat.counit_eq_dual] + calc (modAut r : PiMat ℂ ι p ≃ₐ[ℂ] PiMat ℂ ι p) = 1 + ↔ ∀ i, sig (hφ i) r = 1 := by + simp only [AlgEquiv.ext_iff, AlgEquiv.one_apply, funext_iff, PiMat.modAut, + sig_apply] + constructor + · intro h i a + simpa [Matrix.includeBlock_apply_same] using h (Matrix.includeBlock a) i + · intro h a i + exact h i (a i) + _ ↔ r = 0 ∨ Module.Dual.IsTracial (Module.Dual.pi φ) := by + simp_rw [sig_eq_id_iff, forall_or_left, Module.Dual.pi_isTracial_iff] + +theorem unitary.mul_inj {A : Type*} [Monoid A] [StarMul A] (U : ↥(unitary A)) (x y : A) : + ↑U * x = ↑U * y ↔ x = y := +by + rw [← Unitary.val_toUnits_apply] + exact (Units.mul_right_inj (Unitary.toUnits U)) + +omit [Fintype ι] [DecidableEq ι] in +theorem piInnerAut_modAut_commutes_of [Finite ι] : + withPiQuantum[φ] + ∀ {U : (i : ι) → Matrix.unitaryGroup (p i) ℂ} {r : ℝ}, + (∀ i, (Matrix.innerAutStarAlg (U i)) ((hφ i).matrixIsPosDef.rpow r) + = (hφ i).matrixIsPosDef.rpow r) → + ∀ x, (piInnerAut U) ((modAut (-r)) x) = (modAut (-r)) ((piInnerAut U) x) := +by + intro U r h + simp only [Matrix.innerAutStarAlg_apply', unitary.mul_inv_eq_iff] at h + intro x + funext i + classical + letI := Fintype.ofFinite ι + simp only [StarAlgEquiv.piCongrRight_apply, Unitary.conjStarAlgAut_apply] + rw [PiMat.modAut, PiMat.modAut] + simp only [piInnerAut, StarAlgEquiv.piCongrRight_apply, Unitary.conjStarAlgAut_apply, + sig_apply, neg_neg] + let R := (hφ i).matrixIsPosDef.rpow r + let Rn := (hφ i).matrixIsPosDef.rpow (-r) + let Umat : Matrix (p i) (p i) ℂ := U i + let SU : Matrix (p i) (p i) ℂ := star Umat + change Umat * (R * x i * Rn) * SU = R * (Umat * x i * SU) * Rn + have hcomm : Umat * R = R * Umat := by + simpa [Umat, R] using h i + have hUR : SU * Umat = 1 := by + dsimp [SU, Umat] + exact Matrix.UnitaryGroup.star_mul_self (U i) + have hRU : Umat * SU = 1 := by + dsimp [SU, Umat] + exact Matrix.unitaryGroup.coe_hMul_star_self (U i) + have hRinv : Rn = R⁻¹ := by + simp [Rn, R, Matrix.PosDef.rpow_neg_eq_inv_rpow] + letI := (Matrix.PosDef.rpow.isPosDef (hφ i).matrixIsPosDef r).invertible + have hcommSU : R * SU = SU * R := by + calc + R * SU = (SU * Umat) * (R * SU) := by rw [hUR, one_mul] + _ = SU * (Umat * R) * SU := by noncomm_ring + _ = SU * (R * Umat) * SU := by rw [hcomm] + _ = (SU * R) * (Umat * SU) := by noncomm_ring + _ = SU * R := by rw [hRU, mul_one] + have hcommInv : Rn * SU = SU * Rn := by + rw [hRinv] + rw [← Matrix.mul_right_inj_of_invertible (A := R)] + calc + R * (R⁻¹ * SU) = SU := by + rw [← Matrix.mul_assoc, Matrix.mul_inv_of_invertible, one_mul] + _ = (SU * R) * R⁻¹ := by rw [Matrix.mul_inv_cancel_right_of_invertible] + _ = (R * SU) * R⁻¹ := by rw [hcommSU] + _ = R * (SU * R⁻¹) := by rw [Matrix.mul_assoc] + calc + Umat * (R * x i * Rn) * SU = (Umat * R) * x i * (Rn * SU) := by + noncomm_ring + _ = (R * Umat) * x i * (Rn * SU) := by rw [hcomm] + _ = (R * Umat) * x i * (SU * Rn) := by rw [hcommInv] + _ = R * (Umat * x i * SU) * Rn := by noncomm_ring + +theorem QuantumGraph.Real.PiMat_applyConjInnerAut : + withPiQuantum[φ] + ∀ {A : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + (hA : QuantumGraph.Real (PiMat ℂ ι p) A) → + ∀ {U : (i : ι) → Matrix.unitaryGroup (p i) ℂ}, + piInnerAut U (Module.Dual.pi.matrixBlock φ) = Module.Dual.pi.matrixBlock φ → + let S : (i : ι × ι) → + (j : (Fin (Module.finrank ℂ (hA.PiMat_submodule i)))) → + (((p i.1) × (p i.2)) → + (((EuclideanSpace ℂ (p i.1)) × (EuclideanSpace ℂ (p i.2))))) + := fun i j => (hA.PiMat_orthonormalBasis i j : EuclideanSpace ℂ _).prod_choose + (piInnerAut U).toLinearMap ∘ₗ A ∘ₗ LinearMap.adjoint (piInnerAut U).toLinearMap + = ∑ i : ι × ι, ∑ j, ∑ s : (p i.1 × p i.2), ∑ l : (p i.1 × p i.2), + rankOne ℂ (Matrix.includeBlock + (Matrix.vecMulVec ((U i.1 : Matrix (p i.1) (p i.1) ℂ) *ᵥ (S i j s).1) + (star ((U i.1 : Matrix (p i.1) (p i.1) ℂ) *ᵥ (S i j l).1)))) + (modAut (- (1 / 2)) (Matrix.includeBlock + ((Matrix.vecMulVec ((U i.2 : Matrix (p i.2) (p i.2) ℂ)ᴴᵀ *ᵥ (S i j s).2) + (star ((U i.2 : Matrix (p i.2) (p i.2) ℂ)ᴴᵀ *ᵥ (S i j l).2)))ᴴᵀ))) := +by + withPiQuantumCtx[φ] + intro A hA U hU S + simp_rw [piInnerAut_apply_dualMatrix_iff', innerAutStarAlg_apply_dualMatrix_eq_iff_eq_sqrt] at hU + have hU₂ := piInnerAut_modAut_commutes_of hU + nth_rw 1 [QuantumGraph.Real.PiMat_eq hA] + simp only [piInnerAut] at hU₂ ⊢ + simp only [ContinuousLinearMap.coe_sum, LinearMap.sum_comp, LinearMap.comp_sum, + LinearMap.rankOne_comp', LinearMap.comp_rankOne, StarAlgEquiv.toLinearMap_apply, hU₂] + repeat apply Finset.sum_congr rfl; intro _ _ + congr 2 + · rw [StarAlgEquiv.piCongrRight_apply_includeBlock, Matrix.innerAutStarAlg_apply_vecMulVec_star] + · rw [StarAlgEquiv.piCongrRight_apply_includeBlock, Matrix.vecMulVec_conj, star_star, + Matrix.innerAutStarAlg_apply_star_vecMulVec] + +open QuantumSet in +theorem QuantumGraph.Real.PiMat_conj_unitary_submodule_eq_map : + withPiQuantum[φ] + ∀ {A : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + (hA : QuantumGraph.Real (PiMat ℂ ι p) A) → + ∀ {U : (i : ι) → Matrix.unitaryGroup (p i) ℂ}, + (hU : piInnerAut U (Module.Dual.pi.matrixBlock φ) = Module.Dual.pi.matrixBlock φ) → + ∀ i : ι × ι, + QuantumGraph.Real.PiMat_submodule (hA.piMat_conj_unitary hU) i = + Submodule.map (unitaryTensorEuclidean U i).toLinearMap (hA.PiMat_submodule i) := +by + withPiQuantumCtx[φ] + intro A hA U hU i + rw [Submodule.eq_iff_orthogonalProjection_eq, ← ContinuousLinearMap.coe_inj] + rw [orthogonalProjection_submoduleMap] + nth_rw 1 [OrthonormalBasis.orthogonalProjection'_eq_sum_rankOne (hA.PiMat_orthonormalBasis i)] + simp_rw [QuantumGraph.Real.PiMat_submoduleOrthogonalProjection] + rw [QuantumGraph.Real.PiMat_applyConjInnerAut hA hU] + simp only [ContinuousLinearMap.coe_sum, map_sum, Psi_apply, Psi_toFun_apply, + Finset.sum_apply, StarAlgEquiv.lTensor_tmul, PiMatTensorProductEquiv_tmul, PiMat_toEuclideanLM, + StarAlgEquiv.piCongrRight_apply] + simp only [LinearMap.sum_comp, LinearMap.comp_sum] + simp only [modAut_apply_modAut, add_neg_cancel, starAlgebra.modAut_zero, AlgEquiv.one_apply, + PiMat.transposeStarAlgEquiv_symm_apply, MulOpposite.unop_op] + simp only [LinearMap.comp_rankOne, LinearMap.rankOne_comp, LinearIsometryEquiv.linearMap_adjoint, + LinearIsometryEquiv.symm_symm] + simp only [LinearIsometryEquiv.coe_toLinearEquiv, LinearEquiv.coe_toLinearMap, + LinearMap.coe_toContinuousLinearMap, unitaryTensorEuclidean_apply'] + simp only [Matrix.includeBlock_apply, Matrix.dite_kronecker, Pi.star_apply, star_zero, + apply_dite, Matrix.transpose_zero, + map_zero, Matrix.kronecker_zero] + rw [Fintype.sum_eq_single i] + · simp only [↓reduceDIte] + simp only [ + eq_mp_eq_cast, cast_eq, + Matrix.star_eq_conjTranspose, Matrix.conj_conjTranspose, + Matrix.transpose_transpose, Matrix.vecMulVec_kronecker_vecMulVec, + Matrix.toEuclideanStarAlgEquiv_coe] + congr + ext + simp only [rankOne_lm_sum_sum] + simp only [rankOne_euclideanSpaceTensor_eq_toEuclideanLin_vecMulVec] + simp only [LinearMap.coe_toContinuousLinearMap] + · intro x hx + apply Finset.sum_eq_zero + intro x_1 _ + apply Finset.sum_eq_zero + intro x_2 _ + apply Finset.sum_eq_zero + intro x_3 _ + rcases x with ⟨x₁, x₂⟩ + by_cases h₂ : x₂ = i.2 + · by_cases h₁ : x₁ = i.1 + · exfalso + apply hx + ext <;> assumption + · simp [h₂, h₁] + · simp [h₂] + +theorem orthogonalProjection'_bot {𝕜 E : Type*} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] : + orthogonalProjection' (⊥ : Submodule 𝕜 E) = 0 := +by simp + +omit [Fintype ι] [(i : ι) → Fintype (p i)] [(i : ι) → DecidableEq (p i)] in +lemma LinearMap.proj_apply_includeBlock + (i j : ι) (x : Matrix (p j) (p j) ℂ) : + LinearMap.proj (R := ℂ) i (Matrix.includeBlock (i := j) x) = + if h : j = i then by rw [← h]; exact x else 0 := +by simp [Matrix.includeBlock_apply] + +omit [Fintype ι] in +lemma _root_.PiMat.modAut_includeBlock [Finite ι] : + withPiQuantum[φ] + ∀ (r : ℝ) (j : ι) (x : Matrix (p j) (p j) ℂ), + (modAut r) (Matrix.includeBlock x) + = (letI : starAlgebra (Matrix (p j) (p j) ℂ) := Matrix.isStarAlgebra (φ := φ j); + Matrix.includeBlock + ((modAut r : Matrix (p j) (p j) ℂ ≃ₐ[ℂ] Matrix (p j) (p j) ℂ) x)) := +by + classical + letI := Fintype.ofFinite ι + withPiQuantumCtx[φ] + intro r j x + ext i + by_cases h : j = i + · subst i + simp [Matrix.includeBlock_apply_same, modAut, sig_apply] + · simp [PiMat.modAut, Matrix.includeBlock_apply_ne_same _ h] + +omit [Fintype ι] [DecidableEq ι] in +lemma _root_.PiMat.modAut_proj [Finite ι] : + withPiQuantum[φ] + ∀ (r : ℝ) (j : ι) (x : PiMat ℂ ι p), + (letI : starAlgebra (Matrix (p j) (p j) ℂ) := Matrix.isStarAlgebra (φ := φ j); + ((modAut r : Matrix (p j) (p j) ℂ ≃ₐ[ℂ] Matrix (p j) (p j) ℂ) + (LinearMap.proj (R := ℂ) j x))) + = LinearMap.proj (R := ℂ) j (modAut r x) := +by + classical + letI := Fintype.ofFinite ι + withPiQuantumCtx[φ] + intro r j x + change sig (hφ j) r (x j) = modAut r x j + rw [PiMat.modAut] + +lemma EuclideanSpace.prod_choose_zero_fst + {n m : Type*} [Fintype n] [DecidableEq n] [Fintype m] [DecidableEq m] + (i : n × m) : + ((0 : EuclideanSpace ℂ (n × m)).prod_choose i).1 = 0 := +by + simp only [EuclideanSpace.prod_choose, LinearIsometryEquiv.map_zero] + simp + +open scoped Kronecker + +theorem QuantumGraph.Real.PiMat_submodule_eq_bot_iff_proj_comp_adjoint_proj_eq_zero : + withPiQuantum[φ] + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (p i) (p i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (φ i) + letI : ∀ i, _root_.TopologicalSpace (Matrix (p i) (p i) ℂ) := + fun i => (Module.Dual.NormedAddCommGroup (φ + i)).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI : ∀ i, _root_.SeminormedAddCommGroup (Matrix (p i) (p i) ℂ) := + fun i => (Module.Dual.NormedAddCommGroup (φ i)).toSeminormedAddCommGroup + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (p i) (p i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := φ i) + ∀ {A : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + (hA : QuantumGraph.Real _ A) → ∀ {i : ι × ι}, + hA.PiMat_submodule i = ⊥ ↔ + (LinearMap.proj (R := ℂ) i.1 : + PiMat ℂ ι p →ₗ[ℂ] Mat ℂ (p i.1)) ∘ₗ A ∘ₗ + LinearMap.adjoint + (LinearMap.proj (R := ℂ) i.2 : + PiMat ℂ ι p →ₗ[ℂ] Mat ℂ (p i.2)) = 0 := +by + withPiQuantumCtx[φ] + letI : ∀ i, _root_.starAlgebra (Matrix (p i) (p i) ℂ) := + fun i => Matrix.isStarAlgebra (φ := φ i) + letI : ∀ i, _root_.QuantumSet (Matrix (p i) (p i) ℂ) := + fun i => Module.Dual.IsFaithfulPosMap.quantumSet (φ := φ i) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (p i) (p i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (φ i) + letI : ∀ i, _root_.TopologicalSpace (Matrix (p i) (p i) ℂ) := + fun i => (Module.Dual.NormedAddCommGroup (φ + i)).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI : ∀ i, _root_.SeminormedAddCommGroup (Matrix (p i) (p i) ℂ) := + fun i => (Module.Dual.NormedAddCommGroup (φ i)).toSeminormedAddCommGroup + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (p i) (p i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := φ i) + intro A hA i + rw [Submodule.eq_iff_orthogonalProjection_eq, orthogonalProjection'_bot, + QuantumGraph.Real.PiMat_submoduleOrthogonalProjection] + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne A + simp only [map_sum, Finset.sum_apply, QuantumSet.Psi_apply, QuantumSet.Psi_toFun_apply, + StarAlgEquiv.lTensor_tmul, PiMatTensorProductEquiv_tmul, PiMat_toEuclideanLM, + StarAlgEquiv.piCongrRight_apply] + rw [← map_sum, LinearEquiv.map_eq_zero_iff, + ← map_sum, StarAlgEquiv.map_eq_zero_iff] + simp only [PiMat.transposeStarAlgEquiv_symm_apply, MulOpposite.unop_op] + rw [← Function.Injective.eq_iff (QuantumSet.Psi 0 (1/2)).injective, + ← Function.Injective.eq_iff (AlgEquiv.lTensor _ (Matrix.transposeAlgEquiv _ _ + _).symm).injective, + ← Function.Injective.eq_iff tensorToKronecker.injective] + simp only [LinearMap.sum_comp, LinearMap.comp_sum, + LinearMap.rankOne_comp', LinearMap.comp_rankOne, map_sum, + QuantumSet.Psi_apply, QuantumSet.Psi_toFun_apply, AlgEquiv.lTensor_tmul, + Matrix.transposeAlgEquiv_symm_op_apply, PiMat.modAut_proj, + tensorToKronecker_apply, TensorProduct.toKronecker_apply, map_zero] + rfl + +theorem QuantumGraph.Real.PiMat_submodule_eq_top_iff_proj_comp_adjoint_proj_eq_rankOne_one_one : + withPiQuantum[φ] + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (p i) (p i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (φ i) + letI : ∀ i, _root_.TopologicalSpace (Matrix (p i) (p i) ℂ) := + fun i => (Module.Dual.NormedAddCommGroup (φ + i)).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI : ∀ i, _root_.SeminormedAddCommGroup (Matrix (p i) (p i) ℂ) := + fun i => (Module.Dual.NormedAddCommGroup (φ i)).toSeminormedAddCommGroup + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (p i) (p i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := φ i) + ∀ {A : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, (hA : QuantumGraph.Real _ A) → + ∀ {i : ι × ι}, + hA.PiMat_submodule i = ⊤ ↔ + (LinearMap.proj (R := ℂ) i.1 : + PiMat ℂ ι p →ₗ[ℂ] Mat ℂ (p i.1)) ∘ₗ A ∘ₗ + LinearMap.adjoint + (LinearMap.proj (R := ℂ) i.2 : + PiMat ℂ ι p →ₗ[ℂ] Mat ℂ (p i.2)) + = (rankOne ℂ (1 : Mat ℂ (p i.1)) (1 : Mat ℂ (p i.2))) := +by + withPiQuantumCtx[φ] + letI : ∀ i, _root_.starAlgebra (Matrix (p i) (p i) ℂ) := + fun i => Matrix.isStarAlgebra (φ := φ i) + letI : ∀ i, _root_.QuantumSet (Matrix (p i) (p i) ℂ) := + fun i => Module.Dual.IsFaithfulPosMap.quantumSet (φ := φ i) + letI : ∀ i, _root_.NormedAddCommGroup (Matrix (p i) (p i) ℂ) := + fun i => Module.Dual.NormedAddCommGroup (φ i) + letI : ∀ i, _root_.TopologicalSpace (Matrix (p i) (p i) ℂ) := + fun i => (Module.Dual.NormedAddCommGroup (φ + i)).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI : ∀ i, _root_.SeminormedAddCommGroup (Matrix (p i) (p i) ℂ) := + fun i => (Module.Dual.NormedAddCommGroup (φ i)).toSeminormedAddCommGroup + letI : ∀ i, _root_.InnerProductSpace ℂ (Matrix (p i) (p i) ℂ) := + fun i => Module.Dual.InnerProductSpace (φ := φ i) + intro A hA i + rw [Submodule.eq_iff_orthogonalProjection_eq, orthogonalProjection_of_top, + QuantumGraph.Real.PiMat_submoduleOrthogonalProjection] + obtain ⟨α, β, rfl⟩ := LinearMap.exists_sum_rankOne A + simp only [map_sum, Finset.sum_apply, QuantumSet.Psi_apply, QuantumSet.Psi_toFun_apply, + StarAlgEquiv.lTensor_tmul, PiMatTensorProductEquiv_tmul, PiMat_toEuclideanLM, + StarAlgEquiv.piCongrRight_apply] + rw [← map_sum, ← ContinuousLinearMap.toLinearMapAlgEquiv_symm_apply, + map_eq_one_iff _ (AlgEquiv.injective _), + ← map_sum, map_eq_one_iff _ (StarAlgEquiv.injective _)] + simp only [PiMat.transposeStarAlgEquiv_symm_apply, MulOpposite.unop_op] + rw [← Function.Injective.eq_iff (QuantumSet.Psi 0 (1/2)).injective, + ← Function.Injective.eq_iff (AlgEquiv.lTensor _ (Matrix.transposeAlgEquiv _ _ + _).symm).injective, + ← Function.Injective.eq_iff tensorToKronecker.injective] + simp only [LinearMap.sum_comp, LinearMap.comp_sum, + LinearMap.rankOne_comp', LinearMap.comp_rankOne, map_sum, + QuantumSet.Psi_apply, QuantumSet.Psi_toFun_apply, AlgEquiv.lTensor_tmul, + Matrix.transposeAlgEquiv_symm_op_apply, PiMat.modAut_proj, + tensorToKronecker_apply, TensorProduct.toKronecker_apply, map_one, + star_one, Matrix.transpose_one, Matrix.one_kronecker_one] + rfl + +theorem Matrix.trace_eq_linearMap_trace + {n : Type*} [Fintype n] [DecidableEq n] + (y : Matrix n n ℂ) : + Matrix.trace y = LinearMap.trace ℂ (EuclideanSpace ℂ n) + (Matrix.toEuclideanLin y) := +by + rw [LinearMap.trace_eq_matrix_trace ℂ (PiLp.basisFun 2 ℂ n)] + simp only [Matrix.toLpLin_eq_toLin, LinearMap.toMatrix_toLin] + +lemma Matrix.trace_piMatTensorProductEquiv_apply_lTensor_transpose + {ι : Type*} [Fintype ι] [DecidableEq ι] + {p : ι → Type*} [∀ i, Fintype (p i)] [∀ i, DecidableEq (p i)] + (x : (PiMat ℂ ι p) ⊗[ℂ] (PiMat ℂ ι p)ᵐᵒᵖ) (i : ι × ι) : + Matrix.trace + (PiMatTensorProductEquiv + ((StarAlgEquiv.lTensor (PiMat ℂ ι p) (PiMat.transposeStarAlgEquiv ι p).symm) x) i) + = Matrix.trace (PiMatTensorProductEquiv (LinearMap.lTensor _ (unop ℂ).toLinearMap x) i) := +by + obtain ⟨S, hS⟩ := TensorProduct.exists_finset x + simp_rw [hS, map_sum, Finset.sum_apply, Matrix.trace_sum, + StarAlgEquiv.lTensor_tmul, LinearMap.lTensor_tmul, + PiMatTensorProductEquiv_tmul, Matrix.trace_kronecker, + PiMat.transposeStarAlgEquiv_symm_apply] + rfl + +lemma Matrix.trace_piMatTensorProductEquiv_lTensor_unop_map_modAut + : + withPiQuantum[φ] + ∀ (x : (PiMat ℂ ι p) ⊗[ℂ] (PiMat ℂ ι p)ᵐᵒᵖ) (i : ι × ι), + Matrix.trace + (PiMatTensorProductEquiv + (LinearMap.lTensor _ (unop ℂ).toLinearMap + ((TensorProduct.map (modAut (0 - 1 / 2)).toLinearMap + (AlgEquiv.op (modAut (0 - 1 / 2))).toLinearMap) x)) i) + = Matrix.trace + (PiMatTensorProductEquiv + (LinearMap.lTensor _ (unop ℂ).toLinearMap x) i) := +by + intro x i + obtain ⟨S, hS⟩ := TensorProduct.exists_finset x + simp_rw [hS, map_sum, Finset.sum_apply, Matrix.trace_sum, + TensorProduct.map_tmul, LinearMap.lTensor_tmul, + PiMatTensorProductEquiv_tmul, Matrix.trace_kronecker, + AlgEquiv.toLinearMap_apply] + congr 1 + ext + rw [AlgEquiv.op_apply_apply, LinearEquiv.coe_coe, unop_apply, MulOpposite.unop_op] + simp_rw [PiMat.modAut_trace_apply] + rfl + +lemma Matrix.trace_piMatTensorProductEquiv_lTensor_unop_tenSwap + (x : (PiMat ℂ ι p) ⊗[ℂ] (PiMat ℂ ι p)ᵐᵒᵖ) (i : ι × ι) : + (Matrix.trace + (PiMatTensorProductEquiv + ((LinearMap.lTensor (PiMat ℂ ι p) (unop ℂ).toLinearMap) ((tenSwap ℂ) x)) i)) + = Matrix.trace (PiMatTensorProductEquiv + ((LinearMap.lTensor (PiMat ℂ ι p) (unop ℂ).toLinearMap) x) i.swap) := +by + obtain ⟨S, hS⟩ := TensorProduct.exists_finset x + rw [← LinearEquiv.coe_toLinearMap] + simp_rw [hS, map_sum, Finset.sum_apply, Matrix.trace_sum, + LinearEquiv.coe_coe, tenSwap_apply, + LinearMap.lTensor_tmul, PiMatTensorProductEquiv_tmul, Matrix.trace_kronecker, + LinearEquiv.coe_coe, unop_apply] + congr 1 + ext + rw [mul_comm] + rfl + +/-- Build a linear isometry equivalence from a linear equivalence whose adjoint is its inverse. -/ +def LinearIsometryEquiv.of_linearEquiv + {𝕜 E F : Type*} [RCLike 𝕜] [NormedAddCommGroup E] + [NormedAddCommGroup F] [InnerProductSpace 𝕜 E] + [InnerProductSpace 𝕜 F] + [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] + (f : E ≃ₗ[𝕜] F) (hf : LinearMap.adjoint f.toLinearMap = f.symm.toLinearMap) : + E ≃ₗᵢ[𝕜] F where + toLinearEquiv := f + norm_map' := by + rw [← isometry_iff_norm, isometry_iff_inner] + intro _ _ + rw [← LinearEquiv.coe_toLinearMap, ← LinearMap.adjoint_inner_left] + simp only [hf, LinearEquiv.coe_toLinearMap, LinearEquiv.symm_apply_apply] + +lemma LinearIsometryEquiv.of_linearEquiv_apply {𝕜 E F : Type*} [RCLike 𝕜] [NormedAddCommGroup E] + [NormedAddCommGroup F] [InnerProductSpace 𝕜 E] + [InnerProductSpace 𝕜 F] [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] + (f : E ≃ₗ[𝕜] F) (hf : LinearMap.adjoint f.toLinearMap = f.symm.toLinearMap) (x : E) : + (LinearIsometryEquiv.of_linearEquiv f hf) x = f x := +rfl + +/-- Tensor-product commutativity as a linear isometry equivalence. -/ +noncomputable def TensorProduct.comm_linearIsometryEquiv + (𝕜 E F : Type*) [RCLike 𝕜] [NormedAddCommGroup E] + [NormedAddCommGroup F] [InnerProductSpace 𝕜 E] + [InnerProductSpace 𝕜 F] [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] : + (E ⊗[𝕜] F) ≃ₗᵢ[𝕜] (F ⊗[𝕜] E) := +LinearIsometryEquiv.of_linearEquiv (TensorProduct.comm 𝕜 E F) TensorProduct.comm_adjoint + +lemma TensorProduct.comm_linearIsometryEquiv_apply + {𝕜 E F : Type*} [RCLike 𝕜] [NormedAddCommGroup E] + [NormedAddCommGroup F] [InnerProductSpace 𝕜 E] + [InnerProductSpace 𝕜 F] [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] + (x : E) (y : F) : + (TensorProduct.comm_linearIsometryEquiv 𝕜 E F) (x ⊗ₜ y) = y ⊗ₜ x := +rfl + +/-- Commute the factors of Euclidean space indexed by a product. -/ +noncomputable def + EuclideanSpace.tensor_comm {n m : Type*} [Fintype n] [Fintype m] [DecidableEq n] [DecidableEq m] : + EuclideanSpace ℂ (n × m) ≃ₗᵢ[ℂ] EuclideanSpace ℂ (m × n) := +(euclideanSpaceTensor'.symm.trans (TensorProduct.comm_linearIsometryEquiv ℂ _ _)).trans + (euclideanSpaceTensor') +lemma EuclideanSpace.tensor_comm_apply {n m : + Type*} [Fintype n] [Fintype m] [DecidableEq n] [DecidableEq m] + (x : EuclideanSpace ℂ n) (y : EuclideanSpace ℂ m) : + tensor_comm (euclideanSpaceTensor' (R := ℂ) (x ⊗ₜ[ℂ] y)) + = euclideanSpaceTensor' (R := ℂ) (y ⊗ₜ[ℂ] x) := +by + simp only [tensor_comm] + rw [LinearIsometryEquiv.trans_apply] + nth_rw 2 [LinearIsometryEquiv.trans_apply] + rw [LinearIsometryEquiv.symm_apply_apply] + rfl + +theorem QuantumGraph.Real.piMat_submodule_finrank_eq_swap_of_adjoint : + withPiQuantum[φ] + ∀ {f : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + (hf : QuantumGraph.Real _ f) → LinearMap.adjoint f = f → ∀ i : ι × ι, + Module.finrank ℂ (hf.PiMat_submodule i) + = Module.finrank ℂ (hf.PiMat_submodule i.swap) := +by + withPiQuantumCtx[φ] + intro f hf hf₂ i + rw [← Nat.cast_inj (R := ℂ)] + nth_rw 2 [← Complex.conj_natCast] + simp_rw [← orthogonalProjection_trace, + QuantumGraph.Real.PiMat_submoduleOrthogonalProjection, + LinearMap.coe_toContinuousLinearMap, + PiMat_toEuclideanLM, StarAlgEquiv.piCongrRight_apply, + Matrix.toEuclideanStarAlgEquiv_coe, + ← Matrix.trace_eq_linearMap_trace] + nth_rw 2 [← hf₂] + rw [Psi.adjoint_apply] + simp_rw [Matrix.trace_piMatTensorProductEquiv_apply_lTensor_transpose, + Matrix.trace_piMatTensorProductEquiv_lTensor_unop_map_modAut, + Matrix.trace_piMatTensorProductEquiv_lTensor_unop_tenSwap, + ← Matrix.trace_piMatTensorProductEquiv_apply_lTensor_transpose, + map_star, starRingEnd_apply, Matrix.trace_star, Pi.star_apply, + Matrix.star_eq_conjTranspose, Matrix.conjTranspose_conjTranspose] + rfl + +theorem QuantumGraph.Real.PiMat_submodule_eq_bot_iff_swap_eq_bot_of_adjoint : + withPiQuantum[φ] + ∀ {A : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + (hA : QuantumGraph.Real _ A) → LinearMap.adjoint A = A → ∀ i : ι × ι, + hA.PiMat_submodule i = ⊥ ↔ hA.PiMat_submodule i.swap = ⊥ := +by + intro A hA hA₂ i + simp only [← Submodule.finrank_eq_zero] + rw [hA.piMat_submodule_finrank_eq_swap_of_adjoint hA₂] + +lemma Submodule.finrank_eq_iff_eq_top {K V : Type*} [DivisionRing K] + [AddCommGroup V] [Module K V] [FiniteDimensional K V] {S : Submodule K V} : + Module.finrank K ↥S = Module.finrank K V ↔ S = ⊤ := +by + refine ⟨Submodule.eq_top_of_finrank_eq, ?_⟩ + rintro rfl + simp only [finrank_top] + +theorem QuantumGraph.Real.PiMat_submodule_eq_top_iff_swap_eq_top_of_adjoint : + withPiQuantum[φ] + ∀ {A : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + (hA : QuantumGraph.Real _ A) → LinearMap.adjoint A = A → ∀ i : ι × ι, + hA.PiMat_submodule i = ⊤ ↔ hA.PiMat_submodule i.swap = ⊤ := +by + intro A hA hA₂ i + simp only [← Submodule.finrank_eq_iff_eq_top] + rw [hA.piMat_submodule_finrank_eq_swap_of_adjoint hA₂] + simp only [Prod.fst_swap, Prod.snd_swap] + have hdim : + Module.finrank ℂ (EuclideanSpace ℂ (p i.1 × p i.2)) = + Module.finrank ℂ (EuclideanSpace ℂ (p i.2 × p i.1)) := by + rw [finrank_euclideanSpace (𝕜 := ℂ), finrank_euclideanSpace (𝕜 := ℂ), + Fintype.card_prod, Fintype.card_prod, mul_comm] + rw [hdim] + rfl diff --git a/LeanPool/Monlib4/QuantumGraph/PiMatFinTwo.lean b/LeanPool/Monlib4/QuantumGraph/PiMatFinTwo.lean new file mode 100644 index 0000000000..2f07ddb1c7 --- /dev/null +++ b/LeanPool/Monlib4/QuantumGraph/PiMatFinTwo.lean @@ -0,0 +1,1145 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.QuantumGraph.PiMat +import LeanPool.Monlib4.LinearAlgebra.Ips.Nontracial + +open scoped Functional MatrixOrder ComplexOrder TensorProduct Matrix + +/-- Elaborate a product-of-blocks statement with matrix quantum-set instances on each block. -/ +syntax "withPiBlockQuantum[" term "] " term : term +macro_rules + | `(withPiBlockQuantum[$ψ] $p) => + `(withPiQuantum[$ψ] + letI := fun i => Matrix.isStarAlgebra (φ := $ψ i) + letI := fun i => Module.Dual.IsFaithfulPosMap.quantumSet (φ := $ψ i) + letI := fun i => Module.Dual.NormedAddCommGroup ($ψ i) + letI := fun i => (Module.Dual.NormedAddCommGroup ($ψ + i)).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace + letI := fun i => (Module.Dual.NormedAddCommGroup ($ψ i)).toSeminormedAddCommGroup + letI := fun i => Module.Dual.InnerProductSpace (φ := $ψ i) + $p) + +/-- Introduce product and blockwise matrix quantum-set instances in a proof. -/ +syntax "withPiBlockQuantumCtx" "[" term "]" : tactic +macro_rules + | `(tactic| withPiBlockQuantumCtx[$ψ]) => + `(tactic| + withPiQuantumCtx[$ψ]; + letI := fun i => Matrix.isStarAlgebra (φ := $ψ i); + letI := fun i => Module.Dual.IsFaithfulPosMap.quantumSet (φ := $ψ i); + letI := fun i => Module.Dual.NormedAddCommGroup ($ψ i); + letI := fun i => (Module.Dual.NormedAddCommGroup ($ψ + i)).toPseudoMetricSpace.toUniformSpace.toTopologicalSpace; + letI := fun i => (Module.Dual.NormedAddCommGroup ($ψ i)).toSeminormedAddCommGroup; + letI := fun i => Module.Dual.InnerProductSpace (φ := $ψ i)) + +/-- Elaborate a product-of-blocks statement with blockwise quantum and coalgebra instances. -/ +syntax "withPiBlockCoalgebraQuantum[" term "] " term : term +macro_rules + | `(withPiBlockCoalgebraQuantum[$ψ] $p) => + `(withPiBlockQuantum[$ψ] + letI := PiMat.finiteDimensionalHilbertCoalgebraStruct (φ := $ψ) + $p) + +/-- Introduce product, blockwise quantum, and coalgebra instances in a proof. -/ +syntax "withPiBlockCoalgebraQuantumCtx" "[" term "]" : tactic +macro_rules + | `(tactic| withPiBlockCoalgebraQuantumCtx[$ψ]) => + `(tactic| + withPiBlockQuantumCtx[$ψ]; + letI := PiMat.finiteDimensionalHilbertCoalgebraStruct (φ := $ψ)) + +/-- The algebra equivalence between a two-block product of matrix algebras and the matching + `PiMat`. -/ +def MatProd_algEquiv_PiMat (n' : Fin 2 → Type*) [Π i, Fintype (n' i)] [Π i, DecidableEq (n' i)] : + (Matrix (n' 0) (n' 0) ℂ × Matrix (n' 1) (n' 1) ℂ) + ≃ₐ[ℂ] + PiMat ℂ (Fin 2) n' := +matrixPiFinTwo_algEquiv_prod.symm + +/-- Swap the two types in a `Fin 2`-indexed family. -/ +abbrev PiFinTwo.swap (n' : Fin 2 → Type*) : + Fin 2 → Type _ := +fun i => if i = 0 then (n' 1) else (n' 0) + +instance {n' : Fin 2 → Type*} [Π i, Fintype (n' i)] : + Π i, Fintype ((PiFinTwo.swap n') i) := +fun i => by + unfold PiFinTwo.swap + split_ifs <;> infer_instance +instance {n' : Fin 2 → Type*} [Π i, DecidableEq (n' i)] : + Π i, DecidableEq ((PiFinTwo.swap n') i) := +fun i => by + unfold PiFinTwo.swap + split_ifs <;> infer_instance + +/-- The swapped product-to-`PiMat` equivalence for two matrix blocks. -/ +def MatProd_algEquiv_PiMat_swap (n' : Fin 2 → Type*) [Π i, Fintype (n' i)] [Π i, + DecidableEq (n' i)] : + (Matrix (n' 1) (n' 1) ℂ × Matrix (n' 0) (n' 0) ℂ) + ≃ₐ[ℂ] + PiMat ℂ (Fin 2) (PiFinTwo.swap n') := +MatProd_algEquiv_PiMat (PiFinTwo.swap n') + +/-- Swap the two factors of a product as an algebra equivalence. -/ +@[simps] +def Prod.swap_algEquiv + (α β : Type*) [Semiring α] [Semiring β] [Algebra ℂ α] [Algebra ℂ β] : + (α × β) ≃ₐ[ℂ] (β × α) where + toFun x := x.swap + invFun x := x.swap + left_inv _ := by simp + right_inv _ := by simp + map_add' _ _ := by simp + map_mul' _ _ := by simp + commutes' _ := by simp + +/-- Swap the two blocks of a `PiMat` indexed by `Fin 2`. -/ +def PiMat_finTwo_swapAlgEquiv + {n' : Fin 2 → Type*} [Π i, Fintype (n' i)] [Π i, DecidableEq (n' i)] : + PiMat ℂ (Fin 2) n' ≃ₐ[ℂ] PiMat ℂ (Fin 2) (PiFinTwo.swap n') := +(MatProd_algEquiv_PiMat n').symm.trans ((Prod.swap_algEquiv _ _).trans + (MatProd_algEquiv_PiMat_swap n')) + +/-- The constant `Fin 2`-indexed family with value `n`. -/ +abbrev PiFinTwo_same (n : Type*) : + Fin 2 → Type _ := +fun i => let _ := i; n + +instance {n : Type*} [Fintype n] : + Π i, Fintype ((PiFinTwo_same n) i) := +fun i => by infer_instance +instance {n : Type*} [DecidableEq n] : + Π i, DecidableEq ((PiFinTwo_same n) i) := +fun i => by infer_instance + +theorem PiMat_finTwo_swapAlgEquiv_apply {n' : Fin 2 → Type*} [Π i, Fintype (n' i)] [Π i, + DecidableEq (n' i)] + (x : Matrix (n' 0) (n' 0) ℂ) (y : Matrix (n' 1) (n' 1) ℂ) : + PiMat_finTwo_swapAlgEquiv (MatProd_algEquiv_PiMat n' (x, y)) + = MatProd_algEquiv_PiMat _ (y, x) := +rfl + +lemma PiFinTwo_same_swap {n : Type*} : + PiFinTwo.swap (PiFinTwo_same n) = PiFinTwo_same n := +by ext; simp only [ite_self, Fin.isValue] + +/-- Swap the two identical matrix blocks of a `PiMat` indexed by `Fin 2`. -/ +def PiMat_finTwo_same_swapAlgEquiv + {n : Type*} [Fintype n] [DecidableEq n] : + PiMat ℂ (Fin 2) (PiFinTwo_same n) ≃ₐ[ℂ] PiMat ℂ (Fin 2) (PiFinTwo_same n) := +(MatProd_algEquiv_PiMat (PiFinTwo_same n)).symm.trans ((Prod.swap_algEquiv _ _).trans + (MatProd_algEquiv_PiMat (PiFinTwo_same n))) + + +theorem PiMat_finTwo_same_swapAlgEquiv_apply {n : Type*} [Fintype n] [DecidableEq n] + (x : Matrix n n ℂ) (y : Matrix n n ℂ) : + PiMat_finTwo_same_swapAlgEquiv (MatProd_algEquiv_PiMat (PiFinTwo_same n) (x, y)) + = MatProd_algEquiv_PiMat _ (y, x) := +rfl + +variable {n : Type*} + [Fintype n] [DecidableEq n] + +theorem AlgEquiv.prod_map_inner_of {K R₁ R₂ : Type*} [CommSemiring K] + [Semiring R₁] [Semiring R₂] [Algebra K R₁] [Algebra K R₂] + {f : R₁ ≃ₐ[K] R₁} (hf : f.IsInner) {g : R₂ ≃ₐ[K] R₂} (hg : g.IsInner) : + (f.prod_map g).IsInner := +by + rw [AlgEquiv.prod_isInner_iff_prod_map] + obtain ⟨U, hU, rfl⟩ := hf + obtain ⟨V, hV, rfl⟩ := hg + exact ⟨U, hU, V, hV, rfl⟩ + +/-- Invertibility is preserved by the product-to-`PiMat` equivalence in the same-block case. -/ +@[reducible] +def MatProd_algEquiv_PiMat_same_invertible_of {U : Matrix n n ℂ × Matrix n n ℂ} + (hU : Invertible U) : + Invertible ((MatProd_algEquiv_PiMat (PiFinTwo_same n)) U) := +by + use (MatProd_algEquiv_PiMat _ ⅟U) <;> + simp only [← map_mul, invOf_mul_self, mul_invOf_self, map_one] + +theorem AlgEquiv.toPiMat_finTwo_same_inner_of_matrix_prod_inner + {f : (Matrix n n ℂ × Matrix n n ℂ) ≃ₐ[ℂ] (Matrix n n ℂ × Matrix n n ℂ)} + (hf : f.IsInner) : + ((MatProd_algEquiv_PiMat (PiFinTwo_same n)).symm.trans + (f.trans + (MatProd_algEquiv_PiMat (PiFinTwo_same n)))).IsInner := +by + obtain ⟨U, hU, rfl⟩ := hf + use ((MatProd_algEquiv_PiMat _) U), MatProd_algEquiv_PiMat_same_invertible_of hU + ext1 + simp only [Fin.isValue, MatProd_algEquiv_PiMat, symm_symm, trans_apply, + matrixPiFinTwo_algEquiv_prod_apply, Algebra.autInner_apply, map_mul] + congr + simp only [PiMat.ext_iff, Fin.forall_fin_two] + trivial + +theorem AlgEquiv.PiMat_finTwo_same + (f : PiMat ℂ (Fin 2) (PiFinTwo_same n) ≃ₐ[ℂ] PiMat ℂ (Fin 2) (PiFinTwo_same n)) : + f.IsInner + ∨ + (∃ (g : PiMat ℂ (Fin 2) (PiFinTwo_same n) ≃ₐ[ℂ] PiMat ℂ (Fin 2) (PiFinTwo_same n)) + (_ : AlgEquiv.IsInner g), + f = PiMat_finTwo_same_swapAlgEquiv.trans g) := +by + let f' := ((MatProd_algEquiv_PiMat _).trans f).trans (MatProd_algEquiv_PiMat _).symm + rcases (AlgEquiv.matrix_prod_aut' f') with (⟨f₁, f₂, hf⟩ | ⟨g₁, g₂, hg⟩) + · left + obtain ⟨U, hf₁⟩ := Matrix.aut_mat_inner' f₁ + obtain ⟨V, hf₂⟩ := Matrix.aut_mat_inner' f₂ + have hf₁' : f₁.IsInner := ⟨U, _, hf₁⟩ + have hf₂' : f₂.IsInner := ⟨V, _, hf₂⟩ + have hf' := + AlgEquiv.toPiMat_finTwo_same_inner_of_matrix_prod_inner (AlgEquiv.prod_map_inner_of hf₁' hf₂') + simp only [Fin.isValue, ← hf] at hf' + have : + (MatProd_algEquiv_PiMat _).symm.trans + (f'.trans (MatProd_algEquiv_PiMat _)) = f := + by ext1; simp [f'] + rw [this] at hf' + exact hf' + · right + obtain ⟨U, hg₁⟩ := Matrix.aut_mat_inner' g₁ + obtain ⟨V, hg₂⟩ := Matrix.aut_mat_inner' g₂ + have hg₁' : g₁.IsInner := ⟨U, _, hg₁⟩ + have hg₂' : g₂.IsInner := ⟨V, _, hg₂⟩ + have hg' := + AlgEquiv.toPiMat_finTwo_same_inner_of_matrix_prod_inner (AlgEquiv.prod_map_inner_of hg₁' hg₂') + use (MatProd_algEquiv_PiMat (PiFinTwo_same n)).symm.trans + ((g₁.prod_map g₂).trans (MatProd_algEquiv_PiMat (PiFinTwo_same n))), hg' + rw [funext_iff] at hg + simp only [Fin.isValue, AlgEquiv.coe_trans, Function.comp_apply, + AlgEquiv.prod_map_apply, Prod.swap, Prod.map_apply, f', + AlgEquiv.symm_apply_eq] at hg + ext1 x + specialize hg ((MatProd_algEquiv_PiMat _).symm x) + simp only [AlgEquiv.apply_symm_apply] at hg + rw [hg] + rfl + +variable {ι : Type*} {p : ι → Type*} [Fintype ι] [DecidableEq ι] + [(i : ι) → Fintype (p i)] [(i : ι) → DecidableEq (p i)] + +theorem PiMat.trace_eq_linearMap_trace_toEuclideanLM + (y : (PiMat ℂ (ι × ι) fun i ↦ p i.1 × p i.2)) : + PiMat.traceLinearMap y + = ∑ x : ι × ι, LinearMap.trace ℂ (EuclideanSpace ℂ (p x.1 × p x.2)) + (PiMat_toEuclideanLM y x) := +by + simp only [StarAlgEquiv.piCongrRight_apply, StarAlgEquiv.ofAlgEquiv_coe, + AlgEquiv.ofLinearEquiv_apply, LinearMap.coe_comp, Function.comp_apply, AlgHom.toLinearMap_apply, + Matrix.traceLinearMap_apply, Matrix.blockDiagonal'AlgHom_apply, + Matrix.trace_blockDiagonal'] + apply Finset.sum_congr rfl + intro i _ + change Matrix.trace (y i) = + LinearMap.trace ℂ (EuclideanSpace ℂ (p i.1 × p i.2)) (Matrix.toLpLin 2 2 (y i)) + rw [LinearMap.trace_eq_matrix_trace ℂ (PiLp.basisFun 2 ℂ (p i.1 × p i.2)), + Matrix.toLpLin_eq_toLin, LinearMap.toMatrix_toLin] + +variable {φ : (i : ι) → Module.Dual ℂ (Matrix (p i) (p i) ℂ)} + [hφ : ∀ (i : ι), (φ i).IsFaithfulPosMap] + +theorem QuantumGraph.Real.dim_of_piMat_submodule_eq + : withPiBlockQuantum[φ] + letI : CoalgebraStruct ℂ (PiMat ℂ ι p) := + PiMat.finiteDimensionalHilbertCoalgebraStruct (φ := φ) + ∀ {A : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + (hA : QuantumGraph.Real (PiMat ℂ ι p) A) → + hA.toQuantumGraph.dim_of_piMat_submodule = + ∑ i, Module.finrank ℂ (hA.PiMat_submodule i) := +by + withPiBlockQuantumCtx[φ] + letI : CoalgebraStruct ℂ (PiMat ℂ ι p) := + PiMat.finiteDimensionalHilbertCoalgebraStruct (φ := φ) + intro A hA + rw [← Nat.cast_inj (R := ℂ)] + rw [QuantumGraph.dim_of_piMat_submodule_eq_trace] + simp only [Nat.cast_sum, ← + orthogonalProjection_trace (R := ℂ), + QuantumGraph.Real.PiMat_submoduleOrthogonalProjection, + LinearMap.coe_toContinuousLinearMap] + rw [← PiMat.trace_eq_linearMap_trace_toEuclideanLM] + +variable + {ψ : Π i : Fin 2, Module.Dual ℂ (Matrix (PiFinTwo_same n i) (PiFinTwo_same n i) ℂ)} + [hψ : ∀ i, (ψ i).IsFaithfulPosMap] + {A : withPiBlockQuantum[ψ] + (PiMat ℂ (Fin 2) (PiFinTwo_same n) →ₗ[ℂ] PiMat ℂ (Fin 2) (PiFinTwo_same n))} + (hA : withPiBlockCoalgebraQuantum[ψ] QuantumGraph.Real _ A) + +omit [(i : ι) → DecidableEq (p i)] in +theorem LinearMap.proj_adjoint_apply + : letI : ∀ i, DecidableEq (p i) := fun i => Classical.decEq (p i) + withPiBlockQuantum[φ] + ∀ (i : ι) (x : Matrix (p i) (p i) ℂ), + (LinearMap.adjoint (LinearMap.proj (R := ℂ) i)) x + = Matrix.includeBlock x := +by + classical + withPiBlockQuantumCtx[φ] + intro i x + apply ext_inner_left ℂ + intro y + simp only [LinearMap.adjoint_inner_right, coe_proj, Function.eval] + rw [Module.Dual.pi.IsFaithfulPosMap.includeBlock_right_inner] + +omit [(i : ι) → DecidableEq (p i)] in +theorem LinearMap.proj_adjoint + : letI : ∀ i, DecidableEq (p i) := fun i => Classical.decEq (p i) + withPiBlockQuantum[φ] + ∀ (i : ι), + LinearMap.adjoint (LinearMap.proj (R := ℂ) i) + = LinearMap.single ℂ (fun r => Mat ℂ (p r)) i := +by + classical + withPiBlockQuantumCtx[φ] + intro i + ext1 + rw [LinearMap.proj_adjoint_apply] + rfl + +omit [(i : ι) → DecidableEq (p i)] in +theorem LinearMap.single_adjoint + : letI : ∀ i, DecidableEq (p i) := fun i => Classical.decEq (p i) + withPiBlockQuantum[φ] + ∀ (i : ι), + LinearMap.adjoint (LinearMap.single ℂ (fun r => Mat ℂ (p r)) i) + = LinearMap.proj (R := ℂ) i := +by + classical + withPiBlockQuantumCtx[φ] + intro i + rw [← proj_adjoint, adjoint_adjoint] + +open scoped Classical in +omit [DecidableEq ι] [(i : ι) → DecidableEq (p i)] in +theorem LinearMap.eq_sum_conj_adjoint_proj_comp_proj + : letI : DecidableEq ι := Classical.decEq ι + letI : ∀ i, DecidableEq (p i) := fun i => Classical.decEq (p i) + withPiBlockQuantum[φ] + ∀ (A : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p), + A = ∑ i : ι × ι, + LinearMap.adjoint (LinearMap.proj i.1) + ∘ₗ (LinearMap.proj i.1 ∘ₗ A ∘ₗ LinearMap.adjoint (LinearMap.proj i.2)) + ∘ₗ LinearMap.proj i.2 := +by + classical + withPiBlockQuantumCtx[φ] + intro A + simp_rw [LinearMap.proj_adjoint, Finset.sum_product_univ, + LinearMap.comp_assoc] + rw [LinearMap.lrsum_eq_single_proj_lrcomp] + +private lemma + QuantumGraph.Real.PiFinTwo_same_exists_proj_conj_add_of_piMat_submodule_eq_bot + : withPiBlockCoalgebraQuantum[ψ] + ∀ (_ : hA.PiMat_submodule ((1 : Fin 2), (0 : Fin 2)) = ⊥) + (_ : hA.PiMat_submodule ((0 : Fin 2), (1 : Fin 2)) = ⊥), + -- ∃ (f₁ f₂ : Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ), + (LinearMap.adjoint + (LinearMap.proj (R := ℂ) (φ := fun j => Mat ℂ (PiFinTwo_same n j)) (0 : Fin 2)) + ∘ₗ ((LinearMap.proj (R := ℂ) (φ := fun j => Mat ℂ (PiFinTwo_same n j)) (0 : Fin 2)) ∘ₗ A + ∘ₗ LinearMap.adjoint + (LinearMap.proj (R := ℂ) (φ := fun j => Mat ℂ (PiFinTwo_same n j)) (0 : Fin 2))) + ∘ₗ LinearMap.proj (R := ℂ) (φ := fun j => Mat ℂ (PiFinTwo_same n j)) (0 : Fin 2)) + + (LinearMap.adjoint + (LinearMap.proj (R := ℂ) (φ := fun j => Mat ℂ (PiFinTwo_same n j)) (1 : Fin 2)) + ∘ₗ ((LinearMap.proj (R := ℂ) (φ := fun j => Mat ℂ (PiFinTwo_same n j)) (1 : Fin 2)) ∘ₗ A + ∘ₗ LinearMap.adjoint + (LinearMap.proj (R := ℂ) (φ := fun j => Mat ℂ (PiFinTwo_same n j)) (1 : Fin 2))) + ∘ₗ LinearMap.proj (R := ℂ) (φ := fun j => Mat ℂ (PiFinTwo_same n j)) (1 : Fin 2)) = A := +by + withPiBlockCoalgebraQuantumCtx[ψ] + intro h₂ h₃ + simp only [Fin.isValue, + QuantumGraph.Real.PiMat_submodule_eq_bot_iff_proj_comp_adjoint_proj_eq_zero] at h₂ h₃ + simp_all only [PiFinTwo_same] + nth_rw 3 [LinearMap.eq_sum_conj_adjoint_proj_comp_proj (hφ := hψ) A] + simp only [Finset.sum_product_univ, Fin.sum_univ_two, + Fin.isValue, + h₂, h₃, LinearMap.zero_comp, LinearMap.comp_zero, zero_add, add_zero] + +lemma + QuantumGraph.Real.piFinTwo_same_piMat_submodule_eq_bot_of_adjoint_and_dim_eq_one + : withPiBlockCoalgebraQuantum[ψ] + ∀ (_ : LinearMap.adjoint A = A) + (_ : hA.toQuantumGraph.dim_of_piMat_submodule = 1), + hA.PiMat_submodule ((1 : Fin 2), (0 : Fin 2)) = ⊥ + ∧ ((Module.finrank ℂ (hA.PiMat_submodule 0) = 1 + ∧ hA.PiMat_submodule 1 = ⊥) + ∨ + (hA.PiMat_submodule 0 = ⊥ + ∧ Module.finrank ℂ (hA.PiMat_submodule 1) = 1)) := +by + withPiBlockCoalgebraQuantumCtx[ψ] + intro hA₂ hd + simp only [QuantumGraph.Real.dim_of_piMat_submodule_eq, + Finset.sum_product_univ, Fin.sum_univ_two, + Fin.isValue, Prod.mk_zero_zero, Prod.mk_one_one] at hd + simp only [Fin.isValue, Nat.add_eq_one_iff, AddLeftCancelMonoid.add_eq_zero, + Submodule.finrank_eq_zero] at hd + simp only [Fin.isValue, hA.PiMat_submodule_eq_bot_iff_swap_eq_bot_of_adjoint hA₂ (0, 1), + Prod.swap_prod_mk] at hd + rcases hd with (h | h) + · obtain ⟨h₁, (h₂ | h₂)⟩ := h + · exact ⟨h₂.1, Or.inr ⟨h₁.1, h₂.2⟩⟩ + · rw [h₁.2] at h₂ + simp only [finrank_bot, zero_ne_one, false_and] at h₂ + · obtain ⟨(h₁ | h₁), h₂⟩ := h + · rw [hA.PiMat_submodule_eq_bot_iff_swap_eq_bot_of_adjoint hA₂ (1, 0), + Prod.swap_prod_mk] at h₂ + rw [h₂.1, finrank_bot] at h₁ + simp only [zero_ne_one, and_false] at h₁ + · exact ⟨h₁.2, Or.inl ⟨h₁.1, h₂.2⟩⟩ + +lemma Pi.nat_eq_zero_of_sum_eq_one_and_unique_one + {ι : Type*} [Fintype ι] {f : ι → ℕ} + (h : ∑ i, f i = 1) {i : ι} (hd : f i = 1) + {j : ι} (hj : j ≠ i) : f j = 0 := +by + classical + rw [Finset.sum_eq_add_sum_diff_singleton_of_mem (Finset.mem_univ i), hd] at h + simp only [add_eq_left, Finset.sum_eq_zero_iff, Finset.mem_sdiff, Finset.mem_univ, + Finset.mem_singleton, true_and] at h + exact h _ hj + +theorem Finset.sum_nat_eq_one_iff_exists_unique_eq_one + {ι : Type*} [Fintype ι] {f : ι → ℕ} + (h : ∑ i, f i = 1) : + (∃! i : ι, f i = 1) := +by + classical + have this1 : ∀ i : ι, f i ≤ 1 := + by + intro i + by_contra! + have := + calc 1 = ∑ j, f j := h.symm + _ = f i + + ∑ j ∈ Finset.univ \ {i}, f j := + by rw [Finset.sum_eq_add_sum_diff_singleton_of_mem (Finset.mem_univ _)] + _ > 1 + ∑ j ∈ Finset.univ \ {i}, f j := + by + nlinarith + _ ≥ 1 := by norm_num + linarith + have : ∃! i, 1 ≤ f i := + by + apply existsUnique_of_exists_of_unique + · by_contra! + simp only [Nat.lt_one_iff] at this + simp only [this, Finset.sum_const_zero] at h + norm_num at h + · intro y₁ y₂ hy hd + by_contra! + have := + calc + 1 = ∑ i : ι, f i := h.symm + _ = f y₁ + f y₂ + + ∑ i ∈ (Finset.univ \ {y₁}) \ {y₂}, f i := + by + have : y₂ ∈ Finset.univ \ {y₁} := by simp [this.symm] + rw [Finset.sum_eq_add_sum_diff_singleton_of_mem (Finset.mem_univ y₁), + Finset.sum_eq_add_sum_diff_singleton_of_mem this, add_assoc] + _ ≥ 1 + 1 + + ∑ i ∈ (Finset.univ \ {y₁}) \ {y₂}, f i := + by + apply LE.le.ge + linarith + _ ≥ 2 := by norm_num + linarith + obtain ⟨i, ⟨hi, hii⟩⟩ := this + simp_rw [le_antisymm_iff] + use i + simp only [this1, true_and, hi] + exact hii + +theorem QuantumGraph.Real.dim_of_piMat_submodule_eq_zero_iff_eq_zero + {ι : Type*} {p : ι → Type*} [Fintype ι] [DecidableEq ι] + [(i : ι) → Fintype (p i)] [(i : ι) → DecidableEq (p i)] + {φ : (i : ι) → Module.Dual ℂ (Matrix (p i) (p i) ℂ)} + [hφ : ∀ i, (φ i).IsFaithfulPosMap] + : withPiBlockCoalgebraQuantum[φ] + ∀ {A : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p} (hA : QuantumGraph.Real _ A), + hA.toQuantumGraph.dim_of_piMat_submodule = 0 ↔ A = 0 := +by + withPiBlockCoalgebraQuantumCtx[φ] + intro A hA + simp only [QuantumGraph.Real.dim_of_piMat_submodule_eq] + simp_rw [Finset.sum_eq_zero_iff, + Submodule.finrank_eq_zero, + QuantumGraph.Real.PiMat_submodule_eq_bot_iff_proj_comp_adjoint_proj_eq_zero] + constructor + · intro h + rw [LinearMap.eq_sum_conj_adjoint_proj_comp_proj (hφ := hφ) A] + simp only [h _ (Finset.mem_univ _), LinearMap.comp_zero, LinearMap.zero_comp, + Finset.sum_const_zero] + · rintro rfl + simp only [LinearMap.zero_comp, LinearMap.comp_zero, + Finset.mem_univ, imp_self, implies_true] + +theorem QuantumGraph.Real.exists_unique_includeMap_of_adjoint_and_dim_ofPiMat_submodule_eq_one + {ι : Type*} {p : ι → Type*} [Fintype ι] [DecidableEq ι] + [(i : ι) → Fintype (p i)] [(i : ι) → DecidableEq (p i)] + {φ : (i : ι) → Module.Dual ℂ (Matrix (p i) (p i) ℂ)} + [hφ : ∀ i, (φ i).IsFaithfulPosMap] + : withPiBlockCoalgebraQuantum[φ] + ∀ {A : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, (hA : QuantumGraph.Real _ A) → + (hA₂ : LinearMap.adjoint A = A) → + (hd : hA.toQuantumGraph.dim_of_piMat_submodule = 1) → + ∃! i : ι, + LinearMap.adjoint (LinearMap.proj i) + ∘ₗ LinearMap.proj i + ∘ₗ A ∘ₗ LinearMap.adjoint (LinearMap.proj i) ∘ₗ LinearMap.proj i = A := +by + withPiBlockCoalgebraQuantumCtx[φ] + intro A hA hA₂ hd + have hA_neZero := + (not_iff_not.mpr (hA.dim_of_piMat_submodule_eq_zero_iff_eq_zero)).mp + (ne_zero_of_eq_one hd) + simp only [QuantumGraph.Real.dim_of_piMat_submodule_eq] at hd + obtain ⟨i, hi, hii⟩ := Finset.sum_nat_eq_one_iff_exists_unique_eq_one hd + have this₁ : ∀ j ∈ Finset.univ \ {i}, + Module.finrank ℂ (hA.PiMat_submodule j) = 0 := + by + intro j hj + simp only [Finset.mem_sdiff, Finset.mem_univ, Finset.mem_singleton, true_and] at hj + exact Pi.nat_eq_zero_of_sum_eq_one_and_unique_one hd hi hj + have this₂ := (hA.piMat_submodule_finrank_eq_swap_of_adjoint hA₂) + rw [this₂] at hi + have this₃ := Prod.ext_iff.mp (hii _ hi) + simp only [Prod.fst_swap, Prod.snd_swap] at this₃ + simp_rw [Submodule.finrank_eq_zero, + QuantumGraph.Real.PiMat_submodule_eq_bot_iff_proj_comp_adjoint_proj_eq_zero] at this₁ + have : ∑ x ∈ Finset.univ \ {i}, + LinearMap.adjoint (LinearMap.proj x.1) ∘ₗ + ((LinearMap.proj x.1 ∘ₗ A ∘ₗ LinearMap.adjoint (LinearMap.proj x.2))) ∘ₗ LinearMap.proj x.2 + = (0 : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p) := + by + apply Finset.sum_eq_zero + intro j hj + simp only [this₁ _ hj, LinearMap.comp_zero, LinearMap.zero_comp] + have hAA : A = LinearMap.adjoint (LinearMap.proj i.1) + ∘ₗ (LinearMap.proj i.1 ∘ₗ A ∘ₗ LinearMap.adjoint (LinearMap.proj i.1)) + ∘ₗ LinearMap.proj i.1 := + by + nth_rw 1 [LinearMap.eq_sum_conj_adjoint_proj_comp_proj (hφ := hφ) A] + rw [Finset.sum_eq_add_sum_diff_singleton_of_mem (Finset.mem_univ i)] + simp only [this, add_zero] + rw [this₃.1] + refine ⟨i.1, hAA.symm, fun j hj => ?_⟩ + · by_contra! + specialize this₁ (j, j) + simp only [Finset.mem_sdiff, Finset.mem_univ, Finset.mem_singleton, true_and, + Prod.ext_iff, this₃.1, and_self] at this₁ + have := + calc (0 : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p) + = LinearMap.adjoint (LinearMap.proj j) ∘ₗ + (LinearMap.proj j ∘ₗ A ∘ₗ LinearMap.adjoint (LinearMap.proj j)) ∘ₗ LinearMap.proj j := by + simp only [this₁ this, LinearMap.comp_zero, LinearMap.zero_comp] + _ = A := by simp only [LinearMap.comp_assoc, hj] + _ ≠ 0 := hA_neZero + simp only [ne_eq, not_true_eq_false] at this + +theorem QuantumGraph.Real.piFinTwo_same_exists_matrix_map_eq_map_of_adjoint_and_dim_eq_one + : withPiBlockCoalgebraQuantum[ψ] + ∀ (_ : LinearMap.adjoint A = A) + (_ : hA.toQuantumGraph.dim_of_piMat_submodule = 1), + -- (∃ f : Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ, + LinearMap.adjoint (LinearMap.proj (R := ℂ) (φ := fun j => Mat ℂ (PiFinTwo_same n j)) (0 : Fin 2)) + ∘ₗ LinearMap.proj (R := ℂ) (φ := fun j => Mat ℂ (PiFinTwo_same n j)) (0 : Fin 2) + ∘ₗ A + ∘ₗ LinearMap.adjoint + (LinearMap.proj (R := ℂ) (φ := fun j => Mat ℂ (PiFinTwo_same n j)) (0 : Fin 2)) + ∘ₗ LinearMap.proj (R := ℂ) (φ := fun j => Mat ℂ (PiFinTwo_same n j)) (0 : Fin 2) = A + ∨ + -- ∃ f : Matrix n n ℂ →ₗ[ℂ] Matrix n n ℂ, + LinearMap.adjoint + (LinearMap.proj (R := ℂ) (φ := fun j => Mat ℂ (PiFinTwo_same n j)) (1 : Fin 2)) + ∘ₗ LinearMap.proj (R := ℂ) (φ := fun j => Mat ℂ (PiFinTwo_same n j)) (1 : Fin 2) + ∘ₗ A + ∘ₗ LinearMap.adjoint + (LinearMap.proj (R := ℂ) (φ := fun j => Mat ℂ (PiFinTwo_same n j)) (1 : Fin 2)) + ∘ₗ LinearMap.proj (R := ℂ) (φ := fun j => Mat ℂ (PiFinTwo_same n j)) (1 : Fin 2) = A := +by + withPiBlockCoalgebraQuantumCtx[ψ] + intro hA₂ hd + obtain ⟨h₁, h⟩ := hA.piFinTwo_same_piMat_submodule_eq_bot_of_adjoint_and_dim_eq_one hA₂ hd + have h₂ := h₁ + rw [hA.PiMat_submodule_eq_bot_iff_swap_eq_bot_of_adjoint hA₂, + Prod.swap_prod_mk] at h₂ + obtain hf := hA.PiFinTwo_same_exists_proj_conj_add_of_piMat_submodule_eq_bot h₁ h₂ + simp only [hA.PiMat_submodule_eq_bot_iff_proj_comp_adjoint_proj_eq_zero, + Prod.fst_one, Prod.snd_one, Prod.fst_zero, Prod.snd_zero] at h + rcases h with (h | h) + <;> + simp only [h.1, h.2, LinearMap.comp_zero, LinearMap.zero_comp, + add_zero, zero_add, LinearMap.comp_assoc] at hf + · exact Or.inl hf + · exact Or.inr hf + -- exact Or.inl ⟨_, hf⟩ + -- exact Or.inr ⟨_, hf⟩ + +/-- Projection from a dependent product as an algebra homomorphism. -/ +def AlgHom.proj + (R : Type*) {ι : Type*} [CommSemiring R] {φ : ι → Type*} + [(i : ι) → Semiring (φ i)] [(i : ι) → Algebra R (φ i)] (i : ι) : + (Π i, φ i) →ₐ[R] φ i where + toFun x := x i + map_add' _ _ := by simp + map_mul' _ _ := by simp + map_one' := by simp + map_zero' := by simp + commutes' _ := by simp + +theorem AlgHom.proj_apply + {R ι : Type*} [CommSemiring R] {φ : ι → Type*} + [(i : ι) → Semiring (φ i)] [(i : ι) → Algebra R (φ i)] (x : Π i, φ i) (i : ι) : + AlgHom.proj R i x = x i := +rfl + +theorem AlgHom.proj_toLinearMap + {R ι : Type*} [CommSemiring R] {φ : ι → Type*} + [(i : ι) → Semiring (φ i)] [(i : ι) → Algebra R (φ i)] (i : ι) : + (AlgHom.proj R i).toLinearMap = + @LinearMap.proj R ι _ φ _ _ i := +rfl + +/-- Insert one component into a dependent product as a non-unital algebra homomorphism. -/ +def NonUnitalAlgHom.single (R : Type*) {ι : Type*} [CommSemiring R] + [DecidableEq ι] + (φ : ι → Type*) [(i : ι) → Ring (φ i)] + [(i : ι) → Module R (φ i)] (i : ι) : + φ i →ₙₐ[R] (Π i, φ i) where + toFun x := LinearMap.single R φ i x + map_add' _ _ := by simp [Pi.single_add] + map_smul' _ _ := by simp [] + map_mul' _ _ := by simp [Pi.single_mul] + map_zero' := by simp [Pi.single_zero] + +theorem NonUnitalAlgHom.single_apply + {R ι : Type*} [CommSemiring R] [DecidableEq ι] + {φ : ι → Type*} [(i : ι) → Ring (φ i)] + [(i : ι) → Module R (φ i)] (i : ι) (x : φ i) : + NonUnitalAlgHom.single R φ i x = Pi.single i x := +rfl + +theorem NonUnitalAlgHom.single_toLinearMap + {R ι : Type*} [CommSemiring R] [DecidableEq ι] + {φ : ι → Type*} [(i : ι) → Ring (φ i)] + [(i : ι) → Module R (φ i)] (i : ι) : + (LinearMapClass.linearMap (NonUnitalAlgHom.single R φ i) : φ i →ₗ[R] (Π i, φ i)) = + LinearMap.single R φ i := +rfl + +theorem LinearMap.single_isReal + {R ι : Type*} [DecidableEq ι] [Semiring R] {φ : ι → Type*} + [(i : ι) → AddCommMonoid (φ i)] [(i : ι) → Module R (φ i)] + [(i : ι) → StarAddMonoid (φ i)] (i : ι) : + LinearMap.IsReal (LinearMap.single R φ i) := +by + intro x + ext j + by_cases h : j = i + · subst j + simp [LinearMap.single_apply] + · simp [LinearMap.single_apply, Pi.single_eq_of_ne h] + +theorem LinearMap.proj_isReal + {R ι : Type*} [Semiring R] {φ : ι → Type*} + [(i : ι) → AddCommMonoid (φ i)] [(i : ι) → Module R (φ i)] + [(i : ι) → StarAddMonoid (φ i)] (i : ι) : + LinearMap.IsReal (LinearMap.proj (R := R) (φ := φ) i) := +by intro; simp + +theorem LinearMap.single_comp_inj + {R ι B : Type*} [Semiring R] {φ : ι → Type*} [(i : ι) → AddCommMonoid (φ i)] + [AddCommMonoid B] [Module R B] [(i : ι) → Module R (φ i)] [DecidableEq ι] (i : ι) + (f g : B →ₗ[R] φ i) : + LinearMap.single R φ i ∘ₗ f = LinearMap.single R φ i ∘ₗ g ↔ f = g := +by + simp only [LinearMap.ext_iff, LinearMap.comp_apply, + LinearMap.single_apply, Pi.single_inj] + +theorem LinearMap.comp_proj_inj + {R ι B : Type*} [Semiring R] {φ : ι → Type*} [(i : ι) → AddCommMonoid (φ i)] + [AddCommMonoid B] [Module R B] [(i : ι) → Module R (φ i)] (i : ι) + (f g : φ i →ₗ[R] B) : + f ∘ₗ LinearMap.proj (R := R) i = g ∘ₗ LinearMap.proj (R := R) i ↔ f = g := +by + classical + simp only [LinearMap.ext_iff, LinearMap.comp_apply, + LinearMap.proj_apply] + refine ⟨fun h x => ?_, fun h _ => h _⟩ + simpa only [Pi.single_eq_same] using h (Pi.single i x) + +theorem LinearMap.proj_comp_inj + {R ι B : Type*} [Semiring R] {φ : ι → Type*} [(i : ι) → AddCommMonoid (φ i)] + [AddCommMonoid B] [Module R B] [(i : ι) → Module R (φ i)] + (f g : B →ₗ[R] Π r, φ r) : + (∀ i, LinearMap.proj (R := R) i ∘ₗ f = LinearMap.proj (R := R) i ∘ₗ g) ↔ f = g := +by + classical + simp only [LinearMap.ext_iff, LinearMap.comp_apply, + LinearMap.proj_apply, funext_iff] + rw [forall_comm] + +theorem NonUnitalAlgHom.id_toLinearMap + {R A : Type*} [Semiring R] [NonUnitalNonAssocSemiring A] [Module R A] : + (LinearMapClass.linearMap (NonUnitalAlgHom.id R A) : A →ₗ[R] A) = 1 := +rfl + +theorem QuantumGraph.Real.conj_proj_isReal + : withPiBlockCoalgebraQuantum[φ] + ∀ {f : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + (hf : QuantumGraph.Real _ f) → ∀ (i : ι), + QuantumGraph.Real _ + ((LinearMap.proj (R := ℂ) i) ∘ₗ f ∘ₗ LinearMap.adjoint (LinearMap.proj (R := ℂ) i)) := +by + withPiBlockCoalgebraQuantumCtx[φ] + intro f hf i + simp only [QuantumGraph.real_iff, LinearMap.isReal_iff, + LinearMap.real_comp] + simp only [LinearMap.proj_adjoint, + LinearMap.real_of_isReal (LinearMap.single_isReal (R := ℂ) (ι := ι) (φ := fun r => + Mat ℂ (p r)) _), + LinearMap.real_of_isReal (LinearMap.proj_isReal (R := ℂ) (ι := ι) + (φ := fun r => Mat ℂ (p r)) _), LinearMap.real_of_isReal hf.2, and_true] + rw [← LinearMap.proj_adjoint, + ← AlgHom.proj_toLinearMap] + simp_rw [QuantumSet.schurMul_algHom_comp_algHom_adjoint, hf.1] + +open scoped Classical in +omit [DecidableEq ι] [(i : ι) → DecidableEq (p i)] in +lemma schurMul_proj_adjoint_comp + {B : Type*} [starAlgebra B] [QuantumSet B] + : letI : DecidableEq ι := Classical.decEq ι + letI : ∀ i, DecidableEq (p i) := fun i => Classical.decEq (p i) + withPiBlockQuantum[φ] + ∀ (i : ι) (f g : B →ₗ[ℂ] Mat ℂ (p i)), + (LinearMap.adjoint (LinearMap.proj i) ∘ₗ f) •ₛ (LinearMap.adjoint (LinearMap.proj i) ∘ₗ g) + = LinearMap.adjoint (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i) + ∘ₗ (f •ₛ g) := +by + classical + withPiBlockQuantumCtx[φ] + intro i f g + simp only [LinearMap.proj_adjoint, ← NonUnitalAlgHom.single_toLinearMap, + schurMul_apply_apply, TensorProduct.map_comp] + simp only [← LinearMap.comp_assoc] + congr 2 + exact Eq.symm (nonUnitalAlgHom_comp_mul (NonUnitalAlgHom.single ℂ (fun r ↦ Mat ℂ (p r)) i)) + +open scoped Classical in +omit [Fintype ι] [DecidableEq ι] [(i : ι) → DecidableEq (p i)] in +lemma schurMul_proj_comp + {B : Type*} [starAlgebra B] [QuantumSet B] [Finite ι] + : letI : DecidableEq ι := Classical.decEq ι + letI : ∀ i, DecidableEq (p i) := fun i => Classical.decEq (p i) + withPiBlockQuantum[φ] + ∀ (f g : B →ₗ[ℂ] PiMat ℂ ι p) (i : ι), + ((LinearMap.proj i) ∘ₗ f) •ₛ ((LinearMap.proj i) ∘ₗ g) + = (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i) + ∘ₗ (f •ₛ g) := +by + classical + letI := Fintype.ofFinite ι + withPiBlockQuantumCtx[φ] + intro f g i + simp only [schurMul_apply_apply, TensorProduct.map_comp] + simp only [← LinearMap.comp_assoc] + congr 2 + rw [← AlgHom.proj_toLinearMap] + exact TensorProduct.map_mul'_commute_iff.mpr fun x ↦ congrFun rfl + +lemma schurMul_comp_proj + {B : Type*} [starAlgebra B] [QuantumSet B] + : withPiBlockCoalgebraQuantum[φ] + ∀ (i : ι), + withMatrixQuantum[φ i] + letI := (Coalgebra.ofFiniteDimensionalHilbertAlgebra (R := ℂ) (A := + Mat ℂ (p i))).toCoalgebraStruct + ∀ (f g : Mat ℂ (p i) →ₗ[ℂ] B), + ((f ∘ₗ (LinearMap.proj i)) •ₛ (g ∘ₗ (LinearMap.proj i))) + = (f •ₛ g) ∘ₗ (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i) := +by + withPiBlockCoalgebraQuantumCtx[φ] + intro i + withMatrixQuantumCtx[φ i] + letI := (Coalgebra.ofFiniteDimensionalHilbertAlgebra (R := ℂ) (A := + Mat ℂ (p i))).toCoalgebraStruct + intro f g + simp only [schurMul_apply_apply, TensorProduct.map_comp] + simp only [← LinearMap.comp_assoc] + have hcomul : + TensorProduct.map + (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i) + (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i) ∘ₗ + Coalgebra.comul = + Coalgebra.comul ∘ₗ + LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i := by + apply_fun LinearMap.adjoint using LinearEquiv.injective _ + simp only [Coalgebra.comul_eq_mul_adjoint, LinearMap.adjoint_comp, + LinearMap.adjoint_adjoint, TensorProduct.map_adjoint] + rw [LinearMap.proj_adjoint, ← NonUnitalAlgHom.single_toLinearMap] + have hadj : + LinearMap.adjoint (Coalgebra.comul : + PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p ⊗[ℂ] PiMat ℂ ι p) = + LinearMap.mul' ℂ (PiMat ℂ ι p) := by + exact LinearMap.adjoint_adjoint (LinearMap.mul' ℂ (PiMat ℂ ι p)) + rw [hadj] + exact (nonUnitalAlgHom_comp_mul + (NonUnitalAlgHom.single ℂ (fun r => Mat ℂ (p r)) i)).symm + calc + ((LinearMap.mul' ℂ B ∘ₗ TensorProduct.map f g) ∘ₗ + TensorProduct.map + (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i) + (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i)) ∘ₗ + Coalgebra.comul = + (LinearMap.mul' ℂ B ∘ₗ TensorProduct.map f g) ∘ₗ + (TensorProduct.map + (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i) + (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i) ∘ₗ + Coalgebra.comul) := by + rw [LinearMap.comp_assoc] + _ = + (LinearMap.mul' ℂ B ∘ₗ TensorProduct.map f g) ∘ₗ + (Coalgebra.comul ∘ₗ + LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i) := by + rw [hcomul] + _ = + ((LinearMap.mul' ℂ B ∘ₗ TensorProduct.map f g) ∘ₗ Coalgebra.comul) ∘ₗ + LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i := by + rw [← LinearMap.comp_assoc] + +lemma schurMul_comp_proj_adjoint + {B : Type*} [starAlgebra B] [QuantumSet B] + : withPiBlockCoalgebraQuantum[φ] + ∀ (f g : PiMat ℂ ι p →ₗ[ℂ] B) (i : ι), + withMatrixQuantum[φ i] + letI := (Coalgebra.ofFiniteDimensionalHilbertAlgebra (R := ℂ) (A := + Mat ℂ (p i))).toCoalgebraStruct + (f ∘ₗ LinearMap.adjoint (LinearMap.proj i)) •ₛ (g ∘ₗ LinearMap.adjoint (LinearMap.proj i)) + = (f •ₛ g) ∘ₗ LinearMap.adjoint (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i) := +by + withPiBlockCoalgebraQuantumCtx[φ] + intro f g i + withMatrixQuantumCtx[φ i] + letI := (Coalgebra.ofFiniteDimensionalHilbertAlgebra (R := ℂ) (A := + Mat ℂ (p i))).toCoalgebraStruct + simp only [LinearMap.proj_adjoint, ← NonUnitalAlgHom.single_toLinearMap, + schurMul_apply_apply, TensorProduct.map_comp] + simp only [← LinearMap.comp_assoc] + have hcomul : + TensorProduct.map + (LinearMapClass.linearMap (NonUnitalAlgHom.single ℂ (fun r => Mat ℂ (p r)) i)) + (LinearMapClass.linearMap (NonUnitalAlgHom.single ℂ (fun r => Mat ℂ (p r)) i)) ∘ₗ + Coalgebra.comul = + Coalgebra.comul ∘ₗ + LinearMapClass.linearMap (NonUnitalAlgHom.single ℂ (fun r => Mat ℂ (p r)) i) := by + apply_fun LinearMap.adjoint using LinearEquiv.injective _ + simp only [Coalgebra.comul_eq_mul_adjoint, LinearMap.adjoint_comp, + LinearMap.adjoint_adjoint, TensorProduct.map_adjoint] + have hsingle : + LinearMap.adjoint + (LinearMapClass.linearMap + (NonUnitalAlgHom.single ℂ (fun r => Mat ℂ (p r)) i) : + Mat ℂ (p i) →ₗ[ℂ] PiMat ℂ ι p) = + LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i := by + rw [NonUnitalAlgHom.single_toLinearMap] + rw [← LinearMap.proj_adjoint] + exact LinearMap.adjoint_adjoint _ + have hadjMat : + LinearMap.adjoint (Coalgebra.comul : + Mat ℂ (p i) →ₗ[ℂ] Mat ℂ (p i) ⊗[ℂ] Mat ℂ (p i)) = + LinearMap.mul' ℂ (Mat ℂ (p i)) := by + exact LinearMap.adjoint_adjoint (LinearMap.mul' ℂ (Mat ℂ (p i))) + have hadjPi : + LinearMap.adjoint (Coalgebra.comul : + PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p ⊗[ℂ] PiMat ℂ ι p) = + LinearMap.mul' ℂ (PiMat ℂ ι p) := by + exact LinearMap.adjoint_adjoint (LinearMap.mul' ℂ (PiMat ℂ ι p)) + rw [hsingle] + simp only [hadjPi] + rw [← AlgHom.proj_toLinearMap] + exact TensorProduct.map_mul'_commute_iff.mpr fun x => congrFun rfl + calc + ((LinearMap.mul' ℂ B ∘ₗ TensorProduct.map f g) ∘ₗ + TensorProduct.map + (LinearMapClass.linearMap (NonUnitalAlgHom.single ℂ (fun r => Mat ℂ (p r)) i)) + (LinearMapClass.linearMap (NonUnitalAlgHom.single ℂ (fun r => Mat ℂ (p r)) i))) ∘ₗ + Coalgebra.comul = + (LinearMap.mul' ℂ B ∘ₗ TensorProduct.map f g) ∘ₗ + (TensorProduct.map + (LinearMapClass.linearMap (NonUnitalAlgHom.single ℂ (fun r => Mat ℂ (p r)) i)) + (LinearMapClass.linearMap (NonUnitalAlgHom.single ℂ (fun r => Mat ℂ (p r)) i)) ∘ₗ + Coalgebra.comul) := by + rw [LinearMap.comp_assoc] + _ = + (LinearMap.mul' ℂ B ∘ₗ TensorProduct.map f g) ∘ₗ + (Coalgebra.comul ∘ₗ + LinearMapClass.linearMap (NonUnitalAlgHom.single ℂ (fun r => Mat ℂ (p r)) i)) := by + rw [hcomul] + _ = + ((LinearMap.mul' ℂ B ∘ₗ TensorProduct.map f g) ∘ₗ Coalgebra.comul) ∘ₗ + LinearMapClass.linearMap (NonUnitalAlgHom.single ℂ (fun r => Mat ℂ (p r)) i) := by + rw [← LinearMap.comp_assoc] + +theorem QuantumGraph.isReal_iff_conj_proj_adjoint_isReal + : withPiBlockCoalgebraQuantum[φ] + ∀ (i : ι), + withMatrixQuantum[φ i] + letI := (Coalgebra.ofFiniteDimensionalHilbertAlgebra (R := ℂ) (A := + Mat ℂ (p i))).toCoalgebraStruct + ∀ (f : Mat ℂ (p i) →ₗ[ℂ] Mat ℂ (p i)), + QuantumGraph.Real _ f + ↔ + QuantumGraph.Real (PiMat ℂ ι p) + (LinearMap.adjoint (LinearMap.proj i) ∘ₗ f ∘ₗ LinearMap.proj i) := +by + withPiBlockCoalgebraQuantumCtx[φ] + intro i + withMatrixQuantumCtx[φ i] + letI := (Coalgebra.ofFiniteDimensionalHilbertAlgebra (R := ℂ) (A := + Mat ℂ (p i))).toCoalgebraStruct + intro f + simp only [QuantumGraph.real_iff, LinearMap.isReal_iff, LinearMap.real_comp] + simp only [← LinearMap.comp_assoc] + rw [schurMul_comp_proj, schurMul_proj_adjoint_comp] + rw [LinearMap.proj_adjoint] + nth_rw 2 [LinearMap.real_of_isReal (LinearMap.single_isReal i)] + nth_rw 3 [LinearMap.real_of_isReal (LinearMap.proj_isReal i)] + rw [LinearMap.comp_proj_inj (R := ℂ) (ι := ι) (φ := fun r => Mat ℂ (p r)) i, + LinearMap.comp_proj_inj (R := ℂ) (ι := ι) (φ := fun r => Mat ℂ (p r)) i] + rw [LinearMap.single_comp_inj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i, + LinearMap.single_comp_inj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i] + +theorem QuantumGraph.Real.proj_adjoint_comp_proj_conj_isRealQuantumGraph + : withPiBlockCoalgebraQuantum[φ] + ∀ {f : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + (hf : QuantumGraph.Real (PiMat ℂ ι p) f) → ∀ (i : ι × ι), + QuantumGraph.Real (PiMat ℂ ι p) + (LinearMap.adjoint (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i.1) + ∘ₗ LinearMap.proj i.1 + ∘ₗ f + ∘ₗ LinearMap.adjoint (LinearMap.proj i.2) + ∘ₗ LinearMap.proj i.2) := +by + withPiBlockCoalgebraQuantumCtx[φ] + intro f hf i + constructor + · rw [schurMul_proj_adjoint_comp (hφ := hφ), schurMul_proj_comp (hφ := hφ)] + simp only [← LinearMap.comp_assoc] + rw [schurMul_comp_proj, schurMul_comp_proj_adjoint] + simp only [LinearMap.comp_assoc, hf.1] + · simp only [LinearMap.isReal_iff, LinearMap.real_comp, + LinearMap.proj_adjoint, LinearMap.real_of_isReal + (LinearMap.single_isReal (R := ℂ) (φ := fun r => Mat ℂ (p r)) _), + LinearMap.real_of_isReal (LinearMap.proj_isReal (R := ℂ) (φ := fun r => Mat ℂ (p r)) _), + LinearMap.real_of_isReal hf.2] + +open scoped Classical in +omit [DecidableEq ι] [(i : ι) → DecidableEq (p i)] in +theorem schurMul_proj_adjoint_comp_of_ne_eq_zero + {B : Type*} [starAlgebra B] [QuantumSet B] + : letI : DecidableEq ι := Classical.decEq ι + letI : ∀ i, DecidableEq (p i) := fun i => Classical.decEq (p i) + withPiBlockQuantum[φ] + ∀ {i j : ι} (_ : i ≠ j) + (f : B →ₗ[ℂ] Mat ℂ (p i)) + (g : B →ₗ[ℂ] Mat ℂ (p j)), + (LinearMap.adjoint (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i) + ∘ₗ f) + •ₛ + (LinearMap.adjoint (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) j) + ∘ₗ g) + = 0 := +by + classical + withPiBlockQuantumCtx[φ] + intro i j hij f g + simp only [schurMul_apply_apply, TensorProduct.map_comp, ← LinearMap.comp_assoc] + have : LinearMap.mul' ℂ ((i : ι) → Mat ℂ (p i)) + ∘ₗ TensorProduct.map + (LinearMap.adjoint (LinearMap.proj (R := ℂ) i)) + (LinearMap.adjoint (LinearMap.proj j)) + = 0 := + by + apply TensorProduct.ext' + intro x y + simp only [LinearMap.comp_apply, TensorProduct.map_tmul, LinearMap.mul'_apply, + LinearMap.proj_adjoint_apply, LinearMap.zero_apply] + exact Matrix.includeBlock_hMul_ne_same hij x y + simp_rw [this, LinearMap.zero_comp] + +theorem schurMul_comp_proj_of_ne_eq_zero + {B : Type*} [starAlgebra B] [QuantumSet B] + : withPiBlockCoalgebraQuantum[φ] + ∀ {i j : ι} (_ : i ≠ j) + (f : Mat ℂ (p i) →ₗ[ℂ] B) + (g : Mat ℂ (p j) →ₗ[ℂ] B), + (f ∘ₗ LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i) + •ₛ + (g ∘ₗ LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) j) + = 0 := +by + withPiBlockCoalgebraQuantumCtx[φ] + intro i j hij f g + simp only [schurMul_apply_apply, TensorProduct.map_comp] + simp only [← LinearMap.comp_assoc] + have hcomul : + TensorProduct.map + (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i) + (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) j) ∘ₗ + Coalgebra.comul = 0 := by + apply_fun LinearMap.adjoint using LinearEquiv.injective _ + simp only [map_zero, + LinearMap.adjoint_comp, TensorProduct.map_adjoint] + rw [LinearMap.proj_adjoint, LinearMap.proj_adjoint, + ← NonUnitalAlgHom.single_toLinearMap, ← NonUnitalAlgHom.single_toLinearMap] + have hadj : + LinearMap.adjoint (Coalgebra.comul : + PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p ⊗[ℂ] PiMat ℂ ι p) = + LinearMap.mul' ℂ (PiMat ℂ ι p) := by + exact LinearMap.adjoint_adjoint (LinearMap.mul' ℂ (PiMat ℂ ι p)) + rw [hadj] + change LinearMap.mul' ℂ ((i : ι) → Mat ℂ (p i)) ∘ₗ + TensorProduct.map + (LinearMapClass.linearMap (NonUnitalAlgHom.single ℂ (fun r => Mat ℂ (p r)) i)) + (LinearMapClass.linearMap (NonUnitalAlgHom.single ℂ (fun r => Mat ℂ (p r)) j)) = + 0 + apply TensorProduct.ext' + intro x y + ext k + by_cases hki : k = i + · subst k + simp [LinearMap.comp_apply, TensorProduct.map_tmul, LinearMap.mul'_apply, + NonUnitalAlgHom.single_apply, Pi.single_eq_of_ne hij] + · simp [LinearMap.comp_apply, TensorProduct.map_tmul, LinearMap.mul'_apply, + NonUnitalAlgHom.single_apply, Pi.single_eq_of_ne hki] + calc + ((LinearMap.mul' ℂ B ∘ₗ TensorProduct.map f g) ∘ₗ + TensorProduct.map + (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i) + (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) j)) ∘ₗ + Coalgebra.comul = + (LinearMap.mul' ℂ B ∘ₗ TensorProduct.map f g) ∘ₗ + (TensorProduct.map + (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i) + (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) j) ∘ₗ + Coalgebra.comul) := by + rw [LinearMap.comp_assoc] + _ = 0 := by + rw [hcomul] + simp + +theorem piMat_isRealQuantumGraph_iff_forall_conj_adjoint_proj_comp_proj + : withPiBlockCoalgebraQuantum[φ] + ∀ {f : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + QuantumGraph.Real (PiMat ℂ ι p) f + ↔ + ∀ i : ι × ι, QuantumGraph.Real (PiMat ℂ ι p) + (LinearMap.adjoint (LinearMap.proj (R := ℂ) (φ := fun r => Mat ℂ (p r)) i.1) + ∘ₗ LinearMap.proj i.1 + ∘ₗ f + ∘ₗ LinearMap.adjoint (LinearMap.proj i.2) + ∘ₗ LinearMap.proj i.2) := +by + withPiBlockCoalgebraQuantumCtx[φ] + intro f + refine ⟨fun h i => h.proj_adjoint_comp_proj_conj_isRealQuantumGraph i, fun h => ?_⟩ + constructor + · rw [LinearMap.eq_sum_conj_adjoint_proj_comp_proj (hφ := hφ) f] + simp only [map_sum, LinearMap.sum_apply] + congr + ext1 i + rw [Finset.sum_eq_add_sum_diff_singleton_of_mem (Finset.mem_univ i)] + simp only [LinearMap.comp_assoc, (h i).1, add_eq_left] + apply Finset.sum_eq_zero + intro j hj + simp only [Finset.mem_sdiff, Finset.mem_univ, Finset.mem_singleton, true_and] at hj + rw [Prod.eq_iff_fst_eq_snd_eq, not_and_or] at hj + rcases hj with (h | h) + · rw [schurMul_proj_adjoint_comp_of_ne_eq_zero h] + · simp only [← LinearMap.comp_assoc] + rw [schurMul_comp_proj_of_ne_eq_zero h] + · simp only [LinearMap.isReal_iff] + rw [LinearMap.eq_sum_conj_adjoint_proj_comp_proj (hφ := hφ) f] + simp only [LinearMap.real_sum, + LinearMap.comp_assoc, LinearMap.real_of_isReal (h _).2] + +theorem Pi.single_zero_piFinTwo_same_apply (x : Matrix n n ℂ) : + (Pi.single 0 x : PiMat ℂ (Fin 2) _) = + MatProd_algEquiv_PiMat (PiFinTwo_same n) (x, 0) := +by + ext1 + simp [MatProd_algEquiv_PiMat, Pi.single, Function.update] + rfl +theorem Pi.single_one_piFinTwo_same_apply (x : Matrix n n ℂ) : + (Pi.single 1 x : PiMat ℂ (Fin 2) _) = + MatProd_algEquiv_PiMat (PiFinTwo_same n) (0, x) := +by + simp only [funext_iff, Fin.forall_fin_two, MatProd_algEquiv_PiMat, + matrixPiFinTwo_algEquiv_prod_symm_apply, + single_eq_same, dite_true, single_eq_of_ne (zero_ne_one' _), + one_ne_zero, dite_false] + exact ⟨rfl, rfl⟩ + +theorem + PiMat_finTwo_same_swap_swap (x : PiMat ℂ (Fin 2) (PiFinTwo_same n)) : + PiMat_finTwo_same_swapAlgEquiv + (PiMat_finTwo_same_swapAlgEquiv x) = x := +by simp [PiMat_finTwo_same_swapAlgEquiv] + +theorem PiMat_finTwo_same_swapAlgEquiv_apply_piSingle_zero (x : Matrix n n ℂ) : + PiMat_finTwo_same_swapAlgEquiv (Pi.single 0 x) = + (Pi.single 1 x : PiMat ℂ (Fin 2) (PiFinTwo_same n)) := +by + simp only [Pi.single_zero_piFinTwo_same_apply, + PiMat_finTwo_same_swapAlgEquiv_apply, Pi.single_one_piFinTwo_same_apply] + +theorem PiMat_finTwo_same_swapAlgEquiv_comp_linearMapSingle_zero : + PiMat_finTwo_same_swapAlgEquiv.toLinearMap.comp (LinearMap.single ℂ _ 0) = + (LinearMap.single ℂ _ 1 : _ →ₗ[ℂ] PiMat ℂ (Fin 2) (PiFinTwo_same n)) := +by + simp only [LinearMap.ext_iff, LinearMap.comp_apply, + LinearMap.single_apply] + exact PiMat_finTwo_same_swapAlgEquiv_apply_piSingle_zero + +theorem PiMat_finTwo_same_swapAlgEquiv_apply_piSingle_one (x : Matrix n n ℂ) : + PiMat_finTwo_same_swapAlgEquiv (Pi.single 1 x) = + (Pi.single 0 x : PiMat ℂ (Fin 2) (PiFinTwo_same n)) := +by + rw [← PiMat_finTwo_same_swapAlgEquiv_apply_piSingle_zero, + PiMat_finTwo_same_swap_swap] + +theorem PiMat_finTwo_same_swapAlgEquiv_comp_linearMapSingle_one : + PiMat_finTwo_same_swapAlgEquiv.toLinearMap ∘ₗ (LinearMap.single ℂ _ 1) = + (LinearMap.single ℂ _ 0 : _ →ₗ[ℂ] PiMat ℂ (Fin 2) (PiFinTwo_same n)) := +by + simp only [LinearMap.ext_iff, LinearMap.comp_apply, + LinearMap.single_apply] + exact PiMat_finTwo_same_swapAlgEquiv_apply_piSingle_one + +theorem QuantumGraph.Real.schurProjection_proj_conj + : withPiBlockCoalgebraQuantum[φ] + ∀ {f : PiMat ℂ ι p →ₗ[ℂ] PiMat ℂ ι p}, + (hf : QuantumGraph.Real _ f) → ∀ (i : ι × ι), + schurProjection (A := Mat ℂ (p i.2)) (B := Mat ℂ (p i.1)) + ((LinearMap.proj (R := ℂ) i.1) ∘ₗ f + ∘ₗ (LinearMap.adjoint (LinearMap.proj i.2))) := +by + withPiBlockCoalgebraQuantumCtx[φ] + intro f hf i + constructor + · rw [schurMul_proj_comp (hφ := hφ), schurMul_comp_proj_adjoint (hφ := hφ), hf.1] + · rw [LinearMap.isReal_iff] + simp_rw [LinearMap.real_comp, LinearMap.real_of_isReal hf.2, LinearMap.proj_adjoint, + LinearMap.real_of_isReal (LinearMap.proj_isReal (φ := fun r => Mat ℂ (p r)) _), + LinearMap.real_of_isReal (LinearMap.single_isReal (φ := fun r => Mat ℂ (p r)) _)] diff --git a/LeanPool/Monlib4/QuantumGraph/QamA.lean b/LeanPool/Monlib4/QuantumGraph/QamA.lean new file mode 100644 index 0000000000..b1e529dd5a --- /dev/null +++ b/LeanPool/Monlib4/QuantumGraph/QamA.lean @@ -0,0 +1,1198 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.QuantumGraph.ToProjections + +/-! + +# Single-edged quantum graphs + +This file defines the single-edged quantum graph, and proves that it is a `QAM`. + +-/ + + +variable {n : Type _} [Fintype n] [DecidableEq n] + +open scoped TensorProduct BigOperators Kronecker Functional +-- local notation `ℍ` := matrix (n i) (n i) ℂ +@[reducible] +local notation "ℍ" => Matrix n n ℂ +@[reducible] +local notation "ℍ_" i => Matrix (n i) (n i) ℂ + +-- local notation `⊗K` := matrix (n × n) (n × n) ℂ +@[reducible] +local notation "l(" x ")" => x →ₗ[ℂ] x +@[reducible] +local notation "L(" x ")" => x →L[ℂ] x +@[reducible] +local notation "e_{" i "," j "}" => Matrix.stdBasisMatrix i j (1 : ℂ) + +variable {φ : Module.Dual ℂ (Matrix n n ℂ)} + --{φ : Π i, module.dual ℂ (ℍ_ i)} + --[hφ : ∀ i, fact (φ i).is_faithful_pos_map] + +open scoped Matrix + +open Matrix + +local notation "|" x "⟩⟨" y "|" => @rankOne ℂ _ _ _ _ _ _ _ x y + +local notation "m" => LinearMap.mul' ℂ ℍ + +local notation "η" => Algebra.linearMap ℂ ℍ + +local notation x " ⊗ₘ " y => TensorProduct.map x y + +local notation "υ" => (TensorProduct.assoc ℂ ℍ ℍ ℍ : (ℍ ⊗[ℂ] ℍ) ⊗[ℂ] ℍ →ₗ[ℂ] ℍ ⊗[ℂ] ℍ ⊗[ℂ] ℍ) + +local notation "υ⁻¹" => + (LinearEquiv.symm (TensorProduct.assoc ℂ ℍ ℍ ℍ) : ℍ ⊗[ℂ] ℍ ⊗[ℂ] ℍ →ₗ[ℂ] (ℍ ⊗[ℂ] ℍ) ⊗[ℂ] ℍ) + +local notation "ϰ" => ((TensorProduct.comm ℂ ℍ ℂ) : ℍ ⊗[ℂ] ℂ →ₗ[ℂ] ℂ ⊗[ℂ] ℍ) + +local notation "ϰ⁻¹" => (LinearEquiv.symm (TensorProduct.comm ℂ ℍ ℂ) : ℂ ⊗[ℂ] ℍ →ₗ[ℂ] ℍ ⊗[ℂ] ℂ) + +local notation "τ" => (TensorProduct.lid ℂ ℍ : ℂ ⊗[ℂ] ℍ →ₗ[ℂ] ℍ) + +local notation "τ⁻¹" => (LinearEquiv.symm (TensorProduct.lid ℂ ℍ) : ℍ →ₗ[ℂ] ℂ ⊗[ℂ] ℍ) + +local notation "id" => (1 : ℍ →ₗ[ℂ] ℍ) + +/-- The rank-one quantum adjacency map associated to a nonzero matrix. -/ +noncomputable def qamA (hφ : φ.IsFaithfulPosMap) + (x : { x : ℍ // x ≠ 0 }) :--(hx : x ≠ 0) : + ℍ →ₗ[ℂ] + ℍ := by + letI : φ.IsFaithfulPosMap := hφ + withMatrixQuantumCtx[φ] + exact + (1 / (‖x.1‖ ^ 2 : ℂ)) • + (LinearMap.mulLeft ℂ (x.1 * φ.matrix) * + LinearMap.adjoint (LinearMap.mulRight ℂ (φ.matrix * x.1))) + +theorem qamA_eq [hφ : φ.IsFaithfulPosMap] (x : { x : ℍ // x ≠ 0 }) : + qamA hφ x = + withMatrixQuantum[φ] + ((1 / (‖x.1‖ ^ 2 : ℂ)) • + (LinearMap.mulLeft ℂ (x.1 * φ.matrix) * + LinearMap.adjoint (LinearMap.mulRight ℂ (φ.matrix * x.1)))) := by + withMatrixQuantumCtx[φ] + rfl + +theorem qamA.toMatrix [hφ : φ.IsFaithfulPosMap] (x : { x : ℍ // x ≠ 0 }) : + withMatrixQuantum[φ] + (hφ.toMatrix (qamA hφ x) = + (1 / ‖x.1‖ ^ 2 : ℂ) • + (x.1 * φ.matrix) ⊗ₖ + (hφ.matrixIsPosDef.rpow (1 / 2) * x.1 * hφ.matrixIsPosDef.rpow (1 / 2))ᴴᵀ) := + by + withMatrixQuantumCtx[φ] + simp only [qamA_eq, _root_.map_smul, _root_.map_mul, LinearMap.mulLeft_toMatrix, + LinearMap.matrix.mulRight_adjoint, LinearMap.mulRight_toMatrix, + Module.Dual.IsFaithfulPosMap.sig_apply_sig, Matrix.conjTranspose_mul, + hφ.matrixIsPosDef.1.eq, ← Matrix.mul_kronecker_mul, Matrix.one_mul, + Matrix.mul_one] + have : + (hφ.sig (1 / 2 + -1)) (x.1ᴴ * φ.matrix) = + (hφ.matrixIsPosDef.rpow (1 / 2) * x.1 * + hφ.matrixIsPosDef.rpow (1 / 2))ᴴ := + calc + (hφ.sig (1 / 2 + -1)) (x.1ᴴ * φ.matrix) = + hφ.matrixIsPosDef.rpow (1 / 2) * x.1ᴴ * φ.matrix * + hφ.matrixIsPosDef.rpow (-(1 / 2)) := + by simp only [Module.Dual.IsFaithfulPosMap.sig_apply, Matrix.mul_assoc]; norm_num + _ = + hφ.matrixIsPosDef.rpow (1 / 2) * x.1ᴴ * hφ.matrixIsPosDef.rpow 1 * + hφ.matrixIsPosDef.rpow (-(1 / 2)) := + by simp only [Matrix.PosDef.rpow_one_eq_self] + _ = + (hφ.matrixIsPosDef.rpow (1 / 2) * x.1 * + hφ.matrixIsPosDef.rpow (1 / 2))ᴴ := + by + simp only [Matrix.PosDef.rpow_mul_rpow, Matrix.conjTranspose_mul, + (Matrix.PosDef.rpow.isPosDef _ _).1.eq, Matrix.mul_assoc] + norm_num + rw [Matrix.conj, ← this, ← _root_.map_mul] + +@[reducible, instance] +private noncomputable def has_smul.units_matrix_ne_zero : SMul ℂˣ { x : Matrix n n ℂ // x ≠ 0 } + where smul α x := + (⟨((α : ℂ) • x.1 : Matrix n n ℂ), + smul_ne_zero (Units.ne_zero α) (Set.mem_setOf.mp (Subtype.mem x))⟩ : + { x : Matrix n n ℂ // x ≠ 0 }) + +omit [Fintype n] [DecidableEq n] in +private theorem has_smul.units_matrix_ne_zero_coe (x : { x : Matrix n n ℂ // x ≠ 0 }) (α : ℂˣ) : + (α • x : { x : Matrix n n ℂ // x ≠ 0 }).1 = (α : ℂ) • x.1 := + rfl + +open Matrix + +/-- given a non-zero matrix $x$, we always get $A(x)$ is non-zero -/ +theorem qamA.ne_zero [hφ : φ.IsFaithfulPosMap] (x : { x : Matrix n n ℂ // x ≠ 0 }) : + qamA hφ x ≠ 0 := + by + withMatrixQuantumCtx[φ] + have hx := x.property + simp_rw [ne_eq, qamA, smul_eq_zero, div_eq_zero_iff, one_ne_zero, false_or, sq_eq_zero_iff, + Complex.ofReal_eq_zero, norm_eq_zero, hx, false_or, ← rankOne_toMatrix_transpose_psi_symm, + ← oneMapTranspose_symm_eq, LinearEquiv.map_eq_zero_iff, StarAlgEquiv.map_eq_zero_iff, + AlgEquiv.map_eq_zero_iff, ContinuousLinearMap.coe_eq_zero, rankOne.eq_zero_iff, or_self_iff, hx, + not_false_iff] + +/-- Given any non-zero matrix $x$ and non-zero $\alpha\in\mathbb{C}$ we have + $$A(\alpha x)=A(x),$$ + in other words, it is not injective. However, it `is_almost_injective` (see + `qam_A.is_almost_injective`). -/ +theorem qamA.smul [hφ : φ.IsFaithfulPosMap] (x : { x : Matrix n n ℂ // x ≠ 0 }) (α : ℂˣ) : + qamA hφ (α • x) = qamA hφ x := + by + withMatrixQuantumCtx[φ] + simp_rw [qamA_eq, has_smul.units_matrix_ne_zero_coe, norm_smul, smul_mul, Matrix.mul_smul, + LinearMap.mulRight_smul, LinearMap.adjoint_smul, LinearMap.mulLeft_smul, smul_mul_smul, + smul_smul, Complex.mul_conj, Complex.ofReal_mul, mul_pow, ← one_div_mul_one_div_rev, mul_assoc, + ← Complex.ofReal_pow, Complex.normSq_eq_norm_sq] + rw [one_div_mul_cancel, mul_one] + · simp_rw [ne_eq, Complex.ofReal_eq_zero, sq_eq_zero_iff, norm_eq_zero] + exact Units.ne_zero _ + +private theorem kronecker_to_tensor_product_mul' (x y : Matrix (n × n) (n × n) ℂ) : + kroneckerToTensorProduct (x * y) = kroneckerToTensorProduct x * kroneckerToTensorProduct y := + calc + kroneckerToTensorProduct (x * y) = kroneckerToTensor (x * y) := rfl + _ = kroneckerToTensor x * kroneckerToTensor y := (map_mul _ _ _) + _ = kroneckerToTensorProduct x * kroneckerToTensorProduct y := rfl + +theorem qamA.is_idempotent [hφ : φ.IsFaithfulPosMap] (x : { x : Matrix n n ℂ // x ≠ 0 }) : + withMatrixQuantum[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + (Qam.reflIdempotent hφ (qamA hφ x) (qamA hφ x) = qamA hφ x) := + by + withMatrixQuantumCtx[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + rw [← Function.Injective.eq_iff (hφ.psi (ψ := φ) 0 (1 / 2)).injective, + Module.Dual.IsFaithfulPosMap.psi, Qam.reflIdempotent, Psi.schurMul, qamA_eq] + simp only [← rankOne_toMatrix_transpose_psi_symm] + simp_rw [Module.Dual.IsFaithfulPosMap.psi, _root_.map_smul, LinearEquiv.apply_symm_apply, + smul_mul_smul, ← oneMapTranspose_symm_eq, ← _root_.map_mul] + have hrank : + (((rankOne ℂ x.1 x.1 : L(ℍ)) : l(ℍ)) * + ((rankOne ℂ x.1 x.1 : L(ℍ)) : l(ℍ)) : l(ℍ)) = + (‖x.1‖ ^ 2 : ℂ) • ((rankOne ℂ x.1 x.1 : L(ℍ)) : l(ℍ)) := + by + ext y i j + simp [Module.End.mul_apply, inner_self_eq_norm_sq_to_K] + ring + rw [hrank] + simp_rw [_root_.map_smul, smul_smul, mul_assoc] + have : (‖x.1‖ ^ 2 : ℂ) ≠ 0 := + by simp_rw [ne_eq, sq_eq_zero_iff, Complex.ofReal_eq_zero, norm_eq_zero]; exact x.property + have this' := one_div_mul_cancel this + simp_rw [Complex.ofReal'_eq_isROrC_ofReal] at this' ⊢ + simp_rw [this', mul_one] + -- rw [this', mul_one] + +theorem Psi.one [hφ : φ.IsFaithfulPosMap] : + withMatrixQuantum[φ] + (hφ.psi (ψ := φ) 0 (1 / 2) 1 = + (TensorProduct.map (1 : l(ℍ)) (transposeAlgEquiv n ℂ ℂ).toLinearMap) + (Matrix.kroneckerToTensorProduct (hφ.toMatrix |φ.matrix⁻¹⟩⟨φ.matrix⁻¹|))) := + by + withMatrixQuantumCtx[φ] + nth_rw 1 [← + rankOne.sum_orthonormalBasis_eq_id_lm + (@Module.Dual.IsFaithfulPosMap.orthonormalBasis n _ _ φ _)] + apply_fun (oneMapTranspose : ℍ ⊗[ℂ] ℍᵐᵒᵖ ≃⋆ₐ[ℂ] _) using StarAlgEquiv.injective _ + ext i j + simp only [← oneMapTranspose_symm_eq, StarAlgEquiv.apply_symm_apply, map_sum, + Module.Dual.IsFaithfulPosMap.psi, QuantumSet.Psi_apply, QuantumSet.Psi_toFun_apply, + oneMapTranspose_apply] + have hbasis : hφ.basis = hφ.orthonormalBasis.toBasis := by + ext ij i j + simp [Module.Dual.IsFaithfulPosMap.orthonormalBasis_apply, + Module.Dual.IsFaithfulPosMap.basis_apply] + rw [show hφ.toMatrix = hφ.orthonormalBasis.toMatrix.toAlgEquiv by + simp [Module.Dual.IsFaithfulPosMap.toMatrix, hbasis, + orthonormalBasis_toMatrix_eq_basis_toMatrix]] + simp only [StarAlgEquiv.coe_toAlgEquiv, OrthonormalBasis.toMatrix_apply, + ContinuousLinearMap.coe_coe, rankOne_apply, inner_smul_right] + have hmod : ∀ x, modAut (1 / 2) (hφ.orthonormalBasis x) = + (hφ.orthonormalBasis x.swap)ᴴ := by + intro x + rw [show (modAut (1 / 2) : Matrix n n ℂ ≃ₐ[ℂ] Matrix n n ℂ) = + hφ.sig (1 / 2) from rfl] + simp only [Module.Dual.IsFaithfulPosMap.sig_apply, hφ.orthonormalBasis_apply, conjTranspose_mul, + mul_assoc, PosDef.rpow_mul_rpow, neg_add_cancel, PosDef.rpow_zero, + mul_one, (PosDef.rpow.isPosDef _ _).1.eq, single_conjTranspose, star_one] + rfl + simp only [hmod, star_eq_conjTranspose, conjTranspose_conjTranspose] + rw [show inner ℂ φ.matrix⁻¹ (hφ.orthonormalBasis j) = + star ((φ.matrix⁻¹ * hφ.matrixIsPosDef.rpow (1 / 2)) j.1 j.2) by + rw [← inner_conj_symm] + simp [hφ.inner_coord]] + rw [hφ.inner_coord, ← PosDef.rpow_neg_one_eq_inv_self hφ.matrixIsPosDef] + simp only [sum_apply, kroneckerMap_apply, transpose_apply, starAlgebra.modAut_zero, + AlgEquiv.one_apply, Module.Dual.IsFaithfulPosMap.orthonormalBasis_apply, mul_apply, + single_eq, boole_mul] + simp_rw [ite_and, Finset.sum_ite_irrel, Finset.sum_const_zero, Finset.sum_ite_eq, + Finset.mem_univ, if_true, ite_mul, zero_mul, Prod.swap, mul_ite, mul_zero, + Finset.sum_product_univ, Finset.sum_ite_irrel, Finset.sum_const_zero, + Finset.sum_ite_eq', Finset.mem_univ, if_true] + simp_rw [← mul_apply] + rw [PosDef.rpow_mul_rpow] + ring_nf + rw [← conjTranspose_apply, (PosDef.rpow.isPosDef _ _).1.eq] + rw [mul_comm] + +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (k l) -/ +/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (k l) -/ +theorem one_map_transpose_psi_eq [hφ : φ.IsFaithfulPosMap] (A : l(ℍ)) : + withMatrixQuantum[φ] + ((TensorProduct.map (1 : l(ℍ)) (transposeAlgEquiv n ℂ ℂ).symm.toLinearMap) + (hφ.psi (ψ := φ) 0 (1 / 2) A) = + (TensorProduct.map A (1 : l(ℍ))) + (kroneckerToTensorProduct (hφ.toMatrix |φ.matrix⁻¹⟩⟨φ.matrix⁻¹|))) := + by + withMatrixQuantumCtx[φ] + have := + calc + ∑ k, ∑ l, + ((rankOne ℂ + (A (e_{k,l} * hφ.matrixIsPosDef.rpow (-(1 / 2)))) + (e_{k,l} * hφ.matrixIsPosDef.rpow (-(1 / 2))) : L(ℍ)).toLinearMap) = + A ∘ₗ + ∑ k, ∑ l, + ((rankOne ℂ + (e_{k,l} * hφ.matrixIsPosDef.rpow (-(1 / 2))) + (e_{k,l} * hφ.matrixIsPosDef.rpow (-(1 / 2))) : L(ℍ)).toLinearMap) := + by simp_rw [← LinearMap.comp_rankOne, ← LinearMap.comp_sum] + _ = A ∘ₗ 1 := by + simp_rw [← Finset.sum_product', ← Module.Dual.IsFaithfulPosMap.orthonormalBasis_apply, + Finset.univ_product_univ, rankOne.sum_orthonormalBasis_eq_id_lm] + _ = A := by rw [LinearMap.comp_one] + nth_rw 1 [← this] + simp_rw [map_sum, Module.Dual.IsFaithfulPosMap.psi, QuantumSet.Psi_apply, + QuantumSet.Psi_toFun_apply] + have hzero : + ∀ x x_1, + (modAut 0) (A (stdBasisMatrix x x_1 1 * hφ.matrixIsPosDef.rpow (-(1 / 2)))) = + A + ((modAut 0) + (stdBasisMatrix x x_1 1 * hφ.matrixIsPosDef.rpow (-(1 / 2)))) := + by + intro x x_1 + simp [starAlgebra.modAut_zero] + simp_rw [hzero, TensorProduct.map_tmul, Module.End.one_apply, ← TensorProduct.map_tmul A, + ← QuantumSet.Psi_toFun_apply, ← QuantumSet.Psi_apply, ← map_sum, ← Finset.sum_product', + ← Module.Dual.IsFaithfulPosMap.orthonormalBasis_apply, Finset.univ_product_univ, + rankOne.sum_orthonormalBasis_eq_id_lm] + have hPsi := @Psi.one n _ _ φ hφ + rw [Module.Dual.IsFaithfulPosMap.psi] at hPsi + simp_rw [hPsi, ← oneMapTranspose_symm_eq] + have : + ∀ x, + (TensorProduct.map A (transposeAlgEquiv n ℂ ℂ).symm.toLinearMap) + (StarAlgEquiv.symm (oneMapTranspose : (ℍ ⊗[ℂ] ℍᵐᵒᵖ) ≃⋆ₐ[ℂ] _) x) = + (TensorProduct.map A (1 : l(ℍ))) (kroneckerToTensorProduct x) := + by + intro x + rw [Matrix.kmul_representation x] + simp_rw [map_sum, _root_.map_smul, oneMapTranspose_symm_eq, + kroneckerToTensorProduct_apply, TensorProduct.map_tmul, Module.End.one_apply, + AlgEquiv.toLinearMap_apply, AlgEquiv.symm_apply_apply] + simp_rw [this] + +theorem Psi.schurMul_faithful [hφ : φ.IsFaithfulPosMap] (r₁ r₂ : ℝ) (f g : l(ℍ)) : + withMatrixQuantum[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + (hφ.psi (ψ := φ) r₁ r₂ (f •ₛ g) = + hφ.psi (ψ := φ) r₁ r₂ f * hφ.psi (ψ := φ) r₁ r₂ g) := by + withMatrixQuantumCtx[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + rw [Module.Dual.IsFaithfulPosMap.psi, Psi.schurMul] + +theorem qamA.isReal [hφ : φ.IsFaithfulPosMap] (x : { x : ℍ // x ≠ 0 }) : + withMatrixQuantum[φ] (LinearMap.IsReal (qamA hφ x)) := by + withMatrixQuantumCtx[φ] + simp_rw [LinearMap.isReal_iff, qamA_eq, LinearMap.real_smul, Module.End.mul_eq_comp, + LinearMap.real_comp, LinearMap.matrix.mulRight_adjoint, LinearMap.mulRight_real, + LinearMap.mulLeft_real, ← Module.End.mul_eq_comp, ← (LinearMap.commute_mulLeft_right _ _).eq, + conjTranspose_mul, hφ.matrixIsPosDef.1.eq, sig_apply_matrix_hMul_posDef', + star_eq_conjTranspose, conjTranspose_mul, hφ.matrixIsPosDef.1.eq, + conjTranspose_conjTranspose, starRingEnd_apply, star_div₀, star_one, Complex.star_def, ← + Complex.ofReal_pow, Complex.conj_ofReal] + +private theorem qam_A_is_sa_iff_aux [hφ : φ.IsFaithfulPosMap] (x : ℍ) : + withMatrixQuantum[φ] + ((|φ.matrix * x⟩⟨φ.matrix * x| : l(ℍ)) = + LinearMap.mulLeft ℂ φ.matrix ∘ₗ (|x⟩⟨x| : l(ℍ)) ∘ₗ LinearMap.mulLeft ℂ φ.matrix) := + by + withMatrixQuantumCtx[φ] + calc + (|φ.matrix * x⟩⟨φ.matrix * x| : l(ℍ)) = + LinearMap.mulLeft ℂ φ.matrix ∘ₗ (|x⟩⟨x| : l(ℍ)) ∘ₗ + LinearMap.adjoint (LinearMap.mulLeft ℂ φ.matrix) := + by + simp only [LinearMap.comp_rankOne, LinearMap.rankOne_comp', LinearMap.mulLeft_apply] + _ = LinearMap.mulLeft ℂ φ.matrix ∘ₗ (|x⟩⟨x| : l(ℍ)) ∘ₗ LinearMap.mulLeft ℂ φ.matrix := by + simp_rw [LinearMap.matrix.mulLeft_adjoint, hφ.matrixIsPosDef.1.eq] + +private theorem qam_A_is_sa_iff_aux2 [hφ : φ.IsFaithfulPosMap] (x : ℍ) : + withMatrixQuantum[φ] + ((|x * φ.matrix⟩⟨φ.matrix * x| : l(ℍ)) = + LinearMap.mulRight ℂ φ.matrix ∘ₗ (|x⟩⟨x| : l(ℍ)) ∘ₗ LinearMap.mulLeft ℂ φ.matrix) := + by + withMatrixQuantumCtx[φ] + calc + (|x * φ.matrix⟩⟨φ.matrix * x| : l(ℍ)) = + LinearMap.mulRight ℂ φ.matrix ∘ₗ + (|x⟩⟨x| : l(ℍ)) ∘ₗ LinearMap.adjoint (LinearMap.mulLeft ℂ φ.matrix) := + by + simp only [LinearMap.comp_rankOne, LinearMap.rankOne_comp', LinearMap.mulLeft_apply, + LinearMap.mulRight_apply] + _ = LinearMap.mulRight ℂ φ.matrix ∘ₗ (|x⟩⟨x| : l(ℍ)) ∘ₗ LinearMap.mulLeft ℂ φ.matrix := by + simp_rw [LinearMap.matrix.mulLeft_adjoint, hφ.matrixIsPosDef.1.eq] + +private theorem qam_A_is_sa_iff_aux3 [hφ : φ.IsFaithfulPosMap] (x : { x : ℍ // x ≠ 0 }) : + withMatrixQuantum[φ] + ((h : inner ℂ x.1ᴴ x.1ᴴ • (φ.matrix * x.1ᴴ) = + inner ℂ x.1 x.1ᴴ • (x.1 * φ.matrix)) → + inner ℂ x.1 x.1ᴴ / inner ℂ x.1ᴴ x.1ᴴ ≠ 0) := + by + withMatrixQuantumCtx[φ] + intro h + simp_rw [ne_eq, div_eq_zero_iff, inner_self_eq_zero, ← star_eq_conjTranspose, star_eq_zero, + x.property, or_false, star_eq_conjTranspose] + intro h' + simp_rw [h', zero_smul, smul_eq_zero, inner_self_eq_zero, ← star_eq_conjTranspose, star_eq_zero, + x.property, false_or] at h + letI := hφ.matrixIsPosDef.invertible + have : LinearMap.mulLeft ℂ φ.matrix (star x.1) = LinearMap.mulLeft ℂ φ.matrix 0 := by + simp_rw [LinearMap.mulLeft_apply, h, MulZeroClass.mul_zero] + simpa [LinearMap.mulLeft_apply, star_eq_zero, x.property] using + congrArg (fun y : ℍ => φ.matrix⁻¹ * y) this + +private theorem qam_A_is_sa_iff_aux4 [hφ : φ.IsFaithfulPosMap] (x : { x : ℍ // x ≠ 0 }) : + withMatrixQuantum[φ] + ((h : inner ℂ x.1ᴴ x.1ᴴ • (φ.matrix * x.1ᴴ) = + inner ℂ x.1 x.1ᴴ • (x.1 * φ.matrix)) → + (inner ℂ x.1 x.1ᴴ / inner ℂ x.1ᴴ x.1ᴴ) • hφ.sig 1 x.1 = x.1ᴴ) := + by + withMatrixQuantumCtx[φ] + intro h + letI := hφ.matrixIsPosDef.invertible + calc + (inner ℂ x.1 x.1ᴴ / inner ℂ x.1ᴴ x.1ᴴ) • hφ.sig 1 x.1 = + (inner ℂ x.1 x.1ᴴ / inner ℂ x.1ᴴ x.1ᴴ) • + φ.matrix⁻¹ * x.1 * φ.matrix := + by simp_rw [hφ.sig_apply, PosDef.rpow_one_eq_self, PosDef.rpow_neg_one_eq_inv_self, + smul_mul_assoc] + _ = ((1 / inner ℂ x.1ᴴ x.1ᴴ) • φ.matrix⁻¹) * + (inner ℂ x.1 x.1ᴴ • x.1 * φ.matrix) := by + simp only [Matrix.mul_smul, Matrix.smul_mul, smul_smul, Matrix.mul_assoc, mul_one_div] + _ = ((1 / inner ℂ x.1ᴴ x.1ᴴ) • φ.matrix⁻¹) * + (inner ℂ x.1ᴴ x.1ᴴ • φ.matrix * x.1ᴴ) := by + simp_rw [smul_mul_assoc, ← h] + _ = (inner ℂ x.1ᴴ x.1ᴴ / inner ℂ x.1ᴴ x.1ᴴ) • + φ.matrix⁻¹ * φ.matrix * x.1ᴴ := by + simp_rw [Matrix.smul_mul, Matrix.mul_smul, smul_smul, + mul_assoc, mul_comm (1 / _ : ℂ), mul_one_div] + _ = x.1ᴴ := + by + rw [div_self, one_smul, Matrix.mul_assoc, inv_mul_cancel_left_of_invertible] + simp_rw [ne_eq, inner_self_eq_zero, ← star_eq_conjTranspose, star_eq_zero] + exact x.property + +theorem sig_eq_lmul_rmul [hφ : φ.IsFaithfulPosMap] (t : ℝ) : + (hφ.sig t).toLinearMap = + LinearMap.mulLeft ℂ (hφ.matrixIsPosDef.rpow (-t)) ∘ₗ + LinearMap.mulRight ℂ (hφ.matrixIsPosDef.rpow t) := + by + rw [LinearMap.ext_iff] + intro a + simp_rw [AlgEquiv.toLinearMap_apply, hφ.sig_apply, LinearMap.comp_apply, + LinearMap.mulLeft_apply, LinearMap.mulRight_apply, ← mul_assoc] + +namespace Qam +namespace RankOne + +theorem symmetric_eq [hφ : φ.IsFaithfulPosMap] (x : ℍ) : + withMatrixQuantum[φ] + (symmMap ℂ ℍ ℍ |x⟩⟨x| = |hφ.sig (-1) xᴴ⟩⟨xᴴ|) := by + withMatrixQuantumCtx[φ] + rw [symmMap_rankOne_apply] + rw [show k ℍ = 0 by rfl] + simp_rw [star_eq_conjTranspose] + rw [show modAut (-(2 * (0 : ℝ)) - 1) xᴴ = + hφ.sig (-(2 * (0 : ℝ)) - 1) xᴴ by rfl] + ring_nf + +theorem symmetric'_eq [hφ : φ.IsFaithfulPosMap] (x : ℍ) : + withMatrixQuantum[φ] + ((symmMap ℂ ℍ ℍ).symm |x⟩⟨x| = |xᴴ⟩⟨hφ.sig (-1) xᴴ|) := by + withMatrixQuantumCtx[φ] + rw [symmMap_symm_rankOne_apply] + rw [show k ℍ = 0 by rfl] + simp_rw [star_eq_conjTranspose] + rw [show modAut (-(2 * (0 : ℝ)) - 1) xᴴ = + hφ.sig (-(2 * (0 : ℝ)) - 1) xᴴ by rfl] + ring_nf + +end RankOne +end Qam + +private theorem qam_A_is_sa_iff_aux5 [hφ : φ.IsFaithfulPosMap] (x : { x : ℍ // x ≠ 0 }) : + withMatrixQuantum[φ] + ((h : + (LinearMap.mulLeft ℂ φ.matrix).comp (|x.1ᴴ⟩⟨x.1ᴴ| : l(ℍ)) = + (LinearMap.mulRight ℂ φ.matrix).comp (|x.1⟩⟨x.1| : l(ℍ))) → + symmMap ℂ ℍ ℍ |x.1⟩⟨x.1| = |x.1⟩⟨x.1|) := + by + withMatrixQuantumCtx[φ] + intro h + haveI := hφ.matrixIsPosDef.invertible + calc + symmMap ℂ ℍ ℍ |x.1⟩⟨x.1| = + (hφ.sig (-1)).toLinearMap ∘ₗ (|x.1ᴴ⟩⟨x.1ᴴ| : l(ℍ)) := + ?_ + _ = + LinearMap.mulLeft ℂ φ.matrix ∘ₗ + LinearMap.mulRight ℂ φ.matrix⁻¹ ∘ₗ (|x.1ᴴ⟩⟨x.1ᴴ| : l(ℍ)) := + ?_ + _ = + LinearMap.mulRight ℂ (φ.matrix⁻¹ : ℍ) ∘ₗ + LinearMap.mulRight ℂ φ.matrix ∘ₗ (|x.1⟩⟨x.1| : l(ℍ)) := + ?_ + _ = (|x.1⟩⟨x.1| : l(ℍ)) := ?_ + · rw [symmMap_rankOne_apply, LinearMap.comp_rankOne, AlgEquiv.toLinearMap_apply] + rw [show k ℍ = 0 by rfl] + simp_rw [star_eq_conjTranspose] + rw [show (modAut (-(2 * (0 : ℝ)) - 1) x.1ᴴ) = + hφ.sig (-(2 * (0 : ℝ)) - 1) x.1ᴴ by rfl] + ring_nf + · simp_rw [sig_eq_lmul_rmul, neg_neg, PosDef.rpow_one_eq_self, PosDef.rpow_neg_one_eq_inv_self, + LinearMap.comp_assoc] + · simp_rw [← Module.End.mul_eq_comp, ← mul_assoc, (LinearMap.commute_mulLeft_right _ _).eq, + mul_assoc, Module.End.mul_eq_comp, h] + · rw [← LinearMap.comp_assoc, ← LinearMap.mulRight_mul, mul_inv_of_invertible, + LinearMap.mulRight_one, LinearMap.id_comp] + +theorem sig_comp_eq_iff_eq_sig_inv_comp [hφ : φ.IsFaithfulPosMap] (r : ℝ) (a b : l(ℍ)) : + (hφ.sig r).toLinearMap.comp a = b ↔ a = (hφ.sig (-r)).toLinearMap.comp b := + by + simp_rw [LinearMap.ext_iff, LinearMap.comp_apply] + constructor <;> intro h x + · simp_rw [← h, AlgEquiv.toLinearMap_apply, hφ.sig_apply_sig, neg_add_cancel, + hφ.sig_zero, AlgEquiv.one_apply] + · simp_rw [h, AlgEquiv.toLinearMap_apply, hφ.sig_apply_sig, add_neg_cancel, + hφ.sig_zero, AlgEquiv.one_apply] + +theorem sig_eq_iff_eq_sig_inv [hφ : φ.IsFaithfulPosMap] (r : ℝ) (a b : ℍ) : hφ.sig r a = b ↔ a = + hφ.sig (-r) b := by + constructor <;> rintro rfl <;> + simp only [hφ.sig_apply_sig, neg_add_cancel, add_neg_cancel, hφ.sig_zero, + AlgEquiv.one_apply] + +theorem comp_sig_eq_iff_eq_comp_sig_inv [hφ : φ.IsFaithfulPosMap] (r : ℝ) (a b : l(ℍ)) : + a.comp (hφ.sig r).toLinearMap = b ↔ a = b.comp (hφ.sig (-r)).toLinearMap := + by + simp_rw [LinearMap.ext_iff, LinearMap.comp_apply] + constructor <;> intro h x + · simp only [← h, AlgEquiv.toLinearMap_apply, hφ.sig_apply_sig, add_neg_cancel, + hφ.sig_zero, AlgEquiv.one_apply] + · simp only [h, hφ.sig_apply_sig, neg_add_cancel, hφ.sig_zero, AlgEquiv.toLinearMap_apply, + AlgEquiv.one_apply] + +private theorem qam_A_is_sa_iff_aux_aux6 [hφ : φ.IsFaithfulPosMap] (r : ℝ) (a b : ℍ) : + inner ℂ (hφ.sig r a) b = inner ℂ (hφ.sig (r / 2) a) (hφ.sig (r / 2) b) := + by + simp_rw [← AlgEquiv.toLinearMap_apply] + symm + nth_rw 2 [← Module.Dual.IsFaithfulPosMap.sig_adjoint] + simp_rw [LinearMap.adjoint_inner_right, AlgEquiv.toLinearMap_apply, + Module.Dual.IsFaithfulPosMap.sig_apply_sig hφ, add_halves] + +private theorem qam_A_is_sa_iff_aux2_aux6 [hφ : φ.IsFaithfulPosMap] (x : ℍ) (α : NNRealˣ) + (h : hφ.sig 1 x = (((α : NNReal) : ℝ) : ℂ) • x) : + x * φ.matrix = (((α : NNReal) : ℝ) : ℂ) • φ.matrix * x := + by + have hα : (((α : NNReal) : ℝ) : ℂ) ≠ 0 := by norm_cast; exact Units.ne_zero α + letI gg : NoZeroSMulDivisors ℂ ℍ := inferInstance + have h' := h + rw [sig_eq_iff_eq_sig_inv, _root_.map_smul] at h + symm + calc + (((α : NNReal) : ℝ) : ℂ) • φ.matrix * x = φ.matrix * ((((α : NNReal) : ℝ) : ℂ) • x) := by + simp_rw [Matrix.mul_smul, smul_mul_assoc] + _ = φ.matrix * hφ.sig 1 x := by rw [← h'] + _ = x * φ.matrix := ?_ + haveI := hφ.matrixIsPosDef.invertible + simp_rw [Module.Dual.IsFaithfulPosMap.sig_apply hφ, PosDef.rpow_one_eq_self, + PosDef.rpow_neg_one_eq_inv_self, Matrix.mul_assoc, mul_inv_cancel_left_of_invertible] + +private theorem qam_A_is_sa_iff_aux3_aux6 [hφ : φ.IsFaithfulPosMap] (x : ℍ) (α : NNRealˣ) + : withMatrixQuantum[φ] + ((H : (|xᴴ⟩⟨xᴴ|) = (|hφ.sig 1 x⟩⟨x|)) → + (h : hφ.sig 1 x = (((α : NNReal) : ℝ) : ℂ) • x) → + |(Real.sqrt ((α : NNReal) : ℝ) : ℂ) • x⟩⟨(Real.sqrt ((α : NNReal) : ℝ) : ℂ) • x| = + |xᴴ⟩⟨xᴴ|) := + by + withMatrixQuantumCtx[φ] + intro H h + have : 0 ≤ ((α : NNReal) : ℝ) := NNReal.coe_nonneg _ + rw [H, h] + have hsqrt_star : + ((Real.sqrt ((α : NNReal) : ℝ) : ℂ) • x) = + (star (Real.sqrt ((α : NNReal) : ℝ) : ℂ)) • x := by + simp [Complex.conj_ofReal] + calc + rankOne ℂ ((Real.sqrt ((α : NNReal) : ℝ) : ℂ) • x) + ((Real.sqrt ((α : NNReal) : ℝ) : ℂ) • x) = + ((Real.sqrt ((α : NNReal) : ℝ) : ℂ) * + (Real.sqrt ((α : NNReal) : ℝ) : ℂ)) • rankOne ℂ x x := by + rw [hsqrt_star, rankOne_smul_smul] + simp [Complex.conj_ofReal] + _ = ((((α : NNReal) : ℝ) : ℂ) * 1) • rankOne ℂ x x := by + rw [show (Real.sqrt ((α : NNReal) : ℝ) : ℂ) * + (Real.sqrt ((α : NNReal) : ℝ) : ℂ) = + ((((α : NNReal) : ℝ) : ℂ) * 1) by + rw [← Complex.ofReal_mul, ← Real.sqrt_mul this, Real.sqrt_mul_self this] + simp] + _ = rankOne ℂ (((((α : NNReal) : ℝ) : ℂ) • x)) x := by + symm + rw [show x = star (1 : ℂ) • x by simp] + rw [rankOne_smul_smul] + simp + +private theorem qam_A_is_sa_iff_aux4_aux6 [hφ : φ.IsFaithfulPosMap] (x' : { x : ℍ // x ≠ 0 }) + : withMatrixQuantum[φ] + ((this : + inner ℂ x'.1 x'.1 • hφ.sig 1 x'.1 = + inner ℂ (hφ.sig 1 x'.1) x'.1 • x'.1) → + ∃ α : NNRealˣ, hφ.sig 1 x'.1 = (((α : NNReal) : ℝ) : ℂ) • x'.1) := + by + withMatrixQuantumCtx[φ] + intro this + let x : ℍ := x'.1 + have hx : x ≠ 0 := x'.property + let α : ℝ := ‖hφ.sig (1 / 2) x‖ ^ 2 / ‖x‖ ^ 2 + have hα' : 0 ≤ α := by + simp_rw [α] + exact div_nonneg (sq_nonneg _) (sq_nonneg _) + let α' : NNReal := ⟨α, hα'⟩ + have hα : α' ≠ 0 := by + have hsig : hφ.sig (1 / 2) x ≠ 0 := by + intro hzero + rw [sig_eq_iff_eq_sig_inv] at hzero + have hzero' : x = 0 := by simpa using hzero + exact hx hzero' + have hnum : ‖hφ.sig (1 / 2) x‖ ^ 2 ≠ 0 := by + simpa [norm_eq_zero] using hsig + have hden : ‖x‖ ^ 2 ≠ 0 := by + simpa [norm_eq_zero] using hx + intro hzero + have hαzero : α = 0 := by + change (α' : ℝ) = 0 + exact congrArg (fun z : NNReal => (z : ℝ)) hzero + exact hnum ((div_eq_zero_iff.mp hαzero).resolve_right hden) + exists Units.mk0 α' hα + change hφ.sig 1 x = ((α : ℝ) : ℂ) • x + rw [show α = ‖hφ.sig (1 / 2) x‖ ^ 2 / ‖x‖ ^ 2 by rfl, Complex.ofReal_div] + symm + calc + (((‖(hφ.sig (1 / 2)) x‖ ^ 2 : ℝ) : ℂ) / ((‖x‖ ^ 2 : ℝ) : ℂ)) • x = + (1 / (‖x‖ ^ 2 : ℂ)) • (‖hφ.sig (1 / 2) x‖ ^ 2 : ℂ) • x := + by simp_rw [smul_smul, mul_comm (1 / _ : ℂ), mul_one_div, Complex.ofReal_pow] + _ = (1 / inner ℂ x x) • inner ℂ (hφ.sig (1 / 2) x) (hφ.sig (1 / 2) x) • x := by + simp_rw [inner_self_eq_norm_sq_to_K]; rfl + _ = (1 / inner ℂ x x) • inner ℂ (hφ.sig 1 x) x • x := by rw [← qam_A_is_sa_iff_aux_aux6] + _ = (1 / inner ℂ x x) • inner ℂ x x • hφ.sig 1 x := by rw [← this] + _ = hφ.sig 1 x := ?_ + rw [smul_smul, one_div, inv_mul_cancel₀ (inner_self_ne_zero.mpr hx), one_smul] + +theorem sig_eq_self_iff_commute [hφ : φ.IsFaithfulPosMap] (x : ℍ) : hφ.sig 1 x = x ↔ + Commute φ.matrix x := + by + simp_rw [hφ.sig_apply, Commute, SemiconjBy, PosDef.rpow_one_eq_self, + PosDef.rpow_neg_one_eq_inv_self] + haveI := hφ.matrixIsPosDef.invertible + constructor <;> intro h + · nth_rw 1 [← h] + rw [Matrix.mul_assoc, mul_inv_cancel_left_of_invertible] + · rw [Matrix.mul_assoc, ← h, ← Matrix.mul_assoc, inv_mul_of_invertible, Matrix.one_mul] + +omit [Fintype n] [DecidableEq n] in +private theorem qam_A_is_sa_iff_aux7 (x : { x : ℍ // x ≠ 0 }) (α : NNRealˣ) (β : ℂˣ) + (hx : x.1 = (star (β : ℂ) * (Real.sqrt ((α : NNReal) : ℝ) : ℂ)) • x.1ᴴ) + (hx2 : x.1 = ((β⁻¹ : ℂ) * (((Real.sqrt ((α : NNReal) : ℝ))⁻¹ : ℝ) : ℂ)) • x.1ᴴ) : + ‖(β : ℂ)‖ ^ 2 * ((α : NNReal) : ℝ) = 1 := + by + have : x.1 - x.1 = 0 := sub_self _ + nth_rw 1 [hx] at this + nth_rw 2 [hx2] at this + simp_rw [← sub_smul, smul_eq_zero, ← star_eq_conjTranspose, star_eq_zero, + x.property, or_false, sub_eq_zero, Complex.ofReal_inv, ← mul_inv] at this + have hi : 0 ≤ ((α : NNReal) : ℝ) := NNReal.coe_nonneg _ + rw [← mul_inv_eq_one₀, inv_inv, mul_mul_mul_comm, Complex.star_def, ← + Complex.normSq_eq_conj_mul_self, Complex.normSq_eq_norm_sq, ← + Complex.ofReal_mul, ← Real.sqrt_mul hi, Real.sqrt_mul_self hi, ← Complex.ofReal_mul, + Complex.ofReal_eq_one] at this + · exact this + · simp_rw [ne_eq, inv_eq_zero, mul_eq_zero, Complex.ofReal_eq_zero, Real.sqrt_eq_zero hi, + NNReal.coe_eq_zero, Units.ne_zero, or_false, not_false_iff] + +private theorem qam_A_is_sa_iff_aux8 (α : NNRealˣ) (β : ℂˣ) + (h : ‖(β : ℂ)‖ ^ 2 * ((α : NNReal) : ℝ) = 1) : + ∃ γ : ℂˣ, + (γ : ℂ) ^ 2 = (β : ℂ) * (((α : NNReal) : ℝ).sqrt : ℂ) ∧ + ‖(γ : ℂ)‖ ^ 2 = 1 ∧ star (γ : ℂ) = (γ : ℂ)⁻¹ := + by + let γ : ℂ := ((β : ℂ) * (((α : NNReal) : ℝ).sqrt : ℂ)) ^ ((2 : ℕ) : ℂ)⁻¹ + have hγ : γ ≠ 0 := by + simp only [ne_eq, γ, Complex.cpow_eq_zero_iff, ne_eq, inv_eq_zero, Units.mul_right_eq_zero, + Complex.ofReal_eq_zero, Real.sqrt_eq_zero, NNReal.zero_le_coe, NNReal.coe_eq_zero, + Units.ne_zero, not_false_iff, false_and] + have : γ ^ 2 = (β : ℂ) * (((α : NNReal) : ℝ).sqrt : ℂ) := by + simp_rw [γ, Complex.cpow_nat_inv_pow _ two_ne_zero] + have this1 : ‖γ‖ ^ 2 = 1 := by + rw [show ‖γ‖ ^ 2 = ‖γ ^ 2‖ by rw [norm_pow], this, norm_mul] + have hsquare : + (‖(β : ℂ)‖ * ‖(((α : NNReal) : ℝ).sqrt : ℂ)‖) ^ 2 = (1 : ℝ) ^ 2 := by + rw [mul_pow, Complex.ofReal'_eq_isROrC_ofReal, + RCLike.norm_ofReal, abs_of_nonneg (Real.sqrt_nonneg _), + Real.sq_sqrt (NNReal.coe_nonneg _), h, one_pow] + have hnonneg : 0 ≤ ‖(β : ℂ)‖ * ‖(((α : NNReal) : ℝ).sqrt : ℂ)‖ := + mul_nonneg (norm_nonneg _) (norm_nonneg _) + nlinarith + use Units.mk0 γ hγ + constructor + · exact this + constructor + · exact this1 + rw [← Complex.ofReal_inj, ← Complex.normSq_eq_norm_sq, ← Complex.mul_conj, + Complex.ofReal_one, starRingEnd_apply, mul_comm, mul_eq_one_iff_eq_inv₀ hγ] at this1 + exact this1 + +omit [Fintype n] [DecidableEq n] in +private theorem qam_A_is_sa_iff_aux9 (x : ℍ) (α : NNRealˣ) (β γ : ℂˣ) + (h : (γ : ℂ) ^ 2 = (β : ℂ) * (((α : NNReal) : ℝ).sqrt : ℂ)) (h2 : star (γ : ℂ) = (γ : ℂ)⁻¹) + (hx : xᴴ = ((β : ℂ) * (Real.sqrt ((α : NNReal) : ℝ) : ℂ)) • x) : x.IsAlmostHermitian := + by + use Units.mk0 (star (γ : ℂ)) (star_ne_zero.mpr (Units.ne_zero _)) + use (γ : ℂ) • x + simp_rw [IsHermitian, conjTranspose_smul, h2, Units.val_mk0, smul_smul, + inv_mul_cancel₀ (Units.ne_zero γ), one_smul, true_and] + rw [eq_comm, eq_inv_smul_iff₀ (Units.ne_zero γ), smul_smul, ← sq, h] + exact hx.symm + +private theorem qam_A_is_sa_iff_aux5_aux6 [hφ : φ.IsFaithfulPosMap] (x' : { x : ℍ // x ≠ 0 }) + : withMatrixQuantum[φ] + ((this : + inner ℂ x'.1 x'.1 • hφ.sig 1 x'.1 = + inner ℂ (hφ.sig 1 x'.1) x'.1 • x'.1) → + (h : symmMap ℂ ℍ ℍ |x'.1⟩⟨x'.1| = |x'.1⟩⟨x'.1|) → + (hh : x'.1.IsAlmostHermitian) → Commute φ.matrix x'.1) := + by + withMatrixQuantumCtx[φ] + intro this h hh + obtain ⟨α, hα⟩ := qam_A_is_sa_iff_aux4_aux6 x' this + have : hφ.sig (-1) x'.1ᴴ = (((α : NNReal) : ℝ) : ℂ) • x'.1ᴴ := by + rw [← Module.Dual.IsFaithfulPosMap.sig_conjTranspose, hα, conjTranspose_smul, Complex.star_def, + Complex.conj_ofReal] + rw [Qam.RankOne.symmetric_eq, this] at h + obtain ⟨β, y, hβy, hy⟩ := hh + have this1 : y ≠ 0 := by + intro H + rw [H, smul_zero, eq_comm] at hβy + exact x'.property hβy + have Hβ : β ≠ 0 := by + intro hβ + rw [hβ, zero_smul, eq_comm] at hβy + exact x'.property hβy + simp_rw [← hβy, conjTranspose_smul, hy.eq, rankOne_eq_rankOneLm, smul_smul, rankOneLm_smul, + smul_rankOneLm, smul_rankOneLm', smul_smul] at h + rw [← sub_eq_zero, ← sub_smul, smul_eq_zero, rankOneLm_eq_rankOne, + ContinuousLinearMap.coe_eq_zero, rankOne.eq_zero_iff, or_self_iff] at h + have hscalar : (((α : NNReal) : ℝ) : ℂ) * star β * β - β * star β = 0 := + h.resolve_right this1 + have hβnorm : star β * β ≠ 0 := mul_ne_zero (star_ne_zero.mpr Hβ) Hβ + have hαone : (((α : NNReal) : ℝ) : ℂ) = 1 := by + have hfactor : ((((α : NNReal) : ℝ) : ℂ) - 1) * (star β * β) = 0 := by + ring_nf at hscalar ⊢ + exact hscalar + exact sub_eq_zero.mp ((mul_eq_zero.mp hfactor).resolve_right hβnorm) + rw [hαone, one_smul, sig_eq_self_iff_commute] at hα + exact hα + +private theorem qam_A_is_sa_iff_aux6 [hφ : φ.IsFaithfulPosMap] (x' : { x : ℍ // x ≠ 0 }) + : withMatrixQuantum[φ] + ((h : symmMap ℂ ℍ ℍ |x'.1⟩⟨x'.1| = |x'.1⟩⟨x'.1|) → + x'.1.IsAlmostHermitian ∧ Commute φ.matrix x'.1) := + by + withMatrixQuantumCtx[φ] + intro h + let x : ℍ := x'.1 + have hx : x ≠ 0 := x'.property + have h' := h + rw [← LinearEquiv.eq_symm_apply] at h' + have H : (|xᴴ⟩⟨xᴴ| : l(ℍ)) = (|hφ.sig 1 x⟩⟨x| : l(ℍ)) := + by + rw [← AlgEquiv.toLinearMap_apply, ← LinearMap.comp_rankOne, ← neg_neg (1 : ℝ), ← + sig_comp_eq_iff_eq_sig_inv_comp, LinearMap.comp_rankOne] + rw [Qam.RankOne.symmetric_eq] at h + exact h + have H' : (|xᴴ⟩⟨xᴴ| : l(ℍ)) = (|x⟩⟨hφ.sig 1 x| : l(ℍ)) := + by + simp_rw [← AlgEquiv.toLinearMap_apply] + rw [← Module.Dual.IsFaithfulPosMap.sig_adjoint, ← LinearMap.rankOne_comp, ← neg_neg (1 : ℝ), ← + comp_sig_eq_iff_eq_comp_sig_inv] + have : + (|xᴴ⟩⟨xᴴ| : l(ℍ)) ∘ₗ (hφ.sig (-1)).toLinearMap = + |xᴴ⟩⟨LinearMap.adjoint (hφ.sig (-1)).toLinearMap xᴴ| := + LinearMap.rankOne_comp _ _ _ + rw [this, Module.Dual.IsFaithfulPosMap.sig_adjoint] + rw [Qam.RankOne.symmetric'_eq] at h' + exact h'.symm + have : (|hφ.sig 1 x⟩⟨x| : l(ℍ)) = |x⟩⟨hφ.sig 1 x| := by rw [← H, ← H'] + -- have this' : |hφ.sig 1 x⟩⟨x| = |x⟩⟨hφ.sig 1 x| := + -- by rw [ContinuousLinearMap.coe_inj] at this; exact this + simp_rw [ContinuousLinearMap.coe_inj] at H this + simp_rw [ContinuousLinearMap.ext_iff, rankOne_apply] at this + specialize this x + obtain ⟨α, hα⟩ := qam_A_is_sa_iff_aux4_aux6 x' this + have hα' := (qam_A_is_sa_iff_aux3_aux6 _ α H hα).symm + -- have hα'' := qam_A_is_sa_iff_aux2_aux6 _ _ hα + have hxstar : xᴴ ≠ 0 := by + simpa [star_eq_conjTranspose] using star_ne_zero.mpr hx + have hsqrtx : ((Real.sqrt ((α : NNReal) : ℝ) : ℂ) • x) ≠ 0 := by + apply smul_ne_zero + · simp [Units.ne_zero α] + · exact hx + obtain ⟨β, hβ⟩ := rankOne.ext_iff hxstar hsqrtx hα' + rw [smul_smul] at hβ + have hβ' : (x : ℍ) = (star (β : ℂ) * (Real.sqrt ((α : NNReal) : ℝ) : ℂ)) • (x : ℍ)ᴴ := + by + rw [← Function.Injective.eq_iff (conjTransposeAddEquiv n n ℂ).injective] + simp_rw [conjTransposeAddEquiv_apply, conjTranspose_smul, star_mul', star_star, + Complex.star_def, Complex.conj_ofReal, conjTranspose_conjTranspose] + exact hβ + have hβ'' : (x : ℍ) = ((β⁻¹ : ℂ) * (((Real.sqrt ((α : NNReal) : ℝ))⁻¹ : ℝ) : ℂ)) • (x : ℍ)ᴴ := + by + rw [hβ, smul_smul, mul_mul_mul_comm, inv_mul_cancel₀ (Units.ne_zero β), one_mul, ← + Complex.ofReal_mul, inv_mul_cancel₀ (by + rw [Real.sqrt_ne_zero (NNReal.coe_nonneg _), NNReal.coe_ne_zero] + exact Units.ne_zero _), Complex.ofReal_one, one_smul] + have Hβ := qam_A_is_sa_iff_aux7 x' α β hβ' hβ'' + obtain ⟨γ, hγ, _, Hγ'⟩ := qam_A_is_sa_iff_aux8 α β Hβ + have Hβ' := qam_A_is_sa_iff_aux9 x α β γ hγ Hγ' hβ + exact ⟨Hβ', qam_A_is_sa_iff_aux5_aux6 x' this h Hβ'⟩ + +theorem qamA.of_is_self_adjoint [hφ : φ.IsFaithfulPosMap] (x : { x : ℍ // x ≠ 0 }) + : withMatrixQuantum[φ] + ((h : LinearMap.adjoint (qamA hφ x) = qamA hφ x) → + x.1.IsAlmostHermitian ∧ Commute φ.matrix x.1) := + by + withMatrixQuantumCtx[φ] + intro h + simp_rw [qamA_eq, LinearMap.adjoint_smul, Module.End.mul_eq_comp, LinearMap.adjoint_comp, + LinearMap.adjoint_adjoint, LinearMap.matrix.mulLeft_adjoint, ← Module.End.mul_eq_comp, ← + (LinearMap.commute_mulLeft_right _ _).eq, conjTranspose_mul, hφ.matrixIsPosDef.1.eq] at h + have : + LinearMap.mulRight ℂ (φ.matrix * x.1) = + LinearMap.adjoint (LinearMap.mulRight ℂ (φ.matrix * x.1ᴴ)) := + by + simp_rw [LinearMap.matrix.mulRight_adjoint, conjTranspose_mul, conjTranspose_conjTranspose, + hφ.matrixIsPosDef.1.eq, sig_apply_matrix_hMul_posDef'] + nth_rw 1 [this] at h + simp_rw [← rankOne_psi_transpose_to_lin, ← oneMapTranspose_eq, ← _root_.map_smul] at h + simp only [(AlgEquiv.injective _).eq_iff, (LinearEquiv.injective _).eq_iff, + (StarAlgEquiv.injective _).eq_iff] at h + have thisss : 1 / (‖x.1‖ : ℂ) ^ 2 ≠ 0 := + by + simp_rw [ne_eq, div_eq_zero_iff, one_ne_zero, false_or, sq_eq_zero_iff, + Complex.ofReal_eq_zero, norm_eq_zero] + exact x.property + -- letI gg : NoZeroSMulDivisors ℂ l(ℍ) := LinearMap.noZeroSMulDivisors + simp_rw [starRingEnd_apply, star_div₀, star_one, Complex.star_def, ← Complex.ofReal_pow, + Complex.conj_ofReal, Complex.ofReal_pow] at h + simp_rw [← ContinuousLinearMap.coe_smul, ContinuousLinearMap.coe_inj] at h + letI gg : NoZeroSMulDivisors ℂ (ℍ →ₗ[ℂ] ℍ) := by infer_instance + -- have h'' := smul_right_inj this + rw [smul_right_inj thisss] at h + simp_rw [← ContinuousLinearMap.coe_inj] at h + rw [qam_A_is_sa_iff_aux, qam_A_is_sa_iff_aux2] at h + haveI := hφ.matrixIsPosDef.invertible + simp_rw [← LinearMap.comp_assoc, LinearMap.mulLeft_comp_inj] at h + have h' := qam_A_is_sa_iff_aux5 x h + exact qam_A_is_sa_iff_aux6 x h' + +theorem qamA.is_self_adjoint_of [hφ : φ.IsFaithfulPosMap] (x : { x : ℍ // x ≠ 0 }) (hx₁ : + x.1.IsAlmostHermitian) + (hx₂ : Commute φ.matrix x.1) : withMatrixQuantum[φ] (LinearMap.adjoint (qamA hφ x) = + qamA hφ x) := + by + withMatrixQuantumCtx[φ] + simp_rw [qamA_eq, LinearMap.adjoint_smul, Module.End.mul_eq_comp, LinearMap.adjoint_comp, + LinearMap.adjoint_adjoint, LinearMap.matrix.mulLeft_adjoint, ← Module.End.mul_eq_comp, ← + (LinearMap.commute_mulLeft_right _ _).eq, conjTranspose_mul, hφ.matrixIsPosDef.1.eq] + obtain ⟨α, y, ⟨hxy, hy⟩⟩ := hx₁ + have : 1 / (‖x.1‖ : ℂ) ^ 2 ≠ 0 := + by + simp_rw [ne_eq, div_eq_zero_iff, one_ne_zero, false_or, sq_eq_zero_iff, + Complex.ofReal_eq_zero, norm_eq_zero] + exact x.property + -- letI gg : NoZeroSMulDivisors ℂ l(ℍ) := LinearMap.noZeroSMulDivisors + simp_rw [starRingEnd_apply, star_div₀, star_one, Complex.star_def, ← Complex.ofReal_pow, + Complex.conj_ofReal, Complex.ofReal_pow, smul_right_inj this] + simp_rw [← hx₂.eq, ← hxy, conjTranspose_smul, mul_smul_comm, + LinearMap.mulLeft_smul, LinearMap.mulRight_smul, LinearMap.adjoint_smul, smul_mul_smul, + starRingEnd_apply, mul_comm, LinearMap.matrix.mulRight_adjoint, conjTranspose_mul, + hφ.matrixIsPosDef.1.eq, hy.eq, sig_apply_matrix_hMul_posDef'] + +theorem qamA.is_self_adjoint_iff [hφ : φ.IsFaithfulPosMap] (x : { x : ℍ // x ≠ 0 }) : + withMatrixQuantum[φ] + (LinearMap.adjoint (qamA hφ x) = qamA hφ x ↔ + x.1.IsAlmostHermitian ∧ Commute φ.matrix x.1) := by + withMatrixQuantumCtx[φ] + exact ⟨fun h => qamA.of_is_self_adjoint x h, fun h => qamA.is_self_adjoint_of x h.1 h.2⟩ + +theorem qamA.isRealQam [hφ : φ.IsFaithfulPosMap] (x : { x : ℍ // x ≠ 0 }) : + withMatrixQuantum[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + RealQam hφ (qamA hφ x) := by + withMatrixQuantumCtx[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + exact ⟨qamA.is_idempotent _, qamA.isReal _⟩ + +open scoped ComplexOrder +omit [Fintype n] [DecidableEq n] in +theorem Matrix.PosDef.ne_zero [Finite n] [Nontrivial n] {Q : ℍ} (hQ : Q.PosDef) : Q ≠ 0 := + by + classical + letI := Fintype.ofFinite n + have := PosDef.trace_ne_zero hQ + intro h + rw [h, trace_zero] at this + contradiction + +theorem qamA.edges [hφ : φ.IsFaithfulPosMap] (x : { x : ℍ // x ≠ 0 }) : + withMatrixQuantum[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + (@qamA.isRealQam n _ _ φ hφ x).edges = 1 := + by + withMatrixQuantumCtx[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + rw [RealQam.edges_eq_one_iff] + exact ⟨x, rfl⟩ + +theorem qamA.is_irreflexive_iff [hφ : φ.IsFaithfulPosMap] [Nontrivial n] (x : { x : ℍ // x ≠ 0 }) : + withMatrixQuantum[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + (Qam.reflIdempotent hφ (qamA hφ x) 1 = 0 ↔ x.1.trace = 0) := + by + withMatrixQuantumCtx[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + simp_rw [qamA_eq, ← rankOne_toMatrix_transpose_psi_symm] + rw [← Function.Injective.eq_iff (hφ.psi (ψ := φ) 0 (1 / 2)).injective] + simp_rw [Qam.reflIdempotent, Psi.schurMul_faithful, Psi.one, _root_.map_smul, + LinearEquiv.apply_symm_apply, smul_mul_assoc, ← + oneMapTranspose_symm_eq, ← _root_.map_mul, LinearEquiv.map_zero, smul_eq_zero, + StarAlgEquiv.map_eq_zero_iff, + AlgEquiv.map_eq_zero_iff, rankOne_eq_rankOneLm, one_div, inv_eq_zero, sq_eq_zero_iff, + Complex.ofReal_eq_zero, norm_eq_zero, x.property, false_or, + Module.End.mul_eq_comp, rankOneLm_comp_rankOneLm, smul_eq_zero, rankOneLm_eq_rankOne, + ContinuousLinearMap.coe_eq_zero, rankOne.eq_zero_iff, + Matrix.PosDef.ne_zero hφ.matrixIsPosDef.inv, or_false, + x.property, or_false, Module.Dual.IsFaithfulPosMap.inner_eq'] + haveI := hφ.matrixIsPosDef.invertible + rw [trace_mul_cycle, Matrix.mul_assoc, inv_mul_cancel_left_of_invertible, ← trace_star, + star_eq_zero] + +theorem qamA.is_almost_injective [hφ : φ.IsFaithfulPosMap] (x y : { x : ℍ // x ≠ 0 }) : + withMatrixQuantum[φ] + (qamA hφ x = qamA hφ y ↔ ∃ α : ℂˣ, x.1 = (α : ℂ) • y.1) := + by + withMatrixQuantumCtx[φ] + simp_rw [qamA_eq, ← rankOne_toMatrix_transpose_psi_symm, ← _root_.map_smul, ← + oneMapTranspose_symm_eq] + rw [Function.Injective.eq_iff (hφ.psi _ _).symm.injective, + Function.Injective.eq_iff (oneMapTranspose : ℍ ⊗[ℂ] ℍᵐᵒᵖ ≃⋆ₐ[ℂ] _).symm.injective, + Function.Injective.eq_iff hφ.toMatrix.injective] + have : + ∀ x : { x : ℍ // x ≠ 0 }, + (1 / (‖x.1‖ : ℂ) ^ 2) • (|x.1⟩⟨x.1| : l(ℍ)) = + |(1 / (‖x.1‖ : ℂ)) • x.1⟩⟨(1 / (‖x.1‖ : ℂ)) • x.1| := + by + intro y + symm + rw [show (1 / (‖y.1‖ : ℂ)) • y.1 = + star (1 / (‖y.1‖ : ℂ)) • y.1 by + simp [Complex.conj_ofReal]] + rw [rankOne_lm_smul_smul] + simp [Complex.conj_ofReal, sq] + simp_rw [this, ContinuousLinearMap.coe_inj] + constructor + · intro h + have hxnorm : ((1 / (‖x.1‖ : ℂ)) • x.1) ≠ 0 := by + apply smul_ne_zero + · simp [norm_ne_zero_iff.mpr x.property] + · exact x.property + have hynorm : ((1 / (‖y.1‖ : ℂ)) • y.1) ≠ 0 := by + apply smul_ne_zero + · simp [norm_ne_zero_iff.mpr y.property] + · exact y.property + obtain ⟨α, hα⟩ := rankOne.ext_iff hxnorm hynorm h + let β := (‖x.1‖ : ℂ) * (α : ℂ) * (1 / (‖y.1‖ : ℂ)) + have : β ≠ 0 := by + simp_rw [β, one_div] + apply mul_ne_zero + · apply mul_ne_zero + · simp only [Complex.ofReal_ne_zero, norm_ne_zero_iff] + exact x.property + · exact Units.ne_zero _ + · apply inv_ne_zero + simp only [Complex.ofReal_ne_zero, norm_ne_zero_iff] + exact y.property + use Units.mk0 β this + simp_rw [Units.val_mk0, β, mul_assoc] + rw [← smul_smul] + rw [smul_smul] at hα + rw [← hα, smul_smul, one_div, ← Complex.ofReal_inv, ← Complex.ofReal_mul, + mul_inv_cancel₀ (norm_ne_zero_iff.mpr (x.property)), Complex.ofReal_one, + one_smul] + · rintro ⟨α, hα⟩ + simp_rw [← ContinuousLinearMap.coe_inj, ← this, hα, rankOne_eq_rankOneLm, rankOneLm_smul, + smul_rankOneLm', smul_smul, norm_smul] + simp [Complex.normSq_eq_norm_sq, Complex.mul_conj, Complex.ofReal_mul, one_div, mul_pow] + +theorem qamA.is_reflexive_iff [hφ : φ.IsFaithfulPosMap] [Nontrivial n] (x : { x : ℍ // x ≠ 0 }) : + withMatrixQuantum[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + (Qam.reflIdempotent hφ (qamA hφ x) 1 = 1 ↔ ∃ α : ℂˣ, x.1 = (α : ℂ) • φ.matrix⁻¹) := + by + withMatrixQuantumCtx[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + simp_rw [qamA_eq, ← rankOne_toMatrix_transpose_psi_symm] + rw [← Function.Injective.eq_iff (hφ.psi (ψ := φ) 0 (1 / 2)).injective] + simp_rw [Qam.reflIdempotent, Psi.schurMul_faithful, Psi.one, _root_.map_smul, + LinearEquiv.apply_symm_apply, smul_mul_assoc, ← + oneMapTranspose_symm_eq, ← _root_.map_mul, ← _root_.map_smul] + rw [Function.Injective.eq_iff (oneMapTranspose : ℍ ⊗[ℂ] ℍᵐᵒᵖ ≃⋆ₐ[ℂ] _).symm.injective, + Function.Injective.eq_iff hφ.toMatrix.injective] + simp_rw [rankOne_eq_rankOneLm, Module.End.mul_eq_comp, rankOneLm_comp_rankOneLm, ← + smul_rankOneLm, rankOneLm_eq_rankOne, ContinuousLinearMap.coe_inj] + rw [← sub_eq_zero] + simp only [smul_smul] + rw [rankOne.smul_right_to_left] + have hstar : + star (star ((1 : ℂ) / (↑‖x.1‖ : ℂ) ^ 2) * + star (inner ℂ x.1 φ.matrix⁻¹)) = + ((1 : ℂ) / (↑‖x.1‖ : ℂ) ^ 2) * inner ℂ x.1 φ.matrix⁻¹ := by + simp + rw [hstar, ← rankOne.left_sub, rankOne.eq_zero_iff] + haveI := hφ.matrixIsPosDef.invertible + simp only [sub_eq_zero, Module.Dual.IsFaithfulPosMap.inner_eq'] + rw [trace_mul_cycle, inv_mul_of_invertible, Matrix.one_mul, ← trace_star] + simp only [hφ.matrixIsPosDef.inv.ne_zero, or_false] + constructor + · intro h + simp_rw [← h, smul_smul] + have : x.1.trace ≠ 0 := by + intro h' + rw [h', star_zero, MulZeroClass.mul_zero, zero_smul] at h + exact hφ.matrixIsPosDef.inv.ne_zero h.symm + have : 1 / ↑‖x.1‖ ^ 2 * star x.1.trace ≠ 0 := + by + apply mul_ne_zero + · simp only [one_div, inv_eq_zero, ne_eq, sq_eq_zero_iff, Complex.ofReal_eq_zero, + norm_eq_zero] + exact x.property + · simp only [ne_eq, star_eq_zero] + exact this + use Units.mk0 _ (inv_ne_zero this) + rw [Units.val_mk0, inv_mul_cancel₀ this, one_smul] + · rintro ⟨α, hx⟩ + simp_rw [hx, trace_smul, star_smul, norm_smul, trace_star] + have : (‖φ.matrix⁻¹‖ : ℂ) ^ 2 = φ.matrix⁻¹.trace := by + simp_rw [Complex.ofReal'_eq_isROrC_ofReal, ← inner_self_eq_norm_sq_to_K, + Module.Dual.IsFaithfulPosMap.inner_eq', + hφ.matrixIsPosDef.inv.1.eq, Matrix.mul_assoc, mul_inv_cancel_left_of_invertible] + simp only [Complex.ofReal_mul, mul_pow, one_div, _root_.mul_inv_rev, this, smul_smul, + smul_eq_mul] + rw [mul_rotate, mul_rotate _ _ (α : ℂ), mul_assoc _ _ (star (α : ℂ)), Complex.star_def, + Complex.mul_conj, mul_mul_mul_comm, Complex.normSq_eq_norm_sq, ← + Complex.ofReal_pow, ← Complex.ofReal_inv, ← Complex.ofReal_mul, + hφ.matrixIsPosDef.inv.1.eq, mul_inv_cancel₀ (PosDef.trace_ne_zero hφ.matrixIsPosDef.inv), + mul_inv_cancel₀, one_mul, Complex.ofReal_one, one_smul] + simp only [ne_eq, sq_eq_zero_iff, norm_eq_zero, Units.ne_zero, not_false_iff] + +theorem qamA.of_trivialGraph [hφ : φ.IsFaithfulPosMap] [Nontrivial n] [Nonempty n] : + withMatrixQuantum[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + letI : QuantumSetDeltaForm ℍ := Matrix.quantumSetDeltaForm (φ := φ) + qamA hφ ⟨φ.matrix⁻¹, hφ.matrixIsPosDef.inv.ne_zero⟩ = Qam.trivialGraph ℍ := + by + withMatrixQuantumCtx[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + letI : QuantumSetDeltaForm ℍ := Matrix.quantumSetDeltaForm (φ := φ) + rw [qamA_eq] + haveI := hφ.matrixIsPosDef.invertible + simp only [inv_mul_of_invertible, mul_inv_of_invertible, LinearMap.mulLeft_one, + LinearMap.mulRight_one, ← Module.End.one_eq_id, LinearMap.adjoint_one, one_mul] + have : ((‖φ.matrix⁻¹‖ : ℝ) : ℂ) ^ 2 = φ.matrix⁻¹.trace := by + simp_rw [Complex.ofReal'_eq_isROrC_ofReal, ← inner_self_eq_norm_sq_to_K, + Module.Dual.IsFaithfulPosMap.inner_eq', + hφ.matrixIsPosDef.inv.1.eq, Matrix.mul_assoc, mul_inv_cancel_left_of_invertible] + rw [this, one_div, Qam.trivialGraph_eq] + change φ.matrix⁻¹.trace⁻¹ • (1 : l(ℍ)) = φ.matrix⁻¹.trace⁻¹ • (1 : l(ℍ)) + rfl + +theorem Qam.unique_one_edge_and_refl [hφ : φ.IsFaithfulPosMap] [Nontrivial n] [Nonempty n] + {A : l(ℍ)} : + withMatrixQuantum[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + letI : QuantumSetDeltaForm ℍ := Matrix.quantumSetDeltaForm (φ := φ) + (hA : RealQam hφ A) → + hA.edges = 1 ∧ Qam.reflIdempotent hφ A 1 = 1 ↔ A = Qam.trivialGraph ℍ := + by + withMatrixQuantumCtx[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + letI : QuantumSetDeltaForm ℍ := Matrix.quantumSetDeltaForm (φ := φ) + intro hA + constructor + · rintro ⟨h1, h2⟩ + rw [RealQam.edges_eq_one_iff] at h1 + rcases h1 with ⟨x, rfl⟩ + rw [← qamA_eq] at h2 + rw [← qamA_eq, ← qamA.of_trivialGraph, qamA.is_almost_injective] + exact (qamA.is_reflexive_iff x).mp h2 + · rintro rfl + exact ⟨Qam.trivialGraph_edges, Qam.Nontracial.trivialGraph⟩ + +private theorem star_alg_equiv.is_isometry_iff [hφ : φ.IsFaithfulPosMap] [Nontrivial n] (f : + ℍ ≃⋆ₐ[ℂ] ℍ) : + withMatrixQuantum[φ] (StarAlgEquiv.IsIsometry f ↔ f φ.matrix = φ.matrix) := by + withMatrixQuantumCtx[φ] + rw [StarAlgEquiv.IsIsometry, isometry_iff_norm] + exact List.TFAE.out + (@Module.Dual.IsFaithfulPosMap.starAlgEquiv_is_isometry_tFAE n _ _ φ _ _ f) 4 0 + +-- The conjugation normal form produces large matrix expressions before simplification. +theorem qamA.isometric_starAlgEquiv_conj [hφ : φ.IsFaithfulPosMap] [Nontrivial n] + (x : { x : ℍ // x ≠ 0 }) : + withMatrixQuantum[φ] + (∀ {f : ℍ ≃⋆ₐ[ℂ] ℍ}, StarAlgEquiv.IsIsometry f → + f.toAlgEquiv.toLinearMap ∘ₗ qamA hφ x ∘ₗ f.symm.toAlgEquiv.toLinearMap = + qamA hφ + ⟨f x.1, + (LinearEquiv.map_ne_zero_iff f.toAlgEquiv.toLinearEquiv).mpr x.property⟩) := + by + withMatrixQuantumCtx[φ] + intro f hf + apply_fun hφ.toMatrix using (AlgEquiv.injective _) + have hf' := hf + rw [star_alg_equiv.is_isometry_iff] at hf + haveI := hφ.matrixIsPosDef.invertible + have this2 : f φ.matrix⁻¹ = φ.matrix⁻¹ := by + symm + apply inv_eq_left_inv + nth_rw 2 [← hf] + rw [← _root_.map_mul, inv_mul_of_invertible, _root_.map_one] + obtain ⟨U, rfl⟩ := f.of_matrix_is_inner + have hU : Commute φ.matrix (U⁻¹ : unitaryGroup n ℂ) := by + have hU' : Commute φ.matrix U := + (unitary_commutes_with_hφ_matrix_iff_isIsometry hφ U).mpr hf' + have hU'' : Commute (star φ.matrix) U := by + rw [star_eq_conjTranspose, hφ.matrixIsPosDef.1.eq] + exact hU' + exact hU''.star_right + simp only [← Module.End.mul_eq_comp, _root_.map_mul, innerAutStarAlg_equiv_toLinearMap, + innerAutStarAlg_equiv_symm_toLinearMap, InnerAut.toMatrix, qamA.toMatrix, + Matrix.smul_mul, Matrix.mul_smul, ← mul_kronecker_mul, ← Matrix.conj_mul] + let rpow := hφ.matrixIsPosDef.rpow + have := + calc + ((modAut (-(1 / 2)) : ℍ ≃ₐ[ℂ] ℍ) U) * + (rpow (1 / 2) * x.1 * rpow (1 / 2) * + ((modAut (-(1 / 2)) : ℍ ≃ₐ[ℂ] ℍ) (U⁻¹ : unitaryGroup n ℂ))) = + rpow (1 / 2) * U * (rpow (-(1 / 2)) * rpow (1 / 2)) * x.1 * + (rpow (1 / 2) * rpow (1 / 2)) * + (U⁻¹ : unitaryGroup n ℂ) * + rpow (-(1 / 2)) := + by + rw [show (modAut (-(1 / 2)) : ℍ ≃ₐ[ℂ] ℍ) = hφ.sig (-(1 / 2)) from rfl] + simp only [Module.Dual.IsFaithfulPosMap.sig_apply, Matrix.mul_assoc, rpow, neg_neg] + _ = rpow (1 / 2) * U * x.1 * (φ.matrix * (U⁻¹ : unitaryGroup n ℂ)) * rpow (-(1 / 2)) := + by + rw [PosDef.rpow_mul_rpow, PosDef.rpow_mul_rpow, + neg_add_cancel, PosDef.rpow_zero, Matrix.mul_one, + add_halves, PosDef.rpow_one_eq_self, Matrix.mul_assoc] + simp_rw [mul_assoc] + _ = rpow (1 / 2) * U * x.1 * (U⁻¹ : unitaryGroup n ℂ) * (rpow 1 * rpow (-(1 / 2))) := by + simp_rw [hU.eq, rpow, PosDef.rpow_one_eq_self, mul_assoc] + _ = rpow (1 / 2) * U * x.1 * (U⁻¹ : unitaryGroup n ℂ) * rpow (1 / 2) := + by + simp only [rpow, PosDef.rpow_mul_rpow] + have : (1 : ℝ) + -(1 / 2 : ℝ) = 1 / 2 := by norm_num + rw [this] + have hnorm : ‖(innerAutStarAlg U) x.1‖ = ‖x.1‖ := by + rw [StarAlgEquiv.IsIsometry, isometry_iff_norm] at hf' + exact hf' x.1 + rw [this] + rw [hnorm] + simp_rw [innerAutStarAlg_apply, Matrix.mul_assoc, hU.eq, UnitaryGroup.inv_apply] + simp_rw [unitaryGroup.star_coe_eq_coe_star] + simp only [rpow] + +theorem qamA.iso_iff [hφ : φ.IsFaithfulPosMap] [Nontrivial n] + {x y : { x : ℍ // x ≠ 0 }} :-- (hx : _root_.is_self_adjoint (qam_A hφ x)) + -- (hy : _root_.is_self_adjoint (qam_A hφ y)) + -- qam.iso (@qam_A.is_idempotent n _ _ φ hφ x) (qam_A.is_idempotent y) + withMatrixQuantum[φ] + (@Qam.Iso + n _ _ φ (qamA hφ x) (qamA hφ y) ↔ + ∃ U : unitaryGroup n ℂ, + (∃ β : ℂˣ, x.1 = innerAut U ((β : ℂ) • y.1)) ∧ Commute φ.matrix U) := + by + withMatrixQuantumCtx[φ] + rw [Qam.iso_iff] + simp_rw [← innerAutStarAlg_equiv_toLinearMap] + constructor + · rintro ⟨U, ⟨hU, hUU⟩⟩ + have hUUiso : StarAlgEquiv.IsIsometry (innerAutStarAlg U) := + (unitary_commutes_with_hφ_matrix_iff_isIsometry hφ U).mp hUU + have hU' : + qamA hφ x = + (innerAutStarAlg U).toAlgEquiv.toLinearMap ∘ₗ qamA hφ y ∘ₗ + (innerAutStarAlg U).symm.toAlgEquiv.toLinearMap := by + refine LinearMap.ext fun z => ?_ + simpa only [LinearMap.comp_apply, AlgEquiv.toLinearMap_apply, + StarAlgEquiv.coe_toAlgEquiv, StarAlgEquiv.apply_symm_apply] using + LinearMap.congr_fun hU ((innerAutStarAlg U).symm z) + rw [qamA.isometric_starAlgEquiv_conj _ hUUiso, qamA.is_almost_injective, + Subtype.coe_mk] at hU' + use U + constructor + · simpa [_root_.map_smul, AlgEquiv.toLinearMap_apply, StarAlgEquiv.coe_toAlgEquiv] using hU' + · exact hUU + · rintro ⟨U, ⟨hU, hUU⟩⟩ + have hUUiso : StarAlgEquiv.IsIsometry (innerAutStarAlg U) := + (unitary_commutes_with_hφ_matrix_iff_isIsometry hφ U).mp hUU + have hU' : + qamA hφ x = + (innerAutStarAlg U).toAlgEquiv.toLinearMap ∘ₗ qamA hφ y ∘ₗ + (innerAutStarAlg U).symm.toAlgEquiv.toLinearMap := by + rw [qamA.isometric_starAlgEquiv_conj _ hUUiso, qamA.is_almost_injective, + Subtype.coe_mk] + simpa [_root_.map_smul, AlgEquiv.toLinearMap_apply, StarAlgEquiv.coe_toAlgEquiv] using hU + use U + constructor + · rw [hU'] + ext z + simp only [LinearMap.comp_apply, AlgEquiv.toLinearMap_apply, + StarAlgEquiv.coe_toAlgEquiv, StarAlgEquiv.symm_apply_apply] + · exact hUU diff --git a/LeanPool/Monlib4/QuantumGraph/QamAExample.lean b/LeanPool/Monlib4/QuantumGraph/QamAExample.lean new file mode 100644 index 0000000000..f987744a88 --- /dev/null +++ b/LeanPool/Monlib4/QuantumGraph/QamAExample.lean @@ -0,0 +1,541 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.QuantumGraph.Nontracial +import LeanPool.Monlib4.QuantumGraph.Iso +import LeanPool.Monlib4.LinearAlgebra.ToMatrixOfEquiv +import LeanPool.Monlib4.LinearAlgebra.Ips.MatIps +import LeanPool.Monlib4.QuantumGraph.QamA +import LeanPool.Monlib4.LinearAlgebra.Matrix.Spectra + +section + +/-! + +# Examples of single-edged quantum graph + +This file contains examples of single-edged quantum graphs over `M₂(ℂ)`. The main result is + that all single-edged quantum graphs over `M₂(ℂ)` are isomorphic each other. + +-/ + + +open Matrix + +open scoped Matrix Kronecker Functional + +variable {n : Type _} [Fintype n] [DecidableEq n] + +local notation "ℍ" => Matrix n n ℂ + +private theorem and_true_iff (p : Prop) : p ∧ True ↔ p := + by simp + +private theorem true_and_iff (p : Prop) : True ∧ p ↔ p := + by simp + +private theorem false_and_iff (p : Prop) : False ∧ p ↔ False := + by simp + +private theorem false_or_iff (p : Prop) : False ∨ p ↔ p := + by simp + +/-- The trace functional on square matrices. -/ +def traceModuleDual {𝕜 n : Type _} [Fintype n] [RCLike 𝕜] : Module.Dual 𝕜 (Matrix n n 𝕜) := + traceLinearMap n 𝕜 𝕜 + +/-- The trace functional is faithful and positive. -/ +instance trace_isFaithfulPosMap {n : Type _} [Fintype n] {𝕜 : Type _} [RCLike 𝕜] : + (traceModuleDual : Module.Dual 𝕜 (Matrix n n 𝕜)).IsFaithfulPosMap := + by + simp_rw [Module.Dual.IsFaithfulPosMap_iff, Module.Dual.IsFaithful, Module.Dual.IsPosMap, + traceModuleDual, traceLinearMap_apply, + star_eq_conjTranspose, trace_conjTranspose_hMul_self_nonneg, + trace_conjTranspose_hMul_self_eq_zero, imp_true_iff, and_true_iff] + +theorem traceModuleDual_matrix {n : Type _} [Fintype n] [DecidableEq n] : + (traceModuleDual : Module.Dual ℂ (Matrix n n ℂ)).matrix = 1 := + by + ext i j + have := + (traceModuleDual : Module.Dual ℂ (Matrix n n ℂ)).apply fun k l => + ite (j = k) (ite (i = l) 1 0) 0 + simp only [traceModuleDual, traceLinearMap_apply, trace_iff, mul_apply, mul_ite, + MulZeroClass.mul_zero, mul_one, Finset.sum_ite_eq, Finset.mem_univ, if_true] at this + rw [traceModuleDual, ← this] + rfl + +open scoped BigOperators + +open scoped ComplexOrder + +private theorem PosDef_one_rpow_eq_trace_matrix_rpow (r : ℝ) : + (posDefOne : PosDef (1 : Matrix n n ℂ)).rpow r = + (trace_isFaithfulPosMap : + (traceModuleDual : Module.Dual ℂ ℍ).IsFaithfulPosMap).matrixIsPosDef.rpow + r := + by + calc + (posDefOne : PosDef (1 : Matrix n n ℂ)).rpow r = 1 := posDefOne_rpow n r + _ = + (trace_isFaithfulPosMap : + (traceModuleDual : Module.Dual ℂ ℍ).IsFaithfulPosMap).matrixIsPosDef.rpow r := by + rw [Matrix.PosDef.rpow_cast _ r traceModuleDual_matrix, posDefOne_rpow] + +theorem Matrix.smul_stdBasisMatrix {R α n m : Type _} [DecidableEq n] [DecidableEq m] + [Zero R] [SMulZeroClass α R] (a : α) (i : n) (j : m) (x : R) : + a • stdBasisMatrix i j x = stdBasisMatrix i j (a • x) := by + ext k l + by_cases hki : k = i <;> by_cases hlj : l = j <;> + simp [stdBasisMatrix, Matrix.single, hki, hlj] + +private theorem aux.ug : + (trace_isFaithfulPosMap : + (traceModuleDual : Module.Dual ℂ ℍ).IsFaithfulPosMap).toMatrix.symm = + toLinOfAlgEquiv := + by + rw [AlgEquiv.ext_iff]; intro x + simp_rw [Module.Dual.IsFaithfulPosMap.toMatrix_symm_apply] + simp_rw [toLinOfAlgEquiv_eq, rankOneStdBasis, one_smul, LinearMap.ext_iff, + ContinuousLinearMap.coe_sum, ContinuousLinearMap.coe_smul, + LinearMap.sum_apply, LinearMap.smul_apply, LinearMap.coe_mk, ContinuousLinearMap.coe_coe, + rankOne_apply, Module.Dual.IsFaithfulPosMap.inner_coord', ← + PosDef_one_rpow_eq_trace_matrix_rpow, posDefOne_rpow, Matrix.mul_one, AddHom.coe_mk, + Matrix.smul_stdBasisMatrix, + smul_eq_mul, Module.Dual.IsFaithfulPosMap.basis_apply, + ← PosDef_one_rpow_eq_trace_matrix_rpow, + posDefOne_rpow, + Matrix.mul_one, Matrix.smul_stdBasisMatrix, smul_eq_mul, mul_one] + intro x + repeat' + nth_rw 1 [← Finset.sum_product'] + simp_rw [Prod.mk.eta] + apply Finset.sum_congr rfl + intro _ _ + rfl + +theorem Matrix.stdBasisMatrix.transpose {R n m : Type _} [DecidableEq n] [DecidableEq m] + [Semiring R] (i : n) (j : m) : (stdBasisMatrix i j (1 : R))ᵀ = stdBasisMatrix j i (1 : R) := + by + ext k l + simp [transpose_apply, stdBasisMatrix, Matrix.single, and_comm] + +open scoped TensorProduct + +open scoped ComplexConjugate + +private theorem linear_map.rsmul_adjoint {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] (A : E →ₗ[𝕜] E) (r : ℝ) : + LinearMap.adjoint ((r : 𝕜) • A) = (r : 𝕜) • LinearMap.adjoint A := by + simp_rw [← @LinearMap.star_eq_adjoint 𝕜 E, star_smul, RCLike.star_def, RCLike.conj_ofReal] + +/-- when a matrix $x$ is non-zero, then for any unitary $U$, we also have $f_U(x)$ is non-zero -/ +private noncomputable def inner_aut_inv.of_ne_zero (U : unitaryGroup n ℂ) + (x : { x : Matrix n n ℂ // x ≠ 0 }) : { x : Matrix n n ℂ // x ≠ 0 } := + haveI : innerAut (star U : unitaryGroup n ℂ) x.1 ≠ 0 ↔ x.1 ≠ 0 := by + simp_rw [ne_eq, innerAut_eq_iff, innerAut_apply_zero] + (⟨innerAut (star U : unitaryGroup n ℂ) x.1, this.mpr x.property⟩ : + { x : Matrix n n ℂ // x ≠ 0 }) + +private theorem inner_aut_inv.of_ne_zero_eq (U : unitaryGroup n ℂ) (x : { x : ℍ // x ≠ 0 }) : + (inner_aut_inv.of_ne_zero U x).1 = innerAut (star U : unitaryGroup n ℂ) x.1 := + rfl + +theorem StarAlgEquiv.eq_comp_iff {R E₁ E₂ E₃ : Type _} [_inst_1 : CommSemiring R] + [_inst_2 : Semiring E₂] [_inst_3 : Semiring E₃] [_inst_4 : AddCommMonoid E₁] + [_inst_5 : Algebra R E₂] [_inst_6 : Algebra R E₃] [_inst_7 : Module R E₁] [_inst_8 : Star E₂] + [_inst_9 : Star E₃] (f : E₂ ≃⋆ₐ[R] E₃) (x : E₁ →ₗ[R] E₂) (y : E₁ →ₗ[R] E₃) : + f.toAlgEquiv.toLinearMap.comp x = y ↔ x = f.symm.toAlgEquiv.toLinearMap.comp y := + by + constructor <;> intro h + on_goal 1 => rw [← h] + on_goal 2 => rw [h] + all_goals + rw [LinearMap.ext_iff] + intro a + simp only [LinearMap.comp_apply, StarAlgEquiv.coe_toAlgEquiv, AlgEquiv.toLinearMap_apply, + StarAlgEquiv.symm_apply_apply, StarAlgEquiv.apply_symm_apply] + +theorem ite_comp {R U V W : Type _} [Semiring R] [AddCommMonoid U] [AddCommMonoid V] + [AddCommMonoid W] [Module R U] [Module R V] [Module R W] {P : Prop} [Decidable P] + {x y : W →ₗ[R] U} {f : V →ₗ[R] W} : ite P x y ∘ₗ f = ite P (x ∘ₗ f) (y ∘ₗ f) := by + split_ifs <;> simp + +theorem comp_ite {R U V W : Type _} [Semiring R] [AddCommMonoid U] [AddCommMonoid V] + [AddCommMonoid W] [Module R U] [Module R V] [Module R W] {P : Prop} [Decidable P] + {x y : W →ₗ[R] U} {f : U →ₗ[R] V} : f ∘ₗ ite P x y = ite P (f ∘ₗ x) (f ∘ₗ y) := by + split_ifs <;> simp + +theorem StarAlgEquiv.comp_symm_self {R U V : Type _} [CommSemiring R] [Semiring U] [Semiring V] + [Algebra R U] [Algebra R V] [Star U] [Star V] {f : U ≃⋆ₐ[R] V} : + f.toAlgEquiv.toLinearMap.comp f.symm.toAlgEquiv.toLinearMap = 1 := by + rw [StarAlgEquiv.eq_comp_iff, LinearMap.comp_one] + +theorem StarAlgEquiv.symm_comp_self {R U V : Type _} [CommSemiring R] [Semiring U] [Semiring V] + [Algebra R U] [Algebra R V] [Star U] [Star V] {f : U ≃⋆ₐ[R] V} : + f.symm.toAlgEquiv.toLinearMap.comp f.toAlgEquiv.toLinearMap = 1 := by + simp only [LinearMap.ext_iff, LinearMap.comp_apply, AlgEquiv.toLinearMap_apply, + StarAlgEquiv.coe_toAlgEquiv, StarAlgEquiv.symm_apply_apply, Module.End.one_apply, + forall_true_iff] + +theorem Qam.iso_preserves_ir_reflexive [Nontrivial n] {φ : Module.Dual ℂ ℍ} + [hφ : φ.IsFaithfulPosMap] {x y : ℍ →ₗ[ℂ] ℍ} (hxhy : @Qam.Iso n _ _ φ x y) + (ir_reflexive : Prop) [Decidable ir_reflexive] : + withMatrixQuantum[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + (Qam.reflIdempotent hφ x 1 = ite ir_reflexive 1 0 ↔ + Qam.reflIdempotent hφ y 1 = ite ir_reflexive 1 0) := + by + withMatrixQuantumCtx[φ] + letI : Coalgebra ℂ ℍ := Coalgebra.ofFiniteDimensionalHilbertAlgebra + obtain ⟨f, hf, h⟩ := hxhy + rw [StarAlgEquiv.comp_eq_iff, LinearMap.comp_assoc] at hf + have := List.TFAE.out (@Module.Dual.IsFaithfulPosMap.starAlgEquiv_is_isometry_tFAE n _ _ φ _ + _ f) 0 4 + have hisometry : StarAlgEquiv.IsIsometry f := by + change Isometry f + rw [isometry_iff_norm] + exact this.mp h + let conjugateMap : (ℍ →ₗ[ℂ] ℍ) → ℍ →ₗ[ℂ] ℍ := + fun A => f.toLinearMap ∘ₗ A ∘ₗ f.symm.toLinearMap + have hconj_injective : Function.Injective conjugateMap := by + intro A B hAB + ext z i j + have hz := LinearMap.congr_fun hAB (f z) + have hmatrix : A z = B z := by + simpa [conjugateMap, LinearMap.comp_apply] using hz + exact congrFun (congrFun hmatrix i) j + have hconj_one : conjugateMap 1 = 1 := by + ext z + simp [conjugateMap, LinearMap.comp_apply] + have hconj_zero : conjugateMap 0 = 0 := by + ext z + simp [conjugateMap] + have hconj_const : conjugateMap (ite ir_reflexive 1 0) = ite ir_reflexive 1 0 := by + by_cases hir : ir_reflexive <;> simp [hir, hconj_one, hconj_zero] + have hschur : + Qam.reflIdempotent hφ (conjugateMap y) 1 = + conjugateMap (Qam.reflIdempotent hφ y 1) := by + simpa [conjugateMap, hconj_one] using + (Qam.reflIdempotent_starAlgEquiv_conj (φ := φ) (f := f) hisometry y 1) + rw [hf] + rw [hschur] + constructor + · intro hA + apply hconj_injective + rw [hconj_const] + exact hA + · intro hA + rw [hA, hconj_const] + +/-- a function `f : A → B` is _almost injective_ if for all $x, y \in A$, + if $f(x)=f(y)$ then there exists some $0\neq\alpha \in \mathbb{C}$ such that + $x = \alpha y$ (in other words, $x$ and $y$ are co-linear) -/ +def Function.IsAlmostInjective {A B : Type _} (f : A → B) [SMul ℂˣ A] : Prop := + ∀ x y : A, f x = f y ↔ ∃ α : ℂˣ, x = α • y + +open scoped BigOperators ComplexConjugate + +private theorem nontracial_basis_apply {Q : ℍ} (hQ : Q.PosDef) (i j k l : n) : + (Matrix.stdBasisMatrix i j (1 : ℂ) * hQ.rpow (-(1 / 2))) k l + = ite (i = k) (hQ.rpow (-(1 / 2)) j l) 0 := by + by_cases hik : i = k + · subst k + simp [Matrix.mul_apply, stdBasisMatrix, Matrix.single] + · simp [Matrix.mul_apply, stdBasisMatrix, Matrix.single, hik] + +private theorem prod.eq' {α β : Type _} {p r : α} {q s : β} : (p, q) = (r, s) ↔ p = r ∧ q = s := + Prod.eq_iff_fst_eq_snd_eq + +theorem Matrix.IsAlmostHermitian.spectrum {x : Matrix n n ℂ} (hx : x.IsAlmostHermitian) : + _root_.spectrum ℂ (toLin' x) = {x_1 : ℂ | ∃ i : n, hx.eigenvalues i = x_1} := + by + nth_rw 1 [Matrix.IsAlmostHermitian.eq_smul_matrix hx] + nth_rw 1 [(hx.matrix_isHermitian).spectral_theorem''] + rw [← _root_.map_smul, innerAut.spectrum_eq, ← diagonal_smul, Matrix.spectrum_toLin', + spectrum_diagonal] + simp [Set.range, Pi.smul_apply, Function.comp_apply, Matrix.IsAlmostHermitian.eigenvalues] + +private theorem matrix.is_almost_hermitian.matrix_IsHermitian.eigenvalues_ne_zero + {x : { x : ℍ // x ≠ 0 }} (hx : x.1.IsAlmostHermitian) : + ((@RCLike.ofReal ℂ _) ∘ hx.matrix_isHermitian.eigenvalues : n → ℂ) ≠ 0 := + by + intro hh + have heig : hx.matrix_isHermitian.eigenvalues = 0 := by + ext i + have hi := congrFun hh i + simp only [Function.comp_apply, Pi.zero_apply] at hi + exact RCLike.ofReal_inj.mp hi + have hmatrix_zero : hx.matrix = 0 := (hx.matrix_isHermitian.eigenvalues_eq_zero_iff).mp heig + have h := hx.eq_smul_matrix + rw [hmatrix_zero, smul_zero] at h + exact x.property h + +private theorem example_aux {x : { x : Matrix (Fin 2) (Fin 2) ℂ // x ≠ 0 }} + (hx : (x.val : Matrix (Fin 2) (Fin 2) ℂ).IsAlmostHermitian) + (hh : (hx.matrix_isHermitian.eigenvalues 0 : ℂ) = -(hx.matrix_isHermitian.eigenvalues 1 : ℂ)) + (i : Fin 2) : (hx.matrix_isHermitian.eigenvalues i : ℂ) ≠ 0 := + by + have h := matrix.is_almost_hermitian.matrix_IsHermitian.eigenvalues_ne_zero hx + simp only [ne_eq, funext_iff, Function.comp_apply, Pi.zero_apply] at h + simp only [Complex.ofReal'_eq_isROrC_ofReal] at * + revert i + simp_rw [Fin.forall_fin_two, ne_eq, hh, neg_eq_zero, and_self_iff] at h ⊢ + exact h + +theorem spectra_fin_two {x : Matrix (Fin 2) (Fin 2) ℂ} + (hx : (x : Matrix (Fin 2) (Fin 2) ℂ).IsAlmostHermitian) : + hx.spectra = {(hx.eigenvalues 0 : ℂ), (hx.eigenvalues 1 : ℂ)} := + rfl + +theorem spectra_fin_two' {x : Matrix (Fin 2) (Fin 2) ℂ} + (hx : (x : Matrix (Fin 2) (Fin 2) ℂ).IsAlmostHermitian) : + hx.spectra = [(hx.eigenvalues 0 : ℂ), (hx.eigenvalues 1 : ℂ)] := + rfl + +theorem spectra_fin_two'' {α : Type _} (a : Fin 2 → α) : + Multiset.map (a : Fin 2 → α) Finset.univ.val = {a 0, a 1} := + rfl + +open scoped List +theorem List.coe_inj {α : Type _} (l₁ l₂ : List α) : (l₁ : Multiset α) = l₂ ↔ l₁ ~ l₂ := + Multiset.coe_eq_coe + +theorem spectra_fin_two_ext_aux {A : Type _} (α β γ : A) : + ({α, α} : Multiset A) = {β, γ} ↔ α = β ∧ α = γ := + by + simp only [Multiset.insert_eq_cons] + constructor + · intro h + simp_rw [Multiset.cons_eq_cons, Multiset.singleton_inj, Multiset.singleton_eq_cons_iff] at h + rcases h with (h1 | ⟨_, cs, ⟨hcs₁, _⟩, ⟨hcs₃, _⟩⟩) + · exact h1 + · exact ⟨hcs₁, hcs₃.symm⟩ + · rintro ⟨rfl, rfl⟩ + rfl + +theorem spectra_fin_two_ext {α : Type _} (α₁ α₂ β₁ β₂ : α) : + ({α₁, α₂} : Multiset α) = {β₁, β₂} ↔ α₁ = β₁ ∧ α₂ = β₂ ∨ α₁ = β₂ ∧ α₂ = β₁ := + by + by_cases H₁ : α₁ = α₂ + · rw [H₁, spectra_fin_two_ext_aux] + constructor + · rintro ⟨h1, h2⟩ + left + exact ⟨h1, h2⟩ + · rintro (⟨h1, h2⟩ | ⟨h1, h2⟩) + · exact ⟨h1, h2⟩ + · exact ⟨h2, h1⟩ + by_cases h' : α₁ = β₁ + · simp_rw [h', true_and_iff, Multiset.insert_eq_cons, Multiset.cons_inj_right, + Multiset.singleton_inj] + constructor + · intro hi + left + exact hi + rintro (h | ⟨_, h2⟩) + · exact h + · rw [← h', eq_comm] at h2 + contradiction + simp_rw [Multiset.insert_eq_cons, Multiset.cons_eq_cons, Multiset.singleton_inj, + Multiset.singleton_eq_cons_iff, ne_eq, h', false_and_iff, false_or_iff, not_false_iff, + true_and_iff] + simp only [exists_eq_right_right, and_true_iff, eq_comm] + simp_rw [and_comm] + +@[reducible, instance] +def Multiset.hasSmul {α : Type _} [SMul ℂ α] : SMul ℂ (Multiset α) + where smul a s := s.map ((· • ·) a) + +theorem Multiset.smul_fin_two {α : Type _} [SMul ℂ α] (a b : α) (c : ℂ) : + (c • ({a, b} : Multiset α) : Multiset α) = {c • a, c • b} := + rfl + +omit [Fintype n] [DecidableEq n] in +theorem IsAlmostHermitian.smul_eq {x : Matrix n n ℂ} (hx : x.IsAlmostHermitian) (c : ℂ) : + (hx.smul c).scalar • (hx.smul c).matrix = c • x := by rw [← (hx.smul c).eq_smul_matrix] + +theorem spectra_fin_two_ext_of_traceless {α₁ α₂ β₁ β₂ : ℂ} (hα₂ : α₂ ≠ 0) (hβ₂ : β₂ ≠ 0) + (h₁ : α₁ = -α₂) (h₂ : β₁ = -β₂) : ∃ c : ℂˣ, ({α₁, α₂} : Multiset ℂ) = (c : ℂ) • {β₁, β₂} := + by + simp_rw [h₁, h₂, Multiset.smul_fin_two, smul_neg] + use Units.mk0 (α₂ * β₂⁻¹) (mul_ne_zero hα₂ (inv_ne_zero hβ₂)) + simp_rw [Units.val_mk0, smul_eq_mul, mul_assoc, inv_mul_cancel₀ hβ₂, mul_one] + +theorem Matrix.IsAlmostHermitian.trace {x : Matrix n n ℂ} (hx : x.IsAlmostHermitian) : + x.trace = ∑ i, hx.eigenvalues i := + by + nth_rw 1 [hx.eq_smul_matrix] + rw [trace_smul, hx.matrix_isHermitian.trace_eq_sum_eigenvalues] + simp [Matrix.IsAlmostHermitian.eigenvalues, Finset.mul_sum] + +/-- The unitary eigenvector matrix chosen for an almost-Hermitian matrix. -/ +@[reducible] +noncomputable def Matrix.IsAlmostHermitian.eigenvectorUnitary {x : Matrix n n ℂ} + (hx : x.IsAlmostHermitian) : unitaryGroup n ℂ := +hx.matrix_isHermitian.eigenvectorUnitary +/-- The eigenvector matrix chosen for an almost-Hermitian matrix. -/ +@[reducible] +noncomputable def Matrix.IsAlmostHermitian.eigenvectorMatrix {x : Matrix n n ℂ} + (hx : x.IsAlmostHermitian) : Matrix n n ℂ := +hx.matrix_isHermitian.eigenvectorMatrix + +theorem Matrix.IsAlmostHermitian.eigenvectorMatrix_eq {x : Matrix n n ℂ} + (hx : x.IsAlmostHermitian) : hx.eigenvectorMatrix = hx.matrix_isHermitian.eigenvectorMatrix := + rfl +theorem Matrix.IsAlmostHermitian.eigenvectorUnitary_eq {x : Matrix n n ℂ} + (hx : x.IsAlmostHermitian) : + ↑hx.eigenvectorUnitary = hx.eigenvectorMatrix := +rfl + +theorem Matrix.IsAlmostHermitian.spectral_theorem' {x : Matrix n n ℂ} (hx : x.IsAlmostHermitian) : + x = + hx.scalar • + innerAut hx.eigenvectorUnitary + (diagonal ((@RCLike.ofReal ℂ _) ∘ hx.matrix_isHermitian.eigenvalues)) := + by rw [← Matrix.IsHermitian.spectral_theorem'', ← hx.eq_smul_matrix] + +theorem Matrix.IsAlmostHermitian.eigenvalues_eq {x : Matrix n n ℂ} (hx : x.IsAlmostHermitian) : + hx.eigenvalues = hx.scalar • ((@RCLike.ofReal ℂ _) ∘ hx.matrix_isHermitian.eigenvalues : + n → ℂ) := + rfl + +theorem Matrix.IsAlmostHermitian.spectral_theorem {x : Matrix n n ℂ} (hx : x.IsAlmostHermitian) : + x = + innerAut hx.eigenvectorUnitary (diagonal hx.eigenvalues) := + by + simp_rw [hx.eigenvalues_eq, diagonal_smul, _root_.map_smul] + exact Matrix.IsAlmostHermitian.spectral_theorem' _ + +theorem Matrix.IsAlmostHermitian.eigenvalues_eq_zero_iff {x : Matrix n n ℂ} + (hx : x.IsAlmostHermitian) : hx.eigenvalues = 0 ↔ x = 0 := + by + rw [Matrix.IsAlmostHermitian.eigenvalues_eq] + conv_rhs => rw [hx.eq_smul_matrix] + rw [smul_eq_zero, smul_eq_zero] + have hcomp : + ((@RCLike.ofReal ℂ _) ∘ hx.matrix_isHermitian.eigenvalues : n → ℂ) = 0 ↔ + hx.matrix_isHermitian.eigenvalues = 0 := by + constructor + · intro h + ext i + exact RCLike.ofReal_inj.mp (congrFun h i) + · intro h + ext i + simp [h] + rw [hcomp, hx.matrix_isHermitian.eigenvalues_eq_zero_iff] + +private theorem matrix.is_almost_hermitian.eigenvalues_eq_zero_iff_aux + {x : Matrix (Fin 2) (Fin 2) ℂ} (hx : x.IsAlmostHermitian) : + hx.eigenvalues 0 = 0 ∧ hx.eigenvalues 1 = 0 ↔ x = 0 := + by + rw [← hx.eigenvalues_eq_zero_iff, funext_iff] + simp_rw [Fin.forall_fin_two, Pi.zero_apply] + +omit [Fintype n] in +theorem Matrix.diagonal_eq_zero_iff {x : n → ℂ} : diagonal x = 0 ↔ x = 0 := by + simp_rw [← diagonal_zero, diagonal_eq_diagonal_iff, funext_iff, Pi.zero_apply] + +theorem Matrix.unitaryGroup.star_mul_cancel_right {U₁ U₂ : unitaryGroup n ℂ} : + U₁ * star U₂ * U₂ = U₁ := +by simp only [mul_assoc, Unitary.star_mul_self, mul_one] + +theorem qamA.finTwoIso (x y : { x : Matrix (Fin 2) (Fin 2) ℂ // x ≠ 0 }) + : withMatrixQuantum[(traceModuleDual : Module.Dual ℂ (Matrix (Fin 2) (Fin 2) ℂ))] + letI : Coalgebra ℂ (Matrix (Fin 2) (Fin 2) ℂ) := + Coalgebra.ofFiniteDimensionalHilbertAlgebra + (hx1 : IsSelfAdjoint (qamA trace_isFaithfulPosMap x)) → + (hx2 : + Qam.reflIdempotent trace_isFaithfulPosMap (qamA trace_isFaithfulPosMap x) 1 = 0) → + (hy1 : IsSelfAdjoint (qamA trace_isFaithfulPosMap y)) → + (hy2 : + Qam.reflIdempotent trace_isFaithfulPosMap (qamA trace_isFaithfulPosMap y) 1 = 0) → + @Qam.Iso (Fin 2) _ _ traceModuleDual (qamA trace_isFaithfulPosMap x) + (qamA trace_isFaithfulPosMap y) := + by + withMatrixQuantumCtx[(traceModuleDual : Module.Dual ℂ (Matrix (Fin 2) (Fin 2) ℂ))] + letI : Coalgebra ℂ (Matrix (Fin 2) (Fin 2) ℂ) := + Coalgebra.ofFiniteDimensionalHilbertAlgebra + intro hx1 hx2 hy1 hy2 + simp_rw [qamA.iso_iff, traceModuleDual_matrix, Commute.one_left, and_true_iff, + _root_.map_smul] + rw [exists_comm] + obtain ⟨Hx, _⟩ := (qamA.is_self_adjoint_iff x).mp hx1 + obtain ⟨Hy, _⟩ := (qamA.is_self_adjoint_iff y).mp hy1 + simp_rw [qamA.is_irreflexive_iff, Hx.trace, Hy.trace, Fin.sum_univ_two, + add_eq_zero_iff_eq_neg] at hx2 hy2 + rw [Matrix.IsAlmostHermitian.spectral_theorem Hx, Matrix.IsAlmostHermitian.spectral_theorem Hy] + have HX : diagonal Hx.eigenvalues = of ![![-Hx.eigenvalues 1, 0], ![0, Hx.eigenvalues 1]] := + by + rw [← hx2, ← Matrix.ext_iff] + simp only [Fin.forall_fin_two, diagonal_apply, of_apply, if_true, one_ne_zero, + if_false, zero_ne_one, if_false] + simp only [cons_val_zero, cons_val_one, and_self_iff] + have HY : diagonal Hy.eigenvalues = of ![![-Hy.eigenvalues 1, 0], ![0, Hy.eigenvalues 1]] := + by + rw [← hy2, ← Matrix.ext_iff] + simp only [Fin.forall_fin_two, diagonal_apply, of_apply, if_true, one_ne_zero, + if_false, zero_ne_one, if_false] + simp only [cons_val_zero, cons_val_one, and_self_iff] + simp_rw [HY, HX, innerAut_apply_innerAut] + have hx₁ : Hx.eigenvalues 1 ≠ 0 := by + intro hx₁ + have : diagonal Hx.eigenvalues = 0 := + by + rw [HX, hx₁, neg_zero, ← Matrix.ext_iff] + simp_rw [Fin.forall_fin_two] + simp only [of_apply] + simp only [cons_val_zero, cons_val_one] + aesop + rw [Matrix.diagonal_eq_zero_iff, Matrix.IsAlmostHermitian.eigenvalues_eq_zero_iff] at this + exact (Subtype.mem x) this + have hy₁ : Hy.eigenvalues 1 ≠ 0 := by + intro hy₁ + have : diagonal Hy.eigenvalues = 0 := + by + rw [HY, hy₁, neg_zero, ← Matrix.ext_iff] + simp_rw [Fin.forall_fin_two] + simp only [of_apply] + simp only [cons_val_zero, cons_val_one] + aesop + rw [Matrix.diagonal_eq_zero_iff, Matrix.IsAlmostHermitian.eigenvalues_eq_zero_iff] at this + exact (Subtype.mem y) this + use Units.mk0 (Hx.eigenvalues 1 * (Hy.eigenvalues 1)⁻¹) (mul_ne_zero hx₁ (inv_ne_zero hy₁)) + use Hx.eigenvectorUnitary * star Hy.eigenvectorUnitary + -- use ⟨Hx.eigenvectorMatrix, Hx.eigenvectorMatrix_mem_unitaryGroup⟩ * star + -- (⟨Hy.eigenvectorMatrix, Hy.eigenvectorMatrix_mem_unitaryGroup⟩ : unitaryGroup (Fin 2) ℂ) + have : + (Hx.eigenvalues 1 * (Hy.eigenvalues 1)⁻¹) • diagonal Hy.eigenvalues = diagonal Hx.eigenvalues := + by + rw [HX, HY] + simp only [smul_of, smul_cons, smul_eq_mul, mul_neg, MulZeroClass.mul_zero, + smul_empty, EmbeddingLike.apply_eq_iff_eq] + simp only [inv_mul_cancel_right₀ hy₁] + simp_rw [Matrix.unitaryGroup.star_mul_cancel_right, Units.val_mk0, + ← _root_.map_smul, ← HY, ← HX, this] + +theorem Qam.finTwoIsoOfSingleEdge {A B : Matrix (Fin 2) (Fin 2) ℂ →ₗ[ℂ] Matrix (Fin 2) (Fin 2) ℂ} : + withMatrixQuantum[(traceModuleDual : Module.Dual ℂ (Matrix (Fin 2) (Fin 2) ℂ))] + letI : Coalgebra ℂ (Matrix (Fin 2) (Fin 2) ℂ) := + Coalgebra.ofFiniteDimensionalHilbertAlgebra + (hx0 : RealQam trace_isFaithfulPosMap A) → + (hy0 : RealQam trace_isFaithfulPosMap B) → + (hx : hx0.edges = 1) → (hy : hy0.edges = 1) → + (hx1 : _root_.IsSelfAdjoint A) → + (hx2 : Qam.reflIdempotent trace_isFaithfulPosMap A 1 = 0) → + (hy1 : _root_.IsSelfAdjoint B) → + (hy2 : Qam.reflIdempotent trace_isFaithfulPosMap B 1 = 0) → + @Qam.Iso (Fin 2) _ _ traceModuleDual A B := + by + withMatrixQuantumCtx[(traceModuleDual : Module.Dual ℂ (Matrix (Fin 2) (Fin 2) ℂ))] + letI : Coalgebra ℂ (Matrix (Fin 2) (Fin 2) ℂ) := + Coalgebra.ofFiniteDimensionalHilbertAlgebra + intro hx0 hy0 hx hy hx1 hx2 hy1 hy2 + rw [RealQam.edges_eq_one_iff] at hx hy + obtain ⟨x, rfl⟩ := hx + obtain ⟨y, rfl⟩ := hy + exact qamA.finTwoIso x y hx1 hx2 hy1 hy2 + +end diff --git a/LeanPool/Monlib4/QuantumGraph/ToProjections.lean b/LeanPool/Monlib4/QuantumGraph/ToProjections.lean new file mode 100644 index 0000000000..e97f160e14 --- /dev/null +++ b/LeanPool/Monlib4/QuantumGraph/ToProjections.lean @@ -0,0 +1,918 @@ +/- +Copyright (c) 2023 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import LeanPool.Monlib4.QuantumGraph.Nontracial +import LeanPool.Monlib4.LinearAlgebra.Ips.MinimalProj +import LeanPool.Monlib4.QuantumGraph.Iso +import LeanPool.Monlib4.QuantumGraph.PiMatFinTwo + +/-! + +# Quantum graphs as projections + +This file contains the definition of a quantum graph as a projection, and the proof that the + +-/ + + +variable {p : Type _} [Fintype p] [DecidableEq p] {n : p → Type _} [∀ i, Fintype (n i)] + [∀ i, DecidableEq (n i)] + +open scoped TensorProduct BigOperators Kronecker Functional ComplexOrder + +-- local notation `ℍ` := matrix (n i) (n i) ℂ +@[reducible] +local notation "ℍ" => Matrix p p ℂ +@[reducible] +local notation "ℍ_" i => Matrix (n i) (n i) ℂ + +-- local notation `⊗K` := matrix (n × n) (n × n) ℂ +@[reducible] +local notation "l(" x ")" => x →ₗ[ℂ] x +@[reducible] +local notation "L(" x ")" => x →L[ℂ] x +@[reducible] +local notation "e_{" i "," j "}" => Matrix.stdBasisMatrix i j (1 : ℂ) + +variable {φ : Module.Dual ℂ (Matrix p p ℂ)} + --{φ : Π i, module.dual ℂ (ℍ_ i)} + --[hφ : ∀ i, fact (φ i).is_faithful_pos_map] + +open scoped Matrix + +open Matrix + +local notation "|" x "⟩⟨" y "|" => @rankOne ℂ _ _ _ _ _ _ _ x y + +local notation "m" => LinearMap.mul' ℂ ℍ + +local notation "η" => Algebra.linearMap ℂ ℍ + +local notation x " ⊗ₘ " y => TensorProduct.map x y + +local notation "υ" => (TensorProduct.assoc ℂ ℍ ℍ ℍ : (ℍ ⊗[ℂ] ℍ) ⊗[ℂ] ℍ →ₗ[ℂ] ℍ ⊗[ℂ] ℍ ⊗[ℂ] ℍ) + +local notation "υ⁻¹" => + (LinearEquiv.symm (TensorProduct.assoc ℂ ℍ ℍ ℍ) : ℍ ⊗[ℂ] ℍ ⊗[ℂ] ℍ →ₗ[ℂ] (ℍ ⊗[ℂ] ℍ) ⊗[ℂ] ℍ) + +local notation "ϰ" => ((TensorProduct.comm ℂ ℍ ℂ) : ℍ ⊗[ℂ] ℂ →ₗ[ℂ] ℂ ⊗[ℂ] ℍ) + +local notation "ϰ⁻¹" => (LinearEquiv.symm (TensorProduct.comm ℂ ℍ ℂ) : ℂ ⊗[ℂ] ℍ →ₗ[ℂ] ℍ ⊗[ℂ] ℂ) + +local notation "τ" => (TensorProduct.lid ℂ ℍ : ℂ ⊗[ℂ] ℍ →ₗ[ℂ] ℍ) + +local notation "τ⁻¹" => (LinearEquiv.symm (TensorProduct.lid ℂ ℍ) : ℍ →ₗ[ℂ] ℂ ⊗[ℂ] ℍ) + +local notation "id" => (1 : ℍ →ₗ[ℂ] ℍ) + +/-- Elaborate projection/QAM statements with the matrix coalgebra induced by `φ`. -/ +syntax "withProjectionMatrixCoalgebraQuantum[" term "] " term : term +macro_rules + | `(withProjectionMatrixCoalgebraQuantum[$φ] $p) => + `(withMatrixQuantum[$φ] + letI : Coalgebra ℂ (Matrix p p ℂ) := Coalgebra.ofFiniteDimensionalHilbertAlgebra + $p) + +/-- Introduce the projection matrix coalgebra context induced by `φ` in a proof. -/ +syntax "withProjectionMatrixCoalgebraQuantumCtx" "[" term "]" : tactic +macro_rules + | `(tactic| withProjectionMatrixCoalgebraQuantumCtx[$φ]) => + `(tactic| + withMatrixQuantumCtx[$φ]; + letI : Coalgebra ℂ (Matrix p p ℂ) := Coalgebra.ofFiniteDimensionalHilbertAlgebra) + +namespace FiniteDimensional + +/-- Compatibility spelling for the old `FiniteDimensional.finrank` namespace. -/ +noncomputable abbrev finrank (𝕜 E : Type*) [DivisionRing 𝕜] [AddCommGroup E] + [Module 𝕜 E] : ℕ := + Module.finrank 𝕜 E + +end FiniteDimensional + +namespace Qam + +/-- The reflexive idempotent product used in older Monlib quantum-graph files. -/ +noncomputable abbrev reflIdempotent (hφ : φ.IsFaithfulPosMap) (A : l(ℍ)) : + l(ℍ) →ₗ[ℂ] l(ℍ) := +by + letI : φ.IsFaithfulPosMap := hφ + withProjectionMatrixCoalgebraQuantumCtx[φ] + exact schurMul A + +theorem isReal_and_idempotent_iff_psi_orthogonal_projection + (hφ : φ.IsFaithfulPosMap) (A : l(ℍ)) : + Qam.reflIdempotent hφ A A = A ∧ LinearMap.IsReal A ↔ + IsIdempotentElem ((hφ.psi (ψ := φ) 0 (1 / 2)) A) ∧ + IsSelfAdjoint ((hφ.psi (ψ := φ) 0 (1 / 2)) A) := by + letI : φ.IsFaithfulPosMap := hφ + withProjectionMatrixCoalgebraQuantumCtx[φ] + change A •ₛ A = A ∧ LinearMap.IsReal A ↔ + IsIdempotentElem ((QuantumSet.Psi (A := ℍ) (B := ℍ) 0 (1 / 2)) A) ∧ + IsSelfAdjoint ((QuantumSet.Psi (A := ℍ) (B := ℍ) 0 (1 / 2)) A) + rw [← schurIdempotent_iff_Psi_isIdempotentElem A 0 (1 / 2)] + convert (and_congr_right ?_) using 1 + intro _ + rw [isReal_iff_Psi_isSelfAdjoint A] + rw [show QuantumSet.k ℍ = 0 by rfl] + norm_num + +end Qam + +/-- Linear equivalence from block-diagonal matrix coordinates to the tensor product of + block-diagonal matrices. -/ +noncomputable def blockDiag'KroneckerEquiv {φ : ∀ i, Module.Dual ℂ (ℍ_ i)} + (hφ : ∀ i, (φ i).IsFaithfulPosMap) : + Matrix (Σ i, n i × n i) (Σ i, n i × n i) ℂ ≃ₗ[ℂ] + { x : Matrix (Σ i, n i) (Σ i, n i) ℂ // x.IsBlockDiagonal } ⊗[ℂ] + { x : Matrix (Σ i, n i) (Σ i, n i) ℂ // x.IsBlockDiagonal } := + ((Module.Dual.pi.IsFaithfulPosMap.toMatrix fun i => (hφ i)).symm.toLinearEquiv.trans + ((Module.Dual.pi.IsFaithfulPosMap.psi hφ hφ 0 0).trans + (LinearEquiv.TensorProduct.map (1 : (∀ i, Matrix (n i) (n i) ℂ) ≃ₗ[ℂ] _) + (Pi.transposeAlgEquiv p n : _ ≃ₐ[ℂ] _ᵐᵒᵖ).symm.toLinearEquiv))).trans + (LinearEquiv.TensorProduct.map isBlockDiagonalPiAlgEquiv.symm.toLinearEquiv + isBlockDiagonalPiAlgEquiv.symm.toLinearEquiv) + +theorem Matrix.conj_conjTranspose' {R n₁ n₂ : Type _} [InvolutiveStar R] (A : Matrix n₁ n₂ R) : + (Aᴴᵀ)ᴴ = Aᵀ := by rw [← conj_conjTranspose A] + +-- Porting the inherited block-diagonal matrix calculation needs more heartbeats after Mathlib +-- changes. +theorem toMatrix_mulLeft_mulRight_adjoint {φ : ∀ i, Module.Dual ℂ (Matrix (n i) (n i) ℂ)} + (hφ : ∀ i, (φ i).IsFaithfulPosMap) (x y : ∀ i, ℍ_ i) : + letI : ∀ i, (φ i).IsFaithfulPosMap := hφ + withPiBlockQuantum[φ] + ((Module.Dual.pi.IsFaithfulPosMap.toMatrix fun i => (hφ i)) + (LinearMap.mulLeft ℂ x * (LinearMap.adjoint (LinearMap.mulRight ℂ y) : l(∀ i, ℍ_ i))) = + blockDiagonal' fun i => x i ⊗ₖ ((hφ i).sig (1 / 2) (y i))ᴴᵀ) := + by + letI : ∀ i, (φ i).IsFaithfulPosMap := hφ + withPiBlockQuantumCtx[φ] + simp_rw [_root_.map_mul, ← lmul_eq_mul, ← rmul_eq_mul, rmul_adjoint, pi_lmul_toMatrix, + pi_rmul_toMatrix, ← blockDiagonal'_mul, ← mul_kronecker_mul] + simp only [Matrix.mul_one, Matrix.one_mul] + apply Matrix.blockDiagonal'_inj.mpr + funext i + rw [show (modAut (-QuantumSet.k ((i : p) → Matrix (n i) (n i) ℂ) - 1) (star y)) i = + (hφ i).sig (-1) ((y i)ᴴ) by + change (Module.Dual.pi.IsFaithfulPosMap.sig hφ + (-QuantumSet.k ((i : p) → Matrix (n i) (n i) ℂ) - 1) (star y)) i = + (hφ i).sig (-1) (y i)ᴴ + rw [show QuantumSet.k ((i : p) → Matrix (n i) (n i) ℂ) = 0 by rfl] + simp [Module.Dual.pi.IsFaithfulPosMap.sig_eq_pi_blocks, Pi.star_apply, + star_eq_conjTranspose]] + rw [show (hφ i).sig (1 / 2) ((hφ i).sig (-1) ((y i)ᴴ)) = + ((hφ i).sig (1 / 2) (y i))ᴴ by + rw [Module.Dual.IsFaithfulPosMap.sig_apply_sig] + have : (1 / 2 : ℝ) + -1 = -(1 / 2) := by norm_num + rw [this] + exact (Module.Dual.IsFaithfulPosMap.sig_conjTranspose (hφ i) (1 / 2) (y i)).symm] + rfl + +-- @[instance] +-- private def smul_comm_class_aux {ι₂ : Type _} {E₂ : ι₂ → Type _} [∀ i, AddCommMonoid (E₂ i)] +-- [∀ i, Module ℂ (E₂ i)] : ∀ i : ι₂, SMulCommClass ℂ ℂ (E₂ i) := fun i => by infer_instance + +/-- Apply a linear map between dependent products to a selected input and output component. -/ +@[simps] +def Pi.LinearMap.apply {ι₁ ι₂ : Type _} {E₁ : ι₁ → Type _} [DecidableEq ι₁] + [∀ i, AddCommMonoid (E₁ i)] [∀ i, Module ℂ (E₁ i)] {E₂ : ι₂ → Type _} + [∀ i, AddCommMonoid (E₂ i)] [∀ i, Module ℂ (E₂ i)] (i : ι₁) (j : ι₂) : + ((∀ a, E₁ a) →ₗ[ℂ] ∀ a, E₂ a) →ₗ[ℂ] E₁ i →ₗ[ℂ] E₂ j + where + toFun x := + { toFun := fun a => (x ((LinearMap.single ℂ E₁ i : E₁ i →ₗ[ℂ] ∀ b, E₁ b) a)) j + map_add' := fun a b => by simp only [map_add, Pi.add_apply] + map_smul' := fun c a => by + simp only [LinearMap.map_smul, Pi.smul_apply, RingHom.id_apply] } + map_add' x y := by + ext a + simp only [LinearMap.add_apply, Pi.add_apply, LinearMap.coe_mk] + rfl + map_smul' c x := by + ext a + simp only [LinearMap.smul_apply, Pi.smul_apply, RingHom.id_apply, + LinearMap.coe_mk] + rfl + +-- The matrix/tensor rank-one calculation unfolds several equivalences after the Mathlib port. +theorem rankOne_psi_transpose_to_lin {n : Type _} [DecidableEq n] [Fintype n] + {φ : Module.Dual ℂ (Matrix n n ℂ)} [hφ : φ.IsFaithfulPosMap] (x y : Matrix n n ℂ) : + withMatrixQuantum[φ] + (hφ.toMatrix.symm + (TensorProduct.toKronecker + ((TensorProduct.map (1 : + l(Matrix n n ℂ)) (AlgEquiv.toLinearMap (transposeAlgEquiv n ℂ ℂ).symm)) + ((hφ.psi (ψ := φ) 0 (1 / 2)) |x⟩⟨y|))) = + LinearMap.mulLeft ℂ x * (LinearMap.adjoint (LinearMap.mulRight ℂ y) : l(Matrix n n ℂ))) := + by + withMatrixQuantumCtx[φ] + rw [← Function.Injective.eq_iff hφ.toMatrix.injective] + simp_rw [_root_.map_mul, LinearMap.matrix.mulRight_adjoint, LinearMap.mulRight_toMatrix, + LinearMap.mulLeft_toMatrix, ← mul_kronecker_mul, Matrix.one_mul, + Matrix.mul_one, Module.Dual.IsFaithfulPosMap.sig_apply_sig] + have : (1 / 2 : ℝ) + -1 = -(1 / 2) := by norm_num + rw [AlgEquiv.apply_symm_apply, Module.Dual.IsFaithfulPosMap.psi, LinearEquiv.coe_mk] + simp only [QuantumSet.Psi_apply, QuantumSet.Psi_toFun_apply, TensorProduct.map_tmul, + TensorProduct.toKronecker_apply, Module.End.one_apply, AlgEquiv.toLinearMap_apply, + LinearEquiv.coe_coe, transposeAlgEquiv_symm_op_apply] + rw [starAlgebra.modAut_zero, this] + simp only [AlgEquiv.one_apply] + rw [show modAut (1 / 2) y = hφ.sig (1 / 2) y by rfl] + rw [Matrix.star_eq_conjTranspose] + rw [Module.Dual.IsFaithfulPosMap.sig_conjTranspose hφ (1 / 2) y] + +private theorem matrix.stdBasisMatrix.transpose' {R n p : Type _} [DecidableEq n] [DecidableEq p] + [Semiring R] {i : n} {j : p} {α : R} : + (stdBasisMatrix i j α)ᵀ = stdBasisMatrix j i α := + by + ext + simp [transpose_apply, stdBasisMatrix, single, and_comm] + +-- example : +-- -- { x : matrix (Σ i, n i × n i) (Σ i, n i × n i) ℂ // x.is_blockDiagonal } +-- matrix (Σ i, n i × n i) (Σ i, n i × n i) ℂ +-- ≃ₐ[ℂ] +-- { x : matrix (Σ i : p × p, n i.1 × n i.2) (Σ i : p × p, n i.1 × n i.2) ℂ // x.is_blockDiagonal +-- } +-- -- {x : (matrix (Σ i, n i) (Σ i, n i) ℂ) ⊗[ℂ] (matrix (Σ i, n i) (Σ i, n i) ℂ) // +-- x.is_blockDiagonal} +-- -- {x : matrix (Σ i, n i) (Σ i, n i) ℂ // x.is_blockDiagonal} := +-- -- (Π i, matrix (n i) (n i) ℂ) ⊗[ℂ] (Π i, matrix (n i) (n i) ℂ) +-- := +-- { to_fun := fun x, by { }, +-- -- dite (a.1.1 = b.1.1) +-- -- (fun h1, +-- -- dite (a.1.1 = a.2.1 ∧ b.1.1 = b.2.1) ( +-- -- fun h : a.1.1 = a.2.1 ∧ b.1.1 = b.2.1, +-- -- let a' : n a.1.1 := by rw [h.1]; exact a.2.2 in +-- -- let b' : n b.1.1 := by rw [h.2]; exact b.2.2 in +-- -- x (⟨a.1.1, a.1.2, a'⟩) (⟨b.1.1, b.1.2, b'⟩)) +-- -- (fun h, 0), +-- inv_fun := fun x a b, x (⟨a.1, a.2.1⟩, ⟨a.1, a.2.2⟩) (⟨b.1, b.2.1⟩, ⟨b.1, b.2.2⟩), +-- left_inv := fun x, by +-- { ext1, +-- simp only [], +-- split_ifs, +-- tidy, }, +-- right_inv := fun x, by +-- { ext1, +-- simp only [], +-- split_ifs, +-- tidy, }, +-- } + +theorem rankOne_toMatrix_transpose_psi_symm [hφ : φ.IsFaithfulPosMap] + (x y : ℍ) : + withMatrixQuantum[φ] + ((hφ.psi (ψ := φ) 0 (1 / 2)).symm + ((TensorProduct.map id (transposeAlgEquiv p ℂ ℂ).toLinearMap) + (kroneckerToTensorProduct (hφ.toMatrix |x⟩⟨y|))) = + LinearMap.mulLeft ℂ (x * φ.matrix) * + (LinearMap.adjoint (LinearMap.mulRight ℂ (φ.matrix * y)) : l(ℍ))) := + by + withMatrixQuantumCtx[φ] + have hbasis : hφ.basis = hφ.orthonormalBasis.toBasis := by + ext ij i j + simp [Module.Dual.IsFaithfulPosMap.orthonormalBasis_apply, + Module.Dual.IsFaithfulPosMap.basis_apply] + rw [show hφ.toMatrix |x⟩⟨y| = + LinearMap.toMatrix hφ.orthonormalBasis.toBasis hφ.orthonormalBasis.toBasis + (|x⟩⟨y| : l(ℍ)) by + ext i j + simp [Module.Dual.IsFaithfulPosMap.toMatrix, hbasis, LinearMap.toMatrixAlgEquiv_apply, + LinearMap.toMatrix_apply]] + rw [rankOne_toMatrix_of_onb hφ.orthonormalBasis hφ.orthonormalBasis x y] + simp only [Module.Dual.IsFaithfulPosMap.psi, Matrix.conjTranspose_replicateCol] + rw [show + replicateCol (Fin 1) (hφ.orthonormalBasis.repr x).ofLp * + replicateRow (Fin 1) (star (hφ.orthonormalBasis.repr y).ofLp) = + vecMulVec (hφ.orthonormalBasis.repr x).ofLp + (star (hφ.orthonormalBasis.repr y).ofLp) from + (Matrix.vecMulVec_eq (Fin 1) (hφ.orthonormalBasis.repr x).ofLp + (star (hφ.orthonormalBasis.repr y).ofLp)).symm] + rw [Matrix.kmul_representation + (vecMulVec (hφ.orthonormalBasis.repr x).ofLp (star (hφ.orthonormalBasis.repr y).ofLp))] + simp only [map_sum, _root_.map_smul, kroneckerToTensorProduct_apply, + TensorProduct.map_tmul, QuantumSet.Psi_symm_apply, QuantumSet.Psi_invFun_apply, + vecMulVec_apply, neg_zero, starAlgebra.modAut_zero, AlgEquiv.one_apply] + simp_rw [AlgEquiv.toLinearMap_apply, transposeAlgEquiv_apply, MulOpposite.unop_op, + Module.End.one_apply, ← rankOne_lm_smul_smul, Pi.star_apply, star_star, + matrix.stdBasisMatrix.transpose', star_eq_conjTranspose, Matrix.single_conjTranspose, + star_one] + ext a i j + simp only [LinearMap.sum_apply, ContinuousLinearMap.coe_coe, rankOne_apply, inner_smul_left, + QuantumSet.modAut_isSymmetric, Module.End.mul_apply, LinearMap.matrix.mulRight_adjoint, + LinearMap.mulRight_apply, LinearMap.mulLeft_apply, OrthonormalBasis.repr_apply_apply, + inner_single_left, Module.Dual.IsFaithfulPosMap.inner_coord hφ] + simp_rw [starRingEnd_apply, smul_smul, mul_assoc, + ← mul_comm _ ((modAut (-(1 / 2)) (_ : ℍ) * φ.matrix) _ _)] + rw [Finset.sum_sum_comm_sum] + simp only [← Finset.sum_smul, ← Finset.mul_sum, ← mul_apply] + simp_rw [mul_comm (star _), ← conjTranspose_apply, ← mul_apply, ← Matrix.smul_single'] + rw [show + (∑ x_1, ∑ x_2, Matrix.single x_1 x_2 + ((x * hφ.matrixIsPosDef.rpow (1 / 2) * + ((modAut (-(1 / 2)) : ℍ ≃ₐ[ℂ] ℍ) a * φ.matrix) * + (y * hφ.matrixIsPosDef.rpow (1 / 2))ᴴ) x_1 x_2)) = + x * hφ.matrixIsPosDef.rpow (1 / 2) * + ((modAut (-(1 / 2)) : ℍ ≃ₐ[ℂ] ℍ) a * φ.matrix) * + (y * hφ.matrixIsPosDef.rpow (1 / 2))ᴴ by + exact (Matrix.matrix_eq_sum_single + (x * hφ.matrixIsPosDef.rpow (1 / 2) * + ((modAut (-(1 / 2)) : ℍ ≃ₐ[ℂ] ℍ) a * φ.matrix) * + (y * hφ.matrixIsPosDef.rpow (1 / 2))ᴴ)).symm] + rw [show (modAut (-(1 / 2)) : ℍ ≃ₐ[ℂ] ℍ) = hφ.sig (-(1 / 2)) from rfl] + simp only [Module.Dual.IsFaithfulPosMap.sig_apply, conjTranspose_mul, + (PosDef.rpow.isPosDef _ _).1.eq, hφ.matrixIsPosDef.1.eq] + simp only [neg_neg] + simp_rw [← mul_assoc] + nth_rw 1 [mul_assoc x (hφ.matrixIsPosDef.rpow (1 / 2)) (hφ.matrixIsPosDef.rpow (1 / 2))] + rw [show hφ.matrixIsPosDef.rpow (1 / 2) * hφ.matrixIsPosDef.rpow (1 / 2) = + φ.matrix by + rw [PosDef.rpow_mul_rpow, add_halves, PosDef.rpow_one_eq_self]] + simp_rw [← PosDef.rpow_one_eq_self hφ.matrixIsPosDef] + nth_rw 1 [mul_assoc (x * hφ.matrixIsPosDef.rpow 1 * a) + (hφ.matrixIsPosDef.rpow (-(1 / 2))) (hφ.matrixIsPosDef.rpow 1)] + rw [PosDef.rpow_mul_rpow] + ring_nf + nth_rw 1 [mul_assoc (x * hφ.matrixIsPosDef.rpow 1 * a * + hφ.matrixIsPosDef.rpow 1 * yᴴ) (hφ.matrixIsPosDef.rpow 1) + (hφ.matrixIsPosDef.rpow (-1))] + rw [PosDef.rpow_mul_rpow] + ring_nf + simp only [PosDef.rpow_zero, mul_one] + nth_rw 1 [mul_assoc (x * hφ.matrixIsPosDef.rpow 1 * a) + (hφ.matrixIsPosDef.rpow (1 / 2)) (hφ.matrixIsPosDef.rpow (1 / 2))] + rw [PosDef.rpow_mul_rpow] + ring_nf + +-- @[instance] +-- private def hmm {H : Type _} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [FiniteDimensional ℂ +-- H] +-- (U : Submodule ℂ H) : CompleteSpace U := +-- FiniteDimensional.complete ℂ U + +open LinearMap in +private theorem lm_to_clm_comp {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] {p q : E →ₗ[𝕜] E} : + toContinuousLinearMap p * toContinuousLinearMap q = toContinuousLinearMap (p * q) := + rfl + +open LinearMap in +private theorem is_idempotent_elem_to_clm {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] {p : E →ₗ[𝕜] E} : + IsIdempotentElem p ↔ IsIdempotentElem (toContinuousLinearMap p) := by + simp_rw [IsIdempotentElem, lm_to_clm_comp, Function.Injective.eq_iff (LinearEquiv.injective _)] + +open scoped FiniteDimensional +open LinearMap in +private theorem is_self_adjoint_to_clm {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] [CompleteSpace E] + {p : E →ₗ[𝕜] E} : + IsSelfAdjoint p ↔ IsSelfAdjoint (toContinuousLinearMap p) := by + exact (LinearMap.isSelfAdjoint_toContinuousLinearMap p).symm + +-- Orthogonal projection existence goes through finite-dimensional completeness and CLM coercions. +open LinearMap in +theorem orthogonal_projection_iff_lm {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] {p : E →ₗ[𝕜] E} : + (∃ U : Submodule 𝕜 E, (orthogonalProjection' U : E →ₗ[𝕜] E) = p) ↔ + IsSelfAdjoint p ∧ IsIdempotentElem p := + by + letI : CompleteSpace E := FiniteDimensional.complete 𝕜 E + have := @orthogonal_projection_iff 𝕜 E _ _ _ _ _ (toContinuousLinearMap p) + simp_rw [is_idempotent_elem_to_clm, is_self_adjoint_to_clm] at this ⊢ + rw [← this] + constructor + all_goals + rintro ⟨U, hU⟩ + use U + · rw [← hU] + rfl + · rw [hU] + rfl + +theorem Matrix.conj_eq_transpose_conjTranspose {R n₁ n₂ : Type _} [Star R] (A : Matrix n₁ n₂ R) : + Aᴴᵀ = (Aᵀ)ᴴ := + rfl + +theorem Matrix.conj_eq_conjTranspose_transpose {R n₁ n₂ : Type _} [Star R] (A : Matrix n₁ n₂ R) : + Aᴴᵀ = (Aᴴ)ᵀ := + rfl + +theorem Matrix.star_transpose_eq_star_transpose {R n : Type _} [Star R] (A : Matrix n n R) : + (star A)ᵀ = star Aᵀ := + rfl + +-- Star preservation for this tensor-product algebra equivalence requires deep instance search. +/-- Star algebra equivalence between a matrix tensor product and matrices on product indices. -/ +noncomputable def oneMapTranspose : ℍ ⊗[ℂ] ℍᵐᵒᵖ ≃⋆ₐ[ℂ] Matrix (p × p) (p × p) ℂ := + StarAlgEquiv.ofAlgEquiv + ((AlgEquiv.TensorProduct.map (1 : ℍ ≃ₐ[ℂ] ℍ) (transposeAlgEquiv p ℂ ℂ).symm).trans + tensorToKronecker) + (by + let F : ℍ ⊗[ℂ] ℍᵐᵒᵖ ≃ₐ[ℂ] Matrix (p × p) (p × p) ℂ := + (AlgEquiv.TensorProduct.map (1 : ℍ ≃ₐ[ℂ] ℍ) (transposeAlgEquiv p ℂ ℂ).symm).trans + tensorToKronecker + change ∀ x, F (star x) = star (F x) + intro x + refine x.induction_on ?zero ?tmul ?add + · simp only [star_zero, map_zero] + · intro x₁ x₂ + simp [F, TensorProduct.star_tmul, AlgEquiv.TensorProduct.map_tmul, + tensorToKronecker_apply, TensorProduct.toKronecker_star] + rfl + · intro a b ha hb + calc + F (star (a + b)) = F (star a + star b) := by rw [star_add] + _ = F (star a) + F (star b) := F.map_add (star a) (star b) + _ = star (F a) + star (F b) := by rw [ha, hb] + _ = star (F a + F b) := by rw [star_add] + _ = star (F (a + b)) := by + rw [show F (a + b) = F a + F b from F.map_add a b]) + +theorem oneMapTranspose_eq (x : ℍ ⊗[ℂ] ℍᵐᵒᵖ) : + (oneMapTranspose : ℍ ⊗[ℂ] ℍᵐᵒᵖ ≃⋆ₐ[ℂ] _) x = + TensorProduct.toKronecker + ((TensorProduct.map (1 : l(ℍ)) (transposeAlgEquiv p ℂ ℂ).symm.toLinearMap) x) := + rfl + +theorem oneMapTranspose_symm_eq (x : Matrix (p × p) (p × p) ℂ) : + (oneMapTranspose : ℍ ⊗[ℂ] ℍᵐᵒᵖ ≃⋆ₐ[ℂ] _).symm x = + (TensorProduct.map (1 : l(ℍ)) (transposeAlgEquiv p ℂ ℂ).toLinearMap) + (Matrix.kroneckerToTensorProduct x) := + rfl + +theorem oneMapTranspose_apply (x y : ℍ) : + (oneMapTranspose : _ ≃⋆ₐ[ℂ] Matrix (p × p) (p × p) ℂ) (x ⊗ₜ MulOpposite.op y) = x ⊗ₖ yᵀ := + by + rw [oneMapTranspose_eq, TensorProduct.map_tmul, AlgEquiv.toLinearMap_apply, + TensorProduct.toKronecker_apply, transposeAlgEquiv_symm_op_apply] + rfl + +theorem toMatrix''_map_star [hφ : φ.IsFaithfulPosMap] (x : l(ℍ)) : + withMatrixQuantum[φ] + (hφ.toMatrix (LinearMap.adjoint (x : l(ℍ))) = star (hφ.toMatrix x)) := + by + withMatrixQuantumCtx[φ] + ext + simp only [Module.Dual.IsFaithfulPosMap.toMatrix, LinearMap.toMatrixAlgEquiv_apply, + star_apply, + LinearMap.adjoint_inner_right, RCLike.star_def, inner_conj_symm, + Module.Dual.IsFaithfulPosMap.basis_repr_apply] + +private theorem ffsugh [hφ : φ.IsFaithfulPosMap] {x : Matrix (p × p) (p × p) ℂ} {y : l(ℍ)} : + hφ.toMatrix.symm x = y ↔ x = hφ.toMatrix y := + Equiv.symm_apply_eq _ + +theorem toMatrix''_symm_map_star [hφ : φ.IsFaithfulPosMap] (x : Matrix (p × p) (p × p) ℂ) : + withMatrixQuantum[φ] + (hφ.toMatrix.symm (star x) = LinearMap.adjoint (hφ.toMatrix.symm x)) := by + withMatrixQuantumCtx[φ] + rw [ffsugh, toMatrix''_map_star, AlgEquiv.apply_symm_apply] + +/-- The orthogonal projection onto a submodule, using the finite-dimensional matrix context. -/ +noncomputable def Qam.fdOrthogonalProjection [hφ : φ.IsFaithfulPosMap] + (U : Submodule ℂ ℍ) : l(ℍ) := by + withMatrixQuantumCtx[φ] + letI : AddCommGroup U := Submodule.addCommGroup U + letI : NormedAddCommGroup U := Submodule.normedAddCommGroup U + letI : NormedSpace ℂ U := Submodule.normedSpace U + letI : FiniteDimensional ℂ U := + Submodule.finiteDimensional_of_le (show U ≤ (⊤ : Submodule ℂ ℍ) from le_top) + letI : ProperSpace U := FiniteDimensional.proper ℂ U + let completeU : @CompleteSpace U PseudoMetricSpace.toUniformSpace := complete_of_proper + letI : U.HasOrthogonalProjection := + @Submodule.HasOrthogonalProjection.ofCompleteSpace ℂ ℍ _ _ _ U completeU + exact (orthogonalProjection' U : l(ℍ)) + +theorem Qam.fd_orthogonal_projection_iff_lm [hφ : φ.IsFaithfulPosMap] {q : l(ℍ)} : + withMatrixQuantum[φ] + ((∃ U : Submodule ℂ ℍ, Qam.fdOrthogonalProjection (φ := φ) U = q) ↔ + IsSelfAdjoint q ∧ IsIdempotentElem q) := by + withMatrixQuantumCtx[φ] + change (∃ U : Submodule ℂ ℍ, (orthogonalProjection' U : l(ℍ)) = q) ↔ + IsSelfAdjoint q ∧ IsIdempotentElem q + exact orthogonal_projection_iff_lm + +theorem Qam.fdOrthogonalProjection_eq_sum_rankOne [hφ : φ.IsFaithfulPosMap] + {ι : Type _} [Fintype ι] {U : Submodule ℂ ℍ} : + withMatrixQuantum[φ] + (∀ b : OrthonormalBasis ι ℂ U, + Qam.fdOrthogonalProjection (φ := φ) U = + ∑ i : ι, ((rankOne ℂ (b i).1 (b i).1 : L(ℍ)) : l(ℍ))) := by + withMatrixQuantumCtx[φ] + intro b + letI : AddCommGroup U := Submodule.addCommGroup U + letI : NormedAddCommGroup U := Submodule.normedAddCommGroup U + letI : NormedSpace ℂ U := Submodule.normedSpace U + letI : FiniteDimensional ℂ U := + Submodule.finiteDimensional_of_le (show U ≤ (⊤ : Submodule ℂ ℍ) from le_top) + letI : ProperSpace U := FiniteDimensional.proper ℂ U + let completeU : @CompleteSpace U PseudoMetricSpace.toUniformSpace := complete_of_proper + letI : U.HasOrthogonalProjection := + @Submodule.HasOrthogonalProjection.ofCompleteSpace ℂ ℍ _ _ _ U completeU + unfold Qam.fdOrthogonalProjection + change ((orthogonalProjection' U : L(ℍ)) : l(ℍ)) = + ∑ i : ι, ((rankOne ℂ (b i).1 (b i).1 : L(ℍ)) : l(ℍ)) + rw [← ContinuousLinearMap.coe_sum] + rw [@OrthonormalBasis.orthogonalProjection'_eq_sum_rankOne ι ℂ _ ℍ _ _ _ U completeU b] + +theorem Qam.idempotent_and_real_iff_exists_ortho_proj [hφ : φ.IsFaithfulPosMap] (A : l(ℍ)) : + withMatrixQuantum[φ] + (Qam.reflIdempotent hφ A A = A ∧ LinearMap.IsReal A ↔ + ∃ U : Submodule ℂ ℍ, + Qam.fdOrthogonalProjection (φ := φ) U = + hφ.toMatrix.symm + (TensorProduct.toKronecker + ((TensorProduct.map id (transposeAlgEquiv p ℂ ℂ).symm.toLinearMap) + ((hφ.psi (ψ := φ) 0 (1 / 2)) A)))) := + by + withMatrixQuantumCtx[φ] + rw [Qam.isReal_and_idempotent_iff_psi_orthogonal_projection, + Qam.fd_orthogonal_projection_iff_lm, ← oneMapTranspose_eq, IsIdempotentElem.algEquiv, + IsIdempotentElem.starAlgEquiv, and_comm] + simp_rw [_root_.IsSelfAdjoint, LinearMap.star_eq_adjoint, ← toMatrix''_symm_map_star, ← + map_star, Function.Injective.eq_iff (AlgEquiv.injective _), + Function.Injective.eq_iff (StarAlgEquiv.injective _)] + +/-- The submodule associated to an idempotent real quantum adjacency map. -/ +noncomputable def Qam.submoduleOfIdempotentAndReal [hφ : φ.IsFaithfulPosMap] {A : l(ℍ)} + (hA1 : Qam.reflIdempotent hφ A A = A) (hA2 : LinearMap.IsReal A) : Submodule ℂ ℍ := + by + withMatrixQuantumCtx[φ] + choose U _ using (Qam.idempotent_and_real_iff_exists_ortho_proj A).mp ⟨hA1, hA2⟩ + exact U + +theorem Qam.orthogonalProjection'_eq [hφ : φ.IsFaithfulPosMap] {A : l(ℍ)} + (hA1 : Qam.reflIdempotent hφ A A = A) (hA2 : LinearMap.IsReal A) : + withMatrixQuantum[φ] + (Qam.fdOrthogonalProjection (φ := φ) (Qam.submoduleOfIdempotentAndReal hA1 hA2) = + hφ.toMatrix.symm + (TensorProduct.toKronecker + ((TensorProduct.map id (transposeAlgEquiv p ℂ ℂ).symm.toLinearMap) + ((hφ.psi (ψ := φ) 0 (1 / 2)) A)))) := +by + withMatrixQuantumCtx[φ] + exact (Qam.idempotent_and_real_iff_exists_ortho_proj A).mp ⟨hA1, hA2⟩ |>.choose_spec + +/-- A canonical orthonormal basis for the submodule associated to an idempotent real QAM. -/ +noncomputable def Qam.onbOfIdempotentAndReal [hφ : φ.IsFaithfulPosMap] + {A : l(ℍ)} (hA1 : Qam.reflIdempotent hφ A A = A) (hA2 : LinearMap.IsReal A) : + withMatrixQuantum[φ] + (OrthonormalBasis (Fin (FiniteDimensional.finrank ℂ (Qam.submoduleOfIdempotentAndReal hA1 hA2))) + ℂ (Qam.submoduleOfIdempotentAndReal hA1 hA2)) := +by + withMatrixQuantumCtx[φ] + exact stdOrthonormalBasis ℂ _ + +-- The orthonormal-basis finrank index requires synthesizing the restored submodule structure. +theorem Qam.IdempotentAndReal.eq [hφ : φ.IsFaithfulPosMap] + {A : l(ℍ)} (hA1 : Qam.reflIdempotent hφ A A = A) + (hA2 : LinearMap.IsReal A) : + withMatrixQuantum[φ] + (A = + ∑ i, + LinearMap.mulLeft ℂ + (((Qam.onbOfIdempotentAndReal hA1 hA2 i).1 * φ.matrix)) * + (LinearMap.adjoint + (LinearMap.mulRight ℂ + (φ.matrix * + (Qam.onbOfIdempotentAndReal hA1 hA2 i).1)))) := +by + withMatrixQuantumCtx[φ] + let U := Qam.submoduleOfIdempotentAndReal hA1 hA2 + letI : AddCommGroup U := Submodule.addCommGroup U + letI : NormedAddCommGroup U := Submodule.normedAddCommGroup U + letI : NormedSpace ℂ U := Submodule.normedSpace U + letI : FiniteDimensional ℂ U := + Submodule.finiteDimensional_of_le + (show U ≤ (⊤ : Submodule ℂ ℍ) from le_top) + have hUcomplete : IsComplete (U : Set ℍ) := Submodule.complete_of_finiteDimensional U + letI : CompleteSpace U := completeSpace_coe_iff_isComplete.mpr hUcomplete + simp_rw [← rankOne_toMatrix_transpose_psi_symm, ← map_sum, ← + Qam.fdOrthogonalProjection_eq_sum_rankOne (Qam.onbOfIdempotentAndReal hA1 hA2), + Qam.orthogonalProjection'_eq, AlgEquiv.apply_symm_apply] + simp_rw [← oneMapTranspose_symm_eq, ← oneMapTranspose_eq, StarAlgEquiv.symm_apply_apply, + LinearEquiv.symm_apply_apply] + +/-- Quantum adjacency maps that are both Schur-idempotent and real. -/ +@[class] +structure RealQam (hφ : φ.IsFaithfulPosMap) (A : l(ℍ)) : Prop where +/-- The Schur idempotence condition. -/ +toIdempotent : Qam.reflIdempotent hφ A A = A +/-- The realness condition. -/ +toIsReal : LinearMap.IsReal A + +lemma RealQam_iff [hφ : φ.IsFaithfulPosMap] {A : l(ℍ)} : + RealQam hφ A ↔ Qam.reflIdempotent hφ A A = A ∧ LinearMap.IsReal A := +⟨fun h => ⟨h.toIdempotent, h.toIsReal⟩, fun h => ⟨h.1, h.2⟩⟩ + +theorem RealQam.add_iff [hφ : φ.IsFaithfulPosMap] {A B : ℍ →ₗ[ℂ] ℍ} (hA : RealQam hφ A) (hB : + RealQam hφ B) : + RealQam hφ (A + B) ↔ Qam.reflIdempotent hφ A B + Qam.reflIdempotent hφ B A = 0 := + by + simp only [RealQam_iff] at hA hB ⊢ + simp [map_add, LinearMap.add_apply, hA, hB, add_assoc, add_left_comm, add_comm, + LinearMap.isReal_iff, LinearMap.real_add, + (LinearMap.isReal_iff _).mp hA.2, (LinearMap.isReal_iff _).mp hB.2] + +/-- The zero map as a real QAM. -/ +theorem RealQam.zero [hφ : φ.IsFaithfulPosMap] : RealQam hφ (0 : l(ℍ)) := + by + simp_rw [RealQam_iff, LinearMap.map_zero, true_and] + intro + simp only [LinearMap.zero_apply, star_zero] + +@[reducible, instance] +noncomputable def RealQam.hasZero [hφ : φ.IsFaithfulPosMap] : + Zero { x // RealQam hφ x } where zero := ⟨0, RealQam.zero⟩ + +theorem Qam.reflIdempotent_zero [hφ : φ.IsFaithfulPosMap] (a : l(ℍ)) : Qam.reflIdempotent hφ a 0 = + 0 := + map_zero _ + +theorem Qam.zero_reflIdempotent [hφ : φ.IsFaithfulPosMap] (a : l(ℍ)) : Qam.reflIdempotent hφ 0 a = + 0 := by + simp_rw [LinearMap.map_zero, LinearMap.zero_apply] + +/-- Number of edges of a real QAM, computed as the rank of its associated submodule. -/ +@[reducible] +noncomputable def RealQam.edges [hφ : φ.IsFaithfulPosMap] {x : l(ℍ)} (hx : RealQam hφ x) : ℕ := + FiniteDimensional.finrank ℂ (Qam.submoduleOfIdempotentAndReal hx.1 hx.2) + +/-- Edge-count function on the subtype of real QAMs. -/ +@[reducible] +noncomputable def RealQam.edges' [hφ : φ.IsFaithfulPosMap] : { x : + ℍ →ₗ[ℂ] ℍ // RealQam hφ x } → ℕ := fun x => + FiniteDimensional.finrank ℂ + (Qam.submoduleOfIdempotentAndReal (Set.mem_setOf.mp (Subtype.mem x)).1 + (Set.mem_setOf.mp (Subtype.mem x)).2) + +theorem RealQam.edges_eq [hφ : φ.IsFaithfulPosMap] {A : l(ℍ)} (hA : RealQam hφ A) : + withMatrixQuantum[φ] + ((hA.edges : ℂ) = (A φ.matrix⁻¹).trace) := + by + withMatrixQuantumCtx[φ] + obtain ⟨hA1, hA2⟩ := hA + symm + nth_rw 1 [Qam.IdempotentAndReal.eq hA1 hA2] + let U := Qam.submoduleOfIdempotentAndReal hA1 hA2 + simp_rw [LinearMap.sum_apply, LinearMap.matrix.mulRight_adjoint, Module.End.mul_apply, + LinearMap.mulRight_apply, LinearMap.mulLeft_apply, conjTranspose_mul, + hφ.matrixIsPosDef.1.eq, ← Matrix.mul_assoc, sig_apply_matrix_hMul_posDef'] + have : + ∀ x : Fin (FiniteDimensional.finrank ℂ ↥U), + ((Qam.onbOfIdempotentAndReal hA1 hA2 x).1 * φ.matrix * φ.matrix⁻¹ * φ.matrix * + (Qam.onbOfIdempotentAndReal hA1 hA2 x).1ᴴ).trace = + 1 := + by + intro x + calc + ((Qam.onbOfIdempotentAndReal hA1 hA2 x).1 * φ.matrix * φ.matrix⁻¹ * φ.matrix * + (Qam.onbOfIdempotentAndReal hA1 hA2 x).1ᴴ).trace = + ((Qam.onbOfIdempotentAndReal hA1 hA2 x).1 * hφ.matrixIsPosDef.rpow 1 * + hφ.matrixIsPosDef.rpow (-1) * + φ.matrix * + (Qam.onbOfIdempotentAndReal hA1 hA2 x).1ᴴ).trace := + by simp_rw [PosDef.rpow_one_eq_self, PosDef.rpow_neg_one_eq_inv_self] + _ = + ((Qam.onbOfIdempotentAndReal hA1 hA2 x).1 * + (hφ.matrixIsPosDef.rpow 1 * hφ.matrixIsPosDef.rpow (-1)) * + φ.matrix * + (Qam.onbOfIdempotentAndReal hA1 hA2 x).1ᴴ).trace := + by simp_rw [Matrix.mul_assoc] + _ = + ((Qam.onbOfIdempotentAndReal hA1 hA2 x).1 * φ.matrix * + (Qam.onbOfIdempotentAndReal hA1 hA2 x).1ᴴ).trace := + by simp_rw [PosDef.rpow_mul_rpow, add_neg_cancel, PosDef.rpow_zero, Matrix.mul_one] + _ = inner ℂ (Qam.onbOfIdempotentAndReal hA1 hA2 x).1 + (Qam.onbOfIdempotentAndReal hA1 hA2 x).1 := + by + rw [Module.Dual.IsFaithfulPosMap.inner_eq' hφ] + rw [← trace_mul_cycle] + _ = inner ℂ (Qam.onbOfIdempotentAndReal hA1 hA2 x) + (Qam.onbOfIdempotentAndReal hA1 hA2 x) := rfl + _ = 1 := by + rw [← OrthonormalBasis.repr_apply_apply, OrthonormalBasis.repr_self, + PiLp.single_apply] + simp_rw [if_true] + simp_rw [trace_sum, ← Matrix.mul_assoc, this, Finset.sum_const, Finset.card_fin, + Nat.smul_one_eq_cast] + +theorem completeGraphRealQam [hφ : φ.IsFaithfulPosMap] : + withProjectionMatrixCoalgebraQuantum[φ] + (RealQam hφ (Qam.completeGraph ℍ ℍ)) := +by + withProjectionMatrixCoalgebraQuantumCtx[φ] + exact ⟨Qam.Nontracial.CompleteGraph.qam, Qam.Nontracial.CompleteGraph.isReal⟩ + +theorem Qam.completeGraph_edges [hφ : φ.IsFaithfulPosMap] : + withProjectionMatrixCoalgebraQuantum[φ] + ((@completeGraphRealQam p _ _ φ hφ).edges = + FiniteDimensional.finrank ℂ (⊤ : Submodule ℂ ℍ)) := +by + withProjectionMatrixCoalgebraQuantumCtx[φ] + have this : (RealQam.edges completeGraphRealQam : ℂ) = + (Qam.completeGraph ℍ ℍ φ.matrix⁻¹).trace := RealQam.edges_eq _ + haveI ig := hφ.matrixIsPosDef.invertible + simp_rw [Qam.completeGraph, ContinuousLinearMap.coe_coe, rankOne_apply, + Module.Dual.IsFaithfulPosMap.inner_eq', conjTranspose_one, Matrix.mul_one, + mul_inv_of_invertible, trace_smul, smul_eq_mul, trace_one, + ← Nat.cast_mul, Nat.cast_inj] at this + simp_rw [Qam.completeGraph, finrank_top, Module.finrank_matrix, Module.finrank_self, mul_one] + exact this + +-- Matrix delta-form inference for the restored nontracial trivial graph is expensive here. +-- The theorem statement itself requires synthesizing the Matrix quantum-set delta-form instance. +theorem Qam.trivialGraphRealQam [hφ : φ.IsFaithfulPosMap] [Nonempty p] : + withProjectionMatrixCoalgebraQuantum[φ] + (letI : QuantumSetDeltaForm ℍ := Matrix.quantumSetDeltaForm (φ := φ) + RealQam hφ (Qam.trivialGraph ℍ)) := +by + withProjectionMatrixCoalgebraQuantumCtx[φ] + letI : QuantumSetDeltaForm ℍ := Matrix.quantumSetDeltaForm (φ := φ) + exact ⟨Qam.Nontracial.TrivialGraph.qam, Qam.Nontracial.trivialGraph.isReal⟩ + +theorem Qam.trivialGraph_edges [hφ : φ.IsFaithfulPosMap] [Nonempty p] : + withProjectionMatrixCoalgebraQuantum[φ] + (letI : QuantumSetDeltaForm ℍ := Matrix.quantumSetDeltaForm (φ := φ) + (@Qam.trivialGraphRealQam p _ _ φ hφ _).edges = 1) := +by + withProjectionMatrixCoalgebraQuantumCtx[φ] + letI : QuantumSetDeltaForm ℍ := Matrix.quantumSetDeltaForm (φ := φ) + have := RealQam.edges_eq (@Qam.trivialGraphRealQam p _ _ φ hφ _) + nth_rw 2 [Qam.trivialGraph_eq] at this + simp_rw [LinearMap.smul_apply, Module.End.one_apply, trace_smul, smul_eq_mul] at this + rw [show QuantumSetDeltaForm.delta ℍ = φ.matrix⁻¹.trace by rfl] at this + have hδ : φ.matrix⁻¹.trace ≠ 0 := ne_of_gt (Qam.Nontracial.delta_pos (φ := φ)) + rw [inv_mul_cancel₀ hδ] at this + exact_mod_cast this + +theorem RealQam.edges_eq_zero_iff [hφ : φ.IsFaithfulPosMap] {A : l(ℍ)} (hA : RealQam hφ A) : + hA.edges = 0 ↔ A = 0 := + by + have : ∀ α β : ℕ, α = β ↔ (α : ℂ) = (β : ℂ) := + by + intro α β + simp only [Nat.cast_inj] + constructor + · intro h + rw [RealQam.edges] at h + have h' := h + simp only [Submodule.finrank_eq_zero] at h + rw [Qam.IdempotentAndReal.eq hA.1 hA.2] + let u := Qam.onbOfIdempotentAndReal hA.1 hA.2 + apply Finset.sum_eq_zero + intro i _ + rw [finrank_zero_iff_forall_zero.mp h' (u i)] + norm_cast + simp_rw [Matrix.zero_mul, LinearMap.mulLeft_zero_eq_zero, MulZeroClass.zero_mul] + · intro h + rw [this, RealQam.edges_eq, h, LinearMap.zero_apply, trace_zero] + norm_cast + +theorem psi_apply_complete_graph [hφ : φ.IsFaithfulPosMap] {t s : ℝ} : + withMatrixQuantum[φ] + (hφ.psi (ψ := φ) t s |(1 : ℍ)⟩⟨(1 : ℍ)| = 1) := + by + withMatrixQuantumCtx[φ] + simp only [Module.Dual.IsFaithfulPosMap.psi, + QuantumSet.Psi_apply, QuantumSet.Psi_toFun_apply, _root_.map_one] + simp [star_one, MulOpposite.op_one, Algebra.TensorProduct.one_def] + +lemma AlgEquiv.TensorProduct.map_toLinearMap' {R S T U V : Type _} [CommSemiring R] + [Semiring S] [Semiring T] [Semiring U] [Semiring V] + [Algebra R S] [Algebra R T] [Algebra R U] [Algebra R V] + (f : S ≃ₐ[R] T) (g : U ≃ₐ[R] V) : + (AlgEquiv.TensorProduct.map f g).toLinearMap = + _root_.TensorProduct.map f.toLinearMap g.toLinearMap := +rfl + +lemma AlgEquiv.toLinearMap_one {R S : Type _} [CommSemiring R] [Semiring S] [Algebra R S] : + (AlgEquiv.toLinearMap (1 : S ≃ₐ[R] S)) = 1 := +rfl + +theorem RealQam.edges_eq_dim_iff [hφ : φ.IsFaithfulPosMap] {A : l(ℍ)} (hA : RealQam hφ A) : + withMatrixQuantum[φ] + (hA.edges = FiniteDimensional.finrank ℂ (⊤ : Submodule ℂ ℍ) ↔ + A = |(1 : ℍ)⟩⟨(1 : ℍ)|) := + by + withMatrixQuantumCtx[φ] + constructor + · intro h + rw [RealQam.edges] at h + simp only [finrank_top] at h + let U := Qam.submoduleOfIdempotentAndReal hA.1 hA.2 + have hU : U = (⊤ : Submodule ℂ ℍ) := Submodule.eq_top_of_finrank_eq h + rw [← Function.Injective.eq_iff (LinearEquiv.injective (hφ.psi (ψ := φ) 0 (1 / 2))), + psi_apply_complete_graph] + have t1 := Qam.orthogonalProjection'_eq hA.1 hA.2 + have : Qam.fdOrthogonalProjection (φ := φ) U = 1 := + by + rw [hU] + unfold Qam.fdOrthogonalProjection + change ((orthogonalProjection' (⊤ : Submodule ℂ ℍ) : L(ℍ)) : l(ℍ)) = 1 + rw [orthogonalProjection_of_top] + rfl + change Qam.fdOrthogonalProjection (φ := φ) U = + hφ.toMatrix.symm + (TensorProduct.toKronecker + ((TensorProduct.map id (transposeAlgEquiv p ℂ ℂ).symm.toLinearMap) + ((hφ.psi (ψ := φ) 0 (1 / 2)) A))) at t1 + rw [this] at t1 + have this' := (AlgEquiv.eq_apply_iff_symm_eq _).mpr t1.symm + simp_rw [_root_.map_one, ← tensorToKronecker_apply, MulEquivClass.map_eq_one_iff] at this' + have this'' := AlgEquiv.TensorProduct.map_toLinearMap (1 : + ℍ ≃ₐ[ℂ] ℍ) (transposeAlgEquiv p ℂ ℂ).symm + rw [AlgEquiv.toLinearMap_one] at this'' + rw [← this'', AlgEquiv.toLinearMap_apply, MulEquivClass.map_eq_one_iff] at this' + exact this' + · intro h + rw [← @Qam.completeGraph_edges p _ _ φ] + simp_rw [← @Nat.cast_inj ℂ, RealQam.edges_eq, h] + rfl + +-- The dimension-one projection extraction uses finite-dimensional basis instance synthesis. +private theorem orthogonal_projection_of_dim_one {𝕜 E : Type _} [RCLike 𝕜] [NormedAddCommGroup E] + [InnerProductSpace 𝕜 E] [FiniteDimensional 𝕜 E] {U : Submodule 𝕜 E} + (hU : FiniteDimensional.finrank 𝕜 U = 1) : + ∃ v : { x : E // (x : E) ≠ 0 }, + orthogonalProjection' U = (1 / (‖(v : E)‖ ^ 2 : 𝕜)) • rankOne 𝕜 (v : E) (v : E) := + by + let u : OrthonormalBasis (Fin 1) 𝕜 U := by + rw [← hU] + exact stdOrthonormalBasis 𝕜 U + rw [OrthonormalBasis.orthogonalProjection'_eq_sum_rankOne u, Fin.sum_univ_one] + have hcc : (u 0 : E) ≠ 0 := by + intro h + exact (u.orthonormal.ne_zero 0) (Subtype.ext h) + have : ‖(u 0 : E)‖ = 1 := by + rw [@norm_eq_sqrt_re_inner 𝕜, Real.sqrt_eq_one] + simp_rw [← Submodule.coe_inner, orthonormal_iff_ite.mp u.orthonormal, if_true, + RCLike.one_re] + use ⟨u 0, hcc⟩ + simp only [this, RCLike.ofReal_one, one_div_one, one_smul, one_pow] + +lemma Complex.ofReal'_eq_isROrC_ofReal (a : ℝ) : + (a : ℂ) = RCLike.ofReal a := +rfl + +-- set_option pp.explicit true in +theorem RealQam.edges_eq_one_iff [hφ : φ.IsFaithfulPosMap] {A : l(ℍ)} (hA : RealQam hφ A) : + withMatrixQuantum[φ] + (hA.edges = 1 ↔ + ∃ x : { x : ℍ // x ≠ 0 }, + A = + (1 / (‖x.1‖ ^ 2 : ℂ)) • + (LinearMap.mulLeft ℂ (x.1 * φ.matrix) * + LinearMap.adjoint (LinearMap.mulRight ℂ (φ.matrix * x.1)))) := + by + withMatrixQuantumCtx[φ] + constructor + · intro h + let h' := h + rw [← @Nat.cast_inj ℂ, RealQam.edges_eq hA] at h' + rw [RealQam.edges] at h + let this : (hA.toIdempotent : ((Qam.reflIdempotent hφ) A) A = A) = hA.toIdempotent := rfl + rw [this] at h + obtain ⟨u, hu⟩ := orthogonal_projection_of_dim_one h + let hu' : (u : ℍ) ≠ 0 := by + exact u.property + -- simp_rw [Ne.def, Submodule.coe_eq_zero] + use⟨u, hu'⟩ + let t1 := Qam.orthogonalProjection'_eq hA.toIdempotent hA.toIsReal + simp_rw [← rankOne_toMatrix_transpose_psi_symm, ← LinearEquiv.map_smul, + ← LinearMap.map_smul, ← _root_.map_smul, + ← ContinuousLinearMap.coe_smul, + Complex.ofReal'_eq_isROrC_ofReal, ← hu] + simp_rw [LinearEquiv.eq_symm_apply, ← oneMapTranspose_symm_eq, + StarAlgEquiv.eq_apply_iff_symm_eq, + StarAlgEquiv.symm_symm, AlgEquiv.eq_apply_iff_symm_eq, oneMapTranspose_eq] + rw [← t1] + unfold Qam.fdOrthogonalProjection + rfl + · rintro ⟨x, rfl⟩ + letI := hφ.matrixIsPosDef.invertible + have ugh : ((x : ℍ) * φ.matrix * (x : ℍ)ᴴ).trace = ‖(x : ℍ)‖ ^ 2 := by + rw [← trace_mul_cycle, ← Module.Dual.IsFaithfulPosMap.inner_eq' hφ, + inner_self_eq_norm_sq_to_K] + rfl + have := RealQam.edges_eq hA + rw [← @Nat.cast_inj ℂ, this] + simp only [LinearMap.smul_apply, trace_smul, Module.End.mul_apply, + LinearMap.matrix.mulRight_adjoint, LinearMap.mulLeft_apply, LinearMap.mulRight_apply, + conjTranspose_mul, hφ.matrixIsPosDef.1.eq, sig_apply_matrix_hMul_posDef', + inv_mul_cancel_left_of_invertible, ugh, smul_eq_mul, one_div] at this ⊢ + have this' : ((‖(x : ℍ)‖ : ℝ) ^ 2 : ℂ) ≠ (0 : ℂ) := + by + simp_rw [ne_eq, sq_eq_zero_iff, Complex.ofReal_eq_zero, norm_eq_zero] + exact x.property + -- exact set.mem_set_of.mp (subtype.mem x), + --}, + rw [inv_mul_cancel₀ this', Nat.cast_one] + +-- }, diff --git a/LeanPool/Monlib4/RepTheory.lean b/LeanPool/Monlib4/RepTheory.lean new file mode 100644 index 0000000000..299e63b62c --- /dev/null +++ b/LeanPool/Monlib4/RepTheory.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ + +import LeanPool.Monlib4.RepTheory.AutMat + +/-! +# RepTheory + +Import-only index for the `RepTheory` directory of the monlib4 import. +-/ diff --git a/LeanPool/Monlib4/RepTheory/AutMat.lean b/LeanPool/Monlib4/RepTheory/AutMat.lean new file mode 100644 index 0000000000..b2675d2142 --- /dev/null +++ b/LeanPool/Monlib4/RepTheory/AutMat.lean @@ -0,0 +1,1184 @@ +/- +Copyright (c) 2026 Monica Omar. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Monica Omar +-/ +import Mathlib.Algebra.Module.LinearMap.Basic +import Mathlib.LinearAlgebra.Matrix.NonsingularInverse +import Mathlib.LinearAlgebra.Matrix.ToLinearEquiv +import Mathlib.LinearAlgebra.Matrix.Trace +import LeanPool.Monlib4.LinearAlgebra.Matrix.Basic +import LeanPool.Monlib4.LinearAlgebra.Matrix.Cast +import LeanPool.Monlib4.LinearAlgebra.Matrix.PiMat +import LeanPool.Monlib4.LinearAlgebra.LmulRmul +import LeanPool.Monlib4.Preq.Set +import LeanPool.Monlib4.Preq.StarAlgEquiv + +/-! +# Inner automorphisms of matrix algebras + +This file ports the upstream monlib4 theorem that every automorphism of a +finite, nontrivial matrix algebra over a field is inner. The downstream +corollaries package the implementing matrix as a linear equivalence or as an +element of the general linear group. +-/ + +open scoped BigOperators Matrix + +variable {n R 𝕜 : Type _} [Field 𝕜] [Fintype n] + +local notation "M" n => Matrix n n 𝕜 +local notation "Mₙ" n => Matrix n n R + +namespace Matrix + +private def matT [Semiring R] (f : (Mₙ n) →ₗ[R] Mₙ n) + (y z : n → R) : (n → R) →ₗ[R] n → R where + toFun x := (f (vecMulVec x y)).mulVec z + map_add' w p := by + simp_rw [vecMulVec_eq (Fin 1), replicateCol_add w p, + Matrix.add_mul, map_add, add_mulVec] + map_smul' w r := by + simp_rw [vecMulVec_eq (Fin 1), RingHom.id_apply, + replicateCol_smul, smul_mul, LinearMap.map_smul, smul_mulVec_assoc] + +private theorem matT_apply [Semiring R] (f : (Mₙ n) →ₗ[R] Mₙ n) + (y z r : n → R) : + matT f y z r = (f (vecMulVec r y)).mulVec z := + rfl + +/-- Every automorphism of a finite nontrivial matrix algebra is inner. -/ +theorem automorphism_matrix_inner [Field R] [DecidableEq n] [Nonempty n] + (f : (Mₙ n) ≃ₐ[R] Mₙ n) : + ∃ T : Mₙ n, + (∀ a : Mₙ n, f a * T = T * a) ∧ + Function.Bijective (Matrix.toLin' T) := by + have exists_vector : ∃ u : n → R, u ≠ 0 := ⟨1, one_ne_zero⟩ + have exists_vector' := exists_vector + obtain ⟨u, hu⟩ := exists_vector + obtain ⟨y, hy⟩ := exists_vector' + have f_ne_zero_iff : + f (vecMulVec u y) ≠ 0 ↔ vecMulVec u y ≠ 0 := by + rw [not_iff_not] + exact + ⟨fun hzero => + (injective_iff_map_eq_zero f).mp f.bijective.1 _ hzero, + fun hzero => by rw [hzero, map_zero]⟩ + have exists_z : ∃ z : n → R, (f (vecMulVec u y)) *ᵥ z ≠ 0 := by + simp_rw [ne_eq, ← Classical.not_forall] + suffices ¬f (vecMulVec u y) = 0 by + simp_rw [mulVec_eq, zero_mulVec] at this + exact this + rw [← ne_eq, f_ne_zero_iff] + exact vecMulVec_ne_zero hu hy + obtain ⟨z, hz⟩ := exists_z + let T := matT f.toLinearMap y z + use LinearMap.toMatrix' T + have commute : + ∀ a : Mₙ n, f a * LinearMap.toMatrix' T = + LinearMap.toMatrix' T * a := by + simp_rw [mulVec_eq] + intro A x + symm + calc + (LinearMap.toMatrix' T * A) *ᵥ x = T (A *ᵥ x) := by + ext + rw [← mulVec_mulVec, LinearMap.toMatrix'_mulVec] + _ = (f (vecMulVec (A *ᵥ x) y)) *ᵥ z := by + rw [matT_apply, AlgEquiv.toLinearMap_apply] + _ = (f (A * vecMulVec x y)) *ᵥ z := by + simp_rw [vecMulVec_eq (Fin 1), replicateCol_mulVec, ← Matrix.mul_assoc] + _ = (f A * f (vecMulVec x y)) *ᵥ z := by + simp_rw [_root_.map_mul] + _ = (f A) *ᵥ T x := by + simp_rw [← mulVec_mulVec, ← AlgEquiv.toLinearMap_apply, + ← matT_apply _ y z] + rfl + _ = (f A * LinearMap.toMatrix' T) *ᵥ x := by + simp_rw [← mulVec_mulVec, ← toLin'_apply (LinearMap.toMatrix' T), + toLin'_toMatrix'] + refine ⟨commute, ?_⟩ + simp_rw [Matrix.toLin'_toMatrix'] + suffices Function.Surjective T by + exact ⟨LinearMap.injective_iff_surjective.mpr this, this⟩ + intro w + have hTu : T u ≠ 0 := by + rw [matT_apply _ y z] + exact hz + have exists_dual : ∃ d : n → R, T u ⬝ᵥ d = 1 := by + rw [← vec_ne_zero] at hTu + obtain ⟨q, hq⟩ := hTu + use Pi.single q (T u q)⁻¹ + rw [dotProduct_single, mul_inv_cancel₀ hq] + have exists_preimage : ∃ B : Mₙ n, (f B) *ᵥ T u = w := by + obtain ⟨d, hd⟩ := exists_dual + obtain ⟨B, hB⟩ := f.bijective.2 (vecMulVec w d) + use B + rw [hB, vecMulVec_eq (Fin 1), ← mulVec_mulVec] + suffices replicateRow (Fin 1) d *ᵥ T u = 1 by + ext + simp_rw [this, mulVec, dotProduct, replicateCol_apply, + Pi.one_apply, mul_one, Finset.sum_const, nsmul_eq_mul] + simp only [Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, + Finset.card_singleton, Nat.cast_one, one_mul] + ext + simp_rw [mulVec, Pi.one_apply, ← hd, dotProduct, replicateRow_apply, + mul_comm] + obtain ⟨B, hB⟩ := exists_preimage + use (toLin' B) u + rw [← toLin'_toMatrix' T] + simp_rw [toLin'_apply, mulVec_mulVec, ← commute, ← mulVec_mulVec, + ← toLin'_apply (LinearMap.toMatrix' T), toLin'_toMatrix'] + exact hB + +private def gMat [DecidableEq n] (a : M n) (b : (n → 𝕜) → n → 𝕜) + (hb : Function.LeftInverse b (toLin' a) ∧ + Function.RightInverse b (toLin' a)) : + (n → 𝕜) ≃ₗ[𝕜] n → 𝕜 where + toFun x := (toLin' a) x + map_add' := a.toLin'.map_add' + map_smul' := a.toLin'.map_smul' + invFun := b + left_inv := hb.1 + right_inv := hb.2 + +private theorem gMat_apply [DecidableEq n] (a : M n) + (b : (n → 𝕜) → n → 𝕜) + (hb : Function.LeftInverse b (toLin' a) ∧ + Function.RightInverse b (toLin' a)) (x : n → 𝕜) : + gMat a b hb x = (toLin' a) x := + rfl + +/-- Version of `automorphism_matrix_inner` using a linear equivalence. -/ +theorem automorphism_matrix_inner'' [DecidableEq n] [Nonempty n] + (f : (M n) ≃ₐ[𝕜] M n) : + ∃ T : (n → 𝕜) ≃ₗ[𝕜] n → 𝕜, + ∀ a : M n, + f a = LinearMap.toMatrix' T * a * LinearMap.toMatrix' T.symm := by + obtain ⟨T, hT⟩ := automorphism_matrix_inner f + obtain ⟨r, hr⟩ := Function.bijective_iff_has_inverse.mp hT.2 + let g := gMat T r hr + use g + intro a + have hg : g.toLinearMap = toLin' T := by + ext + simp_rw [LinearMap.coe_comp, LinearEquiv.coe_toLinearMap, + LinearMap.coe_single, Function.comp_apply, Matrix.toLin'_apply, + Matrix.mulVec_single, g, gMat_apply T r hr, Matrix.toLin'_apply, + Matrix.mulVec_single] + rw [hg, LinearMap.toMatrix'_toLin', ← hT.1, + ← LinearMap.toMatrix'_toLin' T, Matrix.mul_assoc, ← hg] + symm + calc + f a * (LinearMap.toMatrix' g * LinearMap.toMatrix' g.symm) = + f a * LinearMap.toMatrix' (g.symm.trans g) := by + simp_rw [← LinearEquiv.comp_coe, LinearMap.toMatrix'_comp] + _ = f a := by + simp_rw [LinearEquiv.symm_trans_self, LinearEquiv.refl_toLinearMap, + LinearMap.toMatrix'_id, Matrix.mul_one] + +namespace Algebra + +/-- Inner automorphism by conjugation with an invertible algebra element. -/ +def autInner {R E : Type _} [CommSemiring R] [Semiring E] + [Algebra R E] (x : E) [Invertible x] : E ≃ₐ[R] E where + toFun y := x * y * ⅟ x + invFun y := ⅟ x * y * x + left_inv _ := by + simp_rw [← mul_assoc, invOf_mul_self, one_mul, invOf_mul_cancel_right] + right_inv _ := by + simp_rw [← mul_assoc, mul_invOf_self, one_mul, mul_invOf_cancel_right] + map_add' _ _ := by + simp_rw [mul_add, add_mul] + commutes' r := by + simp_rw [Algebra.algebraMap_eq_smul_one, mul_smul_one, + smul_mul_assoc, mul_invOf_self] + map_mul' _ _ := by + simp_rw [mul_assoc, invOf_mul_cancel_left] + +theorem autInner_apply {R E : Type _} [CommSemiring R] [Semiring E] + [Algebra R E] (x : E) [Invertible x] (y : E) : + (autInner x : E ≃ₐ[R] E) y = x * y * ⅟ x := + rfl + +end Algebra + +private theorem automorphism_matrix_inner''' [DecidableEq n] [Nonempty n] + (f : (M n) ≃ₐ[𝕜] M n) : + ∃ T : (n → 𝕜) ≃ₗ[𝕜] n → 𝕜, + f = + @Algebra.autInner 𝕜 (M n) _ _ _ + (LinearMap.toMatrix' (T : (n → 𝕜) →ₗ[𝕜] n → 𝕜)) + T.toInvertibleMatrix := by + obtain ⟨T, hT⟩ := automorphism_matrix_inner'' f + use T + ext + simp_rw [Algebra.autInner_apply, hT] + rfl + +/-- Any automorphism of a finite matrix algebra is implemented by conjugation. -/ +theorem aut_mat_inner [DecidableEq n] (f : (M n) ≃ₐ[𝕜] M n) : + ∃ T : (n → 𝕜) ≃ₗ[𝕜] n → 𝕜, + f = + @Algebra.autInner 𝕜 (M n) _ _ _ + (LinearMap.toMatrix' (T : (n → 𝕜) →ₗ[𝕜] n → 𝕜)) + T.toInvertibleMatrix := by + rcases em (Nonempty n) with hn | hn + · exact automorphism_matrix_inner''' f + · use 1 + ext _ i _ + simp only [not_nonempty_iff, isEmpty_iff] at hn + exact False.elim (hn i) + +/-- Any automorphism of a finite matrix algebra is conjugation by `GL n 𝕜`. -/ +theorem aut_mat_inner' [DecidableEq n] (f : (M n) ≃ₐ[𝕜] M n) : + ∃ T : GL n 𝕜, + f = @Algebra.autInner 𝕜 (M n) _ _ _ (T : M n) (Units.invertible T) := by + obtain ⟨T, hT⟩ := aut_mat_inner f + let T' : M n := LinearMap.toMatrix' T + have hT' : T' = LinearMap.toMatrix' T := rfl + let Tinv : M n := LinearMap.toMatrix' T.symm + have hTinv : Tinv = LinearMap.toMatrix' T.symm := rfl + refine ⟨⟨T', Tinv, ?_, ?_⟩, by congr⟩ + · simp only [hT', hTinv, ← LinearMap.toMatrix'_mul, + Module.End.mul_eq_comp, LinearEquiv.comp_coe, + LinearEquiv.symm_trans_self, LinearEquiv.refl_toLinearMap, + LinearMap.toMatrix'_id] + · simp only [hT', hTinv, ← LinearMap.toMatrix'_mul, + Module.End.mul_eq_comp, LinearEquiv.comp_coe, + LinearEquiv.self_trans_symm, LinearEquiv.refl_toLinearMap, + LinearMap.toMatrix'_id] + +/-- Automorphisms of finite matrix algebras preserve trace. -/ +theorem aut_mat_inner_trace_preserving [DecidableEq n] + (f : (M n) ≃ₐ[𝕜] M n) (x : M n) : + (f x).trace = x.trace := by + obtain ⟨T, rfl⟩ := aut_mat_inner' f + rw [Algebra.autInner_apply] + calc + (T * x * ⅟ (T : M n)).trace = (⅟ (T : M n) * (T * x)).trace := by + rw [trace_mul_comm] + _ = ((⅟ (T : M n) * T) * x).trace := by + rw [Matrix.mul_assoc] + _ = x.trace := by + rw [invOf_mul_self, Matrix.one_mul] + +alias AlgEquiv.apply_matrix_trace := aut_mat_inner_trace_preserving + +end Matrix + +theorem automorphism_matrix_inner [Field R] [DecidableEq n] [Nonempty n] + (f : (Mₙ n) ≃ₐ[R] Mₙ n) : + ∃ T : Mₙ n, + (∀ a : Mₙ n, f a * T = T * a) ∧ + Function.Bijective (Matrix.toLin' T) := + Matrix.automorphism_matrix_inner f + +theorem automorphism_matrix_inner'' [DecidableEq n] [Nonempty n] + (f : (M n) ≃ₐ[𝕜] M n) : + ∃ T : (n → 𝕜) ≃ₗ[𝕜] n → 𝕜, + ∀ a : M n, + f a = LinearMap.toMatrix' T * a * LinearMap.toMatrix' T.symm := + Matrix.automorphism_matrix_inner'' f + +theorem aut_mat_inner [DecidableEq n] (f : (M n) ≃ₐ[𝕜] M n) : + ∃ T : (n → 𝕜) ≃ₗ[𝕜] n → 𝕜, + f = + @Matrix.Algebra.autInner 𝕜 (M n) _ _ _ + (LinearMap.toMatrix' (T : (n → 𝕜) →ₗ[𝕜] n → 𝕜)) + T.toInvertibleMatrix := + Matrix.aut_mat_inner f + +theorem aut_mat_inner' [DecidableEq n] (f : (M n) ≃ₐ[𝕜] M n) : + ∃ T : GL n 𝕜, + f = @Matrix.Algebra.autInner 𝕜 (M n) _ _ _ (T : M n) (Units.invertible T) := + Matrix.aut_mat_inner' f + +theorem aut_mat_inner_trace_preserving [DecidableEq n] + (f : (M n) ≃ₐ[𝕜] M n) (x : M n) : + (f x).trace = x.trace := + Matrix.aut_mat_inner_trace_preserving f x + +namespace Algebra + +/-- Root-name compatibility wrapper for upstream monlib4 inner automorphisms. -/ +abbrev autInner {R E : Type _} [CommSemiring R] [Semiring E] + [Algebra R E] (x : E) [Invertible x] : E ≃ₐ[R] E := + Matrix.Algebra.autInner x + +theorem autInner_apply {R E : Type _} [CommSemiring R] [Semiring E] + [Algebra R E] (x : E) [Invertible x] (y : E) : + (autInner x : E ≃ₐ[R] E) y = x * y * ⅟ x := + rfl + +theorem autInner_symm_apply {R E : Type _} [CommSemiring R] [Semiring E] + [Algebra R E] (x : E) [Invertible x] (y : E) : + (autInner x : E ≃ₐ[R] E).symm y = ⅟ x * y * x := + rfl + +theorem coe_autInner_eq_rmul_comp_lmul {R E : Type _} [CommSemiring R] + [Semiring E] [Algebra R E] (x : E) [Invertible x] : + (Algebra.autInner x : E ≃ₐ[R] E) = + (_root_.lmul x : E →ₗ[R] E) ∘ (_root_.rmul (⅟ x) : E →ₗ[R] E) := by + ext a + simp only [autInner_apply, _root_.lmul_apply, _root_.rmul_apply, + Function.comp_apply, mul_assoc] + +theorem coe_autInner_symm_eq_rmul_comp_lmul {R E : Type _} [CommSemiring R] + [Semiring E] [Algebra R E] (x : E) [Invertible x] : + (Algebra.autInner x : E ≃ₐ[R] E).symm = + (_root_.lmul (⅟ x) : E →ₗ[R] E) ∘ (_root_.rmul x : E →ₗ[R] E) := by + ext a + simp only [autInner_symm_apply, _root_.lmul_apply, _root_.rmul_apply, + Function.comp_apply, mul_assoc] + +end Algebra + +theorem lmul_comp_rmul_eq_mulLeftRight {R E : Type _} [CommSemiring R] + [NonUnitalSemiring E] [Module R E] [SMulCommClass R E E] [IsScalarTower R E E] + (a b : E) : + (_root_.lmul a : E →ₗ[R] E) ∘ₗ (_root_.rmul b : E →ₗ[R] E) = + LinearMap.mulLeftRight R (a, b) := by + ext _ + simp only [LinearMap.mulLeftRight_apply, _root_.lmul_apply, _root_.rmul_apply, + LinearMap.comp_apply, mul_assoc] + +theorem lmul_comp_rmul_eq_coe_mulLeftRight {R E : Type _} [CommSemiring R] + [NonUnitalSemiring E] [Module R E] [SMulCommClass R E E] [IsScalarTower R E E] + (a b : E) : + (_root_.lmul a : E →ₗ[R] E) ∘ (_root_.rmul b : E →ₗ[R] E) = + LinearMap.mulLeftRight R (a, b) := by + rw [← lmul_comp_rmul_eq_mulLeftRight] + rfl + +namespace Algebra + +theorem autInner_hMul_autInner {R E : Type _} [CommSemiring R] [Semiring E] + [Algebra R E] (x y : E) [hx : Invertible x] [hy : Invertible y] : + (Algebra.autInner x : E ≃ₐ[R] E) * Algebra.autInner y = + @Algebra.autInner _ _ _ _ _ (x * y) (hx.mul hy) := by + ext + simp_rw [AlgEquiv.mul_apply, Algebra.autInner_apply, invOf_mul, mul_assoc] + +end Algebra + +namespace AlgEquiv + +/-- An algebra automorphism is inner if it is conjugation by an invertible element. -/ +def IsInner {R E : Type*} [CommSemiring R] [Semiring E] + [Algebra R E] (f : E ≃ₐ[R] E) : Prop := + ∃ (a : E) (_ : Invertible a), f = Algebra.autInner a + +/-- Product of algebra equivalences, acting componentwise on a product algebra. -/ +@[simps] +def prod_map {K R₁ R₂ R₃ R₄ : Type*} [CommSemiring K] + [Semiring R₁] [Semiring R₂] [Semiring R₃] [Semiring R₄] + [Algebra K R₁] [Algebra K R₂] [Algebra K R₃] [Algebra K R₄] + (f : R₁ ≃ₐ[K] R₂) (g : R₃ ≃ₐ[K] R₄) : + (R₁ × R₃) ≃ₐ[K] (R₂ × R₄) where + toFun := Prod.map f g + invFun := Prod.map f.symm g.symm + left_inv := fun x => by aesop + right_inv := fun x => by aesop + map_add' := fun x y => by aesop + map_mul' := fun x y => by aesop + commutes' := fun r => by aesop + +/-- Dependent-function algebra equivalence induced by pointwise algebra equivalences. -/ +@[simps] +def Pi {K ι : Type*} [CommSemiring K] {R : ι → Type*} + [∀ i, Semiring (R i)] [∀ i, Algebra K (R i)] + (f : Π i, R i ≃ₐ[K] R i) : + (Π i, R i) ≃ₐ[K] (Π i, R i) where + toFun := fun x i => f i (x i) + invFun := fun x i => (f i).symm (x i) + left_inv := fun x => funext fun i => (f i).left_inv (x i) + right_inv := fun x => funext fun i => (f i).right_inv (x i) + map_add' := fun x y => funext fun i => _root_.map_add _ (x i) (y i) + map_mul' := fun x y => funext fun i => _root_.map_mul _ (x i) (y i) + commutes' := fun r => funext fun i => (f i).commutes r + +end AlgEquiv + +/-- Square matrix algebras of finite types are linearly equivalent exactly when +their index types have the same cardinality. -/ +theorem matrix_linearEquiv_iff_fintype_equiv {R n m : Type*} [Ring R] + [StrongRankCondition R] [Finite n] [Finite m] : + Nonempty (Mat R m ≃ₗ[R] Mat R n) ↔ Nonempty (m ≃ n) := by + letI := Fintype.ofFinite n + letI := Fintype.ofFinite m + have rank_from_linear_equiv := + fun (f : Mat R m ≃ₗ[R] Mat R n) => LinearEquiv.finrank_eq f + simp only [Module.finrank_matrix, ← pow_two, Module.finrank_self, mul_one, + zero_le, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, pow_left_inj₀, + Fintype.card_eq] at rank_from_linear_equiv + have linear_equiv_from_equiv : + ∀ (_ : m ≃ n), Nonempty (Mat R m ≃ₗ[R] Mat R n) := fun f => by + refine ⟨?_⟩ + exact + { toFun := fun x i j => x (f.symm i) (f.symm j) + invFun := fun x i j => x (f i) (f j) + left_inv := fun _ => by + simp only [Equiv.symm_apply_apply] + right_inv := fun _ => by + simp only [Equiv.apply_symm_apply] + map_add' := fun _ _ => by + simp [Matrix.add_apply] + rfl + map_smul' := fun _ _ => by + simp only [Matrix.smul_apply, RingHom.id_apply] + rfl } + exact Iff.intro (fun ⟨f⟩ => rank_from_linear_equiv f) + (fun ⟨f⟩ => linear_equiv_from_equiv f) + +theorem LinearEquiv.nonempty_of_equiv {K R S T : Type*} [Ring K] + [StrongRankCondition K] [AddCommGroup R] [Module K R] [Module.Free K R] + [AddCommGroup S] [Module K S] [Module.Free K S] + [AddCommGroup T] [Module K T] [Module.Free K T] + [Module.Finite K R] [Module.Finite K S] [Module.Finite K T] + (h : R ≃ₗ[K] T) : + Nonempty (R ≃ₗ[K] S) ↔ Nonempty (T ≃ₗ[K] S) := by + have : Nonempty _ := ⟨h⟩ + simp only [LinearEquiv.nonempty_equiv_iff_lift_rank_eq, + ← Module.finrank_eq_rank, Cardinal.lift_natCast, Nat.cast_inj] at this ⊢ + rw [this] + +/-- A dependent product of matrix blocks indexed by an ordered block type. -/ +def OrderedPiMat (R k : Type*) (t n : k → Type*) + (h : ∀ i j : k, Nonempty (n i ≃ n j) ↔ i = j) := + let _ := h + Π i : k, Π _ : t i, Mat R (n i) + +instance Prod.invertible_fst {R₁ R₂ : Type*} [Semiring R₁] [Semiring R₂] + {a : R₁ × R₂} [ha : Invertible a] : + Invertible a.1 := by + use (⅟ a).1 + on_goal 1 => have := ha.invOf_mul_self + on_goal 2 => have := ha.mul_invOf_self + all_goals + rw [Prod.mul_def, Prod.mk_eq_one] at this + simp_rw [this] + +instance Prod.invertible_snd {R₁ R₂ : Type*} [Semiring R₁] [Semiring R₂] + {a : R₁ × R₂} [ha : Invertible a] : + Invertible a.2 := by + use (⅟ a).2 + on_goal 1 => have := ha.invOf_mul_self + on_goal 2 => have := ha.mul_invOf_self + all_goals + rw [Prod.mul_def, Prod.mk_eq_one] at this + simp_rw [this] + +instance Prod.invertible {R₁ R₂ : Type*} [Semiring R₁] [Semiring R₂] + {a : R₁} {b : R₂} [ha : Invertible a] [hb : Invertible b] : + Invertible (a, b) := + ⟨(⅟ a, ⅟ b), by simp, by simp⟩ + +instance Pi.invertible_i {ι : Type*} {R : ι → Type*} [∀ i, Semiring (R i)] + {a : ∀ i, R i} [ha : Invertible a] (i : ι) : + Invertible (a i) := by + use (⅟ a) i + on_goal 1 => have := ha.invOf_mul_self + on_goal 2 => have := ha.mul_invOf_self + all_goals + rw [Pi.mul_def, funext_iff] at this + simp_rw [this] + rfl + +instance Pi.invertible {ι : Type*} {R : ι → Type*} [∀ i, Semiring (R i)] + {a : ∀ i, R i} [ha : ∀ i, Invertible (a i)] : + Invertible a := + ⟨fun i => ⅟ (a i), by simp_rw [mul_def, invOf_mul_self]; rfl, + by simp_rw [mul_def, mul_invOf_self]; rfl⟩ + +namespace AlgEquiv + +theorem prod_isInner_iff_prod_map {K R₁ R₂ : Type*} [CommSemiring K] + [Semiring R₁] [Semiring R₂] [Algebra K R₁] [Algebra K R₂] + (f : (R₁ × R₂) ≃ₐ[K] (R₁ × R₂)) : + AlgEquiv.IsInner f ↔ + ∃ (a : R₁) (_ha : Invertible a) (b : R₂) (_hb : Invertible b), + f = AlgEquiv.prod_map (Algebra.autInner a) (Algebra.autInner b) := by + constructor + · rintro ⟨a, _ha, h⟩ + use a.1, by infer_instance, a.2, by infer_instance + exact h + · rintro ⟨a, _ha, b, _hb, h⟩ + use (a, b), by infer_instance + exact h + +theorem pi_isInner_iff_pi_map {K ι : Type*} {R : ι → Type*} [CommSemiring K] + [∀ i, Semiring (R i)] [∀ i, Algebra K (R i)] + (f : (∀ i, R i) ≃ₐ[K] (∀ i, R i)) : + AlgEquiv.IsInner f ↔ + ∃ (a : ∀ i, R i) (_ha : ∀ i, Invertible (a i)), + f = AlgEquiv.Pi (fun i => Algebra.autInner (a i)) := by + constructor <;> + exact fun ⟨a, _ha, h⟩ => ⟨(fun i => a i), by infer_instance, by rw [h]; rfl⟩ + +theorem pi_isInner_iff_pi_map' {K ι : Type*} {n : ι → Type*} [CommSemiring K] + [∀ i, Fintype (n i)] [∀ i, DecidableEq (n i)] + (f : PiMat K ι n ≃ₐ[K] PiMat K ι n) : + AlgEquiv.IsInner f ↔ + ∃ (a : PiMat K ι n) (_ : ∀ i, Invertible (a i)), + f = AlgEquiv.Pi (fun i => Algebra.autInner (a i)) := + AlgEquiv.pi_isInner_iff_pi_map _ + +end AlgEquiv + +/-- A matrix that commutes with every matrix is scalar. -/ +theorem Matrix.commutes_with_all_iff {R n : Type _} [CommSemiring R] [Fintype n] + [DecidableEq n] {x : Matrix n n R} : + (∀ y : Matrix n n R, Commute y x) ↔ ∃ α : R, x = α • 1 := by + simp_rw [Commute, SemiconjBy] + constructor + · intro h + by_cases h' : x = 0 + · exact ⟨0, by rw [h', zero_smul]⟩ + simp_rw [← eq_zero, Classical.not_forall] at h' + obtain ⟨i, _, _⟩ := h' + have : x = diagonal x.diag := by + ext k l + specialize h (single l k 1) + simp_rw [← Matrix.ext_iff, mul_apply, single, of_apply, boole_mul, mul_boole, ite_and, + Finset.sum_ite_irrel, Finset.sum_const_zero, Finset.sum_ite_eq, Finset.mem_univ, + if_true] at h + specialize h k k + simp_rw [diagonal, of_apply, Matrix.diag] + simp_rw [if_true, @eq_comm _ l k] at h + exact h.symm + have this1 : ∀ k l : n, x k k = x l l := by + intro k l + specialize h (single k l 1) + simp_rw [← Matrix.ext_iff, mul_apply, single, of_apply, boole_mul, mul_boole, ite_and, + Finset.sum_ite_irrel, Finset.sum_const_zero, Finset.sum_ite_eq, Finset.mem_univ, + if_true] at h + specialize h k l + simp_rw [if_true] at h + exact h.symm + use x i i + ext k l + simp_rw [Matrix.smul_apply, one_apply, smul_ite, smul_zero, smul_eq_mul, mul_one] + nth_rw 1 [this] + simp_rw [diagonal, diag, of_apply, this1 i k] + · rintro ⟨α, rfl⟩ y + simp_rw [Matrix.smul_mul, Matrix.mul_smul, Matrix.one_mul, Matrix.mul_one] + +lemma Matrix.center {R n : Type*} [CommSemiring R] [Fintype n] [DecidableEq n] : + Set.center (Matrix n n R) = Submodule.span R {(1 : Matrix n n R)} := by + ext x + rw [Semigroup.mem_center_iff] + have := @Matrix.commutes_with_all_iff _ _ _ _ _ x + simp_rw [Commute, SemiconjBy] at this + rw [this] + simp [Submodule.mem_span_singleton, eq_comm] + +lemma Matrix.prod_center {R n m : Type*} [CommSemiring R] [Fintype n] [Fintype m] + [DecidableEq n] [DecidableEq m] : + Set.center (Matrix n n R × Matrix m m R) = + (Submodule.span R {((1 : Matrix n n R), (0 : Matrix m m R)), (0, 1)}) := by + simp_rw [Set.center_prod, Matrix.center] + ext x + simp only [Set.mem_prod, SetLike.mem_coe, Submodule.mem_span_pair, + Submodule.mem_span_singleton, Prod.smul_mk, smul_zero, Prod.mk_add_mk, zero_add, + add_zero] + nth_rw 3 [← Prod.eta x] + simp_rw [Prod.ext_iff, exists_and_left, exists_and_right] + +lemma Matrix.pi_center {R ι : Type*} [CommSemiring R] {n : ι → Type*} + [∀ i, Fintype (n i)] : + Set.center (∀ i : ι, Matrix (n i) (n i) R) = + { x | ∀ i, x i ∈ Set.center (Matrix (n i) (n i) R) } := by + classical + simp_rw [Set.center_pi, Matrix.center] + ext x + simp only [Set.mem_pi, Set.mem_univ, SetLike.mem_coe, forall_true_left] + simp only [Submodule.mem_span_singleton] + rfl + +lemma PiMat.center {R ι : Type*} [CommSemiring R] {n : ι → Type*} + [∀ i, Fintype (n i)] : + Set.center (PiMat R ι n) = + { x | ∀ i, x i ∈ Set.center (Matrix (n i) (n i) R) } := + Matrix.pi_center + +omit [Fintype n] in +private theorem matrix.one_ne_zero {R : Type _} [Semiring R] [One R] [Zero R] + [NeZero (1 : R)] [DecidableEq n] [hn : Nonempty n] : + (1 : Matrix n n R) ≠ 0 := by + simp_rw [ne_eq, ← Matrix.eq_zero, Matrix.one_apply, ite_eq_right_iff, _root_.one_ne_zero, + imp_false, Classical.not_forall, Classical.not_not] + exact ⟨hn.some, hn.some, rfl⟩ + +theorem Matrix.commutes_with_all_iff_of_ne_zero [DecidableEq n] [Nonempty n] + {x : Matrix n n 𝕜} (hx : x ≠ 0) : + (∀ y : Matrix n n 𝕜, Commute y x) ↔ ∃! α : 𝕜ˣ, x = (α : 𝕜) • 1 := by + simp_rw [Matrix.commutes_with_all_iff] + refine ⟨fun h => ?_, fun ⟨α, hα, _⟩ => ⟨α, hα⟩⟩ + obtain ⟨α, hα⟩ := h + have : α ≠ 0 := by + intro this + rw [this, zero_smul] at hα + contradiction + refine ⟨Units.mk0 α this, hα, fun y hy => ?_⟩ + simp only at hy + rw [hα, ← sub_eq_zero, ← sub_smul, smul_eq_zero, sub_eq_zero] at hy + simp_rw [matrix.one_ne_zero, or_false] at hy + simp_rw [Units.mk0, hy, Units.mk_val] + +theorem Algebra.autInner_eq_autInner_iff [DecidableEq n] (x y : Matrix n n 𝕜) + [Invertible x] [Invertible y] : + (Algebra.autInner x : Matrix n n 𝕜 ≃ₐ[𝕜] Matrix n n 𝕜) = Algebra.autInner y ↔ + ∃ α : 𝕜, y = α • x := by + have : + (∃ α : 𝕜, y = α • x) ↔ ∃ α : 𝕜, ⅟ x * y = α • 1 := by + simp_rw [Matrix.invOf_eq_nonsing_inv, Matrix.inv_mul_eq_iff_eq_mul_of_invertible, + Matrix.mul_smul, Matrix.mul_one] + simp_rw [this, AlgEquiv.ext_iff, Algebra.autInner_apply, + ← Matrix.commutes_with_all_iff, Commute, SemiconjBy, Matrix.invOf_eq_nonsing_inv, + ← Matrix.mul_inv_eq_iff_eq_mul_of_invertible, Matrix.mul_assoc, + ← Matrix.inv_mul_eq_iff_eq_mul_of_invertible, Matrix.inv_inv_of_invertible] + +theorem Matrix.one_ne_zero_iff {𝕜 n : Type*} [DecidableEq n] + [Zero 𝕜] [One 𝕜] [NeZero (1 : 𝕜)] : + (1 : Matrix n n 𝕜) ≠ (0 : Matrix n n 𝕜) ↔ Nonempty n := by + simp_rw [ne_eq, ← Matrix.ext_iff, one_apply, zero_apply, not_forall] + constructor + · rintro ⟨x, _, _⟩ + use x + · intro h + obtain ⟨i⟩ := h + use i, i + simp only [↓reduceIte, one_ne_zero, not_false_iff] + +theorem Matrix.one_eq_zero_iff {𝕜 n : Type*} [DecidableEq n] + [Zero 𝕜] [One 𝕜] [NeZero (1 : 𝕜)] : + (1 : Matrix n n 𝕜) = (0 : Matrix n n 𝕜) ↔ IsEmpty n := by + rw [← not_nonempty_iff, ← @one_ne_zero_iff 𝕜 n, not_ne_iff] + +theorem AlgEquiv.matrix_prod_aut {𝕜 n m : Type*} [Field 𝕜] [Fintype n] + [Fintype m] [DecidableEq n] [DecidableEq m] + (f : (Mat 𝕜 n × Mat 𝕜 m) ≃ₐ[𝕜] (Mat 𝕜 n × Mat 𝕜 m)) : + (f (1, 0) = (1, 0) ∧ f (0, 1) = (0, 1)) ∨ + (f (1, 0) = (0, 1) ∧ f (0, 1) = (1, 0)) := by + let e₁ : Mat 𝕜 n × Mat 𝕜 m := (1, 0) + let e₂ : Mat 𝕜 n × Mat 𝕜 m := (0, 1) + have he₁ : e₁ = (1, 0) := rfl + have he₂ : e₂ = (0, 1) := rfl + rw [← he₁, ← he₂] + have h₁ : e₁ + e₂ = 1 := by + rw [he₁, he₂] + simp only [Prod.mk_add_mk, add_zero, zero_add, Prod.mk_eq_one, and_self] + have h₂ : e₁ * e₂ = 0 := by + rw [he₁, he₂] + simp only [Prod.mk_mul_mk, mul_zero, mul_one, Prod.mk_eq_zero, and_self] + have h₃ : e₂ * e₁ = 0 := by + rw [he₁, he₂] + simp only [Prod.mk_mul_mk, mul_one, mul_zero, Prod.mk_eq_zero, and_self] + have h₄ : e₁ * e₁ = e₁ := by + rw [he₁] + simp only [Prod.mk_mul_mk, mul_one, mul_zero] + have h₅ : e₂ * e₂ = e₂ := by + rw [he₂] + simp only [Prod.mk_mul_mk, mul_zero, mul_one] + have h10 : ∀ a : 𝕜, a • e₁ = (a • 1, 0) := by + intro a + simp_rw [e₁, Prod.smul_mk, smul_zero] + have h11 : ∀ a : 𝕜, a • e₂ = (0, a • 1) := by + intro a + simp_rw [e₂, Prod.smul_mk, smul_zero] + have he₁' : + e₁ ∈ + (Submodule.span 𝕜 {((1 : Mat 𝕜 n), (0 : Mat 𝕜 m)), (0, 1)} : + Set _) := by + simp only [SetLike.mem_coe] + simp_rw [Submodule.mem_span_pair, ← he₁, ← he₂, h10, h11, + Prod.mk_add_mk, add_zero] + use 1, 0 + simp only [one_smul, zero_smul, add_zero] + rfl + have he₂' : + e₂ ∈ + (Submodule.span 𝕜 {((1 : Mat 𝕜 n), (0 : Mat 𝕜 m)), (0, 1)} : + Set _) := by + simp only [SetLike.mem_coe] + simp_rw [Submodule.mem_span_pair, ← he₁, ← he₂, h10, h11, + Prod.mk_add_mk, add_zero] + use 0, 1 + simp only [one_smul, zero_smul, zero_add] + rfl + have center_eq : + Set.center (Matrix n n 𝕜 × Matrix m m 𝕜) = + Submodule.span 𝕜 {((1 : Mat 𝕜 n), (0 : Mat 𝕜 m)), (0, 1)} := + Matrix.prod_center + rw [← center_eq] at he₁' he₂' + have H : ∀ x : Mat 𝕜 n × Mat 𝕜 m, + x ∈ Set.center (Mat 𝕜 n × Mat 𝕜 m) ↔ + ∃ a b : 𝕜, a • e₁ + b • e₂ = f x := by + simp_rw [← Submodule.mem_span_pair] + intro x + have this1 : + f x ∈ Submodule.span 𝕜 {e₁, e₂} ↔ + f x ∈ (Submodule.span 𝕜 {e₁, e₂} : Set _) := by + rfl + rw [this1, he₁, he₂, ← center_eq] + exact (MulEquivClass.apply_mem_center_iff f).symm + obtain ⟨α, β, h₆⟩ : + ∃ a b : 𝕜, a • e₁ + b • e₂ = f e₁ := (H e₁).mp he₁' + obtain ⟨γ, ζ, h₇⟩ : + ∃ a b : 𝕜, a • e₁ + b • e₂ = f e₂ := (H e₂).mp he₂' + have h₈ : f (e₁ * e₂) = 0 := by + rw [h₂, _root_.map_zero] + have h₉ : f (e₁ + e₂) = 1 := by + rw [h₁, _root_.map_one] + by_cases Hem : IsEmpty n + · haveI : NeZero (1 : 𝕜) := by infer_instance + rw [← @Matrix.one_eq_zero_iff 𝕜] at Hem + rw [he₁, he₂, Hem] + simp_rw [← Prod.zero_eq_mk, map_zero, true_and, + AlgEquiv.map_eq_zero_iff, eq_comm, and_self] + by_cases Hen : IsEmpty m + · rw [← @Matrix.one_eq_zero_iff 𝕜] at Hen + simp_rw [Hen, ← Prod.zero_eq_mk, map_zero] + simp only [or_self] + · rw [← @Matrix.one_eq_zero_iff 𝕜, eq_comm] at Hen + nth_rw 2 [Prod.eq_iff_fst_eq_snd_eq] + simp only [Prod.fst_zero, Prod.snd_zero, true_and, Hen, or_false] + simp_rw [← Hem, ← Prod.one_eq_mk, _root_.map_one] + · haveI : Nonempty n := not_isEmpty_iff.mp Hem + rw [← @Matrix.one_eq_zero_iff 𝕜] at Hem + simp_rw [_root_.map_mul, ← h₆, ← h₇, add_mul, mul_add, + smul_mul_smul_comm, h₂, h₃, h₄, h₅, smul_zero, add_zero, + zero_add, h10, h11, Prod.mk_add_mk, add_zero, zero_add, + Prod.zero_eq_mk, Prod.ext_iff, smul_eq_zero, mul_eq_zero, Hem, + or_false] at h₈ + rw [_root_.map_add, ← h₆, ← h₇, add_add_add_comm] at h₉ + simp_rw [← add_smul, Prod.one_eq_mk, h10, h11, Prod.mk_add_mk, + add_zero, zero_add, Prod.ext_iff, Matrix.smul_one_eq_one_iff, + not_isEmpty_of_nonempty, or_false] at h₉ + by_cases hα : α ≠ 0 + · simp_rw [hα, false_or] at h₈ + rw [h₈.1, add_zero] at h₉ + rw [h₉.1] at h₆ + rw [h₈.1, zero_smul, zero_add] at h₇ + rcases h₈ with ⟨_, ((h81 | h81) | h82)⟩ + · rw [h81, zero_add] at h₉ + rw [h81, zero_smul, add_zero, one_smul] at h₆ + rw [← h₆, ← h₇] + simp only [true_and, he₁, he₂, Prod.ext_iff, Hem, false_and, + or_false] + simp only [Prod.smul_mk, smul_zero, true_and] + rw [Matrix.smul_one_eq_one_iff] + exact h₉.2 + · simp_rw [h81, add_zero] at h₉ + rw [h81, zero_smul, eq_comm, AlgEquiv.map_eq_zero_iff] at h₇ + simp_rw [h₇, map_zero, AlgEquiv.map_eq_zero_iff, and_true] + rw [h₇, smul_zero, one_smul, add_zero] at h₆ + left + exact h₆.symm + · simp_rw [he₁, he₂, h82, ← Prod.zero_eq_mk, ← h82, + ← Prod.one_eq_mk, _root_.map_one, _root_.map_zero, + Prod.ext_iff, Prod.fst_one, Prod.snd_one, Prod.fst_zero, + Prod.snd_zero, h82, Hem, true_and, true_or] + · rw [not_ne_iff] at hα + rw [hα] at h₈ h₉ h₆ + simp only [true_or, zero_add, true_and] at h₈ h₉ + rw [zero_smul, zero_add] at h₆ + rw [h₉.1, one_smul] at h₇ + have hβ : β ≠ 0 := by + intro hβ + simp_rw [hβ, zero_smul, + @eq_comm _ (0 : Matrix n n 𝕜 × Matrix m m 𝕜), + AlgEquiv.map_eq_zero_iff, he₁, Prod.zero_eq_mk, Prod.ext_iff, + one_ne_zero, false_and] at h₆ + simp_rw [hβ, false_or] at h₈ + rcases h₈ with (h81 | h82) + · rw [h81, add_zero] at h₉ + rw [h81, zero_smul, add_zero] at h₇ + rcases h₉ with ⟨h₉, (h91 | h92)⟩ + · rw [h91, one_smul] at h₆ + right + exact ⟨h₆.symm, h₇.symm⟩ + · rw [← @Matrix.one_eq_zero_iff 𝕜] at h92 + simp_rw [he₁, he₂, h92, ← Prod.zero_eq_mk, ← h92, + ← Prod.one_eq_mk, _root_.map_one, _root_.map_zero, + Prod.ext_iff, Prod.fst_one, Prod.snd_one, Prod.fst_zero, + Prod.snd_zero, h92, Hem, true_and, true_or] + · simp_rw [he₁, he₂, h82, ← Prod.zero_eq_mk, ← h82, + ← Prod.one_eq_mk, _root_.map_one, _root_.map_zero, + Prod.ext_iff, Prod.fst_one, Prod.snd_one, Prod.fst_zero, + Prod.snd_zero, h82, Hem, true_and, true_or] + +theorem Fin.fintwo_of_neZero {i : Fin 2} (hi : i ≠ 0) : i = 1 := by + revert i + rw [Fin.forall_fin_two] + simp only [Fin.isValue, ne_eq, not_true_eq_false, _root_.zero_ne_one, imp_self, + one_ne_zero, not_false_eq_true, and_self] + +/-- Split a nonempty finite dependent product of matrix algebras into its head and tail. -/ +def matrixPiFin_algEquiv_PiFinTwo {𝕜 : Type*} [CommSemiring 𝕜] + {k : ℕ} {n : Fin (k + 1) → Type*} + [∀ i, Fintype (n i)] [∀ i, DecidableEq (n i)] : + (Π i : Fin (k + 1), Mat 𝕜 (n i)) ≃ₐ[𝕜] + (Mat 𝕜 (n ⟨0, Nat.zero_lt_succ k⟩) × + (Π j : Fin k, Mat 𝕜 (n j.succ))) where + toFun x := (x 0, fun j => x j.succ) + invFun x i := if h : i = 0 then by + rw [h] + exact x.1 + else by + rw [← Fin.succ_pred i h] + exact x.2 (Fin.pred i h) + left_inv x := by + refine funext ?h + simp_rw [Fin.forall_fin_succ] + simp only [↓reduceDIte, eq_mpr_eq_cast, cast_eq] + simp only [true_and] + aesop + right_inv _ := by rfl + map_add' _ _ := by rfl + map_mul' _ _ := by rfl + commutes' _ := by rfl + +theorem matrixPiFin_algEquiv_PiFinTwo_apply {𝕜 : Type*} [CommSemiring 𝕜] + {k : ℕ} {n : Fin (k + 1) → Type*} + [∀ i, Fintype (n i)] [∀ i, DecidableEq (n i)] + (x : Π i : Fin (k + 1), Mat 𝕜 (n i)) : + matrixPiFin_algEquiv_PiFinTwo x = (x 0, fun j : Fin k => x j.succ) := + rfl + +theorem matrixPiFin_algEquiv_PiFinTwo_symm_apply {𝕜 : Type*} [CommSemiring 𝕜] + {k : ℕ} {n : Fin (k + 1) → Type*} + [∀ i, Fintype (n i)] [∀ i, DecidableEq (n i)] + (x : Mat 𝕜 (n 0) × (Π j : Fin k, Mat 𝕜 (n j.succ))) (i : Fin (k + 1)) : + matrixPiFin_algEquiv_PiFinTwo.symm x i = + if h : i = 0 then fun a b => x.1 (by rw [← h]; exact a) (by rw [← h]; exact b) + else by + rw [← Fin.succ_pred i h] + exact x.2 (Fin.pred i h) := by + revert i + simp_rw [Fin.forall_fin_succ] + simp only [↓reduceDIte, eq_mpr_eq_cast, cast_eq] + aesop + +/-- Identify a two-term dependent product of matrix algebras with a binary product. -/ +def matrixPiFinTwo_algEquiv_prod {𝕜 : Type*} [CommSemiring 𝕜] + {n : Fin 2 → Type*} [∀ i, Fintype (n i)] [∀ i, DecidableEq (n i)] : + (Π i : Fin 2, Mat 𝕜 (n i)) ≃ₐ[𝕜] + (Mat 𝕜 (n 0) × Mat 𝕜 (n 1)) where + toFun x := (x 0, x 1) + invFun x i := if h : i = 0 then by + rw [h] + exact x.1 + else by + rw [Fin.fintwo_of_neZero h] + exact x.2 + left_inv x := by + refine funext ?h + simp_rw [Fin.forall_fin_two] + simp only [↓reduceDIte, eq_mpr_eq_cast, cast_eq, Fin.isValue, one_ne_zero, and_self] + right_inv x := by ext <;> rfl + map_add' _ _ := by + simp_rw [Prod.add_def] + rfl + map_mul' _ _ := by + simp_rw [Prod.mul_def] + rfl + commutes' _ := by + simp_rw [Algebra.algebraMap_eq_smul_one, Prod.smul_def] + rfl + +@[simp] +theorem matrixPiFinTwo_algEquiv_prod_apply {𝕜 : Type*} [CommSemiring 𝕜] + {n : Fin 2 → Type*} [∀ i, Fintype (n i)] [∀ i, DecidableEq (n i)] + (x : Π i : Fin 2, Mat 𝕜 (n i)) : + matrixPiFinTwo_algEquiv_prod x = (x 0, x 1) := + rfl + +@[simp] +theorem matrixPiFinTwo_algEquiv_prod_symm_apply {𝕜 : Type*} [CommSemiring 𝕜] + {n : Fin 2 → Type*} [∀ i, Fintype (n i)] [∀ i, DecidableEq (n i)] + (x : Mat 𝕜 (n 0) × Mat 𝕜 (n 1)) (i : Fin 2) : + matrixPiFinTwo_algEquiv_prod.symm x i = + if h : i = 0 then fun a b => + x.1 (by rw [← h]; exact a) (by rw [← h]; exact b) + else fun a b => x.2 (by rw [← Fin.fintwo_of_neZero h]; exact a) + (by rw [← Fin.fintwo_of_neZero h]; exact b) := by + revert i + simp_rw [Fin.forall_fin_two] + simp only [↓reduceDIte, eq_mpr_eq_cast, cast_eq] + aesop + +theorem matrixPiFinTwo_algAut_apply_piSingle {𝕜 : Type*} [Field 𝕜] + {n : Fin 2 → Type*} [∀ i, Fintype (n i)] [∀ i, DecidableEq (n i)] + (f : (Π i : Fin 2, Mat 𝕜 (n i)) ≃ₐ[𝕜] + (Π i : Fin 2, Mat 𝕜 (n i))) : + ∃ σ : Equiv.Perm (Fin 2), + ∀ i, f (Pi.single (σ i) 1) = Pi.single i 1 := by + let f' := matrixPiFinTwo_algEquiv_prod.symm.trans + (f.trans matrixPiFinTwo_algEquiv_prod) + have this1 : + matrixPiFinTwo_algEquiv_prod.symm + ((1 : Matrix (n 0) (n 0) 𝕜), (0 : Matrix (n 1) (n 1) 𝕜)) = + Pi.single 0 1 := by + refine funext ?h + rw [Fin.forall_fin_two, matrixPiFinTwo_algEquiv_prod_symm_apply] + simp only [Fin.isValue] + simp only [↓reduceDIte, Pi.single_eq_same, + matrixPiFinTwo_algEquiv_prod_symm_apply, Fin.isValue, one_ne_zero, + ne_eq, not_false_eq_true, Pi.single_eq_of_ne] + trivial + have this2 : + matrixPiFinTwo_algEquiv_prod.symm + ((0 : Matrix (n 0) (n 0) 𝕜), (1 : Matrix (n 1) (n 1) 𝕜)) = + Pi.single 1 1 := by + refine funext ?_ + rw [Fin.forall_fin_two, matrixPiFinTwo_algEquiv_prod_symm_apply] + simp only [Fin.isValue] + simp only [↓reduceDIte, Pi.single_eq_same, + matrixPiFinTwo_algEquiv_prod_symm_apply, Fin.isValue, one_ne_zero] + trivial + obtain (⟨h1, h2⟩ | ⟨h1, h2⟩) := f'.matrix_prod_aut + · simp_rw [f', AlgEquiv.trans_apply, this1, this2, @eq_comm _ _] at h1 h2 + rw [AlgEquiv.eq_apply_iff_symm_eq, this1] at h1 + rw [AlgEquiv.eq_apply_iff_symm_eq, this2] at h2 + use 1 + rw [Fin.forall_fin_two] + exact ⟨h1.symm, h2.symm⟩ + · simp_rw [f', AlgEquiv.trans_apply, this1, this2, eq_comm] at h1 h2 + rw [AlgEquiv.eq_apply_iff_symm_eq, this2] at h1 + rw [AlgEquiv.eq_apply_iff_symm_eq, this1] at h2 + use Equiv.swap 0 1 + rw [Fin.forall_fin_two] + constructor + · simpa [Equiv.swap_apply_def] using h2.symm + · simpa [Equiv.swap_apply_def] using h1.symm + +theorem Algebra.prod_one_zero_mul {R₁ R₂ : Type*} [Semiring R₁] + [Semiring R₂] (a : R₁ × R₂) : + (1, 0) * a = (a.1, 0) := by + simp_rw [Prod.mul_def, one_mul, zero_mul] + +theorem Algebra.prod_zero_one_mul {R₁ R₂ : Type*} [Semiring R₁] + [Semiring R₂] (a : R₁ × R₂) : + (0, 1) * a = (0, a.2) := by + simp_rw [Prod.mul_def, zero_mul, one_mul] + +namespace AlgEquiv + +/-- Extract the first component of a product algebra equivalence that fixes +`(1, 0)`. -/ +def of_prod_map₁₁ {K R₁ R₂ R₃ R₄ : Type*} [CommSemiring K] + [Semiring R₁] [Semiring R₂] [Semiring R₃] [Semiring R₄] + [Algebra K R₁] [Algebra K R₂] [Algebra K R₃] [Algebra K R₄] + (f : (R₁ × R₂) ≃ₐ[K] (R₃ × R₄)) + (hf : f (1, 0) = (1, 0)) : + R₁ ≃ₐ[K] R₃ where + toFun a := (f (a, 0)).1 + invFun a := (f.symm (a, 0)).1 + left_inv a := by + have hf_symm : (1, 0) = f.symm (1, 0) := by + rw [← hf] + simp only [symm_apply_apply] + have : ((f.symm ((f (a, 0)).1, 0)).1, 0) = (a, 0) := by + rw [← Algebra.prod_one_zero_mul, _root_.map_mul, ← hf_symm, + f.symm_apply_apply, Algebra.prod_one_zero_mul] + simp_rw [Prod.ext_iff, and_true] at this + exact this + right_inv a := by + have : ((f ((f.symm (a, 0)).1, 0)).1, 0) = (a, 0) := by + rw [← Algebra.prod_one_zero_mul, _root_.map_mul, hf, + f.apply_symm_apply, Algebra.prod_one_zero_mul] + simp_rw [Prod.ext_iff, and_true] at this + exact this + map_add' a b := by + nth_rw 1 [← add_zero (0 : _)] + simp_rw [← Prod.mk_add_mk, _root_.map_add] + rfl + map_mul' a b := by + nth_rw 1 [← zero_mul (0 : _)] + simp_rw [← Prod.mk_mul_mk, _root_.map_mul] + rfl + commutes' r := by + simp_rw [Algebra.algebraMap_eq_smul_one] + nth_rw 1 [← smul_zero r] + rw [← Prod.smul_mk, _root_.map_smul, Prod.smul_fst, hf] + +/-- Extract the second component of a product algebra equivalence that fixes +`(0, 1)`. -/ +def of_prod_map₂₂ {K R₁ R₂ R₃ R₄ : Type*} [CommSemiring K] + [Semiring R₁] [Semiring R₂] [Semiring R₃] [Semiring R₄] + [Algebra K R₁] [Algebra K R₂] [Algebra K R₃] [Algebra K R₄] + (f : (R₁ × R₂) ≃ₐ[K] (R₃ × R₄)) + (hf : f (0, 1) = (0, 1)) : + R₂ ≃ₐ[K] R₄ where + toFun a := (f (0, a)).2 + invFun a := (f.symm (0, a)).2 + left_inv a := by + have hf_symm : (0, 1) = f.symm (0, 1) := by + rw [← hf] + simp only [symm_apply_apply] + have : (0, (f.symm (0, (f (0, a)).2)).2) = (0, a) := by + rw [← Algebra.prod_zero_one_mul, _root_.map_mul, ← hf_symm, + f.symm_apply_apply, Algebra.prod_zero_one_mul] + simp_rw [Prod.ext_iff, true_and] at this + exact this + right_inv a := by + have : (0, (f (0, (f.symm (0, a)).2)).2) = (0, a) := by + rw [← Algebra.prod_zero_one_mul, _root_.map_mul, hf, + f.apply_symm_apply, Algebra.prod_zero_one_mul] + simp_rw [Prod.ext_iff, true_and] at this + exact this + map_add' a b := by + nth_rw 1 [← add_zero (0 : _)] + simp_rw [← Prod.mk_add_mk, _root_.map_add] + rfl + map_mul' a b := by + nth_rw 1 [← zero_mul (0 : _)] + simp_rw [← Prod.mk_mul_mk, _root_.map_mul] + rfl + commutes' r := by + simp_rw [Algebra.algebraMap_eq_smul_one] + nth_rw 1 [← smul_zero r] + rw [← Prod.smul_mk, _root_.map_smul, Prod.smul_snd, hf] + +/-- Extract the off-diagonal component of a product algebra equivalence that +sends `(1, 0)` to `(0, 1)`. -/ +def of_prod_map₁₂ {K R₁ R₂ R₃ R₄ : Type*} [CommSemiring K] + [Semiring R₁] [Semiring R₂] [Semiring R₃] [Semiring R₄] + [Algebra K R₁] [Algebra K R₂] [Algebra K R₃] [Algebra K R₄] + (f : (R₁ × R₂) ≃ₐ[K] (R₃ × R₄)) + (hf : f (1, 0) = (0, 1)) : + R₁ ≃ₐ[K] R₄ where + toFun a := (f (a, 0)).2 + invFun a := (f.symm (0, a)).1 + left_inv a := by + have : ((f.symm (0, (f (a, 0)).2)).1, 0) = (a, 0) := by + rw [← Algebra.prod_zero_one_mul, _root_.map_mul, ← hf, + f.symm_apply_apply, Algebra.prod_one_zero_mul, f.symm_apply_apply] + simp_rw [Prod.ext_iff, and_true] at this + exact this + right_inv a := by + have : (0, (f ((f.symm (0, a)).1, 0)).2) = (0, a) := by + rw [← Algebra.prod_one_zero_mul, _root_.map_mul, hf, + f.apply_symm_apply, Algebra.prod_zero_one_mul] + simp_rw [Prod.ext_iff, true_and] at this + exact this + map_add' a b := by + nth_rw 1 [← add_zero (0 : _)] + simp_rw [← Prod.mk_add_mk, _root_.map_add] + rfl + map_mul' a b := by + nth_rw 1 [← zero_mul (0 : _)] + simp_rw [← Prod.mk_mul_mk, _root_.map_mul] + rfl + commutes' r := by + simp_rw [Algebra.algebraMap_eq_smul_one] + nth_rw 1 [← smul_zero r] + rw [← Prod.smul_mk, _root_.map_smul, Prod.smul_snd, hf] + +/-- Extract the off-diagonal component of a product algebra equivalence that +sends `(0, 1)` to `(1, 0)`. -/ +def of_prod_map₂₁ {K R₁ R₂ R₃ R₄ : Type*} [CommSemiring K] + [Semiring R₁] [Semiring R₂] [Semiring R₃] [Semiring R₄] + [Algebra K R₁] [Algebra K R₂] [Algebra K R₃] [Algebra K R₄] + (f : (R₁ × R₂) ≃ₐ[K] (R₃ × R₄)) + (hf : f (0, 1) = (1, 0)) : + R₂ ≃ₐ[K] R₃ where + toFun a := (f (0, a)).1 + invFun a := (f.symm (a, 0)).2 + left_inv a := by + have : (0, (f.symm ((f (0, a)).1, 0)).2) = (0, a) := by + rw [← Algebra.prod_one_zero_mul, _root_.map_mul, ← hf, + f.symm_apply_apply, Algebra.prod_zero_one_mul, f.symm_apply_apply] + simp_rw [Prod.ext_iff, true_and] at this + exact this + right_inv a := by + have : ((f (0, (f.symm (a, 0)).2)).1, 0) = (a, 0) := by + rw [← Algebra.prod_zero_one_mul, _root_.map_mul, hf, + f.apply_symm_apply, Algebra.prod_one_zero_mul] + simp_rw [Prod.ext_iff, and_true] at this + exact this + map_add' a b := by + nth_rw 1 [← add_zero (0 : _)] + simp_rw [← Prod.mk_add_mk, _root_.map_add] + rfl + map_mul' a b := by + nth_rw 1 [← zero_mul (0 : _)] + simp_rw [← Prod.mk_mul_mk, _root_.map_mul] + rfl + commutes' r := by + simp_rw [Algebra.algebraMap_eq_smul_one] + nth_rw 1 [← smul_zero r] + rw [← Prod.smul_mk, _root_.map_smul, Prod.smul_fst, hf] + +end AlgEquiv + +theorem AlgEquiv.matrix_prod_aut' {𝕜 n m : Type*} [Field 𝕜] [Fintype n] + [Fintype m] [DecidableEq n] [DecidableEq m] + (f : (Matrix n n 𝕜 × Matrix m m 𝕜) ≃ₐ[𝕜] + (Matrix n n 𝕜 × Matrix m m 𝕜)) : + (∃ (f₁ : Matrix n n 𝕜 ≃ₐ[𝕜] Matrix n n 𝕜) + (f₂ : Matrix m m 𝕜 ≃ₐ[𝕜] Matrix m m 𝕜), + f = AlgEquiv.prod_map f₁ f₂) + ∨ + (∃ (g₁ : Matrix m m 𝕜 ≃ₐ[𝕜] Matrix n n 𝕜) + (g₂ : Matrix n n 𝕜 ≃ₐ[𝕜] Matrix m m 𝕜), + f = g₁.prod_map g₂ ∘ Prod.swap) := by + rcases AlgEquiv.matrix_prod_aut f with (h | h) + · left + let f₁ : Matrix n n 𝕜 ≃ₐ[𝕜] Matrix n n 𝕜 := + AlgEquiv.of_prod_map₁₁ f h.1 + let f₂ : Matrix m m 𝕜 ≃ₐ[𝕜] Matrix m m 𝕜 := + AlgEquiv.of_prod_map₂₂ f h.2 + use f₁, f₂ + ext1 x + simp_rw [AlgEquiv.prod_map_apply, Prod.map_apply'] + calc + f x = f (x.1, 0) + f (0, x.2) := by + rw [← map_add, Prod.fst_add_snd] + _ = f ((1, 0) * (x.1, 0)) + f ((0, 1) * (0, x.2)) := by + rw [Prod.mul_def] + simp only [one_mul, mul_zero, Prod.mk_mul_mk] + _ = (1, 0) * f (x.1, 0) + (0, 1) * f (0, x.2) := by + simp_rw [_root_.map_mul, h] + _ = ((f (x.1, 0)).1, 0) + (0, (f (0, x.2)).2) := by + simp_rw [Prod.mul_def, zero_mul, one_mul] + _ = (f₁ x.1, 0) + (0, f₂ x.2) := rfl + _ = (f₁ x.1, f₂ x.2) := by + simp only [Prod.mk_add_mk, add_zero, zero_add] + · right + let g₁ : Matrix n n 𝕜 ≃ₐ[𝕜] Matrix m m 𝕜 := + AlgEquiv.of_prod_map₁₂ f h.1 + let g₂ : Matrix m m 𝕜 ≃ₐ[𝕜] Matrix n n 𝕜 := + AlgEquiv.of_prod_map₂₁ f h.2 + use g₂, g₁ + ext1 x + simp_rw [Function.comp_apply, Prod.swap, AlgEquiv.prod_map_apply, + Prod.map_apply] + calc + f x = f (0, x.2) + f (x.1, 0) := by + rw [← map_add, add_comm, Prod.fst_add_snd] + _ = f ((0, 1) * (0, x.2)) + f ((1, 0) * (x.1, 0)) := by + rw [Prod.mul_def] + simp only [one_mul, mul_zero, Prod.mk_mul_mk] + _ = (1, 0) * f (0, x.2) + (0, 1) * f (x.1, 0) := by + simp_rw [_root_.map_mul, h] + _ = ((f (0, x.2)).1, 0) + (0, (f (x.1, 0)).2) := by + simp only [Prod.mk_add_mk, add_zero, zero_add, Prod.mul_def, + zero_mul, one_mul] + _ = (g₂ x.2, 0) + (0, g₁ x.1) := rfl + _ = (g₂ x.2, g₁ x.1) := by + simp_rw [Prod.mk_add_mk, add_zero, zero_add] + +theorem AlgEquiv.matrix_fintype_card_eq_of {𝕜 n m : Type*} [Field 𝕜] + [Fintype n] [Fintype m] [DecidableEq n] [DecidableEq m] + {f : (Matrix n n 𝕜 × Matrix m m 𝕜) ≃ₐ[𝕜] + (Matrix n n 𝕜 × Matrix m m 𝕜)} + (hf : f (0, 1) = (1, 0)) : + Fintype.card n = Fintype.card m := by + let f' := AlgEquiv.of_prod_map₂₁ f hf + have := LinearEquiv.finrank_eq f'.toLinearEquiv + simp only [Module.finrank_matrix, ← pow_two, Module.finrank_self, mul_one, + zero_le, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, pow_left_inj₀] at this + exact this.symm diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index d49bb6d304..c303266d54 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -1611,3 +1611,61 @@ projects: msc: - "60B20" - "60E05" + - slug: monlib4 + title: Monlib4 Operator-Algebra and Quantum-Set Core + summary: Formalizes monlib4's finite matrix-algebra inner-automorphism theorem, unitary inner automorphisms, star-preserving linear maps, the structural core of quantum sets, the core Schur-product definition of quantum graphs, and a self-contained digit-sum divisibility theorem. + branch: operator algebras and quantum graph theory + entry_module: LeanPool.Monlib4 + authors: + - Monica Omar + source: + doi: 10.4169/amer.math.monthly.124.10.966 + github_repo: themathqueen/monlib4 + status: verified + main_declarations: + - Matrix.aut_mat_inner + - QuantumSet + - schurMul + - QuantumGraph + main_results: + - declaration: Matrix.automorphism_matrix_inner + informal: Shows that any automorphism of a finite nontrivial matrix algebra is implemented by an invertible intertwining matrix. + - declaration: Matrix.aut_mat_inner + informal: Packages matrix-algebra automorphisms as inner automorphisms induced by a linear equivalence of the underlying coordinate space. + - declaration: Matrix.aut_mat_inner' + informal: Packages matrix-algebra automorphisms as conjugation by an element of `GL n 𝕜`. + - declaration: Matrix.aut_mat_inner_trace_preserving + informal: Proves that automorphisms of finite matrix algebras preserve trace. + - declaration: Matrix.innerAut + informal: Defines the linear map induced by conjugation with a unitary matrix. + - declaration: Matrix.innerAut_apply_trace_eq + informal: Proves that unitary inner automorphisms preserve matrix trace. + - declaration: Matrix.innerAut.spectrum_eq + informal: Proves that unitary inner automorphisms preserve the spectrum of the associated linear operator. + - declaration: LinearMap.IsReal + informal: Defines star-preserving, or real, function-like maps. + - declaration: LinearMap.real + informal: Defines the star-conjugate involution on linear maps. + - declaration: QuantumSet + informal: Defines the monlib4 quantum-set structure with modular automorphisms and a fixed orthonormal basis. + - declaration: Complex.quantumSet + informal: Instantiates the complex numbers as the base quantum set. + - declaration: schurMul + informal: Defines the Schur product of linear maps using multiplication, tensoring, and coalgebra comultiplication. + - declaration: QuantumGraph + informal: Defines quantum graphs as Schur-idempotent endomorphisms. + - declaration: QuantumGraph.Real + informal: Defines real quantum graphs as Schur-idempotent, star-preserving endomorphisms. + - declaration: nat_repr_mod_eq_sum_repr_mod + informal: Proves that the value represented by digits in base `a + 1` has the same remainder modulo `a` as the sum of those digits. + - declaration: nat_dvd_repr_iff_nat_dvd_sum_repr + informal: Proves the generalized digit-sum divisibility criterion for base `a + 1` modulo `a`. + tags: + - linear-algebra + - operator-algebras + - quantum-sets + - quantum-graphs + - representation-theory + msc: + - "15A69" + - "16W20"